commit f2fc9af70ed8960a04dee876ff2610935820125f Author: CGH0S7 <776459475@qq.com> Date: Tue Jan 13 15:01:15 2026 +0800 asc26 amss-ncku initialized diff --git a/AMSS-NCKU-Python Debug in Ubuntu2204.pdf b/AMSS-NCKU-Python Debug in Ubuntu2204.pdf new file mode 100644 index 0000000..79385e2 Binary files /dev/null and b/AMSS-NCKU-Python Debug in Ubuntu2204.pdf differ diff --git a/AMSS_NCKU_Input.py b/AMSS_NCKU_Input.py new file mode 100755 index 0000000..fe25a50 --- /dev/null +++ b/AMSS_NCKU_Input.py @@ -0,0 +1,232 @@ + +################################################# +## +## This file provides the input parameters required for numerical relativity. +## XIAOQU +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy + +################################################# + +## Setting MPI processes and the output file directory + +File_directory = "GW150914" ## output file directory +Output_directory = "binary_output" ## binary data file directory + ## The file directory name should not be too long +MPI_processes = 64 ## number of mpi processes used in the simulation + +GPU_Calculation = "no" ## Use GPU or not + ## (prefer "no" in the current version, because the GPU part may have bugs when integrated in this Python interface) +CPU_Part = 1.0 +GPU_Part = 0.0 + +################################################# + + +################################################# + +## Setting the physical system and numerical method + +Symmetry = "equatorial-symmetry" ## Symmetry of System: choose equatorial-symmetry、no-symmetry、octant-symmetry +Equation_Class = "BSSN" ## Evolution Equation: choose "BSSN", "BSSN-EScalar", "BSSN-EM", "Z4C" + ## If "BSSN-EScalar" is chosen, it is necessary to set other parameters below +Initial_Data_Method = "Ansorg-TwoPuncture" ## initial data method: choose "Ansorg-TwoPuncture", "Lousto-Analytical", "Cao-Analytical", "KerrSchild-Analytical" +Time_Evolution_Method = "runge-kutta-45" ## time evolution method: choose "runge-kutta-45" +Finite_Diffenence_Method = "4th-order" ## finite-difference method: choose "2nd-order", "4th-order", "6th-order", "8th-order" + +################################################# + + +################################################# + +## Setting the time evolutionary information + +Start_Evolution_Time = 0.0 ## start evolution time t0 +Final_Evolution_Time = 1000.0 ## final evolution time t1 +Check_Time = 100.0 +Dump_Time = 100.0 ## time inteval dT for dumping binary data +D2_Dump_Time = 100.0 ## dump the ascii data for 2d surface after dT' +Analysis_Time = 0.1 ## dump the puncture position and GW psi4 after dT" +Evolution_Step_Number = 10000000 ## stop the calculation after the maximal step number +Courant_Factor = 0.5 ## Courant Factor +Dissipation = 0.15 ## Kreiss-Oliger Dissipation Strength + +################################################# + + +################################################# + +## Setting the grid structure + +basic_grid_set = "Patch" ## grid structure: choose "Patch" or "Shell-Patch" +grid_center_set = "Cell" ## grid center: chose "Cell" or "Vertex" + +grid_level = 9 ## total number of AMR grid levels +static_grid_level = 5 ## number of AMR static grid levels +moving_grid_level = grid_level - static_grid_level ## number of AMR moving grid levels + +analysis_level = 0 +refinement_level = 3 ## time refinement start from this grid level + +largest_box_xyz_max = [320.0, 320.0, 320.0] ## scale of the largest box + ## not ne cess ary to be cubic for "Patch" grid s tructure + ## need to be a cubic box for "Shell-Patch" grid structure +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) + +static_grid_number = 96 ## grid points of each static AMR grid (in x direction) + ## (grid points in y and z directions are automatically adjusted) +moving_grid_number = 48 ## grid points of each moving AMR grid +shell_grid_number = [32, 32, 100] ## grid points of Shell-Patch grid + ## in (phi, theta, r) direction +devide_factor = 2.0 ## resolution between different grid levels dh0/dh1, only support 2.0 now + + +static_grid_type = 'Linear' ## AMR static grid structure , only supports "Linear" +moving_grid_type = 'Linear' ## AMR moving grid structure , only supports "Linear" + +quarter_sphere_number = 96 ## grid number of 1/4 s pher ical surface + ## (which is needed for evaluating the spherical surface integral) + +################################################# + + +################################################# + +## Setting the puncture information + +puncture_number = 2 + +position_BH = numpy.zeros( (puncture_number, 3) ) +parameter_BH = numpy.zeros( (puncture_number, 3) ) +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) +momentum_BH = numpy.zeros( (puncture_number, 3) ) + +puncture_data_set = "Manually" ## Method to give Puncture’s positions and momentum + ## choose "Manually" or "Automatically-BBH" + ## Prefer to choose "Manually", because "Automatically-BBH" is developing now + +## initial orbital distance and ellipticity for BBHs system +## ( needed for "Automatically-BBH" case , not affect the "Manually" case ) +Distance = 10.0 +e0 = 0.0 + +## black hole parameter (M Q* a*) +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.0, +0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.0, -0.46 ] +## dimensionless spin in each direction +dimensionless_spin_BH[0] = [ 0.0, 0.0, +0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## If puncture_data_set is chosen to be "Manually", it is necessary to set the position and momentum of each puncture manually + +## initial position for each puncture +position_BH[0] = [ 0.0, 10.0*29.0/(36.0+29.0), 0.0 ] +position_BH[1] = [ 0.0, -10.0*36.0/(36.0+29.0), 0.0 ] + +## initial mumentum for each puncture +## (needed for "Manually" case, does not affect the "Automatically-BBH" case) +momentum_BH[0] = [ -0.09530152296974252, -0.00084541526517121, 0.0 ] +momentum_BH[1] = [ +0.09530152296974252, +0.00084541526517121, 0.0 ] + + +################################################# + + +################################################# + +## Setting the gravitational wave information + +GW_L_max = 4 ## maximal L number in gravitational wave +GW_M_max = 4 ## maximal M number in gravitational wave +Detector_Number = 12 ## number of dector +Detector_Rmin = 50.0 ## nearest dector distance +Detector_Rmax = 160.0 ## farest dector distance + +################################################# + + +################################################# + +## Setting the apprent horizon + +AHF_Find = "no" ## whether to find the apparent horizon: choose "yes" or "no" + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## Other parameters (testing) +## Only influence the Equation_Class = "BSSN-EScalar" case + +FR_a2 = 3.0 ## f(R) = R + a2 * R^2 +FR_l2 = 10000.0 +FR_phi0 = 0.00005 +FR_r0 = 120.0 +FR_sigma0 = 8.0 +FR_Choice = 2 ## Choice options: 1 2 3 4 5 + ## 1: phi(r) = phi0 * Exp(-(r-r0)**2/sigma0) + ## V(r) = 0 + ## 2: phi(r) = phi0 * a2^2/(1+a2^2) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 3: Schrodinger-Newton gived by system phi(r) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 4: phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma0) - tanh((r-r0)/sigma0) ) + ## V(r) = 0 + ## f(R) = R + a2*R^2 with a2 = +oo + ## 5: phi(r) = phi0 * Exp(-(r-r0)**2/sigma) + ## V(r) = 0 + +################################################# + + +################################################# + +## Other parameters (testing) +## (please do not change if not necessary) + +boundary_choice = "BAM-choice" ## Sommerfeld boundary condition : choose "BAM-choice" or "Shibata-choice" + ## prefer "BAM-choice" + +gauge_choice = 0 ## gauge choice + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## prefer 0 or 1 + +tetrad_type = 2 ## tetradtype + ## v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## this version recommend set to 2 + ## prefer 2 + +################################################# + diff --git a/AMSS_NCKU_Program.py b/AMSS_NCKU_Program.py new file mode 100755 index 0000000..46d15f1 --- /dev/null +++ b/AMSS_NCKU_Program.py @@ -0,0 +1,464 @@ + +################################################################## +## +## AMSS-NCKU Numerical Relativity Startup Program +## Author: Xiaoqu +## 2024/03/19 +## Modified: 2025/12/09 +## +################################################################## + + +################################################################## + +## Print program introduction + +import print_information + +print_information.print_program_introduction() + +################################################################## + +### Pre-run prompts +# +#print( " Simulation will be started, please confirm you have set the correct parameters in the script file " ) +#print( " AMSS_NCKU_Input.py " ) +#print( " If parameters have been set correctly, press Enter to continue !!! " ) +#print( " If you have not set parameters, press Ctrl+C to abort the simulation and adjust the parameters " ) +#print( " in script file AMSS_NCKU_Input.py !!! " ) +# +### Wait for user input (press Enter) to proceed +#inputvalue = input() +#print() + + +################################################################## + +import AMSS_NCKU_Input as input_data + +################################################################## + +## Create directories to store program run data + +import os +import shutil +import sys +import time + +## Set the output directory according to the input file +File_directory = os.path.join(input_data.File_directory) + +## If the specified output directory exists, ask the user whether to continue +if os.path.exists(File_directory): + print( " Output dictionary has been existed !!! " ) + print( " If you want to overwrite the existing file directory, please input 'continue' in the terminal !! " ) + print( " If you want to retain the existing file directory, please input 'stop' in the terminal to stop the " ) + print( " simulation. Then you can reset the output dictionary in the input script file AMSS_NCKU_Input.py !!! " ) + print( ) + ## Prompt whether to overwrite the existing directory + while True: + try: + inputvalue = input() + ## If the user agrees to overwrite, proceed and remove the existing directory + if ( inputvalue == "continue" ): + print( " Continue the calculation !!! " ) + print( ) + break + ## If the user chooses not to overwrite, exit and keep the existing directory + elif ( inputvalue == "stop" ): + print( " Stop the calculation !!! " ) + sys.exit() + ## If the user input is invalid, prompt again + else: + print( " Please input your choice !!! " ) + print( " Input 'continue' or 'stop' in the terminal !!! " ) + except ValueError: + print( " Please input your choice !!! " ) + print( " Input 'continue' or 'stop' in the terminal !!! " ) + +## Remove the existing output directory if present +shutil.rmtree(File_directory, ignore_errors=True) + +## Create the output directory +os.mkdir(File_directory) + +## Copy the Python input file into the run directory +shutil.copy("AMSS_NCKU_Input.py", File_directory) + +# Generate subdirectories to store various output files + +output_directory = os.path.join(File_directory, "AMSS_NCKU_output") +os.mkdir(output_directory) + +binary_results_directory = os.path.join(output_directory, input_data.Output_directory) +os.mkdir(binary_results_directory) + +figure_directory = os.path.join(File_directory, "figure") +os.mkdir(figure_directory) + +print( " Output directory has been generated " ) +print( ) + + +################################################################## + +## Output related parameter information + +import setup + +## Print and save input parameter information +setup.print_input_data( File_directory ) +setup.generate_AMSSNCKU_input() + +#print( ) +#print( " Please check whether the grid boxes and their resolution are appropriate " ) +#print( " If the grid boxes and their resolution are not set properly, press Ctrl+C to abort. " ) +#print( " Adjust the grid levels and the number of grid points per level before retrying. " ) +#print( " If the grid boxes and resolution are correct, press Enter to continue. " ) +#inputvalue = input() ## Wait for user input (press Enter) to proceed +#print() + +setup.print_puncture_information() + + +################################################################## + +## Generate AMSS-NCKU program input files based on the configured parameters + +print( ) +print( " Generating the AMSS-NCKU input parfile for the ABE executable. " ) +print( ) + +## Generate cgh-related input files from the grid information + +import numerical_grid + +numerical_grid.append_AMSSNCKU_cgh_input() + +print( ) +print( " The input parfile for AMSS-NCKU C++ executable file ABE has been generated. " ) +print( " However, the input relevant to TwoPuncture need to be appended later. " ) +print( ) + + +################################################################## + +## Plot the initial grid configuration + +print( ) +print( " Schematically plot the numerical grid structure. " ) +print( ) + +numerical_grid.plot_initial_grid() + + +################################################################## + +## Generate AMSS-NCKU macro files according to the numerical scheme and parameters + +print( ) +print( " Automatically generating the macro file for AMSS-NCKU C++ executable file ABE " ) +print( " (Based on the finite-difference numerical scheme) " ) +print( ) + +import generate_macrodef + +generate_macrodef.generate_macrodef_h() +print( " AMSS-NCKU macro file macrodef.h has been generated. " ) + +generate_macrodef.generate_macrodef_fh() +print( " AMSS-NCKU macro file macrodef.fh has been generated. " ) + + +################################################################## + +# Compile the AMSS-NCKU program according to user requirements + +# Prompt about compiling and running AMSS-NCKU +print( ) +print( " Preparing to compile and run the AMSS-NCKU code as requested " ) +print( " Compiling the AMSS-NCKU code based on the generated macro files " ) +print( ) +#inputvalue = input() +#print() + +AMSS_NCKU_source_path = "AMSS_NCKU_source" +AMSS_NCKU_source_copy = os.path.join(File_directory, "AMSS_NCKU_source_copy") + +############################### + +## If AMSS_NCKU source folder is missing, create it and prompt the user + +# if not os.path.exists(destination_folder): +# os.makedirs(destination_folder) + +if not os.path.exists(AMSS_NCKU_source_path): + os.makedirs(AMSS_NCKU_source_path) + print( " The AMSS-NCKU source files are incomplete; copy all source files into ./AMSS_NCKU_source. " ) + print( " Press Enter to continue. " ) + ## Wait for user input (press Enter) to proceed + inputvalue = input() + +############################### + +# Copy AMSS-NCKU source files to prepare for compilation +shutil.copytree(AMSS_NCKU_source_path, AMSS_NCKU_source_copy) + +# (Comment) Example: copy the src folder to destination +# shutil.copytree(src, dst) + +# Copy the generated macro files into the AMSS_NCKU source folder + +macrodef_h_path = os.path.join(File_directory, "macrodef.h") +macrodef_fh_path = os.path.join(File_directory, "macrodef.fh") + +shutil.copy2(macrodef_h_path, AMSS_NCKU_source_copy) +shutil.copy2(macrodef_fh_path, AMSS_NCKU_source_copy) + +# Notes on copying files: +# shutil.copy2 preserves file metadata such as modification time. +# If you only want to copy file contents without metadata, use shutil.copy. + +############################### + +# Compile related programs + +import makefile_and_run + +## Change working directory to the target source copy +os.chdir(AMSS_NCKU_source_copy) + +## Build the main AMSS-NCKU executable (ABE or ABEGPU) +makefile_and_run.makefile_ABE() + +## If the initial-data method is Ansorg-TwoPuncture, build the TwoPunctureABE executable +if (input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + makefile_and_run.makefile_TwoPunctureABE() + +########################### + +## Change current working directory back up two levels +os.chdir('..') +os.chdir('..') + +print() + +################################################################## + +## Copy the AMSS-NCKU executable (ABE/ABEGPU) to the run directory + +if (input_data.GPU_Calculation == "no"): + ABE_file = os.path.join(AMSS_NCKU_source_copy, "ABE") +elif (input_data.GPU_Calculation == "yes"): + ABE_file = os.path.join(AMSS_NCKU_source_copy, "ABEGPU") + +if not os.path.exists( ABE_file ): + print( ) + print( " Lack of AMSS-NCKU executable file ABE/ABEGPU; recompile AMSS_NCKU_source manually. " ) + print( " When recompilation is finished, press Enter to continue. " ) + ## Wait for user input (press Enter) to proceed + inputvalue = input() + +## Copy the executable ABE (or ABEGPU) into the run directory +shutil.copy2(ABE_file, output_directory) + +########################### + +## If the initial-data method is TwoPuncture, copy the TwoPunctureABE executable to the run directory + +TwoPuncture_file = os.path.join(AMSS_NCKU_source_copy, "TwoPunctureABE") + +if (input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + + if not os.path.exists( TwoPuncture_file ): + print( ) + print( " Lack of AMSS-NCKU executable file TwoPunctureABE; recompile TwoPunctureABE in AMSS_NCKU_source. " ) + print( " When recompilation is finished, press Enter to continue. " ) + inputvalue = input() + + ## Copy the TwoPunctureABE executable into the run directory + shutil.copy2(TwoPuncture_file, output_directory) + +########################### + + +################################################################## + +## If the initial-data method is TwoPuncture, generate the TwoPuncture input files + +if (input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + + print( ) + print( " Initial data is chosen as Ansorg-TwoPuncture" ) + print( ) + + print( ) + print( " Automatically generating the input parfile for the TwoPunctureABE executable " ) + print( ) + + import generate_TwoPuncture_input + + generate_TwoPuncture_input.generate_AMSSNCKU_TwoPuncture_input() + + print( ) + print( " The input parfile for the TwoPunctureABE executable has been generated. " ) + print( ) + + ## Generated AMSS-NCKU TwoPuncture input filename + AMSS_NCKU_TwoPuncture_inputfile = 'AMSS-NCKU-TwoPuncture.input' + AMSS_NCKU_TwoPuncture_inputfile_path = os.path.join( File_directory, AMSS_NCKU_TwoPuncture_inputfile ) + + ## Copy and rename the file + shutil.copy2( AMSS_NCKU_TwoPuncture_inputfile_path, os.path.join(output_directory, 'TwoPunctureinput.par') ) + + ########################### + + ## Run TwoPuncture to generate initial-data files + + start_time = time.time() # Record start time + + print() + ## print( " Ready to launch the AMSS-NCKU TwoPuncture executable; press Enter to continue. " ) + ## inputvalue = input() + print() + + ## Change to the output (run) directory + os.chdir(output_directory) + + ## Run the TwoPuncture executable + makefile_and_run.run_TwoPunctureABE() + + ########################### + + ## Change current working directory back up two levels + os.chdir('..') + os.chdir('..') + +################################################################## + +## Update puncture data based on TwoPuncture run results + +import renew_puncture_parameter + +renew_puncture_parameter.append_AMSSNCKU_BSSN_input(File_directory, output_directory) + + +## Generated AMSS-NCKU input filename +AMSS_NCKU_inputfile = 'AMSS-NCKU.input' +AMSS_NCKU_inputfile_path = os.path.join(File_directory, AMSS_NCKU_inputfile) + +## Copy and rename the file +shutil.copy2( AMSS_NCKU_inputfile_path, os.path.join(output_directory, 'input.par') ) + + +print( ) +print( " Successfully copy all AMSS-NCKU input parfile to target dictionary. " ) +print( ) + + +################################################################## + +## Launch the AMSS-NCKU program + +print() +## print(" Ready to launch AMSS-NCKU; press Enter to continue. ") +## inputvalue = input() +print() + +## Change to the run directory +os.chdir( output_directory ) + +makefile_and_run.run_ABE() + +## Change current working directory back up two levels +os.chdir('..') +os.chdir('..') + + +end_time = time.time() +elapsed_time = end_time - start_time + +################################################################## + +## Copy some basic input and log files out to facilitate debugging + +## Path to the file that stores calculation settings +AMSS_NCKU_error_file_path = os.path.join(binary_results_directory, "setting.par") +## Copy and rename the file for easier inspection +shutil.copy( AMSS_NCKU_error_file_path, os.path.join(output_directory, "AMSSNCKU_setting_parameter") ) + +## Path to the error log file +AMSS_NCKU_error_file_path = os.path.join(binary_results_directory, "Error.log") +## Copy and rename the error log +shutil.copy( AMSS_NCKU_error_file_path, os.path.join(output_directory, "Error.log") ) + +## Primary program outputs +AMSS_NCKU_BH_data = os.path.join(binary_results_directory, "bssn_BH.dat" ) +AMSS_NCKU_ADM_data = os.path.join(binary_results_directory, "bssn_ADMQs.dat" ) +AMSS_NCKU_psi4_data = os.path.join(binary_results_directory, "bssn_psi4.dat" ) +AMSS_NCKU_constraint_data = os.path.join(binary_results_directory, "bssn_constraint.dat") +## copy and rename the file +shutil.copy( AMSS_NCKU_BH_data, os.path.join(output_directory, "bssn_BH.dat" ) ) +shutil.copy( AMSS_NCKU_ADM_data, os.path.join(output_directory, "bssn_ADMQs.dat" ) ) +shutil.copy( AMSS_NCKU_psi4_data, os.path.join(output_directory, "bssn_psi4.dat" ) ) +shutil.copy( AMSS_NCKU_constraint_data, os.path.join(output_directory, "bssn_constraint.dat") ) + +## Additional program outputs +if (input_data.Equation_Class == "BSSN-EM"): + AMSS_NCKU_phi1_data = os.path.join(binary_results_directory, "bssn_phi1.dat" ) + AMSS_NCKU_phi2_data = os.path.join(binary_results_directory, "bssn_phi2.dat" ) + shutil.copy( AMSS_NCKU_phi1_data, os.path.join(output_directory, "bssn_phi1.dat" ) ) + shutil.copy( AMSS_NCKU_phi2_data, os.path.join(output_directory, "bssn_phi2.dat" ) ) +elif (input_data.Equation_Class == "BSSN-EScalar"): + AMSS_NCKU_maxs_data = os.path.join(binary_results_directory, "bssn_maxs.dat" ) + shutil.copy( AMSS_NCKU_maxs_data, os.path.join(output_directory, "bssn_maxs.dat" ) ) + +################################################################## + +## Plot the AMSS-NCKU program results + +print( ) +print( " Plotting the txt and binary results data from the AMSS-NCKU simulation " ) +print( ) + + +import plot_xiaoqu +import plot_GW_strain_amplitude_xiaoqu + +## Plot black hole trajectory +plot_xiaoqu.generate_puncture_orbit_plot( binary_results_directory, figure_directory ) +plot_xiaoqu.generate_puncture_orbit_plot3D( binary_results_directory, figure_directory ) + +## Plot black hole separation vs. time +plot_xiaoqu.generate_puncture_distence_plot( binary_results_directory, figure_directory ) + +## Plot gravitational waveforms (psi4 and strain amplitude) +for i in range(input_data.Detector_Number): + plot_xiaoqu.generate_gravitational_wave_psi4_plot( binary_results_directory, figure_directory, i ) + plot_GW_strain_amplitude_xiaoqu.generate_gravitational_wave_amplitude_plot( binary_results_directory, figure_directory, i ) + +## Plot ADM mass evolution +for i in range(input_data.Detector_Number): + plot_xiaoqu.generate_ADMmass_plot( binary_results_directory, figure_directory, i ) + +## Plot Hamiltonian constraint violation over time +for i in range(input_data.grid_level): + plot_xiaoqu.generate_constraint_check_plot( binary_results_directory, figure_directory, i ) + +## Plot stored binary data +plot_xiaoqu.generate_binary_data_plot( binary_results_directory, figure_directory ) + +print( ) +print( f" This Program Cost = {elapsed_time} Seconds " ) +print( ) + + +################################################################## + +print( ) +print( " The AMSS-NCKU-Python simulation is successfully finished, thanks for using !!! " ) +print( ) + +################################################################## + + diff --git a/AMSS_NCKU_source/ABE.C b/AMSS_NCKU_source/ABE.C new file mode 100644 index 0000000..9a4874e --- /dev/null +++ b/AMSS_NCKU_source/ABE.C @@ -0,0 +1,508 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "misc.h" +#include "macrodef.h" + +#ifndef ABEtype +#error "not define ABEtype" +#endif + +#if (ABEtype == 0) + +#ifdef USE_GPU +#include "bssn_gpu_class.h" +#else +#include "bssn_class.h" +#endif + +#elif (ABEtype == 1) +#include "bssnEScalar_class.h" + +#elif (ABEtype == 2) +#include "Z4c_class.h" + +#elif (ABEtype == 3) +#include "bssnEM_class.h" + +#else +#error "not recognized ABEtype" +#endif + +namespace parameters +{ + map int_par; + map dou_par; + map str_par; +} + +//================================================================================================= +//================================================================================================= + +int main(int argc, char *argv[]) +{ + int myrank = 0, nprocs = 1; + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + double Begin_clock, End_clock; + if (myrank == 0) + { + Begin_clock = MPI_Wtime(); + } + + if (argc > 1) + { + string sttr(argv[1]); + parameters::str_par.insert(map::value_type("inputpar", sttr)); + } + else + { + string sttr("input.par"); + parameters::str_par.insert(map::value_type("inputpar", sttr)); + } + + int checkrun; + char checkfilename[50]; + int ID_type; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, d2DumpTime, CheckTime; + double Courant; + double numepss, numepsb, numepsh; + int Symmetry; + int a_lev, maxl, decn; + double maxrex, drex; + // read parameter from file + { + map::iterator iter; + string out_dir; + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + sprintf(pname, "%s", out_dir.c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "checkrun") + checkrun = atoi(sval.c_str()); + else if (skey == "checkfile") + strcpy(checkfilename, sval.c_str()); + else if (skey == "ID Type") + ID_type = atoi(sval.c_str()); + else if (skey == "Steps") + Steps = atoi(sval.c_str()); + else if (skey == "StartTime") + StartTime = atof(sval.c_str()); + else if (skey == "TotalTime") + TotalTime = atof(sval.c_str()); + else if (skey == "DumpTime") + DumpTime = atof(sval.c_str()); + else if (skey == "d2DumpTime") + d2DumpTime = atof(sval.c_str()); + else if (skey == "CheckTime") + CheckTime = atof(sval.c_str()); + else if (skey == "AnalysisTime") + AnasTime = atof(sval.c_str()); + else if (skey == "Courant") + Courant = atof(sval.c_str()); + else if (skey == "Symmetry") + Symmetry = atoi(sval.c_str()); + else if (skey == "small dissipation") + numepss = atof(sval.c_str()); + else if (skey == "big dissipation") + numepsb = atof(sval.c_str()); + else if (skey == "shell dissipation") + numepsh = atof(sval.c_str()); + else if (skey == "Analysis Level") + a_lev = atoi(sval.c_str()); + else if (skey == "Max mode l") + maxl = atoi(sval.c_str()); + else if (skey == "detector number") + decn = atoi(sval.c_str()); + else if (skey == "farest detector position") + maxrex = atof(sval.c_str()); + else if (skey == "detector distance") + drex = atof(sval.c_str()); + else if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + } + + if (myrank == 0) + { + string out_dir; + char filename[50]; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + sprintf(filename, "%s/setting.par", out_dir.c_str()); + ofstream setfile; + setfile.open(filename, ios::trunc); + + if (!setfile.good()) + { + char cmd[100]; + // sprintf(cmd,"rm %s -f",out_dir.c_str()); + // system(cmd); + sprintf(cmd, "mkdir %s", out_dir.c_str()); + system(cmd); + + setfile.open(filename, ios::trunc); + } + + time_t tnow; + time(&tnow); + struct tm *loc_time; + loc_time = localtime(&tnow); + setfile << "# File created on " << asctime(loc_time); + setfile << "#" << endl; + // echo the micro definition in "microdef.fh" + setfile << "macro definition used in microdef.fh" << endl; + +#if (tetradtype == 0) + setfile << "my own tetrad type for psi4 calculation" << endl; +#elif (tetradtype == 1) + setfile << "Lousto's tetrad type for psi4 calculation" << endl; +#elif (tetradtype == 2) + setfile << "Frans' tetrad type for psi4 calculation" << endl; +#else + setfile << "not recognized tetrad type" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); +#endif + +#ifdef Cell + setfile << "Cell center numerical grid structure" << endl; +#endif +#ifdef Vertex + setfile << "Vertex center numerical grid structure" << endl; +#endif + + setfile << " ghost zone = " << ghost_width << endl; + + setfile << " buffer zone = " << buffer_width << endl; + +#ifdef CPBC + setfile << "constraint preserving boundary condition is used" << endl; + setfile << " ghost zone for CPBC = " << CPBC_ghost_width << endl; +#endif + + setfile << " Gauge type = " << GAUGE << endl; + +#if (ABV == 0) + setfile << "using BSSN variable for constraint violation and psi4 calculation" << endl; +#elif (tetradtype == 1) + setfile << "using ADM variable for constraint violation and psi4 calculation" << endl; +#else + setfile << "not recognized ABV type" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); +#endif + + // echo the micro definition in "microdef.h" + setfile << "macro definition used in microdef.h" << endl; + setfile << " Sommerfeld boundary type = " << SommerType << endl; +#ifdef GaussInt + setfile << "using Gauss integral in waveshell" << endl; +#else + setfile << "using usual integral in waveshell" << endl; +#endif + setfile << " ABE type = " << ABEtype << endl; + setfile << " ID type = " << ID_type << endl; +#ifdef With_AHF + setfile << "Apparent Horizon Finder is turned on" << endl; +#endif + setfile << " Psi4 calculation type = " << Psi4type << endl; +#ifdef Point_Psi4 + setfile << "Using point Psi4 calculation method" << endl; +#endif + setfile << " RestrictProlong time type = " << RPS << endl; + setfile << " RestrictProlong scheme type = " << RPB << endl; + setfile << "Enforce algebra constraint type = " << AGM << endl; + setfile << "Analysis and PBH treat type = " << MAPBH << endl; + setfile << " mesh level parallel type = " << PSTR << endl; + setfile << " regrid type = " << REGLEV << endl; + + setfile << " dim = " << dim << endl; + setfile << " buffer_width = " << buffer_width << endl; + setfile << " SC_width = " << SC_width << endl; + setfile << " CS_width = " << CS_width << endl; + + setfile.close(); + } + + // echo parameters + if (myrank == 0) + { + cout << endl; + cout << " /////////////////////////////////////////////////////////////// " << endl; + cout << " AMSS-NCKU Begin !!! " << endl; + cout << " /////////////////////////////////////////////////////////////// " << endl; + cout << endl; + + if (checkrun) + cout << " checked run" << endl; + else + cout << " new run" << endl; + + cout << " simulation with cpu numbers = " << nprocs << endl; + cout << " simulation time = (" << StartTime << ", " << TotalTime << ")" << endl; + cout << " simulation steps for this run = " << Steps << endl; + cout << " Courant number = " << Courant << endl; + + switch (ID_type) + { + case -3: + cout << " Initial Data Type: Analytical NBH (Cao's Formula)" << endl; + break; + case -2: + cout << " Initial Data Type: Analytical Kerr-Schild" << endl; + break; + case -1: + cout << " Initial Data Type: Analytical NBH (Lousto's Formula)" << endl; + break; + case 0: + cout << " Initial Data Type: Numerical Ansorg TwoPuncture" << endl; + break; + case 1: + cout << " Initial Data Type: Numerical Pablo" << endl; + break; + default: + cout << " OOOOps, not supported Initial Data setting!" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + switch (Symmetry) + { + case 0: + cout << " Symmetry setting: No_Symmetry" << endl; + break; + case 1: + cout << " Symmetry setting: Equatorial" << endl; + break; + case 2: + cout << " Symmetry setting: Octant" << endl; + break; + default: + cout << " OOOOps, not supported Symmetry setting!" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + cout << " Courant = " << Courant << endl; + cout << " artificial dissipation for shell patches = " << numepsh << endl; + cout << " artificial dissipation for fixed levels = " << numepsb << endl; + cout << " artificial dissipation for moving levels = " << numepss << endl; + cout << " Dumpt Time = " << DumpTime << endl; + cout << " Check Time = " << CheckTime << endl; + cout << " Analysis Time = " << AnasTime << endl; + cout << " Analysis level = " << a_lev << endl; + cout << " checkfile = " << checkfilename << endl; + + switch (ghost_width) + { + case 2: + cout << " second order finite difference is used" << endl; + break; + case 3: + cout << " fourth order finite difference is used" << endl; + break; + case 4: + cout << " sixth order finite difference is used" << endl; + break; + case 5: + cout << " eighth order finite difference is used" << endl; + break; + default: + cout << " Why are you using ghost width = " << ghost_width << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + cout << "///////////////////////////////////////////////////////////////" << endl; + } + + //===========================the computation body==================================================== + + bssn_class *ADM; + +#if (ABEtype == 0) + ADM = new bssn_class(Courant, StartTime, TotalTime, DumpTime, d2DumpTime, CheckTime, AnasTime, + Symmetry, checkrun, checkfilename, numepss, numepsb, numepsh, + a_lev, maxl, decn, maxrex, drex); +#elif (ABEtype == 1) + ADM = new bssnEScalar_class(Courant, StartTime, TotalTime, DumpTime, d2DumpTime, CheckTime, AnasTime, + Symmetry, checkrun, checkfilename, numepss, numepsb, numepsh, + a_lev, maxl, decn, maxrex, drex); +#elif (ABEtype == 2) + ADM = new Z4c_class(Courant, StartTime, TotalTime, DumpTime, d2DumpTime, CheckTime, AnasTime, + Symmetry, checkrun, checkfilename, numepss, numepsb, numepsh, + a_lev, maxl, decn, maxrex, drex); +#elif (ABEtype == 3) + ADM = new bssnEM_class(Courant, StartTime, TotalTime, DumpTime, d2DumpTime, CheckTime, AnasTime, + Symmetry, checkrun, checkfilename, numepss, numepsb, numepsh, + a_lev, maxl, decn, maxrex, drex); +#endif + + ADM->Initialize(); + // ADM->testRestrict(); + // ADM->testOutBd(); + + // set up initial data + + // old code manually + /* + #if (ABEtype == 0) + // set up initial data with analytical formula + // ADM->Setup_Initial_Data(); + ADM->Read_Ansorg(); + #elif (ABEtype == 1) + // ADM->Read_Pablo(); + ADM->Read_Ansorg(); + #elif (ABEtype == 2) + ADM->Read_Ansorg(); + // ADM->Setup_KerrSchild(); + #elif (ABEtype == 3) + ADM->Setup_Initial_Data(); + // ADM->Read_Ansorg(); + #endif + */ + + // new code Xiao Qu + switch (ID_type) + { + case (-3): + // set up initial data with Cao's analytical formula + ADM->Setup_Initial_Data_Cao(); + break; + case (-2): + // set up initial data with KerrSchild analytical formula + ADM->Setup_KerrSchild(); + break; + case (-1): + // set up initial data with Lousto's analytical formula + ADM->Setup_Initial_Data_Lousto(); + break; + case (0): + // set up initial data with Ansorg TwoPuncture Solver + ADM->Read_Ansorg(); + break; + case (1): + // set up initial data with Pablo's Olliptic Solver + ADM->Read_Pablo(); + // ADM->Write_Pablo(); + break; + default: + if (myrank == 0) + { + cout << "not recognized ABE::InitialDataType = " << ID_type << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + + End_clock = MPI_Wtime(); + if (myrank == 0) + { + cout << endl; + cout << " Before Evolve, it takes " << MPI_Wtime() - Begin_clock << " seconds" << endl; + cout << endl; + } + + ADM->Evolve(Steps); + + if (myrank == 0) + { + cout << endl; + cout << " Total Evolve Time: " << MPI_Wtime() - End_clock << " seconds!" << endl; + cout << " Total Running Time: " << MPI_Wtime() - Begin_clock << " seconds!" << endl; + cout << endl; + } + + delete ADM; + + //=======================caculation done============================================================= + + if (myrank == 0) + { + cout << endl; + cout << " =============================================================== " << endl; + cout << " Simulation is successfully done!! " << endl; + cout << " =============================================================== " << endl; + cout << endl; + cout << " This run used " << MPI_Wtime() - Begin_clock << " seconds! " << endl; + cout << endl; + } + + MPI_Finalize(); + + exit(0); +} + +//=================================================================================================== +//=================================================================================================== diff --git a/AMSS_NCKU_source/Ansorg.C b/AMSS_NCKU_source/Ansorg.C new file mode 100644 index 0000000..e95776b --- /dev/null +++ b/AMSS_NCKU_source/Ansorg.C @@ -0,0 +1,690 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include "Ansorg.h" +#include +/* read spectral data from file + special: pad phi direction with ghosts for periodic interpolation + order = 4: (-2 -1) 0 ... n-1 (n n+1) +*/ +Ansorg::Ansorg(char *filename, int orderi) : pu_ps(0), coordA(0), coordB(0), coordphi(0) +{ + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + order = orderi / 2 * 2; // order must be even + PIh = PI / 2.0; + char s[1000], *t; + FILE *fp; + double *v; + int nghosts; + int i; + + double x1, y1, z1, x2, y2, z2, dx, dy; + + /* open file */ + fp = fopen(filename, "r"); + if (myrank == 0 && !fp) + { + cout << "could not open " << filename << " for reading Ansorg" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (myrank == 0) + printf(" reading data from %s\n", filename); + + /* skip to line starting with data, extract size info */ + n1 = n2 = n3 = ntotal = -1; + while (fgets(s, 1000, fp)) + { + t = strstr(s, "bhx1 "); + if (t == s) + sscanf(s + 15, "%lf", &x1); + t = strstr(s, "bhy1 "); + if (t == s) + sscanf(s + 15, "%lf", &y1); + t = strstr(s, "bhz1 "); + if (t == s) + sscanf(s + 15, "%lf", &z1); + t = strstr(s, "bhx2 "); + if (t == s) + sscanf(s + 15, "%lf", &x2); + t = strstr(s, "bhy2 "); + if (t == s) + sscanf(s + 15, "%lf", &y2); + t = strstr(s, "bhz2 "); + if (t == s) + sscanf(s + 15, "%lf", &z2); + + t = strstr(s, "data "); + if (t != s) + continue; + sscanf(s + 5, "%d%d%d", &n1, &n2, &n3); + ntotal = n1 * n2 * n3; + if (myrank == 0) + printf(" found data with dimensions %d x %d x %d = %d\n", + n1, n2, n3, ntotal); + break; + } + + if (myrank == 0) + cout << " bhx1 = " << x1 << endl + << " bhy1 = " << y1 << endl + << " bhz1 = " << z1 << endl + << " bhx2 = " << x2 << endl + << " bhy2 = " << y2 << endl + << " bhz2 = " << z2 << endl; + + dx = x1 - x2; + dy = y1 - y2; + + /* x-axis */ + if (dx != 0 && y1 == 0 && y2 == 0 && z1 == 0 && z2 == 0) + { + ps_b = dx / 2; + ps_dx = (x1 + x2) / 2; + ps_rxx = 1; + ps_rxy = 0; + ps_ryx = 0; + ps_ryy = 1; + } + + /* y-axis */ + else if (dy != 0 && x1 == 0 && x2 == 0 && z1 == 0 && z2 == 0) + { + ps_b = dy / 2; + ps_dx = (y1 + y2) / 2; + ps_rxx = 0; + ps_rxy = +1; + ps_ryx = -1; + ps_ryy = 0; + } + + /* else */ + else if (myrank == 0) + { + cout << "puncture location not allowed" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (ntotal == -1 && myrank == 0) + { + cout << "file does not contain the expected data" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + /* get storage if needed */ + int pad = order / 2; + nghosts = n1 * n2 * pad; + if (!(pu_ps)) + pu_ps = new double[ntotal + 2 * nghosts]; + v = pu_ps + nghosts; + + /* read data */ + i = 0; + while (fgets(s, 1000, fp)) + { + if (i < ntotal) + v[i] = atof(t); + i++; + } + if (myrank == 0) + { + printf(" read %d data lines\n", i); + cout << endl; + } + if (myrank == 0 && i < ntotal) + { + cout << "file contains too few data lines" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (myrank == 0 && i > ntotal) + { + cout << "file contains too many data lines" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + /* copy data into ghosts */ + for (i = 0; i < nghosts; i++) + { + (pu_ps)[i] = v[i + ntotal - nghosts]; + (pu_ps)[i + ntotal + nghosts] = v[i]; + } + + if (0) + for (i = 0; i < ntotal + 2 * nghosts; i++) + printf("yoyo %10d %.16e\n", i - nghosts, (pu_ps)[i]); + + /* done */ + fclose(fp); + + set_ABp(); + + if (0) + { + if (myrank == 0) + { + cout << ps_u_at_xyz(0.015625, -4.578125, 0.015625) << endl; + cout << ps_u_at_xyz(0.046875, -4.578125, 0.015625) << endl; + cout << ps_u_at_xyz(0.078125, -4.578125, 0.015625) << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else + for (int i = 0;; i++) + ; + } +} +Ansorg::~Ansorg() +{ + if (coordA) + delete[] coordA; + if (coordB) + delete[] coordB; + if (coordphi) + delete[] coordphi; + if (pu_ps) + delete[] pu_ps; +} +/* interpolate to point given in Cartesian coordinates + calls function in utility/interpolation/barycentric.c +*/ +double Ansorg::ps_u_at_xyz(double x, double y, double z) +{ + double A, B, phi, u, U; + /* + // rotate THETA along clockwise direction + #define THETA (PI*0.25) + A = x; + B = y; + x = A*cos(THETA)+B*sin(THETA); + y =-A*sin(THETA)+B*cos(THETA); + */ + xyz_to_ABp(x, y, z, &A, &B, &phi); + if (0) + printf("x %f y %f z %f phi %f %.1f\n", x, y, z, phi, 180 * phi / PI); + if (0) + printf("A %f B %f phi %f\n", A, B, phi); + + U = interpolate_tri_bar(A, B, phi, n1, n2, n3 + (order / 2) * 2, + coordA, coordB, coordphi, pu_ps); + u = 2 * (A - 1) * U; + if (U > 0.025) + cout << x << "," << y << "," << z << "," << A << "," << B << "," << phi << "," << U << "," << u << endl; + if (!finite(u)) + { + cout << "find NaN in Ansorg::ps_u_at_xyz at (" << x << "," << y << "," << z << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + return u; +} +/* set 1d arrays for spectral coordinates + see Punctures_functions.c for reference + special: pad phi direction with ghosts for periodicity +*/ +void Ansorg::set_ABp() +{ + int pad = order / 2; + int i; + double Acode; + int pr = 0; + + coordA = new double[n1]; + coordB = new double[n2]; + coordphi = new double[n3 + 2 * pad]; + + for (i = 0; i < n1; i++) + { + Acode = -cos(PIh * (2 * i + 1) / n1); + coordA[i] = (Acode + 1) / 2; + if (pr && myrank == 0) + printf("coordA[%2d] = %f\n", i, coordA[i]); + } + + for (i = 0; i < n2; i++) + { + coordB[i] = -cos(PIh * (2 * i + 1) / n2); + if (pr && myrank == 0) + printf("coordB[%2d] = %f\n", i, coordB[i]); + } + + for (i = 0; i < n3 + 2 * pad; i++) + { + coordphi[i] = 2 * PI * (i - pad) / n3; + if (pr && myrank == 0) + printf("coordphi[%2d] = %f %f\n", + i, coordphi[i], coordphi[i] * 180 / PI); + } +} +/* from cartesian to spectral + see coordtrans.m etc + The problem is that the inverse transformation requires several + nested square roots with 8 possible solutions, only one of them relevant. + We have picked the correct solution by testing in Mathematica. + Furthermore, there are special coordinates where the formulas have + to be specialized. + + fixme: needs proper treatment of quantities that are almost zero/singular +*/ +#if 0 +void Ansorg::xyz_to_ABp(double x, double y, double z, + double *A, double *B, double *phi) +{ + const double s2 = sqrt(2.0); + double r, rr, xx; + double t, st, u, su, v, sv, w, sw; + + /* rotate onto x-axis if required */ + w = x; + x = ps_rxx * w + ps_rxy * y; + y = ps_ryx * w + ps_ryy * y; + + /* center black holes at +b and -b */ + x -= ps_dx; + + /* offset parameter b rescales the coordinates */ + x /= ps_b; + y /= ps_b; + z /= ps_b; + + /* helpers */ + r = sqrt(y*y + z*z); + rr = r*r; + xx = x*x; + + + /* phi as in cylindrical coordinates about x-axis + acos covers [0,pi], we need [0,2pi) + */ + if (r>0.0) + *phi = (z < 0.0) ? 2*PI - acos(y/r) : acos(y/r); + else + *phi = 0; + + + /* r > 0 */ + if (r>0.0) { + + /* x != 0, r > 0 */ + if (x != 0.0) { + + t = (1+rr)*(1+rr) + 2*(-1 + rr)*xx + xx*xx; + st = sqrt(t); + u = 1 - xx + rr*(2 + rr + xx + st) + st; + su = sqrt(u); + v = 1 + rr*rr - xx + rr*(2 + xx + st) + st; + sv = sqrt(v); + w = 1 + rr - s2*su + st; + sw = sqrt(w); + + *A = (2*sw*(1 + rr + st - xx) + s2*sv*(-1 - rr + 2*sw + st - xx)) + /(4.*r*xx); + + *B = -(sw/x); + } + + /* x == 0, r > 0 */ + else { + *A = (sqrt(1+rr) - 1)/r; + *B = 0; + } + } + + /* r == 0 */ + else { + + /* x > 1, r == 0 */ + if (x>1.0) { + *A = sqrt(x-1)/sqrt(x+1); + *B = -1; + } + + /* x < -1, r == 0 */ + else if (x<-1.0) { + *A = sqrt(-x-1)/sqrt(-x+1); + *B = +1; + } + + /* -1 <= x <= 1, r == 0 */ + else { + *A = 0; + + /* x != 0 */ + if (x != 0.0) + *B = (sqrt(1-xx) - 1)/x; + + /* x == 0 */ + else + *B = 0; + } + } + if(!finite(*A) || !finite(*B) || (*A)<0 || (*A)>1 || (*B)<-1 || (*B)>1) {*A = 1; *B = 0;} +if(!finite(*A) || !finite(*B) || (*A)<0 || (*A)>1 || (*B)<-1 || (*B)>1 || (*phi)<0 || (*phi)>2*PI){ + cout<<"find ("<<*A<<","<<*B<<","<<*phi<<") in Ansorg::xyz_to_ABp at ("<0) + *phi = (z<0) ? 2*PI - acos(y/r) : acos(y/r); + else + *phi = 0; + + /* r > 0 */ + { + + /* x != 0, r > 0 */ + { + t = (1+rr)*(1+rr) + 2*(-1 + rr)*xx + xx*xx; + st = sqrt(t); + u = rr*(2 + rr + xx + st) + st + 1.0 - xx; + su = sqrt(u); + v = rr*rr + rr*(2 + xx + st) + st + 1.0 - xx; + sv = sqrt(v); + w = rr - s2*su + st + 1.0; + sw = sqrt(w); + + *A = (2*sw*(rr + st + 1 - xx) + s2*sv*(st - rr - 1 + 2*sw - xx)) + /(4.*r*xx); + + *B = -(sw/x); + } + /* x == 0, r > 0 */ + if(!finite(*A) || !finite(*B) || (*A)<0 || (*A)>1 || (*B)<-1 || (*B)>1) + { + *A = (sqrt(1 + rr) - 1)/r + ((sqrt(1 + rr) - 1)*xx)/(2*r*pow((1 + rr),exp)); + + *B = -x/(2*sqrt(1 + rr)); + } + } + + /* r == 0 */ + if(!finite(*A) || !finite(*B) || (*A)<0 || (*A)>1 || (*B)<-1 || (*B)>1) + { + + /* x > 1, r == 0 */ + if (x>1) { + *A = sqrt(x-1)/sqrt(x+1); + *B = -1; + } + + /* x < -1, r == 0 */ + else if (x<-1) { + *A = sqrt(-x-1)/sqrt(-x+1); + *B = +1; + } + + /* -1 <= x <= 1, r == 0 */ + else { + *A = 0; + + /* x != 0 */ + if (x != 0) + *B = (sqrt(1-xx) - 1)/x; + + /* x == 0 */ + else + *B = 0; + } + } + + double aux1 = 0.5 * (x * x + rr - 1); + double aux2 = sqrt (aux1 * aux1 + rr); + double X = asinh (sqrt (aux1 + aux2)); + double R = asin (min(1.0, sqrt (-aux1 + aux2))); + if (x < 0) R = PI - R; + + *A = tanh (0.5 * X); + *B = tan (0.5 * R - PI/4); + +if((*A)<0 || (*A)>1 || (*B)<-1 || (*B)>1 || (*phi)<0 || (*phi)>2*PI){ + cout<<"find ("<<*A<<","<<*B<<","<<*phi<<") in Ansorg::xyz_to_ABp at ("< 0) + *phi = (z < 0) ? 2 * PI - acos(y / r) : acos(y / r); + else + *phi = 0; + + double aux1 = 0.5 * (x * x + rr - 1); + double aux2 = sqrt(aux1 * aux1 + rr); + double X = asinh(sqrt(aux1 + aux2)); + double R = asin(min(1.0, sqrt(-aux1 + aux2))); + if (x < 0) + R = PI - R; + + *A = tanh(0.5 * X); + *B = tan(0.5 * R - PI / 4); +} +#endif +/* three dimensional polynomial interpolation, barycentric */ +double Ansorg::interpolate_tri_bar(double x, double y, double z, + int n1, int n2, int n3, + double *x1, double *x2, double *x3, double *yp) +{ + double u; + double *w, *omega; + double **v; + + int i, j, k, ijk; + int i1, i2, i3; + int di = 1, dj = n1, dk = n1 * n2; + int order1 = order > n1 ? n1 : order; + int order2 = order > n2 ? n2 : order; + int order3 = order > n3 ? n3 : order; + + w = new double[order]; + omega = new double[order]; + v = new double *[order]; + for (int i = 0; i < order; i++) + v[i] = new double[order]; + + i1 = find_point_bisection(x, n1, x1, order1 / 2); + i2 = find_point_bisection(y, n2, x2, order2 / 2); + i3 = find_point_bisection(z, n3, x3, order3 / 2); + ijk = i1 * di + i2 * dj + i3 * dk; + if (0) + printf("%d %d %d\n", i1, i2, i3); + + barycentric_omega(order1, 1, &x1[i1], omega); + for (k = 0; k < order3; k++) + for (j = 0; j < order2; j++) + v[k][j] = barycentric(x, order1, 1, &x1[i1], &yp[ijk + j * dj + k * dk], omega); + + if (0) + for (k = 0; k < order3; k++) + for (j = 0; j < order2; j++) + printf("%2d %2d %.15f\n", k, j, v[k][j]); + + barycentric_omega(order2, 1, &x2[i2], omega); + for (k = 0; k < order3; k++) + w[k] = barycentric(y, order2, 1, &x2[i2], &v[k][0], omega); + + if (0) + for (k = 0; k < order3; k++) + printf("%2d %.15f\n", k, w[k]); + + barycentric_omega(order3, 1, &x3[i3], omega); + u = barycentric(z, order3, 1, &x3[i3], w, omega); + + if (!finite(u)) + { + cout << "find NaN in Ansorg::interpolate_tri_bar at (" << x << "," << y << "," << z << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (i = 0; i < order; i++) + delete[] v[i]; + + delete[] w; + delete[] omega; + delete[] v; + + return u; +} +/* find index such that xp[i] <= x < xp[i+1] + uses bisection, which relies on x being ordered + o is "offset", number of points smaller than x that are required + returns j = i-(o-1), i.e. if o = 2, then + xp[j] < xp[j+1] <= x < xp[j+2] < xp[j+3] + which is useful for interpolation +*/ +int Ansorg::find_point_bisection(double x, int n, double *xp, int o) +{ + int i0 = o - 1, i1 = n - o; + int i; + + if (n < 2 * o) + { + cout << "bisection failed" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (x <= xp[i0]) + return 0; + if (x > xp[i1]) + return n - 2 * o; + + while (i0 != i1 - 1) + { + i = (i0 + i1) / 2; + if (x < xp[i]) + i1 = i; + else + i0 = i; + } + + return i0 - o + 1; +} +/* compute omega[] for barycentric interpolation */ +// SIAM_review 46, 501 (2004) +void Ansorg::barycentric_omega(int n, int s, double *x, double *omega) +{ + double o; + int i, j; + + if (0) + printf("%d %d %p %p\n", n, s, x, omega); + + for (i = 0; i < n; i += s) + { + o = 1; + for (j = 0; j < n; j += s) + { + if (j != i) + { + o /= (x[i] - x[j]); + } + } + omega[i / s] = o; + + if (0) + printf("x[%d] = %9.6f omega[%d] = %13.6e\n", i / s, x[i], i / s, o); + } +} +/* barycentric interpolation with precomputed omega */ +double Ansorg::barycentric(double x0, int n, int s, double *x, double *y, + double *omega) +{ + double a, b, c, d; + int i; + + if (0) + printf("%f %d %d %p %p %p\n", x0, n, s, x, y, omega); + + a = b = 0; + for (i = 0; i < n; i += s) + { + d = x0 - x[i]; + if (d == 0) + return y[i]; + c = omega[i / s] / d; + b += c; + a += c * y[i]; + } + + return a / b; +} diff --git a/AMSS_NCKU_source/Ansorg.h b/AMSS_NCKU_source/Ansorg.h new file mode 100644 index 0000000..557043c --- /dev/null +++ b/AMSS_NCKU_source/Ansorg.h @@ -0,0 +1,53 @@ + +#ifndef Ansorg_H +#define Ansorg_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#define PI M_PI + +class Ansorg +{ +protected: + int n1, n2, n3, ntotal; + int order; + double *coordA, *coordB, *coordphi; + int ps_rxx, ps_rxy, ps_ryx, ps_ryy; + double ps_b, ps_dx; + double PIh; + double *pu_ps; + int myrank; + +public: + Ansorg(char *filename, int orderi); + ~Ansorg(); + double ps_u_at_xyz(double x, double y, double z); + void set_ABp(); + void xyz_to_ABp(double x, double y, double z, + double *A, double *B, double *phi); + double interpolate_tri_bar(double x, double y, double z, + int n1, int n2, int n3, + double *x1, double *x2, double *x3, double *yp); + int find_point_bisection(double x, int n, double *xp, int o); + void barycentric_omega(int n, int s, double *x, double *omega); + double barycentric(double x0, int n, int s, double *x, double *y, + double *omega); +}; +#endif /* Ansorg_H */ diff --git a/AMSS_NCKU_source/Ansorg.psid b/AMSS_NCKU_source/Ansorg.psid new file mode 100644 index 0000000..8e386a0 --- /dev/null +++ b/AMSS_NCKU_source/Ansorg.psid @@ -0,0 +1,65025 @@ +#File created on Fri Nov 22 20:45:24 2024 +#Newton_tol = 5e-12 +#Mp = 0.500002 +#Mm = 0.500002 +bhmass1 = 0.487209 +bhx1 = 0 +bhy1 = 5.5 +bhz1 = 0 +bhpx1 = -0.0901099 +bhpy1 = -0.000703975 +bhpz1 = 0 +bhsx1 = 0 +bhsy1 = 0 +bhsz1 = 0 +bhmass2 = 0.487209 +bhx2 = 0 +bhy2 = -5.5 +bhz2 = 0 +bhpx2 = 0.0901099 +bhpy2 = 0.000703975 +bhpz2 = 0 +bhsx2 = 0 +bhsy2 = 0 +bhsz2 = 0 +data 50 50 26 +-2.0571877672710204e-03 +-2.0612532077036866e-03 +-2.0694114293043596e-03 +-2.0817153066080372e-03 +-2.0982335373402510e-03 +-2.1190208869626983e-03 +-2.1440489957577444e-03 +-2.1730606434757190e-03 +-2.2052552896336930e-03 +-2.2386481355300726e-03 +-2.2691519449276366e-03 +-2.2901513163053559e-03 +-2.2936978720102278e-03 +-2.2732389365136877e-03 +-2.2261304370099150e-03 +-2.1543087709047235e-03 +-2.0631049582443451e-03 +-1.9593090203561874e-03 +-1.8495172662851137e-03 +-1.7391789979771240e-03 +-1.6322792823275222e-03 +-1.5314197103349194e-03 +-1.4380771422463313e-03 +-1.3528994132753396e-03 +-1.2759685260744444e-03 +-1.2070076704796609e-03 +-1.1455319090597786e-03 +-1.0909517682102740e-03 +-1.0426410274336768e-03 +-9.9997887597347052e-04 +-9.6237449757109121e-04 +-9.2928003431230072e-04 +-9.0019612779431129e-04 +-8.7467290317990191e-04 +-8.5230830193807467e-04 +-8.3274500014961922e-04 +-8.1566669565950281e-04 +-8.0079424468447924e-04 +-7.8788193091720252e-04 +-7.7671402244749695e-04 +-7.6710169162876388e-04 +-7.5888032303256096e-04 +-7.5190720522382883e-04 +-7.4605958497145732e-04 +-7.4123305407846609e-04 +-7.3734023521009203e-04 +-7.3430973299019842e-04 +-7.3208531807413446e-04 +-7.3062531509066931e-04 +-7.2990216900931505e-04 +-2.0571887355901397e-03 +-2.0612542139796545e-03 +-2.0694126901812451e-03 +-2.0817173774776319e-03 +-2.0982374355199849e-03 +-2.1190281554228081e-03 +-2.1440616440720887e-03 +-2.1730807464914736e-03 +-2.2052838312920774e-03 +-2.2386831199090640e-03 +-2.2691872548080434e-03 +-2.2901783113767819e-03 +-2.2937092786875076e-03 +-2.2732319967375251e-03 +-2.2261072011562941e-03 +-2.1542741771419377e-03 +-2.0630645368993985e-03 +-1.9592673951857715e-03 +-1.8494776126707713e-03 +-1.7391431225643420e-03 +-1.6322479571165460e-03 +-1.5313930330109707e-03 +-1.4380548262503577e-03 +-1.3528809883921462e-03 +-1.2759534629805873e-03 +-1.2069954507291302e-03 +-1.1455220597336325e-03 +-1.0909438754165214e-03 +-1.0426347380855492e-03 +-9.9997389368391000e-04 +-9.6237057606949423e-04 +-9.2927697025387002e-04 +-9.0019375390834795e-04 +-8.7467108217405536e-04 +-8.5230692128523738e-04 +-8.3274396773670158e-04 +-8.1566593620911591e-04 +-8.0079369683732856e-04 +-7.8788154486141319e-04 +-7.7671375799113053e-04 +-7.6710151662508978e-04 +-7.5888021208255266e-04 +-7.5190713859357890e-04 +-7.4605954767463067e-04 +-7.4123303508382516e-04 +-7.3734022674307241e-04 +-7.3430972990404177e-04 +-7.3208531727212334e-04 +-7.3062531498415111e-04 +-7.2990216899874538e-04 +-2.0571951359926984e-03 +-2.0612608911326712e-03 +-2.0694211727874884e-03 +-2.0817316707219019e-03 +-2.0982651930555631e-03 +-2.1190817416994277e-03 +-2.1441587246938190e-03 +-2.1732428042454482e-03 +-2.2055290604838175e-03 +-2.2390121060506629e-03 +-2.2695701104260553e-03 +-2.2905587796637947e-03 +-2.2940278747036846e-03 +-2.2734504976950052e-03 +-2.2262176255387453e-03 +-2.1542919349363788e-03 +-2.0630156950714983e-03 +-1.9591783293451872e-03 +-1.8493696386924611e-03 +-1.7390311075474064e-03 +-1.6321410492754042e-03 +-1.5312961047995017e-03 +-1.4379698900025065e-03 +-1.3528083106764781e-03 +-1.2758923438245481e-03 +-1.2069447261861441e-03 +-1.1454804048511595e-03 +-1.0909099744284842e-03 +-1.0426073713092699e-03 +-9.9995197475638716e-04 +-9.6235316112360512e-04 +-9.2926325232971522e-04 +-9.0018305046265709e-04 +-8.7466282015169516e-04 +-8.5230062214375205e-04 +-8.3273923359968884e-04 +-8.1566243762433335e-04 +-8.0079116223893596e-04 +-7.8787975163759896e-04 +-7.7671252497341797e-04 +-7.6710069778337898e-04 +-7.5887969121476930e-04 +-7.5190682481343456e-04 +-7.4605937152707883e-04 +-7.4123294514085824e-04 +-7.3734018655916272e-04 +-7.3430971523135184e-04 +-7.3208531345782897e-04 +-7.3062531448806541e-04 +-7.2990216898515187e-04 +-2.0572136921351270e-03 +-2.0612803887734652e-03 +-2.0694467019021856e-03 +-2.0817766014677177e-03 +-2.0983552759937549e-03 +-2.1192590278183735e-03 +-2.1444840768734073e-03 +-2.1737916083703337e-03 +-2.2063682589192452e-03 +-2.2401526701488826e-03 +-2.2709222590610164e-03 +-2.2919410139039605e-03 +-2.2952396796492836e-03 +-2.2743537394502027e-03 +-2.2267705990366760e-03 +-2.1545316566985375e-03 +-2.0630186820218836e-03 +-1.9590268576953696e-03 +-1.8491330299939906e-03 +-1.7387597679389350e-03 +-1.6318676988719167e-03 +-1.5310397339981367e-03 +-1.4377399652153585e-03 +-1.3526082278384382e-03 +-1.2757219241303099e-03 +-1.2068018786412363e-03 +-1.1453621668263644e-03 +-1.0908131262907376e-03 +-1.0425287759230457e-03 +-9.9988874732807724e-04 +-9.6230273889831249e-04 +-9.2922340808386289e-04 +-9.0015187659626679e-04 +-8.7463869920706460e-04 +-8.5228219271554567e-04 +-8.3272535646294562e-04 +-8.1565216443883423e-04 +-8.0078370779208396e-04 +-7.8787446979993727e-04 +-7.7670888814868738e-04 +-7.6709827943877563e-04 +-7.5887815102129816e-04 +-7.5190589591878781e-04 +-7.4605884952577207e-04 +-7.4123267834935768e-04 +-7.3734006726609315e-04 +-7.3430967164355278e-04 +-7.3208530212265485e-04 +-7.3062531301826077e-04 +-7.2990216896145837e-04 +-2.0572420847937449e-03 +-2.0613110753447423e-03 +-2.0694918380153244e-03 +-2.0818680825725288e-03 +-2.0985546113911802e-03 +-2.1196667058530237e-03 +-2.1452450446450820e-03 +-2.1750838789489062e-03 +-2.2083482272081505e-03 +-2.2428460312625713e-03 +-2.2741230699298049e-03 +-2.2952322806264729e-03 +-2.2981573040839688e-03 +-2.2765719327443872e-03 +-2.2281824582486643e-03 +-2.1552124050857819e-03 +-2.0631380101922142e-03 +-1.9587716503223582e-03 +-1.8486633147481925e-03 +-1.7381937027899530e-03 +-1.6312833655661597e-03 +-1.5304836034910200e-03 +-1.4372362635844071e-03 +-1.3521667800397035e-03 +-1.2753439051344981e-03 +-1.2064836954611170e-03 +-1.1450979223982497e-03 +-1.0905960996502842e-03 +-1.0423522592420071e-03 +-9.9974648126782023e-04 +-9.6218910724720787e-04 +-9.2913349456661266e-04 +-9.0008144735762323e-04 +-8.7458414898213921e-04 +-8.5224047660803991e-04 +-8.3269391943761764e-04 +-8.1562887471227136e-04 +-8.0076679689696883e-04 +-7.8786248013706483e-04 +-7.7670062782496559e-04 +-7.6709278365552917e-04 +-7.5887464908590122e-04 +-7.5190378289078253e-04 +-7.4605766157153784e-04 +-7.4123207095480928e-04 +-7.3733979558236913e-04 +-7.3430957234634354e-04 +-7.3208527629515976e-04 +-7.3062530967117568e-04 +-7.2990216891558035e-04 +-2.0572332752168314e-03 +-2.0613068760933105e-03 +-2.0695162974639497e-03 +-2.0819841560678932e-03 +-2.0988834080050071e-03 +-2.1204046976117017e-03 +-2.1466709491468872e-03 +-2.1775297284459083e-03 +-2.2120907133203181e-03 +-2.2479090274435168e-03 +-2.2801077422824529e-03 +-2.3013660762416926e-03 +-2.3035904425113924e-03 +-2.2807076698749275e-03 +-2.2308217906612678e-03 +-2.1564898441568288e-03 +-2.0633641232979008e-03 +-1.9582919310795420e-03 +-1.8477760872773440e-03 +-1.7371209620576995e-03 +-1.6301729597689011e-03 +-1.5294242876998127e-03 +-1.4362748448377509e-03 +-1.3513226866837856e-03 +-1.2746199805952062e-03 +-1.2058735470361565e-03 +-1.1445906225653610e-03 +-1.0901790332545761e-03 +-1.0420127486456257e-03 +-9.9947264251721256e-04 +-9.6197024190852721e-04 +-9.2896021339913999e-04 +-8.9994564775923707e-04 +-8.7447891970655076e-04 +-8.5215997248903625e-04 +-8.3263322995170269e-04 +-8.1558389874492260e-04 +-8.0073412941419322e-04 +-7.8783931260995987e-04 +-7.7668466221933539e-04 +-7.6708215871968311e-04 +-7.5886787725142708e-04 +-7.5189969595425483e-04 +-7.4605536341693546e-04 +-7.4123089570860457e-04 +-7.3733926981890327e-04 +-7.3430938016064780e-04 +-7.3208522630244764e-04 +-7.3062530319344826e-04 +-7.2990216883177641e-04 +-2.0570066052475787e-03 +-2.0610882425306540e-03 +-2.0693473812922556e-03 +-2.0819737587472464e-03 +-2.0992393316216179e-03 +-2.1214583652026785e-03 +-2.1488769911332164e-03 +-2.1813993141879397e-03 +-2.2180051854863675e-03 +-2.2558284003946169e-03 +-2.2893553437327865e-03 +-2.3107383475524032e-03 +-2.3118026683681308e-03 +-2.2868704205357216e-03 +-2.2346467128896799e-03 +-2.1581932865507745e-03 +-2.0634322127836002e-03 +-1.9572665620604130e-03 +-1.8461275795974416e-03 +-1.7352009917837321e-03 +-1.6282164350347882e-03 +-1.5275721279054456e-03 +-1.4346007324005699e-03 +-1.3498561701110602e-03 +-1.2733637852346933e-03 +-1.2048154622298888e-03 +-1.1437111562066257e-03 +-1.0894560694529737e-03 +-1.0414242135705616e-03 +-9.9899790858725161e-04 +-9.6159076627153799e-04 +-9.2865973251994095e-04 +-8.9971012943298903e-04 +-8.7429639444593294e-04 +-8.5202031550533723e-04 +-8.3252793355292551e-04 +-8.1550585587444511e-04 +-8.0067743787031180e-04 +-7.8779910302714817e-04 +-7.7665694943829949e-04 +-7.6706371436401034e-04 +-7.5885612060087231e-04 +-7.5189259996807597e-04 +-7.4605137290178808e-04 +-7.4122885486258591e-04 +-7.3733835675788314e-04 +-7.3430904638561480e-04 +-7.3208513947512464e-04 +-7.3062529194361158e-04 +-7.2990216868955575e-04 +-2.0560418853814806e-03 +-2.0601355004371768e-03 +-2.0684698539423872e-03 +-2.0813362132350885e-03 +-2.0991525475600029e-03 +-2.1224038675056079e-03 +-2.1514806551852983e-03 +-2.1863020997497829e-03 +-2.2255927464457006e-03 +-2.2658874771783809e-03 +-2.3008882441182300e-03 +-2.3221721040473427e-03 +-2.3215440384607589e-03 +-2.2938544817179343e-03 +-2.2385615313452799e-03 +-2.1593548054833407e-03 +-2.0624946627608009e-03 +-1.9549542002938801e-03 +-1.8430703549061633e-03 +-1.7318708985879585e-03 +-1.6249279328966761e-03 +-1.5245114183415167e-03 +-1.4318614955523411e-03 +-1.3474710981320871e-03 +-1.2713285681288222e-03 +-1.2031054360820365e-03 +-1.1422920970089148e-03 +-1.0882907775626892e-03 +-1.0404762695370281e-03 +-9.9823362369324013e-04 +-9.6098003290804462e-04 +-9.2817623670360394e-04 +-8.9933121688659946e-04 +-8.7400276756570438e-04 +-8.5179566499002770e-04 +-8.3235856254943689e-04 +-8.1538032648749089e-04 +-8.0058625337857121e-04 +-7.8773442966937756e-04 +-7.7661237653386516e-04 +-7.6703404893558376e-04 +-7.5883721162037752e-04 +-7.5188118708219623e-04 +-7.4604495474021556e-04 +-7.4122557246285054e-04 +-7.3733688823356233e-04 +-7.3430850955729255e-04 +-7.3208499982608578e-04 +-7.3062527385062939e-04 +-7.2990216846324210e-04 +-2.0529859041437848e-03 +-2.0570929450945716e-03 +-2.0655191274268707e-03 +-2.0786831104357669e-03 +-2.0971796789601349e-03 +-2.1216816879397566e-03 +-2.1526971847331865e-03 +-2.1900667896366413e-03 +-2.2321231168655471e-03 +-2.2747108920497319e-03 +-2.3107867586254402e-03 +-2.3315001179202350e-03 +-2.3287787949220098e-03 +-2.2980632045954785e-03 +-2.2395598354298476e-03 +-2.1575639298448842e-03 +-2.0586581491422130e-03 +-1.9498738421650920e-03 +-1.8374389661732751e-03 +-1.7262042200623178e-03 +-1.6195635738770167e-03 +-1.5196402844846592e-03 +-1.4275678453396180e-03 +-1.3437688876405049e-03 +-1.2681896611155812e-03 +-1.2004794544764135e-03 +-1.1401193793993474e-03 +-1.0865102696319834e-03 +-1.0390299559372266e-03 +-9.9706873202380425e-04 +-9.6004987638572065e-04 +-9.2744027235585941e-04 +-8.9875468653141015e-04 +-8.7355614604160974e-04 +-8.5145404680801674e-04 +-8.3210105924390180e-04 +-8.1518951088773524e-04 +-8.0044766568827905e-04 +-7.8763614810619959e-04 +-7.7654464879726222e-04 +-7.6698897762833725e-04 +-7.5880848557219533e-04 +-7.5186385041761596e-04 +-7.4603520603162203e-04 +-7.4122058708105771e-04 +-7.3733465793480578e-04 +-7.3430769429617146e-04 +-7.3208478775404725e-04 +-7.3062524637575827e-04 +-7.2990216812140931e-04 +-2.0445816079631175e-03 +-2.0486934917717512e-03 +-2.0571890944266493e-03 +-2.0706026950017367e-03 +-2.0896823807273969e-03 +-2.1152424045344969e-03 +-2.1478291265971164e-03 +-2.1871093918004059e-03 +-2.2309844262945965e-03 +-2.2747276436566226e-03 +-2.3108547105592171e-03 +-2.3304420428349650e-03 +-2.3257316880249319e-03 +-2.2926855575221188e-03 +-2.2320201630568366e-03 +-2.1483873761431235e-03 +-2.0485290334770895e-03 +-1.9394658637204472e-03 +-1.8273075787111751e-03 +-1.7167430750649674e-03 +-1.6110077957587898e-03 +-1.5120947728274228e-03 +-1.4210432667341182e-03 +-1.3382151005929359e-03 +-1.2635222286527966e-03 +-1.1965985548706851e-03 +-1.1369221633408201e-03 +-1.0838982446002812e-03 +-1.0369129069464271e-03 +-9.9536639018192011e-04 +-9.5869221706767929e-04 +-9.2636704308271132e-04 +-8.9791455146234571e-04 +-8.7290568405229961e-04 +-8.5095674005791636e-04 +-8.3172634506527298e-04 +-8.1491193040830290e-04 +-8.0024611933222434e-04 +-7.8749325513301173e-04 +-7.7644620136102418e-04 +-7.6692347694216965e-04 +-7.5876674702266998e-04 +-7.5183866492850636e-04 +-7.4602104603931562e-04 +-7.4121334683199293e-04 +-7.3733141927047026e-04 +-7.3430651055528316e-04 +-7.3208447985368688e-04 +-7.3062520648843360e-04 +-7.2990216762661847e-04 +-2.0242505832266076e-03 +-2.0283380502690417e-03 +-2.0368093540448309e-03 +-2.0502446563724886e-03 +-2.0694451486822983e-03 +-2.0952496001979976e-03 +-2.1281435553215074e-03 +-2.1676048879926621e-03 +-2.2112599695005603e-03 +-2.2541900495182347e-03 +-2.2890005267815271e-03 +-2.3071667505655041e-03 +-2.3014251078983480e-03 +-2.2680634898223262e-03 +-2.2078618876650996e-03 +-2.1253532901023288e-03 +-2.0270975494340324e-03 +-1.9199401590566276e-03 +-1.8098428797390475e-03 +-1.7013747930007029e-03 +-1.5976782817422772e-03 +-1.5006794339091371e-03 +-1.4113750848237371e-03 +-1.3301057219697820e-03 +-1.2567783502672779e-03 +-1.1910333718389522e-03 +-1.1323624487663373e-03 +-1.0801880141730166e-03 +-1.0339146650907151e-03 +-9.9296081531747150e-04 +-9.5677694150155337e-04 +-9.2485498721259489e-04 +-8.9673211160004151e-04 +-8.7199095429843086e-04 +-8.5025786657652407e-04 +-8.3120005765125870e-04 +-8.1452226336735357e-04 +-7.9996331477159399e-04 +-7.8729283187823262e-04 +-7.7630816841308423e-04 +-7.6683166939034127e-04 +-7.5870826315685522e-04 +-7.5180338506286256e-04 +-7.4600121573816338e-04 +-7.4120320953400534e-04 +-7.3732688559218569e-04 +-7.3430485374722403e-04 +-7.3208404895780160e-04 +-7.3062515067252257e-04 +-7.2990216693543915e-04 +-1.9822079636128854e-03 +-1.9862153477142506e-03 +-1.9944974110500413e-03 +-2.0075756060452198e-03 +-2.0261615176780674e-03 +-2.0509734464942741e-03 +-2.0823574681614241e-03 +-2.1196822822076473e-03 +-2.1606093468526308e-03 +-2.2005522323781243e-03 +-2.2328081127423482e-03 +-2.2497205568288050e-03 +-2.2446766283428835e-03 +-2.2140738183708776e-03 +-2.1582592289122971e-03 +-2.0810653048780130e-03 +-1.9883895493292736e-03 +-1.8866155468421732e-03 +-1.7814558991234349e-03 +-1.6773832414349850e-03 +-1.5775300284850316e-03 +-1.4838531561104473e-03 +-1.3973961546472947e-03 +-1.3185505753032965e-03 +-1.2472739611048456e-03 +-1.1832546237799410e-03 +-1.1260284997587347e-03 +-1.0750581432344114e-03 +-1.0297839031320228e-03 +-9.8965559291595341e-04 +-9.5415093315043384e-04 +-9.2278527577404766e-04 +-8.9511574344972164e-04 +-8.7074191152203707e-04 +-8.4930445030582653e-04 +-8.3048265574580565e-04 +-8.1399146401995627e-04 +-7.9957832272152421e-04 +-7.8702014346314342e-04 +-7.7612046391116116e-04 +-7.6670688472732984e-04 +-7.5862880726691858e-04 +-7.5175547349541822e-04 +-7.4597429524226244e-04 +-7.4118945219947422e-04 +-7.3732073466318084e-04 +-7.3430260644516301e-04 +-7.3208346459329484e-04 +-7.3062507498665517e-04 +-7.2990216599925334e-04 +-1.9092050028238694e-03 +-1.9130575383074189e-03 +-1.9209580981537628e-03 +-1.9332866047359785e-03 +-1.9505545585675240e-03 +-1.9732551543522048e-03 +-2.0015569645604708e-03 +-2.0348217390539045e-03 +-2.0710320376934031e-03 +-2.1063691343233843e-03 +-2.1352927309817942e-03 +-2.1513852451755296e-03 +-2.1488554627519590e-03 +-2.1241323097491186e-03 +-2.0768108744657694e-03 +-2.0095479015923845e-03 +-1.9270875837569046e-03 +-1.8349705924042778e-03 +-1.7384451440022129e-03 +-1.6418233170964599e-03 +-1.5482643928000129e-03 +-1.4598418764357013e-03 +-1.3777440557733425e-03 +-1.3025039686438242e-03 +-1.2342048046603692e-03 +-1.1726417404235472e-03 +-1.1174399131620768e-03 +-1.0681358092305767e-03 +-1.0242309430677115e-03 +-9.8522574230254815e-04 +-9.5063984559193456e-04 +-9.2002335567672522e-04 +-8.9296223670263099e-04 +-8.6908003393847404e-04 +-8.4803737381831848e-04 +-8.2953020353746562e-04 +-8.1328739038702912e-04 +-7.9906807344040187e-04 +-7.8665900901904375e-04 +-7.7587205190767221e-04 +-7.6654184960997724e-04 +-7.5852378551529429e-04 +-7.5169218093802974e-04 +-7.4593875038356770e-04 +-7.4117129563059715e-04 +-7.3731261996187215e-04 +-7.3429964260545994e-04 +-7.3208269409777297e-04 +-7.3062497521042937e-04 +-7.2990216476598823e-04 +-1.8021240096412340e-03 +-1.8057462008610188e-03 +-1.8131018116986542e-03 +-1.8244054455898394e-03 +-1.8399383640199315e-03 +-1.8599450820449238e-03 +-1.8844221653365177e-03 +-1.9127839413074759e-03 +-1.9434582058029989e-03 +-1.9735661277096783e-03 +-1.9989185606449958e-03 +-2.0145231682960258e-03 +-2.0155873772632984e-03 +-1.9987027012880387e-03 +-1.9627216166416338e-03 +-1.9089578776147074e-03 +-1.8406878489572107e-03 +-1.7622488028059477e-03 +-1.6781227740207251e-03 +-1.5922734233767037e-03 +-1.5078132018251176e-03 +-1.4269417767782124e-03 +-1.3510479693969570e-03 +-1.2808792962641106e-03 +-1.2167171388901708e-03 +-1.1585272386450585e-03 +-1.1060762352430396e-03 +-1.0590159067453853e-03 +-1.0169410052368929e-03 +-9.7942724834964678e-04 +-9.4605517719847064e-04 +-9.1642432434508420e-04 +-8.9016093758312689e-04 +-8.6692153826433294e-04 +-8.4639387144590629e-04 +-8.2829629083681748e-04 +-8.1237626500217566e-04 +-7.9840844859943496e-04 +-7.8619259931164980e-04 +-7.7555151263037118e-04 +-7.6632907516584138e-04 +-7.5838849065378304e-04 +-7.5161070309313275e-04 +-7.4589302295895393e-04 +-7.4114795148468504e-04 +-7.3730219209236286e-04 +-7.3429583550155058e-04 +-7.3208170470505439e-04 +-7.3062484711656909e-04 +-7.2990216318359114e-04 +-1.6665491009410522e-03 +-1.6698834221402933e-03 +-1.6765929507409688e-03 +-1.6867545080154606e-03 +-1.7004584599199428e-03 +-1.7177462305774578e-03 +-1.7384823446738005e-03 +-1.7621490417967667e-03 +-1.7875891434824492e-03 +-1.8127814176091925e-03 +-1.8347850262155005e-03 +-1.8499863519910757e-03 +-1.8546832549190366e-03 +-1.8458711460433322e-03 +-1.8219530885427810e-03 +-1.7830952258696331e-03 +-1.7311077429834503e-03 +-1.6689456005246539e-03 +-1.6000559656461676e-03 +-1.5277947932700394e-03 +-1.4550384591670825e-03 +-1.3840086042317555e-03 +-1.3162611603250590e-03 +-1.2527710826520395e-03 +-1.1940549711777649e-03 +-1.1402945279890755e-03 +-1.0914425466392709e-03 +-1.0473057081075994e-03 +-1.0076052119208181e-03 +-9.7201903565187931e-04 +-9.4021015759125832e-04 +-9.1184461037663301e-04 +-8.8660244487132392e-04 +-8.6418390095055996e-04 +-8.4431242834172293e-04 +-8.2673569988923293e-04 +-8.1122539452633906e-04 +-7.9757626924719315e-04 +-7.8560486078660678e-04 +-7.7514803589057082e-04 +-7.6606152692299196e-04 +-7.5821853480453536e-04 +-7.5150844528709443e-04 +-7.4583568136814434e-04 +-7.4111870016115521e-04 +-7.3728913396215779e-04 +-7.3429107068416607e-04 +-7.3208046693683129e-04 +-7.3062468691203369e-04 +-7.2990216120537646e-04 +-1.5143568406454603e-03 +-1.5173737803530344e-03 +-1.5234027577467465e-03 +-1.5324310597927644e-03 +-1.5444256777914468e-03 +-1.5592990371766850e-03 +-1.5768387836471349e-03 +-1.5965933863873925e-03 +-1.6177234962966519e-03 +-1.6388592251116265e-03 +-1.6580348522450680e-03 +-1.6727818990904940e-03 +-1.6804253256276637e-03 +-1.6785446628029624e-03 +-1.6654697558156524e-03 +-1.6406395371082320e-03 +-1.6046979398731055e-03 +-1.5593105895417461e-03 +-1.5067927908359710e-03 +-1.4496869068785336e-03 +-1.3904064273323777e-03 +-1.3310060982248701e-03 +-1.2730810223181895e-03 +-1.2177640880566404e-03 +-1.1657818265390814e-03 +-1.1175347740453340e-03 +-1.0731798109225104e-03 +-1.0327025875996976e-03 +-9.9597566729685847e-04 +-9.6280235671857635e-04 +-9.3294820266656231e-04 +-9.0616272822040809e-04 +-8.8219386287839133e-04 +-8.6079711757609627e-04 +-8.4174109636442210e-04 +-8.2481052369011909e-04 +-8.0980763279851320e-04 +-7.9655250733047360e-04 +-7.8488278269529994e-04 +-7.7465298145065298e-04 +-7.6573366419256357e-04 +-7.5801051343978509e-04 +-7.5138342440965043e-04 +-7.4576564737523752e-04 +-7.4108300713819056e-04 +-7.3727321297943204e-04 +-7.3428526510866125e-04 +-7.3207895958783827e-04 +-7.3062449188476711e-04 +-7.2990215879809440e-04 +-1.3589608083387139e-03 +-1.3616588238569288e-03 +-1.3670266257390282e-03 +-1.3750060897649856e-03 +-1.3855025850238994e-03 +-1.3983673547776291e-03 +-1.4133616302236059e-03 +-1.4300975203887358e-03 +-1.4479586803313248e-03 +-1.4660179310765167e-03 +-1.4829856670664100e-03 +-1.4972326192462322e-03 +-1.5069213372008213e-03 +-1.5102468539684108e-03 +-1.5057383163402508e-03 +-1.4925352133637463e-03 +-1.4705497432245462e-03 +-1.4404663507229265e-03 +-1.4035896773289945e-03 +-1.3616007925980006e-03 +-1.3162976343545775e-03 +-1.2693801274402472e-03 +-1.2223096968797527e-03 +-1.1762441578724333e-03 +-1.1320315526607721e-03 +-1.0902410294870563e-03 +-1.0512112806058849e-03 +-1.0151027429425395e-03 +-9.8194554388860897e-04 +-9.5167960039323814e-04 +-9.2418609066626401e-04 +-8.9931101135736771e-04 +-8.7688214456919358e-04 +-8.5672086452337774e-04 +-8.3865007389695998e-04 +-8.2249933092040119e-04 +-8.0810799201373957e-04 +-7.9532698705752540e-04 +-7.8401967640803684e-04 +-7.7406210953630792e-04 +-7.6534290901157035e-04 +-7.5776293369792934e-04 +-7.5123482524890126e-04 +-7.4568250710755550e-04 +-7.4104068122531432e-04 +-7.3725435155624290e-04 +-7.3427839281962957e-04 +-7.3207717638978031e-04 +-7.3062426126544301e-04 +-7.2990215595250074e-04 +-1.2115527588368758e-03 +-1.2139519437417972e-03 +-1.2187140769695042e-03 +-1.2257657203657657e-03 +-1.2349927892531089e-03 +-1.2462318055627216e-03 +-1.2592523775114988e-03 +-1.2737282483283173e-03 +-1.2891975100007981e-03 +-1.3050187560928680e-03 +-1.3203379830823629e-03 +-1.3340874894701364e-03 +-1.3450376029418825e-03 +-1.3519105665918973e-03 +-1.3535443222292146e-03 +-1.3490705880532666e-03 +-1.3380590065347408e-03 +-1.3205858932282901e-03 +-1.2972103565158518e-03 +-1.2688704348926487e-03 +-1.2367334472544469e-03 +-1.2020404203947409e-03 +-1.1659759294898634e-03 +-1.1295793941552090e-03 +-1.0936994211166653e-03 +-1.0589834457775014e-03 +-1.0258912908641558e-03 +-9.9472174986018746e-04 +-9.6564383260104700e-04 +-9.3872727159249078e-04 +-9.1396940257581051e-04 +-8.9131730886497318e-04 +-8.7068519711961658e-04 +-8.5196752410329377e-04 +-8.3504860376105289e-04 +-8.1980943876443278e-04 +-8.0613244067657237e-04 +-7.9390458857099382e-04 +-7.8301945979426801e-04 +-7.7337846357612282e-04 +-7.6489152340144140e-04 +-7.5747738745874011e-04 +-7.5106369585675205e-04 +-7.4558689577509680e-04 +-7.4099206848256575e-04 +-7.3723271278169835e-04 +-7.3427051594322920e-04 +-7.3207513400834370e-04 +-7.3062399725779621e-04 +-7.2990215269610353e-04 +-1.0795763413648230e-03 +-1.0817103314207993e-03 +-1.0859424671201458e-03 +-1.0922004801074017e-03 +-1.1003738546326736e-03 +-1.1103095150300163e-03 +-1.1218034608092521e-03 +-1.1345870558311646e-03 +-1.1483079528855490e-03 +-1.1625081988113507e-03 +-1.1766056754371045e-03 +-1.1898885308890251e-03 +-1.2015335732828867e-03 +-1.2106565377859734e-03 +-1.2163939044527782e-03 +-1.2180045454986156e-03 +-1.2149696323511426e-03 +-1.2070661205207047e-03 +-1.1943951599827660e-03 +-1.1773597304117523e-03 +-1.1565999970774054e-03 +-1.1329045617481381e-03 +-1.1071181381120485e-03 +-1.0800621249191849e-03 +-1.0524772631822726e-03 +-1.0249903594794212e-03 +-9.9810197572230454e-04 +-9.7218954102967119e-04 +-9.4752002224397270e-04 +-9.2426721930825156e-04 +-9.0253014597876035e-04 +-8.8235030699089501e-04 +-8.6372675154195919e-04 +-8.4662851694749608e-04 +-8.3100451899303614e-04 +-8.1679117312025249e-04 +-8.0391811753422013e-04 +-7.9231241412869530e-04 +-7.8190156625421311e-04 +-7.7261563907241536e-04 +-7.6438871283572378e-04 +-7.5715984902932317e-04 +-7.5087370673591804e-04 +-7.4548091229760570e-04 +-7.4093825866761317e-04 +-7.3720879062116949e-04 +-7.3426181700655382e-04 +-7.3207288031946756e-04 +-7.3062370609917882e-04 +-7.2990214910609416e-04 +-9.6691812624956353e-04 +-9.6882710296450987e-04 +-9.7261319036229797e-04 +-9.7821229164966037e-04 +-9.8552707255230459e-04 +-9.9442479083576931e-04 +-1.0047332982435083e-03 +-1.0162346396425600e-03 +-1.0286561653943256e-03 +-1.0416601080196846e-03 +-1.0548341237904876e-03 +-1.0676870038421303e-03 +-1.0796548626365481e-03 +-1.0901226464583292e-03 +-1.0984630808757165e-03 +-1.1040903990102314e-03 +-1.1065207795119653e-03 +-1.1054276057935206e-03 +-1.1006793891717142e-03 +-1.0923519850614659e-03 +-1.0807132217732342e-03 +-1.0661847359866553e-03 +-1.0492903092535145e-03 +-1.0306012097945907e-03 +-1.0106873253127523e-03 +-9.9007952433345799e-04 +-9.6924513740101676e-04 +-9.4857569305260630e-04 +-9.2838445119368352e-04 +-9.0891074644958722e-04 +-8.9032835344692593e-04 +-8.7275565593671230e-04 +-8.5626606754691918e-04 +-8.4089775116471881e-04 +-8.2666214750549592e-04 +-8.1355114266261764e-04 +-8.0154290096667781e-04 +-7.9060649473217766e-04 +-7.8070550643263045e-04 +-7.7180078549280860e-04 +-7.6385252832125402e-04 +-7.5682182760025793e-04 +-7.5067181190164049e-04 +-7.4536847303428389e-04 +-7.4088125783421739e-04 +-7.3718348390413202e-04 +-7.3425262500473505e-04 +-7.3207050099349000e-04 +-7.3062339889621815e-04 +-7.2990214531963951e-04 +-8.7486278289636212e-04 +-8.7658861444566717e-04 +-8.8001322994705599e-04 +-8.8508229339509298e-04 +-8.9171358997070156e-04 +-8.9979588099961495e-04 +-9.0918694231513790e-04 +-9.1971055650673296e-04 +-9.3115242093144257e-04 +-9.4325534847605503e-04 +-9.5571478804763201e-04 +-9.6817647208673370e-04 +-9.8023864739843285e-04 +-9.9146147535564212e-04 +-1.0013854250450853e-03 +-1.0095586981657921e-03 +-1.0155712317526935e-03 +-1.0190903960333494e-03 +-1.0198921027376922e-03 +-1.0178813601038738e-03 +-1.0130983943336066e-03 +-1.0057096228316908e-03 +-9.9598593046599181e-04 +-9.8427288859874668e-04 +-9.7095828615275271e-04 +-9.5644171806322405e-04 +-9.4110950537905998e-04 +-9.2531651272076334e-04 +-9.0937495772062536e-04 +-8.9354931356689185e-04 +-8.7805591701627258e-04 +-8.6306580679889136e-04 +-8.4870948249650673e-04 +-8.3508255581677749e-04 +-8.2225156764290487e-04 +-8.1025950986229097e-04 +-7.9913079801305223e-04 +-7.8887558727446200e-04 +-7.7949341889857915e-04 +-7.7097623909273231e-04 +-7.6331085953557955e-04 +-7.5648093797947829e-04 +-7.5046855606760484e-04 +-7.4525546459325732e-04 +-7.4082405715992659e-04 +-7.3715812346063767e-04 +-7.3424342420754939e-04 +-7.3206812156180381e-04 +-7.3062309187265967e-04 +-7.2990214153675209e-04 +-8.0313985311697162e-04 +-8.0472331051501032e-04 +-8.0786751383971002e-04 +-8.1252687338977786e-04 +-8.1863254943242796e-04 +-8.2609180340835020e-04 +-8.3478698137655414e-04 +-8.4457405449203324e-04 +-8.5528071934802248e-04 +-8.6670423016622521e-04 +-8.7860940723799141e-04 +-8.9072761393995488e-04 +-9.0275783033017518e-04 +-9.1437112715341202e-04 +-9.2521968925655745e-04 +-9.3495093349667952e-04 +-9.4322623624259170e-04 +-9.4974254597150016e-04 +-9.5425408144585741e-04 +-9.5659080424415793e-04 +-9.5667065181150035e-04 +-9.5450359001790128e-04 +-9.5018708022461484e-04 +-9.4389409608806331e-04 +-9.3585595338525462e-04 +-9.2634270554079335e-04 +-9.1564371476185306e-04 +-9.0405041584314724e-04 +-8.9184249813895966e-04 +-8.7927796449079846e-04 +-8.6658692600483480e-04 +-8.5396861120165936e-04 +-8.4159089274412084e-04 +-8.2959161464356073e-04 +-8.1808107885780398e-04 +-8.0714517178665760e-04 +-7.9684874227978122e-04 +-7.8723896208683490e-04 +-7.7834849746808690e-04 +-7.7019839485283721e-04 +-7.6280063610092248e-04 +-7.5616035399914236e-04 +-7.5027772032271785e-04 +-7.4514953087822307e-04 +-7.4077051745560936e-04 +-7.3713441783090331e-04 +-7.3423483350911953e-04 +-7.3206590188246601e-04 +-7.3062280563801615e-04 +-7.2990213801123031e-04 +-7.5076497827818720e-04 +-7.5224453958569698e-04 +-7.5518428828097559e-04 +-7.5954535463977038e-04 +-7.6526911940205244e-04 +-7.7227680983530528e-04 +-7.8046892425969209e-04 +-7.8972447387438245e-04 +-7.9990006559781026e-04 +-8.1082892189207622e-04 +-8.2232005093715573e-04 +-8.3415793699531866e-04 +-8.4610328761641047e-04 +-8.5789549649894364e-04 +-8.6925748519856992e-04 +-8.7990340531286814e-04 +-8.8954928614317188e-04 +-8.9792614223334463e-04 +-9.0479443117971964e-04 +-9.0995824844281189e-04 +-9.1327743094290158e-04 +-9.1467591059802710e-04 +-9.1414519208762326e-04 +-9.1174259292399105e-04 +-9.0758468238412188e-04 +-9.0183700082320615e-04 +-8.9470151106729972e-04 +-8.8640329954202055e-04 +-8.7717785726448535e-04 +-8.6725992613117338e-04 +-8.5687449759715454e-04 +-8.4623018166832644e-04 +-8.3551487390620216e-04 +-8.2489345469248119e-04 +-8.1450715272077582e-04 +-8.0447417505979393e-04 +-7.9489122654749999e-04 +-7.8583559076250784e-04 +-7.7736750685379098e-04 +-7.6953263968481214e-04 +-7.6236449819888999e-04 +-7.5588670527171027e-04 +-7.5011506059422764e-04 +-7.4505936677804116e-04 +-7.4072500909779101e-04 +-7.3711429255884323e-04 +-7.3422754778728813e-04 +-7.3206402090606208e-04 +-7.3062256321562973e-04 +-7.2990213502622950e-04 +-7.1661654721994069e-04 +-7.1802826137760359e-04 +-7.2083452289567192e-04 +-7.2500090252392154e-04 +-7.3047551805007892e-04 +-7.3718875094696287e-04 +-7.4505287523945378e-04 +-7.5396161176819463e-04 +-7.6378963928976345e-04 +-7.7439212827457070e-04 +-7.8560441848029509e-04 +-7.9724203707651512e-04 +-8.0910134099274836e-04 +-8.2096114427007531e-04 +-8.3258572672351237e-04 +-8.4372957808585196e-04 +-8.5414408387212261e-04 +-8.6358610026870041e-04 +-8.7182802469060606e-04 +-8.7866861125311072e-04 +-8.8394349373600162e-04 +-8.8753424711391856e-04 +-8.8937489479858848e-04 +-8.8945505236659830e-04 +-8.8781933459021142e-04 +-8.8456314739285898e-04 +-8.7982543661586617e-04 +-8.7377928779614313e-04 +-8.6662142153721099e-04 +-8.5856160759475541e-04 +-8.4981286282666637e-04 +-8.4058305800158227e-04 +-8.3106829252085088e-04 +-8.2144815034544021e-04 +-8.1188275417088264e-04 +-8.0251140050510261e-04 +-7.9345248453030069e-04 +-7.8480440059691193e-04 +-7.7664711817527555e-04 +-7.6904417014475081e-04 +-7.6204483850298723e-04 +-7.5568637299295725e-04 +-7.4999612489298577e-04 +-7.4499351804039812e-04 +-7.4069181078704636e-04 +-7.3709962605734546e-04 +-7.3422224281726725e-04 +-7.3206265223555909e-04 +-7.3062238690259969e-04 +-7.2990213285581526e-04 +-6.9978953524362409e-04 +-7.0116752304433781e-04 +-7.0390741839691470e-04 +-7.0797697812778875e-04 +-7.1332763510900622e-04 +-7.1989426751745296e-04 +-7.2759491195638478e-04 +-7.3633044122440195e-04 +-7.4598423986972856e-04 +-7.5642193178311937e-04 +-7.6749124723187259e-04 +-7.7902216299325137e-04 +-7.9082750520781202e-04 +-8.0270426033418097e-04 +-8.1443587802481373e-04 +-8.2579584834721370e-04 +-8.3655277176152834e-04 +-8.4647699866521441e-04 +-8.5534869804780383e-04 +-8.6296694724946046e-04 +-8.6915916593160579e-04 +-8.7379001079284009e-04 +-8.7676876469265413e-04 +-8.7805433378662407e-04 +-8.7765721031255470e-04 +-8.7563812614920022e-04 +-8.7210354052249964e-04 +-8.6719849023486953e-04 +-8.6109761074522253e-04 +-8.5399526972507590e-04 +-8.4609573669210928e-04 +-8.3760417036243828e-04 +-8.2871898612898553e-04 +-8.1962592059307750e-04 +-8.1049388156576745e-04 +-8.0147248902577085e-04 +-7.9269108786988833e-04 +-7.8425894637300267e-04 +-7.7626633584612214e-04 +-7.6878620377678238e-04 +-7.6187619113161995e-04 +-7.5558079282662743e-04 +-7.4993350992866921e-04 +-7.4495888731465436e-04 +-7.4067436827916452e-04 +-7.3709192689361410e-04 +-7.3421946001710312e-04 +-7.3206193469117613e-04 +-7.3062229450461048e-04 +-7.2990213171862011e-04 +-6.9978944881348803e-04 +-7.0116674418540560e-04 +-7.0390524989566558e-04 +-7.0797271550787980e-04 +-7.1332056874017511e-04 +-7.1988369148966202e-04 +-7.2758014162682574e-04 +-7.3631084078596473e-04 +-7.4595926032340154e-04 +-7.5639115824927819e-04 +-7.6745445263175921e-04 +-7.7897936295113731e-04 +-7.9077900693139472e-04 +-8.0265069675875239e-04 +-8.1437821826359192e-04 +-8.2573537698794235e-04 +-8.3649103299163880e-04 +-8.4641570630756148e-04 +-8.5528961850712059e-04 +-8.6291176784316758e-04 +-8.6910936473948771e-04 +-8.7374674495545746e-04 +-8.7673279164658972e-04 +-8.7802597471462894e-04 +-8.7763635829391255e-04 +-8.7562429465893644e-04 +-8.7209594247928757e-04 +-8.6719613467815240e-04 +-8.6109940370082086e-04 +-8.5400010753858020e-04 +-8.4610258330495983e-04 +-8.3761211378091237e-04 +-8.2872727290604175e-04 +-8.1963396997603759e-04 +-8.1050128281932171e-04 +-8.0147898632734651e-04 +-7.9269655726343837e-04 +-7.8426336880159451e-04 +-7.7626976950959179e-04 +-7.6878875818293967e-04 +-7.6187800437281788e-04 +-7.5558201290291981e-04 +-7.4993428038997248e-04 +-7.4495933710818903e-04 +-7.4067460544496866e-04 +-7.3709203562018102e-04 +-7.3421950051922983e-04 +-7.3206194537336075e-04 +-7.3062229590106407e-04 +-7.2990213173594512e-04 +-7.1661627442051994e-04 +-7.1802580307239272e-04 +-7.2082767859447613e-04 +-7.2498744945024575e-04 +-7.3045321911174214e-04 +-7.3715538520744838e-04 +-7.4500629715800208e-04 +-7.5389984349456287e-04 +-7.6371099688428759e-04 +-7.7429537763818921e-04 +-7.8548895016278795e-04 +-7.9710804169876091e-04 +-8.0894996015802004e-04 +-8.2079456750248697e-04 +-8.3240720527800874e-04 +-8.4354333303869936e-04 +-8.5395509905398387e-04 +-8.6339980880850177e-04 +-8.7164991775941952e-04 +-8.7850381439533837e-04 +-8.8379636544172848e-04 +-8.8740805314823572e-04 +-8.8927160009238818e-04 +-8.8937525267624080e-04 +-8.8776232733982902e-04 +-8.8452712031027246e-04 +-8.7980773810818398e-04 +-8.7377673658224728e-04 +-8.6663061470143902e-04 +-8.5857919403256296e-04 +-8.4983576022960481e-04 +-8.4060860330264749e-04 +-8.3109432596317528e-04 +-8.2147304083187410e-04 +-8.1190537795723303e-04 +-8.0253108691994215e-04 +-7.9346894190322997e-04 +-7.8481763372490300e-04 +-7.7665734615344807e-04 +-7.6905175077251532e-04 +-7.6205020310231070e-04 +-7.5568997352938887e-04 +-7.4999839383134924e-04 +-7.4499484037076908e-04 +-7.4069250705098859e-04 +-7.3709994489900589e-04 +-7.3422236148809378e-04 +-7.3206268351453123e-04 +-7.3062239098989129e-04 +-7.2990213290647537e-04 +-7.5076447633165750e-04 +-7.5224001636717459e-04 +-7.5517169539141081e-04 +-7.5952060507933166e-04 +-7.6522810719364346e-04 +-7.7221547536339039e-04 +-7.8038337774521526e-04 +-7.8961118487884678e-04 +-7.9975611869537340e-04 +-8.1065232724185669e-04 +-8.2211008397532282e-04 +-8.3391546581635962e-04 +-8.4583103335980972e-04 +-8.5759816585305178e-04 +-8.6894171953975691e-04 +-8.7957751068550505e-04 +-8.8922274123586626e-04 +-8.9760892212059715e-04 +-9.0449622349626649e-04 +-9.0968766529737856e-04 +-9.1304132616464343e-04 +-9.1447889528191049e-04 +-9.1398940594289066e-04 +-9.1162774391981348e-04 +-9.0750832382814736e-04 +-9.0179498275177311e-04 +-8.9468852683346242e-04 +-8.8641344898175093e-04 +-8.7720516113630801e-04 +-8.6729874705671918e-04 +-8.5691984488280742e-04 +-8.4627789689636294e-04 +-8.3556170864017060e-04 +-8.2493706036905782e-04 +-8.1454600636300862e-04 +-8.0450746407268706e-04 +-7.9491871295320725e-04 +-7.8585747106465890e-04 +-7.7738427925637301e-04 +-7.6954498626629784e-04 +-7.6237318620001819e-04 +-7.5589250901714861e-04 +-7.5011870370968593e-04 +-7.4506148317842738e-04 +-7.4072612056720751e-04 +-7.3711480047435963e-04 +-7.3422773652425061e-04 +-7.3206407059380862e-04 +-7.3062256970337660e-04 +-7.2990213510663372e-04 +-8.0313904321634958e-04 +-8.0471601227341191e-04 +-8.0784719626702097e-04 +-8.1248694928436006e-04 +-8.1856641954298993e-04 +-8.2599298517076398e-04 +-8.3464934431371071e-04 +-8.4439217458529741e-04 +-8.5505034810037437e-04 +-8.6642285012915690e-04 +-8.7827681633971305e-04 +-8.9034645126207293e-04 +-9.0233393460319037e-04 +-9.1391361641337263e-04 +-9.2474067422088806e-04 +-9.3446483036726115e-04 +-9.4274871920293352e-04 +-9.4928925827809322e-04 +-9.5383928433060556e-04 +-9.5622616547882315e-04 +-9.5636435234532449e-04 +-9.5425986392685773e-04 +-9.5000621888879921e-04 +-9.4377286544234762e-04 +-9.3578831292120274e-04 +-9.2632068959204493e-04 +-9.1565833992648688e-04 +-9.0409250480715040e-04 +-8.9190334807729462e-04 +-8.7934982697955935e-04 +-8.6666329766297331e-04 +-8.5404435667405464e-04 +-8.4166223390466893e-04 +-8.2965602376234681e-04 +-8.1813711145728495e-04 +-8.0719226948934423e-04 +-7.9688702912690773e-04 +-7.8726905096860287e-04 +-7.7837131726335006e-04 +-7.7021504399754496e-04 +-7.6281226465823291e-04 +-7.5616807378208124e-04 +-7.5028254103116812e-04 +-7.4515231934134114e-04 +-7.4077197671572369e-04 +-7.3713508279156016e-04 +-7.3423508005825849e-04 +-7.3206596668477938e-04 +-7.3062281409019749e-04 +-7.2990213811590233e-04 +-8.7486153921486145e-04 +-8.7657740741308885e-04 +-8.7998203315246284e-04 +-8.8502100727830561e-04 +-8.9161213670343185e-04 +-8.9964445245017564e-04 +-9.0897643884656372e-04 +-9.1943323319910813e-04 +-9.3080272241182589e-04 +-9.4283086374815294e-04 +-9.5521719848290433e-04 +-9.6761231283787981e-04 +-9.7961967529551454e-04 +-9.9080445606584055e-04 +-1.0007112311900758e-03 +-1.0088907414170982e-03 +-1.0149334056669683e-03 +-1.0185048362212753e-03 +-1.0193771316810262e-03 +-1.0174499516756356e-03 +-1.0127573770492098e-03 +-1.0054596795150334e-03 +-9.9582229576939936e-04 +-9.8418653626300401e-04 +-9.7093735420445023e-04 +-9.5647293754379465e-04 +-9.4117945607952852e-04 +-9.2541260273367257e-04 +-9.0948609195228751e-04 +-8.9366626784802966e-04 +-8.7817146563033514e-04 +-8.6317466436876256e-04 +-8.4880812117716948e-04 +-8.3516895094168039e-04 +-8.2232491373777374e-04 +-8.1031993727077953e-04 +-7.9917910998724795e-04 +-7.8891302901230745e-04 +-7.7952148377845093e-04 +-7.7099651304330351e-04 +-7.6332490172708039e-04 +-7.5649019444963431e-04 +-7.5047430216025450e-04 +-7.4525877191088845e-04 +-7.4082578089911476e-04 +-7.3715890635498468e-04 +-7.3424371373595042e-04 +-7.3206819751585502e-04 +-7.3062310176690069e-04 +-7.2990214165922151e-04 +-9.6691626231682837e-04 +-9.6881030700220064e-04 +-9.7256644073085981e-04 +-9.7812048359448484e-04 +-9.8537521478225484e-04 +-9.9419847760783497e-04 +-1.0044195196009266e-03 +-1.0158229463370619e-03 +-1.0281401292446927e-03 +-1.0410389156018114e-03 +-1.0541140292346170e-03 +-1.0668822806822137e-03 +-1.0787878818252429e-03 +-1.0892228072927413e-03 +-1.0975645403536428e-03 +-1.1032288381695608e-03 +-1.1057297208875070e-03 +-1.1047349502817955e-03 +-1.1001048071518709e-03 +-1.0919055831744688e-03 +-1.0803955924277827e-03 +-1.0659881923895914e-03 +-1.0492009056272203e-03 +-1.0306010820350163e-03 +-1.0107569440598217e-03 +-9.9019957997971181e-04 +-9.6939792039143092e-04 +-9.4874595367537811e-04 +-9.2855980309919546e-04 +-9.0908171707540064e-04 +-8.9048819184670968e-04 +-8.7289999641883091e-04 +-8.5639252663624610e-04 +-8.4100551303965387e-04 +-8.2675157331622991e-04 +-8.1362342365099859e-04 +-8.0159976422014816e-04 +-7.9064996310044026e-04 +-7.8073770974979582e-04 +-7.7182381793665844e-04 +-7.6386834580522735e-04 +-7.5683217900564227e-04 +-7.5067819834696229e-04 +-7.4537213000042601e-04 +-7.4088315566294403e-04 +-7.3718434287266764e-04 +-7.3425294179895264e-04 +-7.3207058393183575e-04 +-7.3062340968572210e-04 +-7.2990214545309178e-04 +-1.0795735988472076e-03 +-1.0816856190050048e-03 +-1.0858736924784045e-03 +-1.0920654795650456e-03 +-1.1001507865901841e-03 +-1.1099777456531688e-03 +-1.1213450417917352e-03 +-1.1339887936719030e-03 +-1.1475639080769967e-03 +-1.1616222447979124e-03 +-1.1755935417667944e-03 +-1.1887786410033844e-03 +-1.2003660647861422e-03 +-1.2094801791015599e-03 +-1.2152611523906474e-03 +-1.2169655588851070e-03 +-1.2140664382040483e-03 +-1.2063281429508469e-03 +-1.1938369463873814e-03 +-1.1769810982878877e-03 +-1.1563882218734852e-03 +-1.1328378370075763e-03 +-1.1071694434014816e-03 +-1.0802027852341272e-03 +-1.0526797565838491e-03 +-1.0252302093727323e-03 +-9.9835877583189805e-04 +-9.7244728095957059e-04 +-9.4776692131513839e-04 +-9.2449526307940115e-04 +-9.0273448041074730e-04 +-8.8252859931264383e-04 +-8.6387858576507295e-04 +-8.4675486023978600e-04 +-8.3110727321283396e-04 +-8.1687281219066320e-04 +-8.0398140385150231e-04 +-7.9236018383432416e-04 +-7.8193657235971898e-04 +-7.7264044197715832e-04 +-7.6440560898262150e-04 +-7.5717082985896230e-04 +-7.5088044148274012e-04 +-7.4548474940688532e-04 +-7.4094024165699383e-04 +-7.3720968506382778e-04 +-7.3426214599190353e-04 +-7.3207296627587827e-04 +-7.3062371726629195e-04 +-7.2990214924412568e-04 +-1.2115488105301257e-03 +-1.2139163670738563e-03 +-1.2186150847149060e-03 +-1.2255715165859196e-03 +-1.2346723272464303e-03 +-1.2457564111103931e-03 +-1.2585983860155421e-03 +-1.2728805895220051e-03 +-1.2881538393320190e-03 +-1.3037933248665557e-03 +-1.3189640950364110e-03 +-1.3326173160169276e-03 +-1.3435385119008496e-03 +-1.3504579885712067e-03 +-1.3522122954548169e-03 +-1.3479220244934683e-03 +-1.3371379571914105e-03 +-1.3199135013966608e-03 +-1.2967850330609903e-03 +-1.2686715892833119e-03 +-1.2367273334734866e-03 +-1.2021864958048807e-03 +-1.1662324615744123e-03 +-1.1299076131179549e-03 +-1.0940660514402122e-03 +-1.0593618156065506e-03 +-1.0262613892255915e-03 +-9.9506962304768171e-04 +-9.6596064767907604e-04 +-9.3900828166839962e-04 +-9.1421295922867985e-04 +-8.9152399714893392e-04 +-8.7085712083569816e-04 +-8.5210774038346456e-04 +-8.3516069129151106e-04 +-8.1989717829348684e-04 +-8.0619958599726402e-04 +-7.9395470833156228e-04 +-7.8305583365722762e-04 +-7.7340401951954472e-04 +-7.6490880589709181e-04 +-7.5748854870867253e-04 +-7.5107050420828759e-04 +-7.4559075691890426e-04 +-7.4099405614944330e-04 +-7.3723360647172192e-04 +-7.3427084381796166e-04 +-7.3207521951189683e-04 +-7.3062400835197973e-04 +-7.2990215283314235e-04 +-1.3589552971458633e-03 +-1.3616091662713773e-03 +-1.3668884842978962e-03 +-1.3747352804883276e-03 +-1.3850564714834065e-03 +-1.3977077179956848e-03 +-1.4124592114211137e-03 +-1.4289379890837718e-03 +-1.4465491139112180e-03 +-1.4643921456755334e-03 +-1.4812062468330034e-03 +-1.4953876916594241e-03 +-1.5051153219104146e-03 +-1.5085863778967830e-03 +-1.5043164551076661e-03 +-1.4914181592263732e-03 +-1.4697693061916687e-03 +-1.4400196639910224e-03 +-1.4034451263911650e-03 +-1.3617075921537895e-03 +-1.3165961272425932e-03 +-1.2698105572338187e-03 +-1.2228183196465220e-03 +-1.1767865662159417e-03 +-1.1325737133859948e-03 +-1.0907587704665797e-03 +-1.0516889245298418e-03 +-1.0155314189592615e-03 +-9.8232151760896239e-04 +-9.5200280320755718e-04 +-9.2445891791478072e-04 +-8.9953739199867067e-04 +-8.7706685126455962e-04 +-8.5686902068168142e-04 +-8.3876681387269267e-04 +-8.2258957491420769e-04 +-8.0817630450526787e-04 +-7.9537749479640220e-04 +-7.8405602820515532e-04 +-7.7408746506765400e-04 +-7.6535994761966271e-04 +-7.5777387693251185e-04 +-7.5124146884274841e-04 +-7.4568625943494398e-04 +-7.4104260620742261e-04 +-7.3725521459137020e-04 +-7.3427870872638367e-04 +-7.3207725863126932e-04 +-7.3062427192413905e-04 +-7.2990215608409513e-04 +-1.5143494837863065e-03 +-1.5173074954674111e-03 +-1.5232184127203726e-03 +-1.5320700023067552e-03 +-1.5438321513044566e-03 +-1.5584249968771799e-03 +-1.5756513228718525e-03 +-1.5950841156984676e-03 +-1.6159179735301473e-03 +-1.6368232853980526e-03 +-1.6558741779464582e-03 +-1.6706322271388483e-03 +-1.6784335625873701e-03 +-1.6768449321706849e-03 +-1.6641610894813858e-03 +-1.6397717882948983e-03 +-1.6042693847892800e-03 +-1.5592763068412092e-03 +-1.5070795807009269e-03 +-1.4502095597485544e-03 +-1.3910813228338278e-03 +-1.3317602103233143e-03 +-1.2738562772165345e-03 +-1.2185181114790023e-03 +-1.1664864373185228e-03 +-1.1181734138627595e-03 +-1.0737447418698199e-03 +-1.0331923337313310e-03 +-9.9639290803012247e-04 +-9.6315231180121028e-04 +-9.3323746081715750e-04 +-9.0639843731840511e-04 +-8.8238319562668438e-04 +-8.6094693693612549e-04 +-8.4185776026118951e-04 +-8.2489978357023260e-04 +-8.0987459348751817e-04 +-7.9660162570924719e-04 +-7.8491789016886776e-04 +-7.7467732046679935e-04 +-7.6574993268150281e-04 +-7.5802091343690943e-04 +-7.5138971265243239e-04 +-7.4576918660819577e-04 +-7.4108481741815121e-04 +-7.3727402259081355e-04 +-7.3428556087523546e-04 +-7.3207903647155663e-04 +-7.3062450183911283e-04 +-7.2990215892091770e-04 +-1.6665398759689986e-03 +-1.6698003098576139e-03 +-1.6763618860928780e-03 +-1.6863024487006578e-03 +-1.6997172617600263e-03 +-1.7166601673152422e-03 +-1.7370194011530823e-03 +-1.7603145491947554e-03 +-1.7854382013823692e-03 +-1.8104246929545056e-03 +-1.8323824103704616e-03 +-1.8477259190784908e-03 +-1.8527487508813202e-03 +-1.8444071893358080e-03 +-1.8210395347033220e-03 +-1.7827387202187851e-03 +-1.7312512104640963e-03 +-1.6694896996294157e-03 +-1.6008838022010460e-03 +-1.5287927265371162e-03 +-1.4561095003227439e-03 +-1.3850783219584541e-03 +-1.3172779570288114e-03 +-1.2537031930474998e-03 +-1.1948861441424114e-03 +-1.1410196685356156e-03 +-1.0920639713631226e-03 +-1.0478302342250884e-03 +-1.0080420549726235e-03 +-9.7237838247282054e-04 +-9.4050225421836442e-04 +-9.1207921804565932e-04 +-8.8678854576710383e-04 +-8.6432956557881810e-04 +-8.4442478248916849e-04 +-8.2682094946638976e-04 +-8.1128888140981445e-04 +-7.9762254153737137e-04 +-7.8563774777257590e-04 +-7.7517072243356864e-04 +-7.6607662469528267e-04 +-7.5822814941676250e-04 +-7.5151423920483866e-04 +-7.4583893293446652e-04 +-7.4112035919339134e-04 +-7.3728987440220333e-04 +-7.3429134073298185e-04 +-7.3208053704735914e-04 +-7.3062469598179360e-04 +-7.2990216131725040e-04 +-1.8021133777789927e-03 +-1.8056504190147231e-03 +-1.8128356330467271e-03 +-1.8238853834376930e-03 +-1.8390883211507380e-03 +-1.8587070306484025e-03 +-1.8827717783617642e-03 +-1.9107485704401349e-03 +-1.9411313547300635e-03 +-1.9711101668320840e-03 +-1.9965484260760238e-03 +-2.0124699839021119e-03 +-2.0140507422693669e-03 +-1.9978080680389527e-03 +-1.9624986031513466e-03 +-1.9093458431796691e-03 +-1.8415628439191767e-03 +-1.7634588085388367e-03 +-1.6795188168776541e-03 +-1.5937298114220635e-03 +-1.5092361643864328e-03 +-1.4282694017662097e-03 +-1.3522452720823438e-03 +-1.2819315675828679e-03 +-1.2176235282049446e-03 +-1.1592954800589994e-03 +-1.1067187414125906e-03 +-1.0595470998040208e-03 +-1.0173756230906583e-03 +-9.7977935479571631e-04 +-9.4633764679891131e-04 +-9.1664862895817780e-04 +-8.9033711293381383e-04 +-8.6705824976981375e-04 +-8.4649852826187077e-04 +-8.2837517753781497e-04 +-8.1243467373552376e-04 +-7.9845080300807619e-04 +-7.8622256661563792e-04 +-7.7557210315701470e-04 +-7.6634273013318757e-04 +-7.5839715968191283e-04 +-7.5161591309590202e-04 +-7.4589593998130276e-04 +-7.4114943683983511e-04 +-7.3730285390692033e-04 +-7.3429607654810331e-04 +-7.3208176722181037e-04 +-7.3062485519837103e-04 +-7.2990216328323236e-04 +-1.9091940133864397e-03 +-1.9129585421505239e-03 +-1.9206831200842924e-03 +-1.9327501972207497e-03 +-1.9496810360611256e-03 +-1.9719920764259759e-03 +-1.9998944389080018e-03 +-2.0328136177090225e-03 +-2.0688106808243907e-03 +-2.1041426162051527e-03 +-2.1333160715415263e-03 +-2.1499077161897689e-03 +-2.1480603445672834e-03 +-2.1240934545949273e-03 +-2.0774838868068369e-03 +-2.0107960958828490e-03 +-1.9287270626784688e-03 +-1.8368146972057324e-03 +-1.7403352213443376e-03 +-1.6436426030857979e-03 +-1.5499386089554827e-03 +-1.4613323299745679e-03 +-1.3790381733247304e-03 +-1.3036062937147649e-03 +-1.2351297973855464e-03 +-1.1734086378117283e-03 +-1.1180693819584468e-03 +-1.0686479558573935e-03 +-1.0246442600150988e-03 +-9.8555665440263154e-04 +-9.5090261386989708e-04 +-9.2023017665211575e-04 +-8.9312343498553480e-04 +-8.6920428742901651e-04 +-8.4813193790265454e-04 +-8.2960111754031072e-04 +-8.1333965955744235e-04 +-7.9910582536604714e-04 +-7.8668562626090248e-04 +-7.7589028391955768e-04 +-7.6655390735140658e-04 +-7.5853142201199144e-04 +-7.5169676065143783e-04 +-7.4594130977207677e-04 +-7.4117259680931032e-04 +-7.3731319894316573e-04 +-7.3429985325560701e-04 +-7.3208274868643674e-04 +-7.3062498226344997e-04 +-7.2990216485292986e-04 +-1.9821980245032372e-03 +-1.9861258207814971e-03 +-1.9942488778227668e-03 +-2.0070916931466385e-03 +-2.0253769662035045e-03 +-2.0498489819513795e-03 +-2.0809008131132960e-03 +-2.1179704877751760e-03 +-2.1588022689133968e-03 +-2.1988836937308241e-03 +-2.2315456156951408e-03 +-2.2490994463159569e-03 +-2.2448334490517952e-03 +-2.2150101344603789e-03 +-2.1598520082854547e-03 +-2.0831140158495492e-03 +-1.9906741015361792e-03 +-1.8889419130942952e-03 +-1.7836797035362278e-03 +-1.6794137371449682e-03 +-1.5793222059556902e-03 +-1.4853953993797882e-03 +-1.3986982077601718e-03 +-1.3196339598031885e-03 +-1.2481652739372109e-03 +-1.1839813204771795e-03 +-1.1266165182710400e-03 +-1.0755307588179433e-03 +-1.0301613400782040e-03 +-9.8995506280225129e-04 +-9.5438688684308106e-04 +-9.2296974101323530e-04 +-8.9525867607675178e-04 +-8.7085152361657172e-04 +-8.4938749940972837e-04 +-8.3054469107609924e-04 +-8.1403703166562172e-04 +-7.9961113459356837e-04 +-7.8704321567504626e-04 +-7.7613623018276507e-04 +-7.6671728984342767e-04 +-7.5863538487226071e-04 +-7.5175941173049037e-04 +-7.4597649300050389e-04 +-7.4119056815747362e-04 +-7.3732123071583260e-04 +-7.3430278677294361e-04 +-7.3208351129446121e-04 +-7.3062508101799358e-04 +-7.2990216607357594e-04 +-2.0242428755450114e-03 +-2.0282686303720902e-03 +-2.0366167783337484e-03 +-2.0498705852320964e-03 +-2.0688421212938313e-03 +-2.0943953258993771e-03 +-2.1270611597648398e-03 +-2.1663843128986999e-03 +-2.2100696943466065e-03 +-2.2532640354215013e-03 +-2.2885903733869343e-03 +-2.3074684030713988e-03 +-2.3025125982645638e-03 +-2.2698656956661569e-03 +-2.2101931521955045e-03 +-2.1279765179950966e-03 +-2.0297863646544147e-03 +-1.9225180921244498e-03 +-1.8121960034445078e-03 +-1.7034457915705245e-03 +-1.5994522100007981e-03 +-1.5021685686279066e-03 +-1.4126065148818525e-03 +-1.3311126373817975e-03 +-1.2575946278668116e-03 +-1.1916906089167777e-03 +-1.1328886138689542e-03 +-1.0806070688887419e-03 +-1.0342467130793009e-03 +-9.9322249925816257e-04 +-9.5698192488561447e-04 +-9.2501443330079655e-04 +-8.9685511767329212e-04 +-8.7208492554366804e-04 +-8.5032882796651525e-04 +-8.3125290896622617e-04 +-8.1456098521663059e-04 +-7.9999113400365627e-04 +-7.8731235422500141e-04 +-7.7632148521450568e-04 +-7.6684044412035721e-04 +-7.5871380238508247e-04 +-7.5180669751549083e-04 +-7.4600306229180905e-04 +-7.4120414629438977e-04 +-7.3732730166632795e-04 +-7.3430500490547510e-04 +-7.3208408808588487e-04 +-7.3062515572418197e-04 +-7.2990216699768407e-04 +-2.0445765351843220e-03 +-2.0486478104091701e-03 +-2.0570625044829638e-03 +-2.0703576552866310e-03 +-2.0892907158598069e-03 +-2.1146975365545963e-03 +-2.1471637624752523e-03 +-2.1864147108225001e-03 +-2.2304203826233951e-03 +-2.2745083179686104e-03 +-2.3111976009703556e-03 +-2.3314931869403842e-03 +-2.3275051335129244e-03 +-2.2950548672852045e-03 +-2.2347651911002134e-03 +-2.1512649022782794e-03 +-2.0513309573658529e-03 +-1.9420477621478684e-03 +-1.8295905880408459e-03 +-1.7187008040419043e-03 +-1.6126489936382077e-03 +-1.5134479564152875e-03 +-1.4221455226436893e-03 +-1.3391050005706643e-03 +-1.2642359159309678e-03 +-1.1971679534793661e-03 +-1.1373744630366397e-03 +-1.0842560732836012e-03 +-1.0371948213730527e-03 +-9.9558747180907643e-04 +-9.5886466052026254e-04 +-9.2650068505478658e-04 +-8.9801732171919250e-04 +-8.7298397780590897e-04 +-8.5101571917796522e-04 +-8.3177017859406793e-04 +-8.1494398518858289e-04 +-8.0026911064718113e-04 +-7.8750936587328223e-04 +-7.7645717676145219e-04 +-7.6693070056126804e-04 +-7.5877130243820023e-04 +-7.5184138661602007e-04 +-7.4602256207440887e-04 +-7.4121411539877259e-04 +-7.3733176044448877e-04 +-7.3430663444520221e-04 +-7.3208451191190580e-04 +-7.3062521062634367e-04 +-7.2990216767759549e-04 +-2.0529830626801744e-03 +-2.0570673641200667e-03 +-2.0654483702976082e-03 +-2.0785469934756300e-03 +-2.0969654576672978e-03 +-2.1213937804517736e-03 +-2.1523716730035333e-03 +-2.1897878476316462e-03 +-2.2320321054651406e-03 +-2.2749919924921367e-03 +-2.3116173657238208e-03 +-2.3329794911536588e-03 +-2.3308766144147738e-03 +-2.3006239829880602e-03 +-2.2423585435774221e-03 +-2.1603755440287452e-03 +-2.0613067072089084e-03 +-1.9522501250522715e-03 +-1.8394946094332106e-03 +-1.7279352235174271e-03 +-1.6209928554357569e-03 +-1.5208038490430156e-03 +-1.4285055563628187e-03 +-1.3445191346033690e-03 +-1.2687867618025805e-03 +-1.2009527494674249e-03 +-1.1404932613648955e-03 +-1.0868046610515165e-03 +-1.0392609507805684e-03 +-9.9724924965497526e-04 +-9.6019025607913975e-04 +-9.2754878183045166e-04 +-8.9883794132002571e-04 +-8.7361944742002211e-04 +-8.5150165009528214e-04 +-8.3213638488711071e-04 +-8.1521530974236782e-04 +-8.0046614829406984e-04 +-7.8764908604730250e-04 +-7.7655345464699023e-04 +-7.6699476860539928e-04 +-7.5881213488702048e-04 +-7.5186602935482815e-04 +-7.4603641906662401e-04 +-7.4122120174330134e-04 +-7.3733493067839088e-04 +-7.3430779330442336e-04 +-7.3208481336735397e-04 +-7.3062524968123168e-04 +-7.2990216816212912e-04 +-2.0560405156652105e-03 +-2.0601231759654242e-03 +-2.0684358916994044e-03 +-2.0812717003018399e-03 +-2.0990542743875166e-03 +-2.1222817818131907e-03 +-2.1513692925074950e-03 +-2.1862740763806091e-03 +-2.2257665248056726e-03 +-2.2664143477695814e-03 +-2.3019070674382314e-03 +-2.3237457336166617e-03 +-2.3236183453784771e-03 +-2.2962712605862998e-03 +-2.2411148115164315e-03 +-2.1618527116280435e-03 +-2.0647975853979698e-03 +-1.9569839699427258e-03 +-1.8448004477551704e-03 +-1.7333098564612977e-03 +-1.6261038218900864e-03 +-1.5254603987789252e-03 +-1.4326206859420338e-03 +-1.3480747631570166e-03 +-1.2718064945510994e-03 +-1.2034825824589885e-03 +-1.1425888966779501e-03 +-1.0885237178663585e-03 +-1.0406585388980259e-03 +-9.9837572314554271e-04 +-9.6109030904271888e-04 +-9.2826132511559102e-04 +-8.9939640075051438e-04 +-8.7405226233416464e-04 +-8.5183284182728308e-04 +-8.3238612247903837e-04 +-8.1540043569465069e-04 +-8.0060064833998386e-04 +-7.8774449910613809e-04 +-7.7661922571601563e-04 +-7.6703855064356346e-04 +-7.5884004707195418e-04 +-7.5188287933841084e-04 +-7.4604589647530846e-04 +-7.4122604949609396e-04 +-7.3733709984822855e-04 +-7.3430858635785358e-04 +-7.3208501969086531e-04 +-7.3062527641393877e-04 +-7.2990216849481786e-04 +-2.0570060344164906e-03 +-2.0610831123338792e-03 +-2.0693333583751512e-03 +-2.0819478602799191e-03 +-2.0992028435655005e-03 +-2.1214224026424458e-03 +-2.1488711851909391e-03 +-2.1814823865298027e-03 +-2.2182712323438468e-03 +-2.2563959342729728e-03 +-2.2903289843931134e-03 +-2.3121561042616272e-03 +-2.3136051713478125e-03 +-2.2889170758572208e-03 +-2.2367658728818353e-03 +-2.1602326743634147e-03 +-2.0652868503676178e-03 +-1.9588825850802402e-03 +-1.8474918257775951e-03 +-1.7363265419280472e-03 +-1.6291299965667948e-03 +-1.5283052086437099e-03 +-1.4351843902197558e-03 +-1.3503183819954245e-03 +-1.2737284666251272e-03 +-1.2051024047718740e-03 +-1.1439364082367468e-03 +-1.0896324812009509e-03 +-1.0415619998929632e-03 +-9.9910516061636886e-04 +-9.6167388694793482e-04 +-9.2872379321512087e-04 +-8.9975915495143339e-04 +-8.7433358727984696e-04 +-8.5204823057832108e-04 +-8.3254861362641738e-04 +-8.1552093623872329e-04 +-8.0068822735068778e-04 +-7.8780664690077421e-04 +-7.7666207864035867e-04 +-7.6706708436656524e-04 +-7.5885824254935403e-04 +-7.5189386602943979e-04 +-7.4605207728464600e-04 +-7.4122921158865235e-04 +-7.3733851497475591e-04 +-7.3430910379819405e-04 +-7.3208515432344448e-04 +-7.3062529385945830e-04 +-7.2990216871315287e-04 +-2.0572330738655659e-03 +-2.0613050714908907e-03 +-2.0695114591979852e-03 +-2.0819758358955331e-03 +-2.0988742227509558e-03 +-2.1204043057000623e-03 +-2.1467023337606323e-03 +-2.1776370114557071e-03 +-2.2123439164321744e-03 +-2.2483955985829174e-03 +-2.2809027936801876e-03 +-2.3024920631309386e-03 +-2.3049953596498657e-03 +-2.2822801585504690e-03 +-2.2324310215412306e-03 +-2.1580233512295093e-03 +-2.0647471728134233e-03 +-1.9594886135291313e-03 +-1.8487803689575912e-03 +-1.7379454158249750e-03 +-1.6308393393541590e-03 +-1.5299571393823552e-03 +-1.4366978289985538e-03 +-1.3516568190782422e-03 +-1.2748830495636753e-03 +-1.2060801652353978e-03 +-1.1447525707440891e-03 +-1.0903057009188492e-03 +-1.0421115713702179e-03 +-9.9954949135512951e-04 +-9.6202975051855636e-04 +-9.2900604344222770e-04 +-8.9998069954430832e-04 +-8.7450549705875833e-04 +-8.5217991067291490e-04 +-8.3264799445197015e-04 +-8.1559466141640136e-04 +-8.0074182725602626e-04 +-7.8784469331408399e-04 +-7.7668831972261371e-04 +-7.6708456124314366e-04 +-7.5886938971782563e-04 +-7.5190059820906866e-04 +-7.4605586531582705e-04 +-7.4123114985526922e-04 +-7.3733938252658685e-04 +-7.3430942105544598e-04 +-7.3208523687812448e-04 +-7.3062530455794271e-04 +-7.2990216884858533e-04 +-2.0572420288397395e-03 +-2.0613105777125685e-03 +-2.0694905770040082e-03 +-2.0818664001600994e-03 +-2.0985549055112795e-03 +-2.1196760906204886e-03 +-2.1452795825975951e-03 +-2.1751739182397783e-03 +-2.2085417117582639e-03 +-2.2432025678553662e-03 +-2.2746930101209613e-03 +-2.2960286653147311e-03 +-2.2991414359693923e-03 +-2.2776650149284551e-03 +-2.2292938931478953e-03 +-2.1562657371009099e-03 +-2.0640835565065197e-03 +-1.9595865366846816e-03 +-1.8493448906524654e-03 +-1.7387516528154609e-03 +-1.6317332654706049e-03 +-1.5308426325927674e-03 +-1.4375207840400049e-03 +-1.3523912138216018e-03 +-1.2755203929011372e-03 +-1.2066221694316578e-03 +-1.1452063641162083e-03 +-1.0906808540389725e-03 +-1.0424183401224918e-03 +-9.9979784043151016e-04 +-9.6222885888629930e-04 +-9.2916409643553014e-04 +-9.0010484401770944e-04 +-8.7460188358598500e-04 +-8.5225377742873269e-04 +-8.3270376655550891e-04 +-8.1563605133924623e-04 +-8.0077192893383679e-04 +-7.8786606679133876e-04 +-7.7670306548244716e-04 +-7.6709438468796059e-04 +-7.5887565687350925e-04 +-7.5190438402159617e-04 +-7.4605799593429408e-04 +-7.4123224025331549e-04 +-7.3733987065721228e-04 +-7.3430959958504182e-04 +-7.3208528333899565e-04 +-7.3062531057995969e-04 +-7.2990216892677485e-04 +-2.0572136822510057e-03 +-2.0612803036807003e-03 +-2.0694465401649531e-03 +-2.0817767644382328e-03 +-2.0983574081858115e-03 +-2.1192676233240154e-03 +-2.1445090448267002e-03 +-2.1738515336533833e-03 +-2.2064924455556245e-03 +-2.2403774736848665e-03 +-2.2712781234852449e-03 +-2.2924351803911796e-03 +-2.2958475370301532e-03 +-2.2750263546719371e-03 +-2.2274523188161211e-03 +-2.1551759600456043e-03 +-2.0635956911358652e-03 +-1.9595231349585373e-03 +-1.8495474141758286e-03 +-1.7390985041757661e-03 +-1.6321405075536094e-03 +-1.5312572197487358e-03 +-1.4379121690828724e-03 +-1.3527439665524058e-03 +-1.2758285995567553e-03 +-1.2068855337287905e-03 +-1.1454276498246753e-03 +-1.0908642862708302e-03 +-1.0425686511829630e-03 +-9.9991973043581203e-04 +-9.6232671386945249e-04 +-9.2924186083510960e-04 +-9.0016598211661197e-04 +-8.7464938948362018e-04 +-8.5229020925068374e-04 +-8.3273129070890451e-04 +-8.1565648889180377e-04 +-8.0078679994051536e-04 +-7.8787663064913650e-04 +-7.7671035665567907e-04 +-7.6709924387916581e-04 +-7.5887875806416964e-04 +-7.5190625799277210e-04 +-7.4605905091068439e-04 +-7.4123278031303314e-04 +-7.3734011248007187e-04 +-7.3430968804768322e-04 +-7.3208530636462404e-04 +-7.3062531356554630e-04 +-7.2990216896820124e-04 +-2.0571951360640424e-03 +-2.0612608937943676e-03 +-2.0694212184600115e-03 +-2.0817320052608466e-03 +-2.0982666953927166e-03 +-2.1190867414755208e-03 +-2.1441723102649723e-03 +-2.1732744909960305e-03 +-2.2055938412513460e-03 +-2.2391285656954453e-03 +-2.2697537540197180e-03 +-2.2908131542428551e-03 +-2.2943401817278365e-03 +-2.2737955373733215e-03 +-2.2265668678494201e-03 +-2.1546216277074028e-03 +-2.0633106602504225e-03 +-1.9594318102418426e-03 +-1.8495811400035247e-03 +-1.7392038938362278e-03 +-1.6322801357810757e-03 +-1.5314069384770193e-03 +-1.4380576157741486e-03 +-1.3528774389584602e-03 +-1.2759466569085538e-03 +-1.2069873092983650e-03 +-1.1455137315800926e-03 +-1.0909360074999759e-03 +-1.0426276593168385e-03 +-9.9996773670892741e-04 +-9.6236535661574536e-04 +-9.2927263798300505e-04 +-9.0019022443447397e-04 +-8.7466825679623184e-04 +-8.5230469879696606e-04 +-8.3274225119342828e-04 +-8.1566463653304330e-04 +-8.0079273448098107e-04 +-7.8788085031079489e-04 +-7.7671327160572148e-04 +-7.6710118811999209e-04 +-7.5887999983742505e-04 +-7.5190700888914626e-04 +-7.4605947390774929e-04 +-7.4123299697662136e-04 +-7.3734020954449608e-04 +-7.3430972357059119e-04 +-7.3208531561426643e-04 +-7.3062531476627906e-04 +-7.2990216898857773e-04 +-2.0571887361712777e-03 +-2.0612542199343895e-03 +-2.0694127205032444e-03 +-2.0817175250039291e-03 +-2.0982380205400615e-03 +-2.1190300193933659e-03 +-2.1440666197372997e-03 +-2.1730922581553089e-03 +-2.2053072733234638e-03 +-2.2387251773872568e-03 +-2.2692534986673012e-03 +-2.2902700005868444e-03 +-2.2938217858244959e-03 +-2.2733562371937874e-03 +-2.2262329039903759e-03 +-2.1543928019830561e-03 +-2.0631706346914778e-03 +-1.9593585478728101e-03 +-1.8495536528244844e-03 +-1.7392052322937849e-03 +-1.6322979454169253e-03 +-1.5314328619492148e-03 +-1.4380863477348649e-03 +-1.3529058251615332e-03 +-1.2759729753424277e-03 +-1.2070107479996510e-03 +-1.1455340311267792e-03 +-1.0909532263820914e-03 +-1.0426420251480743e-03 +-9.9997955487343216e-04 +-9.6237495616644875e-04 +-9.2928034108827394e-04 +-9.0019633036370202e-04 +-8.7467303464793748e-04 +-8.5230838531701633e-04 +-8.3274505141626152e-04 +-8.1566672587156885e-04 +-8.0079426144731829e-04 +-7.8788193940331581e-04 +-7.7671402610998144e-04 +-7.6710169270561201e-04 +-7.5888032290854493e-04 +-7.5190720469450073e-04 +-7.4605958443895240e-04 +-7.4123305369766599e-04 +-7.3734023499690395e-04 +-7.3430973289858030e-04 +-7.3208531804647777e-04 +-7.3062531508405525e-04 +-7.2990216899997595e-04 +-2.0571877673459574e-03 +-2.0612532084484671e-03 +-2.0694114329007402e-03 +-2.0817153234328751e-03 +-2.0982336030112348e-03 +-2.1190210949318593e-03 +-2.1440495494854388e-03 +-2.1730619230612637e-03 +-2.2052578938415528e-03 +-2.2386528063694584e-03 +-2.2691593006438828e-03 +-2.2901614963653297e-03 +-2.2937103624100686e-03 +-2.2732527285848790e-03 +-2.2261443905961789e-03 +-2.1543219381280950e-03 +-2.0631167344617517e-03 +-1.9593191373775834e-03 +-1.8495257057010849e-03 +-1.7391858911221605e-03 +-1.6322848300708600e-03 +-1.5314241304998986e-03 +-1.4380806404047266e-03 +-1.3529021695472061e-03 +-1.2759706914430172e-03 +-1.2070093680654366e-03 +-1.1455332375516273e-03 +-1.0909528059002069e-03 +-1.0426418360844896e-03 +-9.9997950419668854e-04 +-9.6237498362907804e-04 +-9.2928040837130595e-04 +-9.0019641370071293e-04 +-8.7467311984314828e-04 +-8.5230846439919214e-04 +-8.3274512040343741e-04 +-8.1566678328664870e-04 +-8.0079430733793458e-04 +-7.8788197469853688e-04 +-7.7671405219994377e-04 +-7.6710171116793906e-04 +-7.5888033533060885e-04 +-7.5190721255885735e-04 +-7.4605958905108675e-04 +-7.4123305614398952e-04 +-7.3734023612599578e-04 +-7.3430973332249360e-04 +-7.3208531816006150e-04 +-7.3062531510175387e-04 +-7.2990216900944993e-04 +-2.0571877672716735e-03 +-2.0612532076811521e-03 +-2.0694114290990486e-03 +-2.0817153058609395e-03 +-2.0982335355765954e-03 +-2.1190208838972879e-03 +-2.1440489919034799e-03 +-2.1730606411124349e-03 +-2.2052552939259510e-03 +-2.2386481548125150e-03 +-2.2691519886675112e-03 +-2.2901513907887285e-03 +-2.2936979766013024e-03 +-2.2732390634801567e-03 +-2.2261305747599326e-03 +-2.1543089080221034e-03 +-2.0631050861272143e-03 +-1.9593091339775133e-03 +-1.8495173637007257e-03 +-1.7391790793694830e-03 +-1.6322793490887166e-03 +-1.5314197643864433e-03 +-1.4380771856109965e-03 +-1.3528994478451655e-03 +-1.2759685535079332e-03 +-1.2070076921748506e-03 +-1.1455319261666924e-03 +-1.0909517816606021e-03 +-1.0426410379753644e-03 +-9.9997888420400873e-04 +-9.6237450396683202e-04 +-9.2928003925302671e-04 +-9.0019613158320855e-04 +-8.7467290605948650e-04 +-8.5230830410273949e-04 +-8.3274500175544385e-04 +-8.1566669683190180e-04 +-8.0079424552416010e-04 +-7.8788193150482622e-04 +-7.7671402284734410e-04 +-7.6710169189165016e-04 +-7.5888032319818563e-04 +-7.5190720532269787e-04 +-7.4605958502648676e-04 +-7.4123305410634397e-04 +-7.3734023522245898e-04 +-7.3430973299468529e-04 +-7.3208531807529217e-04 +-7.3062531509081265e-04 +-7.2990216900929912e-04 +-2.0571887355651615e-03 +-2.0612542113592697e-03 +-2.0694126697063456e-03 +-2.0817172990950715e-03 +-2.0982372232887232e-03 +-2.1190276881087756e-03 +-2.1440607498490619e-03 +-2.1730792118048702e-03 +-2.2052814476439552e-03 +-2.2386797860723911e-03 +-2.2691830912083717e-03 +-2.2901736820744316e-03 +-2.2937046709993565e-03 +-2.2732278406358691e-03 +-2.2261037512119387e-03 +-2.1542715005584520e-03 +-2.0630625694091349e-03 +-1.9592660099049621e-03 +-1.8494766710539731e-03 +-1.7391425016822155e-03 +-1.6322475593250813e-03 +-1.5313927858692489e-03 +-1.4380546783936505e-03 +-1.3528809045306382e-03 +-1.2759534194234274e-03 +-1.2069954318601999e-03 +-1.1455220554235886e-03 +-1.0909438792010475e-03 +-1.0426347459172392e-03 +-9.9997390309230962e-04 +-9.6237058560263121e-04 +-9.2927697911004341e-04 +-9.0019376169487599e-04 +-8.7467108875001324e-04 +-8.5230692665947913e-04 +-8.3274397200214137e-04 +-8.1566593950075793e-04 +-8.0079369930582793e-04 +-7.8788154665680201e-04 +-7.7671375925318761e-04 +-7.6710151747805939e-04 +-7.5888021263270091e-04 +-7.5190713892860474e-04 +-7.4605954786427769e-04 +-7.4123303518127120e-04 +-7.3734022678680891e-04 +-7.3430972992006172e-04 +-7.3208531727629329e-04 +-7.3062531498468627e-04 +-7.2990216899873595e-04 +-2.0571951357346734e-03 +-2.0612608701758676e-03 +-2.0694210112240591e-03 +-2.0817310509985655e-03 +-2.0982635028552574e-03 +-2.1190779799546249e-03 +-2.1441514272222497e-03 +-2.1732300705859680e-03 +-2.2055088903685763e-03 +-2.2389832389079585e-03 +-2.2695330806063296e-03 +-2.2905163144341461e-03 +-2.2939840771385614e-03 +-2.2734093487644189e-03 +-2.2261818360400729e-03 +-2.1542626420578146e-03 +-2.0629927957603340e-03 +-1.9591610168613952e-03 +-1.8493568531069188e-03 +-1.7390218120027184e-03 +-1.6321343571583837e-03 +-1.5312913134460566e-03 +-1.4379664678403894e-03 +-1.3528058671443612e-03 +-1.2758905971392614e-03 +-1.2069434752354101e-03 +-1.1454795069238105e-03 +-1.0909093284809470e-03 +-1.0426069057813340e-03 +-9.9995163886604948e-04 +-9.6235291871669102e-04 +-9.2926307756056696e-04 +-9.0018292476866640e-04 +-8.7466273013454116e-04 +-8.5230055808365975e-04 +-8.3273918841093864e-04 +-8.1566240611863990e-04 +-8.0079114060384521e-04 +-7.8787973706548179e-04 +-7.7671251539607026e-04 +-7.6710069168092700e-04 +-7.5887968747687822e-04 +-7.5190682263749349e-04 +-7.4605937034253472e-04 +-7.4123294455219783e-04 +-7.3734018630222751e-04 +-7.3430971513932682e-04 +-7.3208531343426297e-04 +-7.3062531448504049e-04 +-7.2990216898509994e-04 +-2.0572136909886864e-03 +-2.0612803062574690e-03 +-2.0694460715251638e-03 +-2.0817741859286421e-03 +-2.0983486797397683e-03 +-2.1192443129403947e-03 +-2.1444554480034789e-03 +-2.1737414888717468e-03 +-2.2062885761805128e-03 +-2.2400381267902976e-03 +-2.2707745288566526e-03 +-2.2917704820403732e-03 +-2.2950624375494312e-03 +-2.2741857573638871e-03 +-2.2266230828623845e-03 +-2.1544096511308957e-03 +-2.0629222315895648e-03 +-1.9589530631745852e-03 +-1.8490778371826209e-03 +-1.7387191005290108e-03 +-1.6318380057525035e-03 +-1.5310181576762662e-03 +-1.4377243141650818e-03 +-1.3525968707927708e-03 +-1.2757136690159823e-03 +-1.2067958636686649e-03 +-1.1453577724046646e-03 +-1.0908099077686546e-03 +-1.0425264139360404e-03 +-9.9988701187730001e-04 +-9.6230146367204459e-04 +-9.2922247221941781e-04 +-9.0015119176372282e-04 +-8.7463820046509121e-04 +-8.5228183202927272e-04 +-8.3272509809681190e-04 +-8.1565198167069615e-04 +-8.0078358055905201e-04 +-7.8787438300276051e-04 +-7.7670883042204502e-04 +-7.6709824225209525e-04 +-7.5887812801411748e-04 +-7.5190588240318555e-04 +-7.4605884210789000e-04 +-7.4123267463649639e-04 +-7.3734006563554058e-04 +-7.3430967105659435e-04 +-7.3208530197177305e-04 +-7.3062531299886906e-04 +-7.2990216896120586e-04 +-2.0572420812129534e-03 +-2.0613108437769158e-03 +-2.0694900863238992e-03 +-2.0818613850854999e-03 +-2.0985363293778859e-03 +-2.1196259188913619e-03 +-2.1451656987961547e-03 +-2.1749450598339652e-03 +-2.2081277420487131e-03 +-2.2425292935845369e-03 +-2.2737144189294671e-03 +-2.2947597691548244e-03 +-2.2976647776346646e-03 +-2.2761033436641672e-03 +-2.2277691102018326e-03 +-2.1548688625860853e-03 +-2.0628650257291338e-03 +-1.9585616800479638e-03 +-1.8485054225298287e-03 +-1.7380767252490664e-03 +-1.6311974806142390e-03 +-1.5304208457000337e-03 +-1.4371904828974328e-03 +-1.3521333707925015e-03 +-1.2753194824755227e-03 +-1.2064657989726783e-03 +-1.1450847736755834e-03 +-1.0905864156422411e-03 +-1.0423451135080843e-03 +-9.9974120300967738e-04 +-9.6218520874444160e-04 +-9.2913061938398249e-04 +-9.0007933349486847e-04 +-8.7458260266995783e-04 +-8.5223935365282650e-04 +-8.3269311190658796e-04 +-8.1562830139724927e-04 +-8.0076639645317244e-04 +-7.8786220611931613e-04 +-7.7670044507087486e-04 +-7.6709266562717971e-04 +-7.5887457589375758e-04 +-7.5190373980485643e-04 +-7.4605763788088771e-04 +-7.4123205907797567e-04 +-7.3733979035940428e-04 +-7.3430957046411740e-04 +-7.3208527581091452e-04 +-7.3062530960891331e-04 +-7.2990216891480092e-04 +-2.0572332660434046e-03 +-2.0613063434605141e-03 +-2.0695123145612385e-03 +-2.0819689759991400e-03 +-2.0988420322193956e-03 +-2.1203125214349682e-03 +-2.1464920495354446e-03 +-2.1772178773209151e-03 +-2.2115976445994446e-03 +-2.2472036766257777e-03 +-2.2792001096419530e-03 +-2.3003171786491112e-03 +-2.3024955835034720e-03 +-2.2796630654116968e-03 +-2.2298969019757088e-03 +-2.1557179478967070e-03 +-2.0627481191041034e-03 +-1.9578160946491048e-03 +-1.8474167824142186e-03 +-1.7368536983135773e-03 +-1.6299759809750725e-03 +-1.5292798210885263e-03 +-1.4361690858664812e-03 +-1.3512452442093351e-03 +-1.2745631830797086e-03 +-1.2058317951217457e-03 +-1.1445598535883216e-03 +-1.0901563056673706e-03 +-1.0419959312201433e-03 +-9.9946018702264973e-04 +-9.6196101903265046e-04 +-9.2895339519235534e-04 +-8.9994062370919877e-04 +-8.7447523687373253e-04 +-8.5215729276485542e-04 +-8.3263129946966480e-04 +-8.1558252591562607e-04 +-8.0073316908174500e-04 +-7.8783865456057904e-04 +-7.7668422278650260e-04 +-7.6708187459693239e-04 +-7.5886770087949017e-04 +-7.5189959203434938e-04 +-7.4605530623056610e-04 +-7.4123086701911856e-04 +-7.3733925719483991e-04 +-7.3430937560902581e-04 +-7.3208522513100623e-04 +-7.3062530304279642e-04 +-7.2990216882991006e-04 +-2.0570065846464282e-03 +-2.0610871704534544e-03 +-2.0693394717636376e-03 +-2.0819437405225527e-03 +-2.0991577329748093e-03 +-2.1212771711354500e-03 +-2.1485270430935395e-03 +-2.1807935113176660e-03 +-2.2170551087449986e-03 +-2.2544794623004889e-03 +-2.2876284310969978e-03 +-2.3087465029894170e-03 +-2.3097213741006665e-03 +-2.2848782358081323e-03 +-2.2328748119287037e-03 +-2.1567068640713058e-03 +-2.0622397313326082e-03 +-1.9563407181696856e-03 +-1.8454251215498606e-03 +-1.7346761648852698e-03 +-1.6278280573617861e-03 +-1.5272862302295538e-03 +-1.4343907260373793e-03 +-1.3497019129892441e-03 +-1.2732503263239790e-03 +-1.2047318377669208e-03 +-1.1436493784874257e-03 +-1.0894103336850413e-03 +-1.0413902999590395e-03 +-9.9897274223790231e-04 +-9.6157209787573633e-04 +-9.2864590857067895e-04 +-8.9969992755445653e-04 +-8.7428890554300720e-04 +-8.5201485937174489e-04 +-8.3252399831429999e-04 +-8.1550305439745765e-04 +-8.0067547624868636e-04 +-7.8779775767435242e-04 +-7.7665605031756178e-04 +-7.6706313260165959e-04 +-7.5885575923139684e-04 +-7.5189238692227622e-04 +-7.4605125560403313e-04 +-7.4122879598987940e-04 +-7.3733833084265897e-04 +-7.3430903703895084e-04 +-7.3208513706902859e-04 +-7.3062529163413106e-04 +-7.2990216868573600e-04 +-2.0560418437188845e-03 +-2.0601335576167870e-03 +-2.0684557401665382e-03 +-2.0812829363194537e-03 +-2.0990083161012080e-03 +-2.1220852721774305e-03 +-2.1508699748253720e-03 +-2.1852554495630323e-03 +-2.2239695396311355e-03 +-2.2636059059965683e-03 +-2.2979870947703851e-03 +-2.3188340692562857e-03 +-2.3180504976442382e-03 +-2.2904950154244430e-03 +-2.2355542203700688e-03 +-2.1568136502426046e-03 +-2.0604409633104863e-03 +-1.9533484364598563e-03 +-1.8418440700625816e-03 +-1.7309492887510212e-03 +-1.6242423229557799e-03 +-1.5240043415464936e-03 +-1.4314874636789051e-03 +-1.3471953367277000e-03 +-1.2711250687275756e-03 +-1.2029550038669958e-03 +-1.1421806704822062e-03 +-1.0882080891457433e-03 +-1.0404148238580325e-03 +-9.9818793861706926e-04 +-9.6094608477093470e-04 +-9.2815105864662683e-04 +-8.9931260951972298e-04 +-8.7398909098216639e-04 +-8.5178568925752896e-04 +-8.3235136006683361e-04 +-8.1537519426682725e-04 +-8.0058265670746205e-04 +-7.8773196105693137e-04 +-7.7661072558593515e-04 +-7.6703298005330951e-04 +-7.5883654730072268e-04 +-7.5188079523735081e-04 +-7.4604473890545122e-04 +-7.4122546409219163e-04 +-7.3733684051431223e-04 +-7.3430849234214256e-04 +-7.3208499539352415e-04 +-7.3062527328041896e-04 +-7.2990216845621571e-04 +-2.0529858282532475e-03 +-2.0570897688031459e-03 +-2.0654964501447500e-03 +-2.0785980514718030e-03 +-2.0969505759399444e-03 +-2.1211789067878146e-03 +-2.1517421145139529e-03 +-2.1884484012906044e-03 +-2.2296437036468351e-03 +-2.2712625620178177e-03 +-2.3064310124569836e-03 +-2.3264960417747971e-03 +-2.3235239748354880e-03 +-2.2929741959490588e-03 +-2.2349615283922962e-03 +-2.1536380073526253e-03 +-2.0554520852535921e-03 +-1.9473420600121922e-03 +-1.8354877796098311e-03 +-1.7247257264841540e-03 +-1.6184556402885307e-03 +-1.5188155815238611e-03 +-1.4269560895096857e-03 +-1.3433156287318896e-03 +-1.2678537261488526e-03 +-1.2002301770832997e-03 +-1.1399341191819692e-03 +-1.0863723843367080e-03 +-1.0389272264289073e-03 +-9.9699217606597423e-04 +-9.5999287203685810e-04 +-9.2739791758716743e-04 +-8.9872333448896260e-04 +-8.7353306886850304e-04 +-8.5143719267994895e-04 +-8.3208887662299222e-04 +-8.1518082111412752e-04 +-8.0044157028704983e-04 +-7.8763196101825305e-04 +-7.7654184650256439e-04 +-7.6698716211713439e-04 +-7.5880735654354611e-04 +-7.5186318411268774e-04 +-7.4603483884687566e-04 +-7.4122040264190149e-04 +-7.3733457669170478e-04 +-7.3430766497860410e-04 +-7.3208478020370636e-04 +-7.3062524540432603e-04 +-7.2990216810944774e-04 +-2.0445814855169797e-03 +-2.0486888780101970e-03 +-2.0571567760219885e-03 +-2.0704823127935495e-03 +-2.0893598072890662e-03 +-2.1145388554267095e-03 +-2.1465035217163885e-03 +-2.1848851445850710e-03 +-2.2276110829008841e-03 +-2.2700739028485776e-03 +-2.3049994312465522e-03 +-2.3237057942434489e-03 +-2.3186111009474053e-03 +-2.2857157825494387e-03 +-2.2256387932435440e-03 +-2.1428606238396348e-03 +-2.0439505718213894e-03 +-1.9358007332639969e-03 +-1.8244473353500261e-03 +-1.7145511851912145e-03 +-1.6093487651112097e-03 +-1.5108489551336232e-03 +-1.4201120032764111e-03 +-1.3375204726632486e-03 +-1.2630043846479312e-03 +-1.1962123304737346e-03 +-1.1366338458567908e-03 +-1.0836828196727486e-03 +-1.0367518599458620e-03 +-9.9524601569535645e-04 +-9.5860234921893417e-04 +-9.2630011578553005e-04 +-8.9786490902785294e-04 +-8.7286907797090444e-04 +-8.5092996250388047e-04 +-8.3170696203937664e-04 +-8.1489808716323007e-04 +-8.0023639809779753e-04 +-7.8748657062643955e-04 +-7.7644172356961048e-04 +-7.6692057357898751e-04 +-7.5876494016839234e-04 +-7.5183759790755506e-04 +-7.4602045769192854e-04 +-7.4121305115351817e-04 +-7.3733128897238035e-04 +-7.3430646351920143e-04 +-7.3208446773694610e-04 +-7.3062520492919877e-04 +-7.2990216760742592e-04 +-2.0242504115088825e-03 +-2.0283322012798642e-03 +-2.0367692161164953e-03 +-2.0500962143517151e-03 +-2.0690491502575316e-03 +-2.0943897229860988e-03 +-2.1265318513047377e-03 +-2.1649162316452900e-03 +-2.2072035548042182e-03 +-2.2486101831169338e-03 +-2.2819719097581194e-03 +-2.2990302234695711e-03 +-2.2927273550248906e-03 +-2.2594192409930410e-03 +-2.1998051474364606e-03 +-2.1182421598586816e-03 +-2.0210943817102578e-03 +-1.9150474094109951e-03 +-1.8059607615669450e-03 +-1.6983549121570764e-03 +-1.5953618722177312e-03 +-1.4989194097216340e-03 +-1.4100458329518581e-03 +-1.3291052854978867e-03 +-1.2560266631873468e-03 +-1.1904689028219516e-03 +-1.1319385593407088e-03 +-1.0798696466602252e-03 +-1.0336755806913864e-03 +-9.9278140304102447e-04 +-9.5664253265516992e-04 +-9.2475458389226989e-04 +-8.9665743930764075e-04 +-8.7193576140950967e-04 +-8.5021740854606136e-04 +-8.3117071793207392e-04 +-8.1450127477381961e-04 +-7.9994855429717411e-04 +-7.8728266905881718e-04 +-7.7630135263455130e-04 +-7.6682724547098347e-04 +-7.5870550743288676e-04 +-7.5180175633570063e-04 +-7.4600031700630470e-04 +-7.4120275757839221e-04 +-7.3732668631746072e-04 +-7.3430478177907233e-04 +-7.3208403041204162e-04 +-7.3062514828541275e-04 +-7.2990216690605987e-04 +-1.9822077559928154e-03 +-1.9862089245009204e-03 +-1.9944542866818164e-03 +-2.0074172763312743e-03 +-2.0257406157591184e-03 +-2.0500615698221540e-03 +-2.0806512137382604e-03 +-2.1168385860450916e-03 +-2.1563163611884105e-03 +-2.1946269724845272e-03 +-2.2252896253204175e-03 +-2.2409122362942848e-03 +-2.2351037899693035e-03 +-2.2043649072346016e-03 +-2.1490019339621032e-03 +-2.0726974583321419e-03 +-1.9811560644303139e-03 +-1.8805849280507960e-03 +-1.7765691479750389e-03 +-1.6735083724835570e-03 +-1.5745063672752023e-03 +-1.4815205455661761e-03 +-1.3956107091339985e-03 +-1.3171909288393600e-03 +-1.2462418435239260e-03 +-1.1824725964767982e-03 +-1.1254366263545492e-03 +-1.0746105659634676e-03 +-1.0294457769080597e-03 +-9.8940053244357261e-04 +-9.5395897760051918e-04 +-9.2264131013277144e-04 +-8.9500829574707882e-04 +-8.7066224698935726e-04 +-8.4924589409878361e-04 +-8.3044008865581663e-04 +-8.1396094763231427e-04 +-7.9955682068209399e-04 +-7.8700531370023562e-04 +-7.7611050301862187e-04 +-7.6670041056327385e-04 +-7.5862476947863560e-04 +-7.5175308442038970e-04 +-7.4597297567888157e-04 +-7.4118878805795780e-04 +-7.3732044162292071e-04 +-7.3430250055165117e-04 +-7.3208343729292899e-04 +-7.3062507147162684e-04 +-7.2990216595599129e-04 +-1.9092047849792336e-03 +-1.9130513855304889e-03 +-1.9209177342295587e-03 +-1.9331395198881635e-03 +-1.9501646468444798e-03 +-1.9724109052627350e-03 +-1.9999754501230592e-03 +-2.0321778671405755e-03 +-2.0670184613196647e-03 +-2.1007803444434286e-03 +-2.1281095748156694e-03 +-2.1428236308077431e-03 +-2.1393490545712733e-03 +-2.1142472108367514e-03 +-2.0671245122502093e-03 +-2.0005398181556200e-03 +-1.9190769423095629e-03 +-1.8281073640389271e-03 +-1.7327396439187717e-03 +-1.6371917119833480e-03 +-1.5445726343627174e-03 +-1.4569392419714671e-03 +-1.3754845409044217e-03 +-1.3007575392930302e-03 +-1.2328616393415411e-03 +-1.1716123033970150e-03 +-1.1166529268451571e-03 +-1.0675354314178618e-03 +-1.0237738766480126e-03 +-9.8487862713379478e-04 +-9.5037706051002784e-04 +-9.1982524167664407e-04 +-8.9281369867961308e-04 +-8.6896945976254133e-04 +-8.4795580853874589e-04 +-8.2947072326434535e-04 +-8.1324462963475435e-04 +-7.9903786891373995e-04 +-7.8663813092396111e-04 +-7.7585800057496318e-04 +-7.6653270057587910e-04 +-7.5851807039047613e-04 +-7.5168879462559691e-04 +-7.4593687767312352e-04 +-7.4117035206163091e-04 +-7.3731220324422208e-04 +-7.3429949190578639e-04 +-7.3208265522341849e-04 +-7.3062497020323159e-04 +-7.2990216470435350e-04 +-1.8021238077666859e-03 +-1.8057409678344084e-03 +-1.8130683059576229e-03 +-1.8242843174845699e-03 +-1.8396180799731062e-03 +-1.8592513493903553e-03 +-1.8831189590922089e-03 +-1.9105933552046310e-03 +-1.9401038936157963e-03 +-1.9688373007811367e-03 +-1.9927395372795519e-03 +-2.0070033413999763e-03 +-2.0070269811827018e-03 +-1.9895452714447587e-03 +-1.9534677371900607e-03 +-1.9000717047013445e-03 +-1.8325272875719713e-03 +-1.7550347874540004e-03 +-1.6719448448043114e-03 +-1.5871178622237426e-03 +-1.5035986104706607e-03 +-1.4235514630716996e-03 +-1.3483542317306372e-03 +-1.2787589559373374e-03 +-1.2150598631883842e-03 +-1.1572388252929988e-03 +-1.1050788183995575e-03 +-1.0582465394802431e-03 +-1.0163495669315837e-03 +-9.7897423005577941e-04 +-9.4570962920841409e-04 +-9.1616208508829837e-04 +-8.8996317050495793e-04 +-8.6677355702309035e-04 +-8.4628421447550614e-04 +-8.2821600166333288e-04 +-8.1231833720140669e-04 +-7.9836739972455155e-04 +-7.8616414429045003e-04 +-7.7553231297324877e-04 +-7.6631654541274032e-04 +-7.5838064771807385e-04 +-7.5160604757787083e-04 +-7.4589044422790167e-04 +-7.4114665037876303e-04 +-7.3730161679424458e-04 +-7.3429562725326229e-04 +-7.3208165094589342e-04 +-7.3062484018866997e-04 +-7.2990216309829674e-04 +-1.6665489319228591e-03 +-1.6698793792245461e-03 +-1.6765677130917138e-03 +-1.6866640440160608e-03 +-1.7002198940486799e-03 +-1.7172291893221175e-03 +-1.7375077538834948e-03 +-1.7605002988146155e-03 +-1.7850395102923049e-03 +-1.8091371750394083e-03 +-1.8299366403198407e-03 +-1.8439525354909539e-03 +-1.8476303825055028e-03 +-1.8380968400310538e-03 +-1.8138364520488264e-03 +-1.7750298565420083e-03 +-1.7234392423735028e-03 +-1.6619303351229711e-03 +-1.5938468048707927e-03 +-1.5224493911057894e-03 +-1.4505406177318598e-03 +-1.3802934142693030e-03 +-1.3132376024958610e-03 +-1.2503391830882978e-03 +-1.1921171123448764e-03 +-1.1387618464647345e-03 +-1.0902377760972893e-03 +-1.0463637422991182e-03 +-1.0068723763222373e-03 +-9.7145174589503738e-04 +-9.3977338539148942e-04 +-9.1151039233167467e-04 +-8.8634854839749985e-04 +-8.6399268874328252e-04 +-8.4416992252901930e-04 +-8.2663082732415674e-04 +-8.1114938696278587e-04 +-7.9752219099804393e-04 +-7.8556723855556369e-04 +-7.7512256889587957e-04 +-7.6604485916574616e-04 +-7.5820807486661856e-04 +-7.5150222215374627e-04 +-7.4583222739026296e-04 +-7.4111695440974882e-04 +-7.3728836092039351e-04 +-7.3429079051960785e-04 +-7.3208039454606918e-04 +-7.3062467757727828e-04 +-7.2990216109041677e-04 +-1.5143567098114665e-03 +-1.5173708767195937e-03 +-1.5233851011599443e-03 +-1.5323683477489398e-03 +-1.5442607966946720e-03 +-1.5589415518846347e-03 +-1.5761627447058502e-03 +-1.5954424960740936e-03 +-1.6159263753063981e-03 +-1.6362554954954232e-03 +-1.6545088577435592e-03 +-1.6682962452446485e-03 +-1.6750434924421847e-03 +-1.6724332984411310e-03 +-1.6588775086585799e-03 +-1.6338578453496328e-03 +-1.5980155836255231e-03 +-1.5529747535209886e-03 +-1.5009850788555825e-03 +-1.4445162486679106e-03 +-1.3859155230831147e-03 +-1.3271856634530013e-03 +-1.2698863739954663e-03 +-1.2151303090447573e-03 +-1.1636356592066527e-03 +-1.1158028519389640e-03 +-1.0717936714208960e-03 +-1.0316012333695735e-03 +-9.9510645573365605e-04 +-9.6212086196433976e-04 +-9.3241752164262824e-04 +-9.0575254465507528e-04 +-8.8187946105613610e-04 +-8.6055845165570240e-04 +-8.4156196527118146e-04 +-8.2467786778096938e-04 +-8.0971094962906055e-04 +-7.9648337449514178e-04 +-7.8483447207265331e-04 +-7.7462014877135782e-04 +-7.6571209909733645e-04 +-7.5799693717573712e-04 +-7.5137532449265419e-04 +-7.4576114063537070e-04 +-7.4108072442136325e-04 +-7.3727220033924560e-04 +-7.3428489757122045e-04 +-7.3207886451489082e-04 +-7.3062447961586593e-04 +-7.2990215864694567e-04 +-1.3589607127437885e-03 +-1.3616568443987496e-03 +-1.3670149073426396e-03 +-1.3749648751968005e-03 +-1.3853946020696596e-03 +-1.3981332443679878e-03 +-1.4129176951331649e-03 +-1.4293375316979660e-03 +-1.4467614928530973e-03 +-1.4642618387853174e-03 +-1.4805685799686281e-03 +-1.4940945935505714e-03 +-1.5030637596676602e-03 +-1.5057420529408904e-03 +-1.5007254416665365e-03 +-1.4872024449705077e-03 +-1.4651074151166982e-03 +-1.4351182395752626e-03 +-1.3985093946657498e-03 +-1.3569174993275778e-03 +-1.3120917997317581e-03 +-1.2656873375758966e-03 +-1.2191292932512306e-03 +-1.1735495981379477e-03 +-1.1297802440198704e-03 +-1.0883824071752043e-03 +-1.0496927370329159e-03 +-1.0138735389439799e-03 +-9.8095908311761652e-04 +-9.5089450800686149e-04 +-9.2356649429013878e-04 +-8.9882633823117270e-04 +-8.7650666033778184e-04 +-8.5643310343729668e-04 +-8.3843225240791506e-04 +-8.2233679594745943e-04 +-8.0798872830223898e-04 +-7.9524119144363560e-04 +-7.8395939728563709e-04 +-7.7402094496086535e-04 +-7.6531575491600224e-04 +-7.5774577344280740e-04 +-7.5122455240067283e-04 +-7.4567677443794977e-04 +-7.4103777014915208e-04 +-7.3725305739417177e-04 +-7.3427792228611388e-04 +-7.3207705451301284e-04 +-7.3062424552349328e-04 +-7.2990215575848016e-04 +-1.2115526917651563e-03 +-1.2139506401882833e-03 +-1.2187065649682451e-03 +-1.2257395714961607e-03 +-1.2349245488292734e-03 +-1.2460839414851724e-03 +-1.2589714131265527e-03 +-1.2732450169836895e-03 +-1.2884305604825223e-03 +-1.3038816567672383e-03 +-1.3187504786667280e-03 +-1.3319892112750678e-03 +-1.3424016811565303e-03 +-1.3487536644415283e-03 +-1.3499299110503924e-03 +-1.3451038832179645e-03 +-1.3338743828519553e-03 +-1.3163297967427588e-03 +-1.2930237919863826e-03 +-1.2648746986285559e-03 +-1.2330212807352206e-03 +-1.1986729630618005e-03 +-1.1629844481015252e-03 +-1.1269700839472206e-03 +-1.0914595553315103e-03 +-1.0570875368021162e-03 +-1.0243064438088749e-03 +-9.9341185123711143e-04 +-9.6457254170520198e-04 +-9.3785996523937994e-04 +-9.1327429714454513e-04 +-8.9076598760847662e-04 +-8.7025273940315151e-04 +-8.5163238963837664e-04 +-8.3479238207823765e-04 +-8.1961653807630260e-04 +-8.0598976259136116e-04 +-7.9380121529859873e-04 +-7.8294636712899113e-04 +-7.7332826447037127e-04 +-7.6485824195700466e-04 +-7.5745626053325631e-04 +-7.5105099837195755e-04 +-7.4557978562046843e-04 +-7.4098844721998103e-04 +-7.3723109889786752e-04 +-7.3426992798790284e-04 +-7.3207498148544466e-04 +-7.3062397753727976e-04 +-7.2990215245292327e-04 +-1.0795762955712127e-03 +-1.0817094903619112e-03 +-1.0859377458485031e-03 +-1.0921842176954161e-03 +-1.1003315958431092e-03 +-1.1102180411190817e-03 +-1.1216294048261933e-03 +-1.1342865903338146e-03 +-1.1478281215379733e-03 +-1.1617903891098453e-03 +-1.1755914181815407e-03 +-1.1885272473851683e-03 +-1.1997911797904995e-03 +-1.2085232013145869e-03 +-1.2138890320078238e-03 +-1.2151774960941532e-03 +-1.2118956330875795e-03 +-1.2038381195399405e-03 +-1.1911133828898899e-03 +-1.1741211398882579e-03 +-1.1534895905965941e-03 +-1.1299896820971516e-03 +-1.1044460697649202e-03 +-1.0776605203843125e-03 +-1.0503565448512875e-03 +-1.0231471687626090e-03 +-9.9652288899322442e-04 +-9.7085451639017492e-04 +-9.4640528594344448e-04 +-9.2334749345606793e-04 +-9.0178024493197111e-04 +-8.8174619590341478e-04 +-8.6324618344576262e-04 +-8.4625136121421599e-04 +-8.3071287736010530e-04 +-8.1656935849881880e-04 +-8.0375255059573082e-04 +-7.9219147555098990e-04 +-7.8181542919251459e-04 +-7.7255609671229863e-04 +-7.6434900920249293e-04 +-7.5713451689100864e-04 +-7.5085841381185661e-04 +-7.4547231554314192e-04 +-7.4093386573639039e-04 +-7.3720682740400969e-04 +-7.3426110019104648e-04 +-7.3207269405520508e-04 +-7.3062368198873926e-04 +-7.2990214880861240e-04 +-9.6691809554750468e-04 +-9.6882656547587207e-04 +-9.7261024483791779e-04 +-9.7820224719601372e-04 +-9.8550108242062410e-04 +-9.9436860316701897e-04 +-1.0046262904147968e-03 +-1.0160493853899231e-03 +-1.0283588415944179e-03 +-1.0412120412928614e-03 +-1.0541946653593003e-03 +-1.0668176830100290e-03 +-1.0785244280301874e-03 +-1.0887122435029530e-03 +-1.0967705662275401e-03 +-1.1021327902777484e-03 +-1.1043341439620250e-03 +-1.1030642455676417e-03 +-1.0982028090593620e-03 +-1.0898306170968252e-03 +-1.0782140727938025e-03 +-1.0637679897090770e-03 +-1.0470055465565951e-03 +-1.0284854651485859e-03 +-1.0087648158499825e-03 +-9.8836265129404648e-04 +-9.6773627860976250e-04 +-9.4726934320503225e-04 +-9.2726937039052596e-04 +-9.0797189886343565e-04 +-8.8954852599372155e-04 +-8.7211672713692579e-04 +-8.5574994754622762e-04 +-8.4048704001875633e-04 +-8.2634056748236335e-04 +-8.1330379827985804e-04 +-8.0135641303604333e-04 +-7.9046904539027663e-04 +-7.8060682307712446e-04 +-7.7173208374902932e-04 +-7.6380642797962679e-04 +-7.5679225085250722e-04 +-7.5065386994144407e-04 +-7.4535834489305270e-04 +-7.4087606391854376e-04 +-7.3718115584881904e-04 +-7.3425177296164510e-04 +-7.3207027919458458e-04 +-7.3062337015165413e-04 +-7.2990214496476810e-04 +-8.7486276260552269e-04 +-8.7658827158597612e-04 +-8.8001138623739958e-04 +-8.8507605728256600e-04 +-8.9169751059892002e-04 +-8.9976115641134428e-04 +-9.0912076480952390e-04 +-9.1959572217923335e-04 +-9.3096736619182946e-04 +-9.4297478630770879e-04 +-9.5531108138158900e-04 +-9.6762178646225242e-04 +-9.7950777094576611e-04 +-9.9053500633186110e-04 +-1.0002528565286055e-03 +-1.0082208401785745e-03 +-1.0140414552549052e-03 +-1.0173943734376582e-03 +-1.0180660141650990e-03 +-1.0159688484402231e-03 +-1.0111467902532325e-03 +-1.0037660578225665e-03 +-9.9409389955788449e-04 +-9.8246965421690149e-04 +-9.6927329704730883e-04 +-9.5489601723497408e-04 +-9.3971596004497541e-04 +-9.2408063052123860e-04 +-9.0829604682182686e-04 +-8.9262177899104627e-04 +-8.7727053926916414e-04 +-8.6241090449534785e-04 +-8.4817190799192242e-04 +-8.3464850773300008e-04 +-8.2190722667157873e-04 +-8.0999151653369649e-04 +-7.9892659610542158e-04 +-7.8872365688589612e-04 +-7.7938342101433681e-04 +-7.7089909021273671e-04 +-7.6325875148014997e-04 +-7.5644731484832671e-04 +-7.5044805769250195e-04 +-7.4524384373622014e-04 +-7.4081807611658306e-04 +-7.3715543454631405e-04 +-7.3424243773826303e-04 +-7.3206786430843307e-04 +-7.3062305849319739e-04 +-7.2990214112441222e-04 +-8.0313983995303738e-04 +-8.0472309126707791e-04 +-8.0786634421492714e-04 +-8.1252293078217007e-04 +-8.1862239684527363e-04 +-8.2606987845113054e-04 +-8.3474515238898166e-04 +-8.4450130968889692e-04 +-8.5516307622911149e-04 +-8.6652496351889176e-04 +-8.7834968560353570e-04 +-8.9036759818693551e-04 +-9.0227822077974026e-04 +-9.1375505365561644e-04 +-9.2445473951026185e-04 +-9.3403103610297737e-04 +-9.4215308575373142e-04 +-9.4852629727588413e-04 +-9.5291315007650038e-04 +-9.5515076418771570e-04 +-9.5516238299480456e-04 +-9.5296095139613915e-04 +-9.4864444195932169e-04 +-9.4238404871744067e-04 +-9.3440743794686047e-04 +-9.2497970416331602e-04 +-9.1438453569468844e-04 +-9.0290752211755502e-04 +-8.9082277552830671e-04 +-8.7838330221088039e-04 +-8.6581498602183386e-04 +-8.5331367992155056e-04 +-8.4104473367227115e-04 +-8.2914426597817381e-04 +-8.1772156213815871e-04 +-8.0686209503998076e-04 +-7.9663079345063093e-04 +-7.8707529654535396e-04 +-7.7822902804114695e-04 +-7.7011399506970437e-04 +-7.6274326800956254e-04 +-7.5612313161305740e-04 +-7.5025491893956865e-04 +-7.4513655145924109e-04 +-7.4076381414765519e-04 +-7.3713139565434222e-04 +-7.3423372227927051e-04 +-7.3206561160541633e-04 +-7.3062276793125916e-04 +-7.2990213754517321e-04 +-7.5076497006207874e-04 +-7.5224439903538471e-04 +-7.5518352729259282e-04 +-7.5954277190933472e-04 +-7.6526244390967752e-04 +-7.7226235604422211e-04 +-7.8044128137108820e-04 +-7.8967626493773018e-04 +-7.9982182521706779e-04 +-8.1070915008343749e-04 +-8.2214550088457138e-04 +-8.3391418152607439e-04 +-8.4577558025833845e-04 +-8.5746989853996262e-04 +-8.6872217583405895e-04 +-8.7925003856859963e-04 +-8.8877421998057211e-04 +-8.9703135559553800e-04 +-9.0378797160154854e-04 +-9.0885411459548247e-04 +-9.1209487921114693e-04 +-9.1343826346410961e-04 +-9.1287829855058074e-04 +-9.1047313244276755e-04 +-9.0633850821977217e-04 +-9.0063769023978398e-04 +-8.9356923966206914e-04 +-8.8535409861017003e-04 +-8.7622325864851838e-04 +-8.6640695653266439e-04 +-8.5612595725975172e-04 +-8.4558513022511394e-04 +-8.3496924614442144e-04 +-8.2444073717512928e-04 +-8.1413906488222716e-04 +-8.0418131254928957e-04 +-7.9466363814736712e-04 +-7.8566327194628280e-04 +-7.7724080244842217e-04 +-7.6944255510713827e-04 +-7.6230292357574113e-04 +-7.5584655978617207e-04 +-7.5009036602604001e-04 +-7.4504525980129870e-04 +-7.4071770179178257e-04 +-7.3711099004558059e-04 +-7.3422633114033937e-04 +-7.3206370263529882e-04 +-7.3062252183297223e-04 +-7.2990213451449377e-04 +-7.1661654258932460e-04 +-7.1802817159272864e-04 +-7.2083400580034073e-04 +-7.2499910051272243e-04 +-7.3047079928676556e-04 +-7.3717845633655362e-04 +-7.4503308428497416e-04 +-7.5392694883237652e-04 +-7.6373315027748832e-04 +-7.7430526450083343e-04 +-7.8547716710163030e-04 +-7.9706323335302308e-04 +-8.0885918467124020e-04 +-8.2064391972337105e-04 +-8.3218269555537208e-04 +-8.4323197788127851e-04 +-8.5354613433885390e-04 +-8.6288589619310950e-04 +-8.7102819116542782e-04 +-8.7777661462040994e-04 +-8.8297154076765036e-04 +-8.8649875889710466e-04 +-8.8829560033244781e-04 +-8.8835379839069853e-04 +-8.8671874284214803e-04 +-8.8348526280235609e-04 +-8.7879049967091549e-04 +-8.7280473596011287e-04 +-8.6572118557353957e-04 +-8.5774572709027106e-04 +-8.4908740801223185e-04 +-8.3995031671192145e-04 +-8.3052716372901587e-04 +-8.2099467879779263e-04 +-8.1151074235520334e-04 +-8.0221304190776477e-04 +-7.9321897322914717e-04 +-7.8462648443607726e-04 +-7.7651557441780822e-04 +-7.6895019256751327e-04 +-7.6198033289814286e-04 +-7.5564416389114553e-04 +-7.4997008021019447e-04 +-7.4497860060180395e-04 +-7.4068406667625883e-04 +-7.3709611984888767e-04 +-7.3422094930066211e-04 +-7.3206231349978669e-04 +-7.3062234282820376e-04 +-7.2990213231060349e-04 +-6.9978953343284513e-04 +-7.0116746674276124e-04 +-7.0390703938727310e-04 +-7.0797557938726636e-04 +-7.1332387491451527e-04 +-7.1988594695830785e-04 +-7.2757877532256352e-04 +-7.3630200507140964e-04 +-7.4593767317570649e-04 +-7.5635001530126832e-04 +-7.6738544330753617e-04 +-7.7887282594268762e-04 +-7.9062425514556643e-04 +-8.0243652901847173e-04 +-8.1409361402069757e-04 +-8.2537034247369249e-04 +-8.3603753620262297e-04 +-8.4586860967402833e-04 +-8.5464749883410265e-04 +-8.6217750947570316e-04 +-8.6829042774676810e-04 +-8.7285504521798947e-04 +-8.7578417910171382e-04 +-8.7703935079208172e-04 +-8.7663252310723398e-04 +-8.7462464920081632e-04 +-8.7112118483837473e-04 +-8.6626508100455849e-04 +-8.6022803791052595e-04 +-8.5320092547668382e-04 +-8.4538425537814563e-04 +-8.3697945216819444e-04 +-8.2818146039237677e-04 +-8.1917298953302145e-04 +-8.1012048012794717e-04 +-8.0117169961473078e-04 +-7.9245475735870857e-04 +-7.8407826434663834e-04 +-7.7613234533447436e-04 +-7.6869022717894562e-04 +-7.6181016367478089e-04 +-7.5553750334052771e-04 +-7.4990675395028474e-04 +-7.4494354082131967e-04 +-7.4066639206162477e-04 +-7.3708831213728195e-04 +-7.3421812544946833e-04 +-7.3206158500967774e-04 +-7.3062224898911470e-04 +-7.2990213115547715e-04 +-6.9978944951421299e-04 +-7.0116671051605509e-04 +-7.0390493389872332e-04 +-7.0797144063129182e-04 +-7.1331701388127632e-04 +-7.1987567824985442e-04 +-7.2756443418975662e-04 +-7.3628297418103803e-04 +-7.4591341947917705e-04 +-7.5632013597084341e-04 +-7.6734971785778077e-04 +-7.7883126953738060e-04 +-7.9057716605819279e-04 +-8.0238452178512862e-04 +-8.1403762958805127e-04 +-8.2531162809867465e-04 +-8.3597759120257822e-04 +-8.4580909807748319e-04 +-8.5459013572853823e-04 +-8.6212393316334576e-04 +-8.6824207337419732e-04 +-8.7281303631789136e-04 +-8.7574925111446342e-04 +-8.7701181557618343e-04 +-8.7661227685209347e-04 +-8.7461121951698160e-04 +-8.7111380750965253e-04 +-8.6626279385753247e-04 +-8.6022977875087315e-04 +-8.5320562271182579e-04 +-8.4539090304868022e-04 +-8.3698716477633827e-04 +-8.2818950638175815e-04 +-8.1918080502493200e-04 +-8.1012766632170973e-04 +-8.0117800812157019e-04 +-7.9246006782489223e-04 +-7.8408255826946177e-04 +-7.7613567922302327e-04 +-7.6869270735926867e-04 +-7.6181192422675170e-04 +-7.5553868796373409e-04 +-7.4990750202342561e-04 +-7.4494397754468569e-04 +-7.4066662233582552e-04 +-7.3708841770445349e-04 +-7.3421816477467732e-04 +-7.3206159538145789e-04 +-7.3062225034499018e-04 +-7.2990213117229898e-04 +-7.1661627771696032e-04 +-7.1802578472139936e-04 +-7.2082736038207287e-04 +-7.2498603836071711e-04 +-7.3044914831414383e-04 +-7.3714606014178851e-04 +-7.4498785966984260e-04 +-7.5386697541384134e-04 +-7.6365679303896700e-04 +-7.7421132519025972e-04 +-7.8536505395969489e-04 +-7.9693313143858343e-04 +-8.0871220238941128e-04 +-8.2048218295068095e-04 +-8.3200936105328946e-04 +-8.4305114406268327e-04 +-8.5336264022246075e-04 +-8.6270501705782256e-04 +-8.7085525866201826e-04 +-8.7761660540871969e-04 +-8.8282868674591437e-04 +-8.8637623098589895e-04 +-8.8819530640512311e-04 +-8.8827631691415563e-04 +-8.8666339165960177e-04 +-8.8345028229034391e-04 +-8.7877331526316281e-04 +-8.7280225878843068e-04 +-8.6573011157528763e-04 +-8.5776280251203066e-04 +-8.4910964009168757e-04 +-8.3997511975204614e-04 +-8.3055244072324297e-04 +-8.2101884604173522e-04 +-8.1153270875762476e-04 +-8.0223215628641702e-04 +-7.9323495239047386e-04 +-7.8463933303921703e-04 +-7.7652550519272925e-04 +-7.6895755291765038e-04 +-7.6198554161272664e-04 +-7.5564765980285626e-04 +-7.4997228321745405e-04 +-7.4497988450769658e-04 +-7.4068474270804657e-04 +-7.3709642942559081e-04 +-7.3422106452313007e-04 +-7.3206234386984873e-04 +-7.3062234679672588e-04 +-7.2990213235979125e-04 +-7.5076448270120649e-04 +-7.5224000725337254e-04 +-7.5517130032944969e-04 +-7.5951874152564952e-04 +-7.6522262343928194e-04 +-7.7220280383322485e-04 +-7.8035822066306810e-04 +-7.8956626786889613e-04 +-7.9968206105656672e-04 +-8.1053768677913287e-04 +-8.2194163488400894e-04 +-8.3367875564705764e-04 +-8.4551123651519053e-04 +-8.5718120680654676e-04 +-8.6841558447255888e-04 +-8.7893361226706131e-04 +-8.8845716203381578e-04 +-8.9672335129797995e-04 +-9.0349842718994257e-04 +-9.0859139204754573e-04 +-9.1186563331236944e-04 +-9.1324697141247687e-04 +-9.1272703793684399e-04 +-9.1036161973981084e-04 +-9.0626436781357283e-04 +-9.0059689271267964e-04 +-8.9355663251007513e-04 +-8.8536395305610323e-04 +-8.7624976914166275e-04 +-8.6644464946260594e-04 +-8.5616998692208469e-04 +-8.4563145901872441e-04 +-8.3501472001653828e-04 +-8.2448307580408413e-04 +-8.1417678954671859e-04 +-8.0421363426953969e-04 +-7.9469032586399055e-04 +-7.8568451645588807e-04 +-7.7725708748050608e-04 +-7.6945454292194496e-04 +-7.6231135912052249e-04 +-7.5585219488580931e-04 +-7.5009390327936826e-04 +-7.4504731470299542e-04 +-7.4071878096393362e-04 +-7.3711148320199874e-04 +-7.3422651439294950e-04 +-7.3206375087921007e-04 +-7.3062252813219737e-04 +-7.2990213459256186e-04 +-8.0313905358665933e-04 +-8.0471600509911267e-04 +-8.0784661703382343e-04 +-8.1248416679753556e-04 +-8.1855818856500686e-04 +-8.2597393167467028e-04 +-8.3461151476281394e-04 +-8.4432471477555399e-04 +-8.5493939893516700e-04 +-8.6625175947616106e-04 +-8.7802675851914903e-04 +-8.8999751035026499e-04 +-9.0186664115724673e-04 +-9.1331083525620130e-04 +-9.2398964111521588e-04 +-9.3355905505746709e-04 +-9.4168944090864261e-04 +-9.4808617752023419e-04 +-9.5251040247060193e-04 +-9.5479671768988446e-04 +-9.5486498101951273e-04 +-9.5272430510396191e-04 +-9.4846883430289234e-04 +-9.4226633957499798e-04 +-9.3434176225112755e-04 +-9.2495832760321368e-04 +-9.1439873579276219e-04 +-9.0294838813160909e-04 +-8.9088185743932738e-04 +-8.7845307669239502e-04 +-8.6588913863391284e-04 +-8.5338722451547516e-04 +-8.4111400190194508e-04 +-8.2920680356677766e-04 +-8.1777596658745371e-04 +-8.0690782420433644e-04 +-7.9666796777283359e-04 +-7.8710451111096654e-04 +-7.7825118474104894e-04 +-7.7013016042370226e-04 +-7.6275455866358136e-04 +-7.5613062707373521e-04 +-7.5025959956721410e-04 +-7.4513925889475906e-04 +-7.4076523100434098e-04 +-7.3713204129245453e-04 +-7.3423396166413975e-04 +-7.3206567452469202e-04 +-7.3062277613783532e-04 +-7.2990213764680329e-04 +-8.7486155506315245e-04 +-8.7657739020938609e-04 +-8.7998109596460145e-04 +-8.8501655202622006e-04 +-8.9159900536694015e-04 +-8.9961412805991811e-04 +-9.0891637808132380e-04 +-9.1932645713665637e-04 +-9.3062782877844199e-04 +-9.4256263542871158e-04 +-9.5482794935689117e-04 +-9.6707401834097300e-04 +-9.7890678175594436e-04 +-9.8989707447899415e-04 +-9.9959824816848271e-04 +-1.0075722868965677e-03 +-1.0134221566628083e-03 +-1.0168258223713067e-03 +-1.0175660011383198e-03 +-1.0155499706992763e-03 +-1.0108156781201540e-03 +-1.0035233743498784e-03 +-9.9393501779725959e-04 +-9.8238581002301406e-04 +-9.6925297291380018e-04 +-9.5492632955344664e-04 +-9.3978387838208649e-04 +-9.2417392872206358e-04 +-9.0840395209840826e-04 +-8.9273533515558110e-04 +-8.7738273054629480e-04 +-8.6251659908692733e-04 +-8.4826768057277889e-04 +-8.3473239248182170e-04 +-8.2197844153267252e-04 +-8.1005018807471432e-04 +-7.9897350424660857e-04 +-7.8876001064875803e-04 +-7.7941067038700840e-04 +-7.7091877504264757e-04 +-7.6327238563265684e-04 +-7.5645630234292573e-04 +-7.5045363681437726e-04 +-7.4524705494928600e-04 +-7.4081974976706287e-04 +-7.3715619469117821e-04 +-7.3424271885349569e-04 +-7.3206793805539788e-04 +-7.3062306809992990e-04 +-7.2990214124332297e-04 +-9.6691628577727496e-04 +-9.6881025757367004e-04 +-9.7256485366495728e-04 +-9.7811310690965373e-04 +-9.8535363733260901e-04 +-9.9414886609568479e-04 +-1.0043216293583511e-03 +-1.0156496545747444e-03 +-1.0278577993807177e-03 +-1.0406088975565785e-03 +-1.0534954921086455e-03 +-1.0660363386518744e-03 +-1.0776826332269370e-03 +-1.0878385432759520e-03 +-1.0958981253655635e-03 +-1.1012962536309288e-03 +-1.1035660608025523e-03 +-1.1023917069151747e-03 +-1.0976449144292151e-03 +-1.0893971798889492e-03 +-1.0779056683160677e-03 +-1.0635771543617708e-03 +-1.0469187394428763e-03 +-1.0284853408282857e-03 +-1.0088324120322589e-03 +-9.8847921912880040e-04 +-9.6788462290114193e-04 +-9.4743465721492932e-04 +-9.2743962761426780e-04 +-9.0813790196715954e-04 +-8.8970372020676309e-04 +-8.7225687364839285e-04 +-8.5587273216750450e-04 +-8.4059167066059272e-04 +-8.2642739482257179e-04 +-8.1337397896195712e-04 +-8.0141162397371853e-04 +-7.9051125066124397e-04 +-7.8063809063176712e-04 +-7.7175444691541682e-04 +-7.6382178583780697e-04 +-7.5680230146548744e-04 +-7.5066007080849698e-04 +-7.4536189559447558e-04 +-7.4087790659983506e-04 +-7.3718198985729374e-04 +-7.3425208055039905e-04 +-7.3207035972289267e-04 +-7.3062338062763457e-04 +-7.2990214509434240e-04 +-1.0795736327461854e-03 +-1.0816854960439249e-03 +-1.0858709696708868e-03 +-1.0920531400086168e-03 +-1.1001150096860456e-03 +-1.1098959121397850e-03 +-1.1211843060577155e-03 +-1.1337057112948985e-03 +-1.1471056947740200e-03 +-1.1609301748218947e-03 +-1.1746086881209822e-03 +-1.1874495984994212e-03 +-1.1986575832040928e-03 +-1.2073810087745640e-03 +-1.2127891771070640e-03 +-1.2141686816816840e-03 +-1.2110186666195847e-03 +-1.2031215715122873e-03 +-1.1905713788140486e-03 +-1.1737535027418219e-03 +-1.1532839651958076e-03 +-1.1299248949087639e-03 +-1.1044958846739492e-03 +-1.0777970948525840e-03 +-1.0505531560710739e-03 +-1.0233800509764867e-03 +-9.9677222866413617e-04 +-9.7110476825730356e-04 +-9.4664501164120360e-04 +-9.2356891146371184e-04 +-9.0197864231471314e-04 +-8.8191930773335496e-04 +-8.6339360587286322e-04 +-8.4637403334263919e-04 +-8.3081264581390279e-04 +-8.1664862533477149e-04 +-8.0381399795426795e-04 +-7.9223785716971465e-04 +-7.8184941809112513e-04 +-7.7258017889293425e-04 +-7.6436541437947217e-04 +-7.5714517863825434e-04 +-7.5086495285937589e-04 +-7.4547604115306166e-04 +-7.4093579110371961e-04 +-7.3720769585579316e-04 +-7.3426141961668043e-04 +-7.3207277751387875e-04 +-7.3062369283135654e-04 +-7.2990214894263301e-04 +-1.2115488581890370e-03 +-1.2139160973134607e-03 +-1.2186104492442282e-03 +-1.2255510108919623e-03 +-1.2346133987176399e-03 +-1.2456223606478359e-03 +-1.2583364241666088e-03 +-1.2724219867837204e-03 +-1.2874172115189425e-03 +-1.3026918249191006e-03 +-1.3174164987260549e-03 +-1.3305617380277963e-03 +-1.3409461252561062e-03 +-1.3473432662909337e-03 +-1.3486365601575023e-03 +-1.3439886665272392e-03 +-1.3329800739791905e-03 +-1.3156769261855267e-03 +-1.2926108170791331e-03 +-1.2646816263588219e-03 +-1.2330153442376424e-03 +-1.1988147961921043e-03 +-1.1632335296109673e-03 +-1.1272887695886809e-03 +-1.0918155358761363e-03 +-1.0574549151173608e-03 +-1.0246657903162639e-03 +-9.9374961774358387e-04 +-9.6488015204955588e-04 +-9.3813281058629855e-04 +-9.1351077708567052e-04 +-8.9096667029028257e-04 +-8.7041966756525957e-04 +-8.5176853162961699e-04 +-8.3490121263031416e-04 +-8.1970172809946911e-04 +-8.0605495681532636e-04 +-7.9384987868242978e-04 +-7.8298168403964337e-04 +-7.7335307780729875e-04 +-7.6487502225593032e-04 +-7.5746709745801860e-04 +-7.5105760888533697e-04 +-7.4558353456650529e-04 +-7.4099037712888462e-04 +-7.3723196661888571e-04 +-7.3427024633519180e-04 +-7.3207506450441982e-04 +-7.3062398830908639e-04 +-7.2990215258597992e-04 +-1.3589553616962025e-03 +-1.3616086297719649e-03 +-1.3668807800313648e-03 +-1.3747019350753905e-03 +-1.3849614514654569e-03 +-1.3974927744191577e-03 +-1.4120414963486286e-03 +-1.4282116884952751e-03 +-1.4453928748955917e-03 +-1.4626832773447385e-03 +-1.4788408389975591e-03 +-1.4923032396506940e-03 +-1.5013101804167601e-03 +-1.5041297811668646e-03 +-1.4993448537508236e-03 +-1.4861178146163801e-03 +-1.4643496309956091e-03 +-1.4346845187520401e-03 +-1.3983690397682111e-03 +-1.3570211980812345e-03 +-1.3123816255951400e-03 +-1.2661052680979759e-03 +-1.2196231445215937e-03 +-1.1740762522214707e-03 +-1.1303066562966912e-03 +-1.0888851079097269e-03 +-1.0501565046493625e-03 +-1.0142897606074976e-03 +-9.8132413319632484e-04 +-9.5120832009184045e-04 +-9.2383139427929754e-04 +-8.9904614103382473e-04 +-8.7668600001397678e-04 +-8.5657695457544815e-04 +-8.3854560020437579e-04 +-8.2242441765409304e-04 +-8.0805505577748714e-04 +-7.9529023152974810e-04 +-7.8399469277054567e-04 +-7.7404556370879189e-04 +-7.6533229841405776e-04 +-7.5775639868725102e-04 +-7.5123100294388699e-04 +-7.4568041772956402e-04 +-7.4103963919478920e-04 +-7.3725389535106911e-04 +-7.3427822901319230e-04 +-7.3207713436471405e-04 +-7.3062425587246712e-04 +-7.2990215588625089e-04 +-1.5143495667292891e-03 +-1.5173065179514529e-03 +-1.5232061128469206e-03 +-1.5320177818020152e-03 +-1.5436845164082957e-03 +-1.5580929076729193e-03 +-1.5750097844062893e-03 +-1.5939770713155267e-03 +-1.6141732978123902e-03 +-1.6342786841387173e-03 +-1.6524109225648752e-03 +-1.6662089808967093e-03 +-1.6731095425040717e-03 +-1.6707828974744053e-03 +-1.6576068192345819e-03 +-1.6330152775815105e-03 +-1.5975994651024077e-03 +-1.5529414657015446e-03 +-1.5012635442921386e-03 +-1.4450237288421532e-03 +-1.3865708234384864e-03 +-1.3279178773512102e-03 +-1.2706391138753758e-03 +-1.2158624316167966e-03 +-1.1643198024128504e-03 +-1.1164229390691039e-03 +-1.0723421899158513e-03 +-1.0320767506184329e-03 +-9.9551157365210404e-04 +-9.6246064889033301e-04 +-9.3269837502763951e-04 +-9.0598140480310405e-04 +-8.8206329232951659e-04 +-8.6070391764534880e-04 +-8.4167523918652720e-04 +-8.2476453396286044e-04 +-8.0977596457844434e-04 +-7.9653106559116255e-04 +-7.8486855939065335e-04 +-7.7464378054163240e-04 +-7.6572789485426719e-04 +-7.5800703496812171e-04 +-7.5138143001062538e-04 +-7.4576457702468096e-04 +-7.4108248209788570e-04 +-7.3727298642479316e-04 +-7.3428518474335570e-04 +-7.3207893916450804e-04 +-7.3062448928095638e-04 +-7.2990215876619956e-04 +-1.6665399750117524e-03 +-1.6697986820323389e-03 +-1.6763433627316490e-03 +-1.6862251204940986e-03 +-1.6995002327462735e-03 +-1.7161746818397730e-03 +-1.7360873125963298e-03 +-1.7587190957777299e-03 +-1.7829510391198934e-03 +-1.8068488833108407e-03 +-1.8276037736161327e-03 +-1.8417577090254296e-03 +-1.8457520142186551e-03 +-1.8366753588712349e-03 +-1.8129494026549032e-03 +-1.7746836941978325e-03 +-1.7235785470924839e-03 +-1.6624586447553994e-03 +-1.5946506139990061e-03 +-1.5234183548490470e-03 +-1.4515805617221350e-03 +-1.3813320683859092e-03 +-1.3142248683427902e-03 +-1.2512442190783521e-03 +-1.1929241405143566e-03 +-1.1394659207869518e-03 +-1.0908411466106624e-03 +-1.0468730287022093e-03 +-1.0072965267833079e-03 +-9.7180065152239852e-04 +-9.4005699467969797e-04 +-9.1173818299462579e-04 +-8.8652924169098759e-04 +-8.6413412070631790e-04 +-8.4427901191464383e-04 +-8.2671359972743283e-04 +-8.1121102904494391e-04 +-7.9756711870549379e-04 +-7.8559916990825879e-04 +-7.7514459621039493e-04 +-7.6605951822472261e-04 +-7.5821741009588384e-04 +-7.5150784771083902e-04 +-7.4583538447199821e-04 +-7.4111856523352896e-04 +-7.3728907984459840e-04 +-7.3429105272129638e-04 +-7.3208046261931284e-04 +-7.3062468638348784e-04 +-7.2990216119904027e-04 +-1.8021134848470659e-03 +-1.8056479692324676e-03 +-1.8128098619297490e-03 +-1.8237793670668628e-03 +-1.8387927363663712e-03 +-1.8580492689491514e-03 +-1.8815165179046107e-03 +-1.9086171047614793e-03 +-1.9378446150229566e-03 +-1.9664526437262143e-03 +-1.9904381962342144e-03 +-2.0050097360126257e-03 +-2.0055349272017197e-03 +-1.9886765903859662e-03 +-1.9532511929779887e-03 +-1.9004484155273568e-03 +-1.8333768955911944e-03 +-1.7562096798107011e-03 +-1.6733003674143051e-03 +-1.5885319700233282e-03 +-1.5049802555587237e-03 +-1.4248405326628905e-03 +-1.3495167590444220e-03 +-1.2797806609727040e-03 +-1.2159399215256614e-03 +-1.1579847474897347e-03 +-1.1057026572975810e-03 +-1.0587622987386369e-03 +-1.0167715566040778e-03 +-9.7931610553297519e-04 +-9.4598389110658561e-04 +-9.1637987201708521e-04 +-8.9013422663199475e-04 +-8.6690629600185787e-04 +-8.4638583018724269e-04 +-8.2829259607710012e-04 +-8.1237504869161937e-04 +-7.9840852339516642e-04 +-7.8619324080095125e-04 +-7.7555230517744602e-04 +-7.6632980359189729e-04 +-7.5838906484013298e-04 +-7.5161110618747386e-04 +-7.4589327648689628e-04 +-7.4114809257219564e-04 +-7.3730225937767440e-04 +-7.3429586129544039e-04 +-7.3208171164602606e-04 +-7.3062484803562927e-04 +-7.2990216319504238e-04 +-1.9091941148749148e-03 +-1.9129552660196868e-03 +-1.9206507464730369e-03 +-1.9326186990284359e-03 +-1.9493165056822085e-03 +-1.9711845249414600e-03 +-1.9983612217166599e-03 +-2.0302280723589771e-03 +-2.0648616094960590e-03 +-2.0986184636330152e-03 +-2.1261902828791416e-03 +-2.1413889724551582e-03 +-2.1385770025962002e-03 +-2.1142094829160736e-03 +-2.0677780023423292e-03 +-2.0017518016287273e-03 +-1.9206688506300006e-03 +-1.8298979496369203e-03 +-1.7345748559858590e-03 +-1.6389581769168033e-03 +-1.5461982327436179e-03 +-1.4583864075718286e-03 +-1.3767410682479645e-03 +-1.3018278420943315e-03 +-1.2337597592757465e-03 +-1.1723569197110146e-03 +-1.1172641065779595e-03 +-1.0680326972772149e-03 +-1.0241751841089336e-03 +-9.8519992396546401e-04 +-9.5063219346802630e-04 +-9.2002605294997535e-04 +-8.9297021291037800e-04 +-8.6909010271407963e-04 +-8.4804762478462019e-04 +-8.2953957664643537e-04 +-8.1329537996369073e-04 +-7.9907452383973525e-04 +-7.8666397471838679e-04 +-7.7587570279826043e-04 +-7.6654440794147918e-04 +-7.5852548498454278e-04 +-7.5169324126088616e-04 +-7.4593936269046321e-04 +-7.4117161543045811e-04 +-7.3731276540137222e-04 +-7.3429969643482333e-04 +-7.3208270822583518e-04 +-7.3062497705130437e-04 +-7.2990216478876883e-04 +-1.9821981056956637e-03 +-1.9861219990561195e-03 +-1.9942129753348810e-03 +-2.0069474247384343e-03 +-2.0249788605097461e-03 +-2.0489697757500613e-03 +-2.0792368756416125e-03 +-2.1151765119117034e-03 +-2.1545617592059261e-03 +-2.1930068738821099e-03 +-2.2240637703789400e-03 +-2.2403091483703562e-03 +-2.2352560611926860e-03 +-2.2052740609335730e-03 +-2.1505485047915900e-03 +-2.0746867256563927e-03 +-1.9833743175419519e-03 +-1.8828437675449806e-03 +-1.7787283893476479e-03 +-1.6754799064650624e-03 +-1.5762464951051592e-03 +-1.4830179921962519e-03 +-1.3968749384351885e-03 +-1.3182428392500209e-03 +-1.2471072607270360e-03 +-1.1831781792578503e-03 +-1.1260075596326055e-03 +-1.0750694490804001e-03 +-1.0298122467318881e-03 +-9.8969130056958160e-04 +-9.5418807507112252e-04 +-9.2282041523805637e-04 +-8.9514707506124498e-04 +-8.7076867398214826e-04 +-8.4932652996054416e-04 +-8.3050032135923801e-04 +-8.1400519116851594e-04 +-7.9958867910244187e-04 +-7.8702771547635734e-04 +-7.7612581115135953e-04 +-7.6671051332574431e-04 +-7.5863115595077254e-04 +-7.5175690821752605e-04 +-7.4597510957426824e-04 +-7.4118987158824749e-04 +-7.3732092326118405e-04 +-7.3430267563943431e-04 +-7.3208348263704428e-04 +-7.3062507732770537e-04 +-7.2990216602815416e-04 +-2.0242429277985432e-03 +-2.0282647985976764e-03 +-2.0365822362775456e-03 +-2.0497330128306890e-03 +-2.0684636448423653e-03 +-2.0935602695325325e-03 +-2.1254809014427619e-03 +-2.1637311113414551e-03 +-2.2060478474748022e-03 +-2.2477110559463664e-03 +-2.2815736624017041e-03 +-2.2993231215481225e-03 +-2.2937832886922374e-03 +-2.2611691524904312e-03 +-2.2020687619974167e-03 +-2.1207892552801101e-03 +-2.0237051472639152e-03 +-1.9175504974209257e-03 +-1.8082455549725638e-03 +-1.7003657634769975e-03 +-1.5970842743125869e-03 +-1.5003652860733066e-03 +-1.4112414879638058e-03 +-1.3300829466272716e-03 +-1.2568192241132845e-03 +-1.1911070434635811e-03 +-1.1324494360141870e-03 +-1.0802765249658165e-03 +-1.0339979802865581e-03 +-9.9303548310098323e-04 +-9.5684155969437781e-04 +-9.2490939682179658e-04 +-8.9677687107767641e-04 +-8.7202700203695279e-04 +-8.5028630793525391e-04 +-8.3122203348805614e-04 +-8.1453887143858629e-04 +-7.9997556515388894e-04 +-7.8730162412211468e-04 +-7.7631428247411914e-04 +-7.6683576522337165e-04 +-7.5871088570123903e-04 +-7.5180497253448633e-04 +-7.4600210990246089e-04 +-7.4120366711822358e-04 +-7.3732709030124507e-04 +-7.3430492854493958e-04 +-7.3208406840313399e-04 +-7.3062515319028006e-04 +-7.2990216696649623e-04 +-2.0445765601439557e-03 +-2.0486445240644065e-03 +-2.0570338645387195e-03 +-2.0702443933887250e-03 +-2.0889795230638825e-03 +-2.1140098190118944e-03 +-2.1458574888132400e-03 +-2.1842106443057140e-03 +-2.2270634223701658e-03 +-2.2698609465174021e-03 +-2.3053323659971083e-03 +-2.3247264239188402e-03 +-2.3203330692582323e-03 +-2.2880163208440865e-03 +-2.2283041397871094e-03 +-2.1456546128084258e-03 +-2.0466711415542413e-03 +-1.9383076547331449e-03 +-1.8266640381071958e-03 +-1.7164520481304873e-03 +-1.6109422866252159e-03 +-1.5121628261368469e-03 +-1.4211822346965003e-03 +-1.3383845167440856e-03 +-1.2636973352028601e-03 +-1.1967651843914492e-03 +-1.1370730031158803e-03 +-1.0840302508286364e-03 +-1.0370255826340322e-03 +-9.9546067319414809e-04 +-9.5876978183456697e-04 +-9.2642987439559422e-04 +-8.9796469298440956e-04 +-8.7294509665911059e-04 +-8.5098722780244281e-04 +-8.3174952184778992e-04 +-8.1492921049098157e-04 +-8.0025872132746204e-04 +-7.8750221321812147e-04 +-7.7645238004495488e-04 +-7.6692758729288624e-04 +-7.5876936321184305e-04 +-7.5184024050778202e-04 +-7.4602192967379924e-04 +-7.4121379738714471e-04 +-7.3733162023250200e-04 +-7.3430658380910457e-04 +-7.3208449886361148e-04 +-7.3062520894686864e-04 +-7.2990216765692170e-04 +-2.0529830693574468e-03 +-2.0570649311650847e-03 +-2.0654277490843222e-03 +-2.0784658897879341e-03 +-2.0967425793777870e-03 +-2.1208993649192713e-03 +-2.1514260605846446e-03 +-2.1881775633768178e-03 +-2.2295553361283828e-03 +-2.2715354976705344e-03 +-2.3072374973311595e-03 +-2.3279324569349946e-03 +-2.3255608826316808e-03 +-2.2954606215068243e-03 +-2.2376789717752990e-03 +-2.1563679749415209e-03 +-2.0580237234714329e-03 +-1.9496493229903479e-03 +-1.8374837101456020e-03 +-1.7264064432355576e-03 +-1.6198433975872614e-03 +-1.5199453398398741e-03 +-1.4278665551917520e-03 +-1.3440440765258488e-03 +-1.2684334771189156e-03 +-1.2006897195198604e-03 +-1.1402971371216831e-03 +-1.0866582214481189e-03 +-1.0391515090778696e-03 +-9.9716744823614696e-04 +-9.6012917258083818e-04 +-9.2750327398958882e-04 +-8.9880417005328906e-04 +-8.7359453082841855e-04 +-8.5148341270453460e-04 +-8.3212317576838741e-04 +-8.1520587030150810e-04 +-8.0045951582218000e-04 +-7.8764452300642549e-04 +-7.7655039647035740e-04 +-7.6699278481894993e-04 +-7.5881089981592366e-04 +-7.5186529973394795e-04 +-7.4603601663328627e-04 +-7.4122099944317786e-04 +-7.3733484150985721e-04 +-7.3430776110985614e-04 +-7.3208480507273681e-04 +-7.3062524861374856e-04 +-7.2990216814898447e-04 +-2.0560405138041206e-03 +-2.0601215912717623e-03 +-2.0684227648032965e-03 +-2.0812202980049588e-03 +-2.0989128985275905e-03 +-2.1219667339603936e-03 +-2.1507618479451578e-03 +-2.1852282404177976e-03 +-2.2241382692129545e-03 +-2.2641174707486488e-03 +-2.2989763236282708e-03 +-2.3203619924364806e-03 +-2.3200645591623975e-03 +-2.2928416030280874e-03 +-2.2380333425889997e-03 +-2.1592390024823874e-03 +-2.0626769907384230e-03 +-1.9553192412174519e-03 +-1.8435239004226949e-03 +-1.7323464399306712e-03 +-1.6253840468711592e-03 +-1.5249257487692171e-03 +-1.4322245947874269e-03 +-1.3477814611540303e-03 +-1.2715891079374388e-03 +-1.2033211913162795e-03 +-1.1424688458389145e-03 +-1.0884342607096502e-03 +-1.0405917968483828e-03 +-9.9832590894283050e-04 +-9.6105315649541994e-04 +-9.2823367455152433e-04 +-8.9937589926304402e-04 +-8.7403714752472652e-04 +-8.5182178580455251e-04 +-8.3237811915551970e-04 +-8.1539471913724345e-04 +-8.0059663337758561e-04 +-7.8774173789421850e-04 +-7.7661737574332573e-04 +-7.6703735094984745e-04 +-7.5883930035923421e-04 +-7.5188243831967704e-04 +-7.4604565327543459e-04 +-7.4122592726371631e-04 +-7.3733704597984105e-04 +-7.3430856691101892e-04 +-7.3208501468106923e-04 +-7.3062527576924342e-04 +-7.2990216848687380e-04 +-2.0570060304026957e-03 +-2.0610821893309009e-03 +-2.0693258563267525e-03 +-2.0819185946154848e-03 +-2.0991223051870051e-03 +-2.1212422535637700e-03 +-2.1485214058565940e-03 +-2.1808741698775723e-03 +-2.2173134255385253e-03 +-2.2550305071641972e-03 +-2.2885737854221309e-03 +-2.3101230729902804e-03 +-2.3114715149954337e-03 +-2.2868654369067195e-03 +-2.2349324103552804e-03 +-2.1586870056133169e-03 +-2.0640404875311457e-03 +-1.9579097901036928e-03 +-1.8467497301446856e-03 +-1.7357690116378108e-03 +-1.6287150742817500e-03 +-1.5279980100420055e-03 +-1.4349574244362302e-03 +-1.3501506941868005e-03 +-1.2736044109342771e-03 +-1.2050104423917199e-03 +-1.1438680851654551e-03 +-1.0895816192631211e-03 +-1.0415240824806929e-03 +-9.9907687772865777e-04 +-9.6165280322218691e-04 +-9.2870810778164666e-04 +-8.9974752848212590e-04 +-8.7432501762165198e-04 +-8.5204196328390013e-04 +-8.3254407746267197e-04 +-8.1551769655387088e-04 +-8.0068595220642589e-04 +-7.8780508233674629e-04 +-7.7666103047434223e-04 +-7.6706640467806976e-04 +-7.5885781951991432e-04 +-7.5189361619419875e-04 +-7.4605193951880582e-04 +-7.4122914235013487e-04 +-7.3733848446203725e-04 +-7.3430909278322473e-04 +-7.3208515148588313e-04 +-7.3062529349430670e-04 +-7.2990216870864736e-04 +-2.0572330705430830e-03 +-2.0613045912966001e-03 +-2.0695076168864793e-03 +-2.0819608975955629e-03 +-2.0988331138711474e-03 +-2.1203121409116435e-03 +-2.1465225221855623e-03 +-2.1773220429780293e-03 +-2.2118434904620727e-03 +-2.2476761099826758e-03 +-2.2799720607746855e-03 +-2.3014104508354526e-03 +-2.3038596825624182e-03 +-2.2811898676004918e-03 +-2.2314593784231074e-03 +-2.1572068997764548e-03 +-2.0640909839826386e-03 +-1.9589780066002161e-03 +-1.8483918833687501e-03 +-1.7376541961037330e-03 +-1.6306229974651200e-03 +-1.5297971894677311e-03 +-1.4365797791044868e-03 +-1.3515696674531470e-03 +-1.2748186078150492e-03 +-1.2060324094125803e-03 +-1.1447170958701915e-03 +-1.0902792926122708e-03 +-1.0420918823430231e-03 +-9.9953480277689363e-04 +-9.6201879843275061e-04 +-9.2899789349883415e-04 +-8.9997465695371474e-04 +-8.7450104193671112e-04 +-8.5217665158151439e-04 +-8.3264563494047294e-04 +-8.1559297584347414e-04 +-8.0074064323830516e-04 +-7.8784387891123024e-04 +-7.7668777400938759e-04 +-7.6708420730742981e-04 +-7.5886916939636522e-04 +-7.5190046807127901e-04 +-7.4605579354518857e-04 +-7.4123111378074336e-04 +-7.3733936662744319e-04 +-7.3430941531549558e-04 +-7.3208523539937311e-04 +-7.3062530436764084e-04 +-7.2990216884623066e-04 +-2.0572420268849118e-03 +-2.0613103606050703e-03 +-2.0694888619553157e-03 +-2.0818597515609304e-03 +-2.0985366149514585e-03 +-2.1196350309556941e-03 +-2.1451992331463650e-03 +-2.1750324827824533e-03 +-2.2083156044156254e-03 +-2.2428754702275046e-03 +-2.2742677984914361e-03 +-2.2955330137604006e-03 +-2.2986203144132774e-03 +-2.2771646651180625e-03 +-2.2288482509703039e-03 +-2.1558915884622686e-03 +-2.0637830974986589e-03 +-1.9593528881860400e-03 +-1.8491671936473827e-03 +-1.7386184626094910e-03 +-1.6316343074516512e-03 +-1.5307694421883434e-03 +-1.4374667357741266e-03 +-1.3523512829753369e-03 +-1.2754908418502165e-03 +-1.2066002491535135e-03 +-1.1451900642811203e-03 +-1.0906687072262213e-03 +-1.0424092742003799e-03 +-9.9979106977056940e-04 +-9.6222380527377996e-04 +-9.2916033201854954e-04 +-9.0010205029071859e-04 +-8.7459982193854532e-04 +-8.5225226797589436e-04 +-8.3270267288515628e-04 +-8.1563526948450111e-04 +-8.0077137936238312e-04 +-7.8786568855193921e-04 +-7.7670281189446235e-04 +-7.6709422013651976e-04 +-7.5887555439689016e-04 +-7.5190432346790173e-04 +-7.4605796252767025e-04 +-7.4123222345697513e-04 +-7.3733986325270906e-04 +-7.3430959691130873e-04 +-7.3208528265006931e-04 +-7.3062531049128984e-04 +-7.2990216892567026e-04 +-2.0572136813918219e-03 +-2.0612802236373877e-03 +-2.0694459144877629e-03 +-2.0817743441635737e-03 +-2.0983507499742842e-03 +-2.1192526586766734e-03 +-2.1444796904355060e-03 +-2.1737996728436282e-03 +-2.2064091542083101e-03 +-2.2402563980255382e-03 +-2.2711200526887463e-03 +-2.2922502892668592e-03 +-2.2956526321461575e-03 +-2.2748388281166078e-03 +-2.2272849935858425e-03 +-2.1550352325905983e-03 +-2.0634824741599610e-03 +-1.9594349197207916e-03 +-1.8494801802396944e-03 +-1.7390479937835505e-03 +-1.6321028871553209e-03 +-1.5312293237126206e-03 +-1.4378915141162454e-03 +-1.3527286651949316e-03 +-1.2758172446532046e-03 +-1.2068770878940979e-03 +-1.1454213525875557e-03 +-1.0908595811335415e-03 +-1.0425651304938398e-03 +-9.9991709467249089e-04 +-9.6232474197423810e-04 +-9.2924038876732791e-04 +-9.0016488740332537e-04 +-8.7464858010166257e-04 +-8.5228961561848219e-04 +-8.3273085990437563e-04 +-8.1565618046292628e-04 +-8.0078658285527278e-04 +-7.8787648106161119e-04 +-7.7671025625689375e-04 +-7.6709917866760158e-04 +-7.5887871741742705e-04 +-7.5190623395595833e-04 +-7.4605903764092291e-04 +-7.4123277363729310e-04 +-7.3734010953568343e-04 +-7.3430968698405075e-04 +-7.3208530609047842e-04 +-7.3062531353025150e-04 +-7.2990216896775281e-04 +-2.0571951358039856e-03 +-2.0612608727602617e-03 +-2.0694210555694636e-03 +-2.0817313758164594e-03 +-2.0982649615372728e-03 +-2.1190828344464065e-03 +-2.1441646180217211e-03 +-2.1732608365783784e-03 +-2.2055717887287224e-03 +-2.2390963144580623e-03 +-2.2697113878751736e-03 +-2.2907632973928767e-03 +-2.2942873091477299e-03 +-2.2737443622842511e-03 +-2.2265209300679737e-03 +-2.1545827546087986e-03 +-2.0632791898260333e-03 +-1.9594071320901507e-03 +-1.8495622085910074e-03 +-1.7391895774462166e-03 +-1.6322694020690139e-03 +-1.5313989265018332e-03 +-1.4380516444625411e-03 +-1.3528729866852380e-03 +-1.2759433319843962e-03 +-1.2069848209601427e-03 +-1.1455118652387740e-03 +-1.0909346050788102e-03 +-1.0426266042563408e-03 +-9.9996694280493344e-04 +-9.6236475983001667e-04 +-9.2927219048384373e-04 +-9.0018989027790893e-04 +-8.7466800880007438e-04 +-8.5230451627674425e-04 +-8.3274211831889117e-04 +-8.1566454113106120e-04 +-8.0079266715939559e-04 +-7.8788080381323280e-04 +-7.7671324033259698e-04 +-7.6710116776924995e-04 +-7.5887998713152134e-04 +-7.5190700136430007e-04 +-7.4605946974820928e-04 +-7.4123299488170803e-04 +-7.3734020861964897e-04 +-7.3430972323624308e-04 +-7.3208531552803821e-04 +-7.3062531475516978e-04 +-7.2990216898842627e-04 +-2.0571887361294544e-03 +-2.0612542171410128e-03 +-2.0694126991472835e-03 +-2.0817174423345647e-03 +-2.0982377913092223e-03 +-2.1190294979157834e-03 +-2.1440655809305451e-03 +-2.1730903889607802e-03 +-2.2053042084927469e-03 +-2.2387206214372606e-03 +-2.2692474101426463e-03 +-2.2902627069647137e-03 +-2.2938139088862263e-03 +-2.2733484708934459e-03 +-2.2262258013531298e-03 +-2.1543866783797598e-03 +-2.0631655841940322e-03 +-1.9593545138618237e-03 +-1.8495505016198159e-03 +-1.7392028066162937e-03 +-1.6322960950565992e-03 +-1.5314314574511110e-03 +-1.4380852839212116e-03 +-1.3529050195887093e-03 +-1.2759723647915347e-03 +-1.2070102846198664e-03 +-1.1455336789498245e-03 +-1.0909529584445647e-03 +-1.0426418212309799e-03 +-9.9997939977795988e-04 +-9.6237483842193420e-04 +-9.2928025199413053e-04 +-9.0019626328312363e-04 +-8.7467298448855562e-04 +-8.5230834814915780e-04 +-8.3274502419194507e-04 +-8.1566670621705689e-04 +-8.0079424750927888e-04 +-7.8788192973403535e-04 +-7.7671401958099315e-04 +-7.6710168844200269e-04 +-7.5888032023829191e-04 +-7.5190720310875433e-04 +-7.4605958356029544e-04 +-7.4123305325422785e-04 +-7.3734023480079910e-04 +-7.3430973282758458e-04 +-7.3208531802814651e-04 +-7.3062531508168746e-04 +-7.2990216899993107e-04 +-2.0571877673444747e-03 +-2.0612532084043327e-03 +-2.0694114325909667e-03 +-2.0817153221969198e-03 +-2.0982335993393417e-03 +-2.1190210858232856e-03 +-2.1440495295408954e-03 +-2.1730618835155914e-03 +-2.2052578224603051e-03 +-2.2386526899258411e-03 +-2.2691591306400580e-03 +-2.2901612750347087e-03 +-2.2937101040528722e-03 +-2.2732524547788707e-03 +-2.2261441228803810e-03 +-2.1543216926299324e-03 +-2.0631165201491792e-03 +-1.9593189570166840e-03 +-1.8495255578826323e-03 +-1.7391857722122740e-03 +-1.6322847356247340e-03 +-1.5314240561094775e-03 +-1.4380805821192799e-03 +-1.3529021240247931e-03 +-1.2759706559548410e-03 +-1.2070093404318782e-03 +-1.1455332160549901e-03 +-1.0909527891971584e-03 +-1.0426418231282604e-03 +-9.9997949417220686e-04 +-9.6237497590086131e-04 +-9.2928040244256071e-04 +-9.0019640918169289e-04 +-8.7467311642689554e-04 +-8.5230846184303417e-04 +-8.3274511851490663e-04 +-8.1566678191276364e-04 +-8.0079430635702153e-04 +-7.8788197401395579e-04 +-7.7671405173523986e-04 +-7.6710171086305317e-04 +-7.5888033513887539e-04 +-7.5190721244458450e-04 +-7.4605958898756985e-04 +-7.4123305611184737e-04 +-7.3734023611174827e-04 +-7.3430973331732445e-04 +-7.3208531815872229e-04 +-7.3062531510157509e-04 +-7.2990216900942987e-04 +-2.0571877672736767e-03 +-2.0612532076205686e-03 +-2.0694114285390894e-03 +-2.0817153038325958e-03 +-2.0982335308527972e-03 +-2.1190208759199196e-03 +-2.1440489825991509e-03 +-2.1730606377425563e-03 +-2.2052553122884353e-03 +-2.2386482198451202e-03 +-2.2691521281389105e-03 +-2.2901516224635024e-03 +-2.2936982974409025e-03 +-2.2732394495534394e-03 +-2.2261309911146931e-03 +-2.1543093206705067e-03 +-2.0631054697322587e-03 +-1.9593094739435274e-03 +-1.8495176545948568e-03 +-1.7391793220235554e-03 +-1.6322795478590567e-03 +-1.5314199251384311e-03 +-1.4380773144603168e-03 +-1.3528995504818683e-03 +-1.2759686349026324e-03 +-1.2070077565072264e-03 +-1.1455319768685069e-03 +-1.0909518215079686e-03 +-1.0426410691941979e-03 +-9.9997890857065567e-04 +-9.6237452289626903e-04 +-9.2928005387253327e-04 +-9.0019614279212244e-04 +-8.7467291457677136e-04 +-8.5230831050440200e-04 +-8.3274500650376429e-04 +-8.1566670029819123e-04 +-8.0079424800648142e-04 +-7.8788193324183964e-04 +-7.7671402402919667e-04 +-7.6710169266862619e-04 +-7.5888032368767136e-04 +-7.5190720561488125e-04 +-7.4605958518910809e-04 +-7.4123305418872859e-04 +-7.3734023525900895e-04 +-7.3430973300795223e-04 +-7.3208531807872606e-04 +-7.3062531509126085e-04 +-7.2990216900932134e-04 +-2.0571887354973997e-03 +-2.0612542041132122e-03 +-2.0694126130475264e-03 +-2.0817170822703605e-03 +-2.0982366366677939e-03 +-2.1190263978529125e-03 +-2.1440582843955556e-03 +-2.1730749879189243e-03 +-2.2052749009960296e-03 +-2.2386706527773993e-03 +-2.2691717187934409e-03 +-2.2901610824460749e-03 +-2.2936921829750491e-03 +-2.2732166330643876e-03 +-2.2260945039729771e-03 +-2.1542643786523694e-03 +-2.0630573812201046e-03 +-1.9592623978425903e-03 +-1.8494742508050996e-03 +-1.7391409355568739e-03 +-1.6322465812539627e-03 +-1.5313921999988303e-03 +-1.4380543469970442e-03 +-1.3528807338538521e-03 +-1.2759533472002876e-03 +-1.2069954175754245e-03 +-1.1455220732185219e-03 +-1.0909439129160173e-03 +-1.0426347857196811e-03 +-9.9997394322490652e-04 +-9.6237062289855147e-04 +-9.2927701202308636e-04 +-9.0019378967073893e-04 +-8.7467111182148332e-04 +-8.5230694518777966e-04 +-8.3274398651323118e-04 +-8.1566595058318316e-04 +-8.0079370754835254e-04 +-7.8788155261173723e-04 +-7.7671376341626516e-04 +-7.6710152027896299e-04 +-7.5888021443241656e-04 +-7.5190714002113543e-04 +-7.4605954848110318e-04 +-7.4123303549752961e-04 +-7.3734022692850839e-04 +-7.3430972997189895e-04 +-7.3208531728978304e-04 +-7.3062531498643856e-04 +-7.2990216899877260e-04 +-2.0571951350198910e-03 +-2.0612608121130262e-03 +-2.0694205636594648e-03 +-2.0817293346307212e-03 +-2.0982588231907226e-03 +-2.1190675689101643e-03 +-2.1441312403169487e-03 +-2.1731948654448892e-03 +-2.2054531616663565e-03 +-2.2389035398737425e-03 +-2.2694309303905066e-03 +-2.2903992788652354e-03 +-2.2938634936878499e-03 +-2.2732961857593148e-03 +-2.2260835339967160e-03 +-2.1541822930242634e-03 +-2.0629300764820166e-03 +-1.9591136751462941e-03 +-1.8493219507522169e-03 +-1.7389964840756867e-03 +-1.6321161593891315e-03 +-1.5312783123442562e-03 +-1.4379572032461364e-03 +-1.3527992680505835e-03 +-1.2758858921449576e-03 +-1.2069401147400054e-03 +-1.1454771016317445e-03 +-1.0909076032848887e-03 +-1.0426056662410324e-03 +-9.9995074729713205e-04 +-9.6235227732281118e-04 +-9.2926261660517461e-04 +-9.0018259430226573e-04 +-8.7466249420988993e-04 +-8.5230039070544007e-04 +-8.3273907069277963e-04 +-8.1566232428136346e-04 +-8.0079108456046196e-04 +-7.8787969941660299e-04 +-7.7671249071276690e-04 +-7.6710067598960007e-04 +-7.5887967788615331e-04 +-7.5190681706541250e-04 +-7.4605936731459213e-04 +-7.4123294304984067e-04 +-7.3734018564738609e-04 +-7.3430971490505686e-04 +-7.3208531337433120e-04 +-7.3062531447736910e-04 +-7.2990216898501938e-04 +-2.0572136877874546e-03 +-2.0612800774015313e-03 +-2.0694443244041122e-03 +-2.0817674930870508e-03 +-2.0983304073959484e-03 +-2.1192035606561969e-03 +-2.1443761819325072e-03 +-2.1736027609695172e-03 +-2.2060680907084844e-03 +-2.2397212954279821e-03 +-2.2703660650540023e-03 +-2.2912991802204793e-03 +-2.2945728245734724e-03 +-2.2737219639582212e-03 +-2.2262160214331188e-03 +-2.1540731845533009e-03 +-2.0626564090133739e-03 +-1.9587498176899007e-03 +-1.8489259320329670e-03 +-1.7386072561115318e-03 +-1.6317564063810547e-03 +-1.5309589118222770e-03 +-1.4376813742402795e-03 +-1.3525657385983450e-03 +-1.2756910598069957e-03 +-1.2067794045122924e-03 +-1.1453457585120304e-03 +-1.0908011166113766e-03 +-1.0425199681302910e-03 +-9.9988228005973116e-04 +-9.6229798968749719e-04 +-9.2921992485911226e-04 +-9.0014932919195434e-04 +-8.7463684505025441e-04 +-8.5228085251290290e-04 +-8.3272439692801549e-04 +-8.1565148597847201e-04 +-8.0078323568860232e-04 +-7.8787414786310472e-04 +-7.7670867411446247e-04 +-7.6709814160680855e-04 +-7.5887806577117989e-04 +-7.5190584585205884e-04 +-7.4605882205384824e-04 +-7.4123266460177399e-04 +-7.3734006122974324e-04 +-7.3430966947094064e-04 +-7.3208530156424064e-04 +-7.3062531294651369e-04 +-7.2990216896057464e-04 +-2.0572420711519076e-03 +-2.0613102008866921e-03 +-2.0694852294085471e-03 +-2.0818428227580839e-03 +-2.0984856722524865e-03 +-2.1195129250951160e-03 +-2.1449459241273169e-03 +-2.1745606276473658e-03 +-2.2075172769314955e-03 +-2.2416525253300132e-03 +-2.2725834957148428e-03 +-2.2934524553232609e-03 +-2.2963024696594420e-03 +-2.2748076348270397e-03 +-2.2266265158851889e-03 +-2.1539195501187594e-03 +-2.0621109566640395e-03 +-1.9579818939546474e-03 +-1.8480696094958576e-03 +-1.7377539763915551e-03 +-1.6309606183514895e-03 +-1.5302478411292986e-03 +-1.4370643353535011e-03 +-1.3520413541866702e-03 +-1.2752522478277199e-03 +-1.2064165533477193e-03 +-1.1450486090936029e-03 +-1.0905597926408146e-03 +-1.0423254774558125e-03 +-9.9972670499939051e-04 +-9.6217450508140356e-04 +-9.2912272852258080e-04 +-9.0007353428576866e-04 +-8.7457836202872014e-04 +-8.5223627508273917e-04 +-8.3269089876997053e-04 +-8.1562673061893022e-04 +-8.0076529960692970e-04 +-7.8786145574970821e-04 +-7.7669994473065834e-04 +-7.6709234255807135e-04 +-7.5887437558817578e-04 +-7.5190362191079505e-04 +-7.4605757306676240e-04 +-7.4123202658886759e-04 +-7.3733977607352483e-04 +-7.3430956531630434e-04 +-7.3208527448662055e-04 +-7.3062530943866419e-04 +-7.2990216891271860e-04 +-2.0572332401244831e-03 +-2.0613048630991381e-03 +-2.0695012662693296e-03 +-2.0819268926923532e-03 +-2.0987273607136763e-03 +-2.1200571082541542e-03 +-2.1459964119240772e-03 +-2.1763540302891697e-03 +-2.2102320196524415e-03 +-2.2452504118289475e-03 +-2.2766870993642602e-03 +-2.2974135509027196e-03 +-2.2994652897135497e-03 +-2.2767724394754944e-03 +-2.2273380935080842e-03 +-2.1535828855558338e-03 +-2.0610446513950951e-03 +-1.9565005604009486e-03 +-1.8464236714967137e-03 +-1.7361151800746348e-03 +-1.6294318243629325e-03 +-1.5288808399062702e-03 +-1.4358770874911826e-03 +-1.3510314877795836e-03 +-1.2744064555611006e-03 +-1.2057166174506328e-03 +-1.1444749977270951e-03 +-1.0900936441613151e-03 +-1.0419495770891819e-03 +-9.9942586483691928e-04 +-9.6193561107624551e-04 +-9.2893461638486813e-04 +-8.9992678957879601e-04 +-8.7446509808747699e-04 +-8.5214991701241161e-04 +-8.3262598694960736e-04 +-8.1557874866150569e-04 +-8.0073052720689873e-04 +-7.8783684452962026e-04 +-7.7668301424223729e-04 +-7.6708109328579833e-04 +-7.5886721592542878e-04 +-7.5189930632269257e-04 +-7.4605514901891876e-04 +-7.4123078815439749e-04 +-7.3733922249464927e-04 +-7.3430936309847397e-04 +-7.3208522191132552e-04 +-7.3062530262875847e-04 +-7.2990216882482786e-04 +-2.0570065261444779e-03 +-2.0610841870780847e-03 +-2.0693175203207125e-03 +-2.0818604983147007e-03 +-2.0989315395601900e-03 +-2.1207750084747640e-03 +-2.1475573515452825e-03 +-2.1791150854424063e-03 +-2.2144231758043859e-03 +-2.2507430517556943e-03 +-2.2828456710270711e-03 +-2.3032307186507945e-03 +-2.3039586741786444e-03 +-2.2793630592585399e-03 +-2.2279702177583111e-03 +-2.1525931280218227e-03 +-2.0589400400473435e-03 +-1.9537792777210906e-03 +-1.8434820477447650e-03 +-1.7332247042707934e-03 +-1.6267541623219918e-03 +-1.5264958517892371e-03 +-1.4338102655832572e-03 +-1.3492756276378181e-03 +-1.2729368472389692e-03 +-1.2045008343534631e-03 +-1.1434787573145905e-03 +-1.0892840420669867e-03 +-1.0412966705702234e-03 +-9.9890327490549137e-04 +-9.6152057586328761e-04 +-9.2860776275047283e-04 +-8.9967178082700310e-04 +-8.7426824684008211e-04 +-8.5199981024776535e-04 +-8.3251314548454629e-04 +-8.1549532921157506e-04 +-8.0067006756937942e-04 +-7.8779404855951044e-04 +-7.7665357167432494e-04 +-7.6706152896064631e-04 +-7.5885476317941679e-04 +-7.5189179973608104e-04 +-7.4605093233200560e-04 +-7.4122863374492234e-04 +-7.3733825942687878e-04 +-7.3430901128279007e-04 +-7.3208513043884131e-04 +-7.3062529078136214e-04 +-7.2990216867525610e-04 +-2.0560417248730407e-03 +-2.0601281436175550e-03 +-2.0684165477674716e-03 +-2.0811351503727377e-03 +-2.0986084189681437e-03 +-2.1212021676662563e-03 +-2.1491775506557037e-03 +-2.1823551863892859e-03 +-2.2194721630543041e-03 +-2.2572850877596402e-03 +-2.2899506333771418e-03 +-2.3095883464123168e-03 +-2.3083750853701290e-03 +-2.2811919678305047e-03 +-2.2272273455524374e-03 +-2.1497783722674423e-03 +-2.0547559525874951e-03 +-1.9489039793535922e-03 +-1.8384503998365672e-03 +-1.7283991405820022e-03 +-1.6223454665515262e-03 +-1.5226016269067769e-03 +-1.4304529365208826e-03 +-1.3464327237574748e-03 +-1.2705623759722050e-03 +-1.2025391057508752e-03 +-1.1418726543638248e-03 +-1.0879795453044765e-03 +-1.0402450159758586e-03 +-9.9806170223177030e-04 +-9.6085229138002264e-04 +-9.2808150381889891e-04 +-8.9926121205765935e-04 +-8.7395131731720873e-04 +-8.5175813972826247e-04 +-8.3233147108086720e-04 +-8.1536102328692893e-04 +-8.0057272640596873e-04 +-7.8772514576199533e-04 +-7.7660616796818743e-04 +-7.6703002945704816e-04 +-7.5883471357282247e-04 +-7.5187971367341865e-04 +-7.4604414318563410e-04 +-7.4122516499161182e-04 +-7.3733670881413684e-04 +-7.3430844483126029e-04 +-7.3208498316063985e-04 +-7.3062527170679806e-04 +-7.2990216843686823e-04 +-2.0529856109088775e-03 +-2.0570809040340722e-03 +-2.0654334376166554e-03 +-2.0783620223185514e-03 +-2.0963152185974466e-03 +-2.1197850249811386e-03 +-2.1490948747322804e-03 +-2.1839632507103294e-03 +-2.2227731297931657e-03 +-2.2617080137632048e-03 +-2.2943633018124424e-03 +-2.3126333225343305e-03 +-2.3089679114528198e-03 +-2.2788787395010661e-03 +-2.2222264461971377e-03 +-2.1427662064974974e-03 +-2.0465746709754182e-03 +-1.9403324448871058e-03 +-1.8300862166593034e-03 +-1.7206331917177236e-03 +-1.6153891713128030e-03 +-1.5165332745661674e-03 +-1.4252632875582129e-03 +-1.3420615466370291e-03 +-1.2669243603739460e-03 +-1.1995406255757705e-03 +-1.1394217073788840e-03 +-1.0859910471831301e-03 +-1.0386431455828165e-03 +-9.9678049454131898e-04 +-9.5983526665089811e-04 +-9.2728082576090491e-04 +-8.9863666753054036e-04 +-8.7346928128774698e-04 +-8.5139060961878649e-04 +-8.3205520740098772e-04 +-8.1515680660072354e-04 +-8.0042472637783277e-04 +-7.8762039110426079e-04 +-7.7653410346461399e-04 +-7.6698214588038051e-04 +-7.5880423716957225e-04 +-7.5186134325294759e-04 +-7.4603382442349465e-04 +-7.4121989310408449e-04 +-7.3733435225173459e-04 +-7.3430758398815245e-04 +-7.3208475934600928e-04 +-7.3062524272079772e-04 +-7.2990216807644734e-04 +-2.0445811336284093e-03 +-2.0486759802069926e-03 +-2.0570669100883014e-03 +-2.0701481353187132e-03 +-2.0884650098087327e-03 +-2.1125880200164038e-03 +-2.1428287012927537e-03 +-2.1787201305810086e-03 +-2.2182622189047189e-03 +-2.2571778061693357e-03 +-2.2887750808355876e-03 +-2.3050418273447572e-03 +-2.2988837845678667e-03 +-2.2664078341142128e-03 +-2.2079623550468499e-03 +-2.1275528235774471e-03 +-2.0312704551712080e-03 +-1.9256510283204528e-03 +-1.8165273009019868e-03 +-1.7084823837975000e-03 +-1.6047557398917471e-03 +-1.5074002241388005e-03 +-1.4175342696984435e-03 +-1.3355979181206826e-03 +-1.2615712507164430e-03 +-1.1951435475243016e-03 +-1.1358360651124299e-03 +-1.0830867840014209e-03 +-1.0363063126247911e-03 +-9.9491301747421180e-04 +-9.5835376152317883e-04 +-9.2611499802728139e-04 +-8.9772760945478727e-04 +-8.7276784020459686e-04 +-8.5085591075411489e-04 +-8.3165336225946680e-04 +-8.1485980837228450e-04 +-8.0020951852291869e-04 +-7.8746808846621335e-04 +-7.7642934326679208e-04 +-7.6691254655879564e-04 +-7.5875994485000793e-04 +-7.5183464804717663e-04 +-7.4601883119899005e-04 +-7.4121223376364103e-04 +-7.3733092877533541e-04 +-7.3430633349411275e-04 +-7.3208443424216624e-04 +-7.3062520061898826e-04 +-7.2990216755441321e-04 +-2.0242499165478173e-03 +-2.0283158218012479e-03 +-2.0366575190432106e-03 +-2.0496839648883065e-03 +-2.0679503722052539e-03 +-2.0920049412808872e-03 +-2.1220632177055693e-03 +-2.1574630150514797e-03 +-2.1959602713697585e-03 +-2.2331458671747757e-03 +-2.2624940696170446e-03 +-2.2764837871741632e-03 +-2.2686274731749312e-03 +-2.2354693524458918e-03 +-2.1774847132773906e-03 +-2.0985430019125318e-03 +-2.0044658294452356e-03 +-1.9014957770322471e-03 +-1.7952091845956685e-03 +-1.6899919829779615e-03 +-1.5889475664980623e-03 +-1.4940461541154799e-03 +-1.4063656058194512e-03 +-1.3263356398526738e-03 +-1.2539458181752986e-03 +-1.1889064338678661e-03 +-1.1307653019467007e-03 +-1.0789885170250386e-03 +-1.0330139224849410e-03 +-9.9228491680444005e-04 +-9.5627060641629755e-04 +-9.2447677101815940e-04 +-8.9645083441506214e-04 +-8.7178306015158955e-04 +-8.5010547915065370e-04 +-8.3108955142491801e-04 +-8.1444321340898957e-04 +-7.9990772342286597e-04 +-7.8725455727361564e-04 +-7.7628249979096241e-04 +-7.6681500897630842e-04 +-7.5869788532385244e-04 +-7.5179725150429765e-04 +-7.4599783128631786e-04 +-7.4120150757611149e-04 +-7.3732613517828291e-04 +-7.3430458273714648e-04 +-7.3208397912057695e-04 +-7.3062514168350243e-04 +-7.2990216682484728e-04 +-1.9822071560065026e-03 +-1.9861909039503053e-03 +-1.9943341754337577e-03 +-2.0069773559505759e-03 +-2.0245723804728968e-03 +-2.0475320268058257e-03 +-2.0759196453041121e-03 +-2.1089545090640744e-03 +-2.1444159426751413e-03 +-2.1782035950279844e-03 +-2.2044520120655378e-03 +-2.2165016337082717e-03 +-2.2085762961047990e-03 +-2.1774621825632668e-03 +-2.1233524148565807e-03 +-2.0495140537544242e-03 +-1.9611169361234779e-03 +-1.8638793792095164e-03 +-1.7630332502552751e-03 +-1.6627760807627794e-03 +-1.5661322706167614e-03 +-1.4750607721763756e-03 +-1.3906665475294591e-03 +-1.3134261121362965e-03 +-1.2433841242455879e-03 +-1.1803074581850743e-03 +-1.1237980498610565e-03 +-1.0733715383281519e-03 +-1.0285097940694640e-03 +-9.8869452491940745e-04 +-9.5342767108693219e-04 +-9.2224285185937621e-04 +-8.9471092247490392e-04 +-8.7044177576033066e-04 +-8.4908384624837404e-04 +-8.3032229306826875e-04 +-8.1387650258715662e-04 +-7.9949732192320698e-04 +-7.8696427904187253e-04 +-7.7608294142482253e-04 +-7.6668249707061967e-04 +-7.5861359746145465e-04 +-7.5174647428637555e-04 +-7.4596932474416415e-04 +-7.4118695055233651e-04 +-7.3731963086636225e-04 +-7.3430220757799488e-04 +-7.3208336176203311e-04 +-7.3062506174678687e-04 +-7.2990216583633982e-04 +-1.9092041540524718e-03 +-1.9130340908131958e-03 +-1.9208052062391092e-03 +-1.9327306276594207e-03 +-1.9490820618014502e-03 +-1.9700684087562734e-03 +-1.9955890165741959e-03 +-2.0248467571458775e-03 +-2.0558912485779440e-03 +-2.0852879346539809e-03 +-2.1081993814608306e-03 +-2.1190944850781354e-03 +-2.1130031696889860e-03 +-2.0868536529017427e-03 +-2.0402834876785598e-03 +-1.9755800143524565e-03 +-1.8968824095034083e-03 +-1.8090932064333811e-03 +-1.7169339817007176e-03 +-1.6243618617322226e-03 +-1.5343468802702883e-03 +-1.4488997721545695e-03 +-1.3692267040527326e-03 +-1.2959209972602693e-03 +-1.2291420993659863e-03 +-1.1687617036148052e-03 +-1.1144738063951841e-03 +-1.0658731015905807e-03 +-1.0225084081323314e-03 +-9.8391762114364558e-04 +-9.4964955759601125e-04 +-9.1927679826814279e-04 +-8.9240251294154290e-04 +-8.6866337690905343e-04 +-8.4773003312898034e-04 +-8.2930608476558261e-04 +-8.1312627316773068e-04 +-7.9895426859419999e-04 +-7.8658034567278005e-04 +-7.7581911085523967e-04 +-7.6650737935840660e-04 +-7.5850225325147620e-04 +-7.5167942282786159e-04 +-7.4593169491483891e-04 +-7.4116774074721719e-04 +-7.3731104999449264e-04 +-7.3429907485351889e-04 +-7.3208254764161110e-04 +-7.3062495634625905e-04 +-7.2990216453382335e-04 +-1.8021232219798706e-03 +-1.8057262296491108e-03 +-1.8129748032582498e-03 +-1.8239473898532762e-03 +-1.8387284864446300e-03 +-1.8573259876384872e-03 +-1.8795037398179441e-03 +-1.9045182380476751e-03 +-1.9308032830796810e-03 +-1.9557273888567775e-03 +-1.9756110134230968e-03 +-1.9861598212814616e-03 +-1.9833009273758340e-03 +-1.9641661701984121e-03 +-1.9278229949356461e-03 +-1.8754475579340975e-03 +-1.8099153230801102e-03 +-1.7350468839111256e-03 +-1.6548287192586538e-03 +-1.5728351210759107e-03 +-1.4919233890665238e-03 +-1.4141601868679350e-03 +-1.3408929031137177e-03 +-1.2728861773996895e-03 +-1.2104698810408516e-03 +-1.1536706137121220e-03 +-1.1023166371551209e-03 +-1.0561159969365332e-03 +-1.0147118156875966e-03 +-9.7771982677811358e-04 +-9.4475284554544083e-04 +-9.1543599913982592e-04 +-8.8941561230464737e-04 +-8.6636385327714619e-04 +-8.4598062445376992e-04 +-8.2799372329691093e-04 +-8.1215796940862508e-04 +-7.9825376209355175e-04 +-7.8608537236100906e-04 +-7.7547916355628563e-04 +-7.6628186048713137e-04 +-7.5835893716683675e-04 +-7.5159316049630759e-04 +-7.4588330603696294e-04 +-7.4114304881838834e-04 +-7.3730002433774631e-04 +-7.3429505081435093e-04 +-7.3208150213928988e-04 +-7.3062482101215792e-04 +-7.2990216286223828e-04 +-1.6665484406729154e-03 +-1.6698679702040397e-03 +-1.6764972077856341e-03 +-1.6864122530195534e-03 +-1.6995570059732186e-03 +-1.7157938070287279e-03 +-1.7348035841801871e-03 +-1.7559271340412974e-03 +-1.7779691538638634e-03 +-1.7990330311974244e-03 +-1.8164954928280906e-03 +-1.8272266232728354e-03 +-1.8280811614791173e-03 +-1.8165494389852635e-03 +-1.7913416947343440e-03 +-1.7526785776007009e-03 +-1.7021890968912203e-03 +-1.6424915450608563e-03 +-1.5766426958585126e-03 +-1.5076394093408124e-03 +-1.4380795852186007e-03 +-1.3700012270728432e-03 +-1.3048618706822557e-03 +-1.2436027651898235e-03 +-1.1867494464944714e-03 +-1.1345166653878075e-03 +-1.0869009729777544e-03 +-1.0437549212478749e-03 +-1.0048428271890709e-03 +-9.6988072209800563e-04 +-9.3856385003348046e-04 +-9.1058488432226676e-04 +-8.8564548481123218e-04 +-8.6346321780371286e-04 +-8.4377533025405897e-04 +-8.2634044628550091e-04 +-8.1093893432109335e-04 +-7.9737245983442506e-04 +-7.8546307233983640e-04 +-7.7505205844143174e-04 +-7.6599871177741061e-04 +-7.5817911518086657e-04 +-7.5148499279066366e-04 +-7.4582266479831963e-04 +-7.4111212120725575e-04 +-7.3728622072895180e-04 +-7.3429001487908057e-04 +-7.3208019413180023e-04 +-7.3062465173403320e-04 +-7.2990216077218836e-04 +-1.5143563290070895e-03 +-1.5173626663506836e-03 +-1.5233357183754472e-03 +-1.5321936811635507e-03 +-1.5438024503699626e-03 +-1.5579488159829095e-03 +-1.5742865348502715e-03 +-1.5922496861368516e-03 +-1.6109421175468865e-03 +-1.6290355068970053e-03 +-1.6447328606525855e-03 +-1.6558608974213676e-03 +-1.6601250239737914e-03 +-1.6554938303616055e-03 +-1.6406063477869708e-03 +-1.6150627822975150e-03 +-1.5794969215462671e-03 +-1.5354174054578605e-03 +-1.4848921259638717e-03 +-1.4301893261087634e-03 +-1.3734727225655876e-03 +-1.3166010416481781e-03 +-1.2610359343618817e-03 +-1.2078340306193943e-03 +-1.1576904523795122e-03 +-1.1110053618045015e-03 +-1.0679541594895794e-03 +-1.0285506673504271e-03 +-9.9269896747581883e-04 +-9.6023335997707615e-04 +-9.3094776442439315e-04 +-9.0461654460065549e-04 +-8.8100874992533501e-04 +-8.5989750065259228e-04 +-8.4106589809868461e-04 +-8.2431051141123918e-04 +-8.0944321528548342e-04 +-7.9629193544501244e-04 +-7.8470069476939994e-04 +-7.7452923275301156e-04 +-7.6565238452244234e-04 +-7.5795934437458885e-04 +-7.5135289595483360e-04 +-7.4574866164706316e-04 +-7.4107440371060432e-04 +-7.3726939641347066e-04 +-7.3428387989200395e-04 +-7.3207860126710646e-04 +-7.3062444564455774e-04 +-7.2990215822846640e-04 +-1.3589604341685193e-03 +-1.3616512361415906e-03 +-1.3669820935398990e-03 +-1.3748500004825922e-03 +-1.3850942821928727e-03 +-1.3974829044126609e-03 +-1.4116853411852027e-03 +-1.4272287686948337e-03 +-1.4434406391280088e-03 +-1.4593917144741502e-03 +-1.4738664212276013e-03 +-1.4853944802395256e-03 +-1.4923697628536599e-03 +-1.4932548453293513e-03 +-1.4868308510013312e-03 +-1.4724221204887545e-03 +-1.4500243248732471e-03 +-1.4202970946317276e-03 +-1.3844312329981620e-03 +-1.3439401181718415e-03 +-1.3004380304097198e-03 +-1.2554556265745383e-03 +-1.2103176617927222e-03 +-1.1660843660030817e-03 +-1.1235432838566997e-03 +-1.0832335301535244e-03 +-1.0454861191149262e-03 +-1.0104685540731106e-03 +-9.7822660049093563e-04 +-9.4871987659465049e-04 +-9.2185031770540917e-04 +-8.9748390979968386e-04 +-8.7546668303035535e-04 +-8.5563610951336453e-04 +-8.3782897751629825e-04 +-8.2188664964403103e-04 +-8.0765842855829090e-04 +-7.9500358471997759e-04 +-7.8379245939856265e-04 +-7.7390694450963358e-04 +-7.6524055562300088e-04 +-7.5769825106598268e-04 +-7.5119610374386147e-04 +-7.4566089903538258e-04 +-7.4102970859483790e-04 +-7.3724947352871606e-04 +-7.3427661926386042e-04 +-7.3207671700750937e-04 +-7.3062420193042196e-04 +-7.2990215522122806e-04 +-1.2115524961074868e-03 +-1.2139469397814489e-03 +-1.2186855039683611e-03 +-1.2256666328371219e-03 +-1.2347346643864323e-03 +-1.2456730413718795e-03 +-1.2581912579372335e-03 +-1.2719039109277256e-03 +-1.2863027962535581e-03 +-1.3007277627814558e-03 +-1.3143481391436841e-03 +-1.3261712574922607e-03 +-1.3350938055643629e-03 +-1.3400022136219995e-03 +-1.3399109436674714e-03 +-1.3341091166213413e-03 +-1.3222763004381299e-03 +-1.3045342806201528e-03 +-1.2814215886139410e-03 +-1.2538018876143266e-03 +-1.2227347732543816e-03 +-1.1893420744993300e-03 +-1.1546957068731506e-03 +-1.1197405492965132e-03 +-1.0852538668929832e-03 +-1.0518349917625700e-03 +-1.0199158326894828e-03 +-9.8978306334629560e-04 +-9.6160485162487784e-04 +-9.3545741864402602e-04 +-9.1134881703931454e-04 +-8.8923883293619494e-04 +-8.6905486106424190e-04 +-8.5070410806713367e-04 +-8.3408269180524611e-04 +-8.1908224467836009e-04 +-8.0559458069939826e-04 +-7.9351490142546318e-04 +-7.8274392407702402e-04 +-7.7318923061924145e-04 +-7.6476606492125387e-04 +-7.5739774740181376e-04 +-7.5101583166921468e-04 +-7.4556009359819878e-04 +-7.4097841795722275e-04 +-7.3722662918767516e-04 +-7.3426829962986752e-04 +-7.3207455907030859e-04 +-7.3062392292103171e-04 +-7.2990215177946708e-04 +-1.0795761618685679e-03 +-1.0817070984745153e-03 +-1.0859244927786576e-03 +-1.0921388206215138e-03 +-1.1002139462659333e-03 +-1.1099637504818542e-03 +-1.1211459710491795e-03 +-1.1334525371732638e-03 +-1.1464966938406012e-03 +-1.1597991810085959e-03 +-1.1727784474859283e-03 +-1.1847524247609353e-03 +-1.1949601500284596e-03 +-1.2026088291104060e-03 +-1.2069452178533079e-03 +-1.2073411370557084e-03 +-1.2033752928787074e-03 +-1.1948914408959103e-03 +-1.1820181399327025e-03 +-1.1651460276576678e-03 +-1.1448701137360055e-03 +-1.1219123966646762e-03 +-1.0970419326626882e-03 +-1.0710060808901175e-03 +-1.0444806087436618e-03 +-1.0180403620254584e-03 +-9.9214795824978754e-04 +-9.6715588121918457e-04 +-9.4331703686679330e-04 +-9.2079956366174426e-04 +-8.9970283211935546e-04 +-8.8007269366301654e-04 +-8.6191494485801212e-04 +-8.4520660748432081e-04 +-8.2990501805627276e-04 +-8.1595493181805558e-04 +-8.0329393602822786e-04 +-7.9185648387651271e-04 +-7.8157683784403620e-04 +-7.7239117164337268e-04 +-7.6423903588187917e-04 +-7.5706435103455733e-04 +-7.5081605519164473e-04 +-7.4544850422355593e-04 +-7.4092169823602907e-04 +-7.3720138972374518e-04 +-7.3425911477554022e-04 +-7.3207217814684315e-04 +-7.3062361520858158e-04 +-7.2990214798469345e-04 +-9.6691800584467987e-04 +-9.6882503441991449e-04 +-9.7260196691958717e-04 +-9.7817418683719790e-04 +-9.8542868879887948e-04 +-9.9421234977018023e-04 +-1.0043290012128651e-03 +-1.0155350380751632e-03 +-1.0275336980717763e-03 +-1.0399689367753952e-03 +-1.0524209776354302e-03 +-1.0644068436510229e-03 +-1.0753898918071697e-03 +-1.0848018330394792e-03 +-1.0920784227423657e-03 +-1.0967061550827659e-03 +-1.0982730420226062e-03 +-1.0965136775087560e-03 +-1.0913387998397761e-03 +-1.0828428222985794e-03 +-1.0712881746534580e-03 +-1.0570707413607037e-03 +-1.0406743028958307e-03 +-1.0226228031060890e-03 +-1.0034377898015523e-03 +-9.8360557350161450e-04 +-9.6355569031384358e-04 +-9.4364994802115514e-04 +-9.2417998920394306e-04 +-9.0537084210336573e-04 +-8.8738807845554807e-04 +-8.7034666303942656e-04 +-8.5432013417307379e-04 +-8.3934926064140384e-04 +-8.2544971816441587e-04 +-8.1261860746910473e-04 +-8.0083981219026895e-04 +-7.9008829310398194e-04 +-7.8033346006300009e-04 +-7.7154177442274158e-04 +-7.6367872725742600e-04 +-7.5671032199075270e-04 +-7.5060417020903077e-04 +-7.4533028978766445e-04 +-7.4086167674910076e-04 +-7.3717470714598527e-04 +-7.3424941281211508e-04 +-7.3206966481535512e-04 +-7.3062329052980639e-04 +-7.2990214398181577e-04 +-8.7486270329201329e-04 +-8.7658729371296493e-04 +-8.8000619998518869e-04 +-8.8505862532303053e-04 +-8.9165270404652913e-04 +-8.9966456142181767e-04 +-9.0893686967325122e-04 +-9.1927683692053549e-04 +-9.3045372570924110e-04 +-9.4219631560212003e-04 +-9.5419120324097446e-04 +-9.6608338808018134e-04 +-9.7748101881079612e-04 +-9.8796617837286992e-04 +-9.9711288784611724e-04 +-1.0045120313658250e-03 +-1.0098009149922794e-03 +-1.0126932943536747e-03 +-1.0130046974066169e-03 +-1.0106682620800239e-03 +-1.0057381063234201e-03 +-9.9837988088810029e-04 +-9.8885074326977265e-04 +-9.7747275009578871e-04 +-9.6460421691408639e-04 +-9.5061303637410642e-04 +-9.3585469791506164e-04 +-9.2065631525372336e-04 +-9.0530673180596319e-04 +-8.9005193610902861e-04 +-8.7509460235993654e-04 +-8.6059649083288219e-04 +-8.4668257665920050e-04 +-8.3344601040505524e-04 +-8.2095326861997763e-04 +-8.0924907972576164e-04 +-7.9836089005824956e-04 +-7.8830276387173589e-04 +-7.7907869612871988e-04 +-7.7068536774897863e-04 +-7.6311439949516455e-04 +-7.5635417109154543e-04 +-7.5039127276757566e-04 +-7.4521165157775927e-04 +-7.4080150745306429e-04 +-7.3714798574590987e-04 +-7.3423970503783305e-04 +-7.3206715167064868e-04 +-7.3062296602623036e-04 +-7.2990213998219157e-04 +-8.0313980146509397e-04 +-8.0472246562105886e-04 +-8.0786305281736065e-04 +-8.1251190698861954e-04 +-8.1859410064399343e-04 +-8.2600888083182006e-04 +-8.3462890597063382e-04 +-8.4429928821710975e-04 +-8.5483652467326999e-04 +-8.6602753115569159e-04 +-8.7762919097822813e-04 +-8.8936907439912108e-04 +-9.0094820330109573e-04 +-9.1204681783258205e-04 +-9.2233392033612806e-04 +-9.3148084458610715e-04 +-9.3917825535840384e-04 +-9.4515500512162539e-04 +-9.4919646043449047e-04 +-9.5115957136341007e-04 +-9.5098227570025295e-04 +-9.4868576352213029e-04 +-9.4436941399974998e-04 +-9.3819948071322890e-04 +-9.3039350974615279e-04 +-9.2120284926903192e-04 +-9.1089546246539833e-04 +-8.9974074121872897e-04 +-8.8799734430043860e-04 +-8.7590443513876882e-04 +-8.6367618731107384e-04 +-8.5149910387897023e-04 +-8.3953154739170447e-04 +-8.2790485916261049e-04 +-8.1672551028341461e-04 +-8.0607783019140812e-04 +-7.9602697091828742e-04 +-7.8662186814504515e-04 +-7.7789804528928899e-04 +-7.6988017197365463e-04 +-7.6258433492578065e-04 +-7.5602001081752530e-04 +-7.5019175028218175e-04 +-7.4510059355592593e-04 +-7.4074524349535486e-04 +-7.3712302312061654e-04 +-7.3423064377152816e-04 +-7.3206480743422022e-04 +-7.3062266347015707e-04 +-7.2990213625406233e-04 +-7.5076494604910159e-04 +-7.5224399834687890e-04 +-7.5518138737917535e-04 +-7.5953555391072825e-04 +-7.6524384482868529e-04 +-7.7222215349310910e-04 +-7.8036447282418819e-04 +-7.8954240070496949e-04 +-7.9960467019143673e-04 +-8.1037683371499171e-04 +-8.2166131532898222e-04 +-8.3323815207136389e-04 +-8.4486685185928179e-04 +-8.5628985913688987e-04 +-8.6723808658704514e-04 +-8.7743879321680574e-04 +-8.8662574952750846e-04 +-8.9455116786641103e-04 +-9.0099838973983152e-04 +-9.0579394972729605e-04 +-9.0881750730932164e-04 +-9.1000832214617911e-04 +-9.0936742025216251e-04 +-9.0695524464610544e-04 +-9.0288524346872400e-04 +-8.9731436984278842e-04 +-8.9043175585294340e-04 +-8.8244685818850014e-04 +-8.7357820024710120e-04 +-8.6404353601532468e-04 +-8.5405192080399044e-04 +-8.4379786112788913e-04 +-8.3345747132335210e-04 +-8.2318640205153893e-04 +-8.1311922047580597e-04 +-8.0336989784332959e-04 +-7.9403307833135592e-04 +-7.8518584565739555e-04 +-7.7688975716469467e-04 +-7.6919296924626423e-04 +-7.6213232725230295e-04 +-7.5573533457718453e-04 +-7.5002194859328435e-04 +-7.4500617586485186e-04 +-7.4069745664998086e-04 +-7.3710184033338403e-04 +-7.3422296038747406e-04 +-7.3206282085843853e-04 +-7.3062240718139331e-04 +-7.2990213309675111e-04 +-7.1661652908064746e-04 +-7.1802791670015772e-04 +-7.2083255597298122e-04 +-7.2499407387978290e-04 +-7.3045766861583696e-04 +-7.3714984798995428e-04 +-7.4497812957339518e-04 +-7.5383074740604031e-04 +-7.6357642872665061e-04 +-7.7406433202617444e-04 +-7.8512427734086533e-04 +-7.9656745004333005e-04 +-8.0818781285611427e-04 +-8.1976450142830302e-04 +-8.3106548316669261e-04 +-8.4185270141235358e-04 +-8.5188878892255269e-04 +-8.6094521570642018e-04 +-8.6881146294203663e-04 +-8.7530454007953137e-04 +-8.8027795509486512e-04 +-8.8362917239667759e-04 +-8.8530468626209018e-04 +-8.8530209480025188e-04 +-8.8366893197873507e-04 +-8.8049842570667571e-04 +-8.7592271508489116e-04 +-8.7010431406451985e-04 +-8.6322671893721383e-04 +-8.5548502604616459e-04 +-8.4707728464054736e-04 +-8.3819710334196416e-04 +-8.2902780366871239e-04 +-8.1973820787811953e-04 +-8.1047998462252600e-04 +-8.0138636420612453e-04 +-7.9257197414727971e-04 +-7.8413352689431345e-04 +-7.7615110344359233e-04 +-7.6868980770006495e-04 +-7.6180160682254262e-04 +-7.5552721510821876e-04 +-7.4989791831436218e-04 +-7.4493726897409201e-04 +-7.4066261015537198e-04 +-7.3708640524553588e-04 +-7.3421736537468906e-04 +-7.3206137497045746e-04 +-7.3062222071209107e-04 +-7.2990213080002743e-04 +-6.9978952820064157e-04 +-7.0116730880131356e-04 +-7.0390598379819677e-04 +-7.0797169301162004e-04 +-7.1331343819250857e-04 +-7.1986286514687454e-04 +-7.2753402543045175e-04 +-7.3622316227749921e-04 +-7.4580857884229683e-04 +-7.5615066445004959e-04 +-7.6709217819541516e-04 +-7.7845891912220184e-04 +-7.9006094541276303e-04 +-8.0169453397701922e-04 +-8.1314508405551757e-04 +-8.2419114796277750e-04 +-8.3460970336270135e-04 +-8.4418265546224575e-04 +-8.5270437837559456e-04 +-8.5998989457686042e-04 +-8.6588308910474758e-04 +-8.7026421037427479e-04 +-8.7305586822690744e-04 +-8.7422682973186218e-04 +-8.7379313154688275e-04 +-8.7181633895416202e-04 +-8.6839912631039363e-04 +-8.6367866424853399e-04 +-8.5781851915932511e-04 +-8.5099986874393526e-04 +-8.4341281200610058e-04 +-8.3524842664441394e-04 +-8.2669204012285021e-04 +-8.1791797446408422e-04 +-8.0908583406256280e-04 +-8.0033825356682091e-04 +-7.9179991918436126e-04 +-7.8357762093680602e-04 +-7.7576107773445139e-04 +-7.6842429071137378e-04 +-7.6162721185711211e-04 +-7.5541755499354047e-04 +-7.4983261739421808e-04 +-7.4490101815309032e-04 +-7.4064429125287733e-04 +-7.3707829623537115e-04 +-7.3421442758052585e-04 +-7.3206061609954083e-04 +-7.3062212287315685e-04 +-7.2990212959513263e-04 +-6.9978945167056155e-04 +-7.0116661915598281e-04 +-7.0390406368567922e-04 +-7.0796791864895443e-04 +-7.1330718123281082e-04 +-7.1985350053655774e-04 +-7.2752094694564402e-04 +-7.3620580693380328e-04 +-7.4578646051665022e-04 +-7.5612341577185448e-04 +-7.6705959807862780e-04 +-7.7842102137914331e-04 +-7.9001800203718463e-04 +-8.0164710538037180e-04 +-8.1309402832470856e-04 +-8.2413760253335531e-04 +-8.3455503554883618e-04 +-8.4412838280020167e-04 +-8.5265206497780555e-04 +-8.5994103454091811e-04 +-8.6583899126413508e-04 +-8.7022589938291089e-04 +-8.7302401480808241e-04 +-8.7420171830883636e-04 +-8.7377466745706945e-04 +-8.7180409139418259e-04 +-8.6839239833364325e-04 +-8.6367657837422489e-04 +-8.5782010669032327e-04 +-8.5100415241404150e-04 +-8.4341887440756358e-04 +-8.3525546022990488e-04 +-8.2669937773737618e-04 +-8.1792510187102111e-04 +-8.0909238757183018e-04 +-8.0034400665898156e-04 +-7.9180476210308204e-04 +-7.8358153680962246e-04 +-7.7576411809624109e-04 +-7.6842655252764484e-04 +-7.6162881740337435e-04 +-7.5541863531783599e-04 +-7.4983329960396912e-04 +-7.4490141642553432e-04 +-7.4064450125278152e-04 +-7.3707839250796868e-04 +-7.3421446344337966e-04 +-7.3206062555814682e-04 +-7.3062212410965636e-04 +-7.2990212961047431e-04 +-7.1661628752876089e-04 +-7.1802573997899611e-04 +-7.2082649564515820e-04 +-7.2498216177394384e-04 +-7.3043792388340458e-04 +-7.3712030408453052e-04 +-7.4493688670274364e-04 +-7.5377605425173489e-04 +-7.6350679420272133e-04 +-7.7397866334512463e-04 +-7.8502203479734482e-04 +-7.9644880234490693e-04 +-8.0805377075548123e-04 +-8.1961700357026249e-04 +-8.3090740833291336e-04 +-8.4168778715761376e-04 +-8.5172144824108254e-04 +-8.6078025948723119e-04 +-8.6865375352403553e-04 +-8.7515861609412755e-04 +-8.8014767599265764e-04 +-8.8351743005022070e-04 +-8.8521322066808248e-04 +-8.8523143355088367e-04 +-8.8361845298602442e-04 +-8.8046652423990344e-04 +-8.7590704319312300e-04 +-8.7010205476239469e-04 +-8.6323485899102745e-04 +-8.5550059811119797e-04 +-8.4709755939892247e-04 +-8.3821972271711886e-04 +-8.2905085526234197e-04 +-8.1976024741182085e-04 +-8.1050001706676643e-04 +-8.0140379571320898e-04 +-7.9258654646081699e-04 +-7.8414524426717027e-04 +-7.7616015987951969e-04 +-7.6869652001823065e-04 +-7.6180635694197561e-04 +-7.5553040322601250e-04 +-7.4989992735992523e-04 +-7.4493843983962067e-04 +-7.4066322666651002e-04 +-7.3708668756581176e-04 +-7.3421747045248763e-04 +-7.3206140266661110e-04 +-7.3062222433120715e-04 +-7.2990213084488369e-04 +-7.5076450159753641e-04 +-7.5223999323578673e-04 +-7.5517023692901709e-04 +-7.5951363926161453e-04 +-7.6520753031397021e-04 +-7.7216784449004455e-04 +-7.8028872507945315e-04 +-7.8944208812437109e-04 +-7.9947721121798401e-04 +-8.1022046632061293e-04 +-8.2147539779594127e-04 +-8.3302345288227162e-04 +-8.4462578027849730e-04 +-8.5602658256944838e-04 +-8.6695848558386243e-04 +-8.7715022242257953e-04 +-8.8633660204062552e-04 +-8.9427027644304420e-04 +-9.0073433272276464e-04 +-9.0555435317696482e-04 +-9.0860844038950230e-04 +-9.0983386809872428e-04 +-9.0922947389349910e-04 +-9.0685354745708780e-04 +-9.0281762894860727e-04 +-8.9727716322854118e-04 +-8.9042025814068326e-04 +-8.8245584483197497e-04 +-8.7360237670132239e-04 +-8.6407791047828282e-04 +-8.5409207412839394e-04 +-8.4384011115081381e-04 +-8.3349894166285133e-04 +-8.2322501314662606e-04 +-8.1315362379979800e-04 +-8.0339937388832167e-04 +-7.9405741638963146e-04 +-7.8520521973465352e-04 +-7.7690460840695245e-04 +-7.6920390160997211e-04 +-7.6214002009929811e-04 +-7.5574047354025179e-04 +-7.5002517441245190e-04 +-7.4500804984453043e-04 +-7.4069844080732773e-04 +-7.3710229007025081e-04 +-7.3422312750575747e-04 +-7.3206286485475434e-04 +-7.3062241292600903e-04 +-7.2990213316794677e-04 +-8.0313908433372265e-04 +-8.0471600334904839e-04 +-8.0784506249967781e-04 +-8.1247655594491772e-04 +-8.1853554551693242e-04 +-8.2592138156853997e-04 +-8.3450703424502322e-04 +-8.4413824119272923e-04 +-8.5463254032085774e-04 +-8.6577838013715991e-04 +-8.7733469404835027e-04 +-8.8903156798641819e-04 +-9.0057285699684012e-04 +-9.1164170500365141e-04 +-9.2190976441905838e-04 +-9.3105041067223472e-04 +-9.3875542269730239e-04 +-9.4475362580693817e-04 +-9.4882916296428550e-04 +-9.5083668783021243e-04 +-9.5071105062397227e-04 +-9.4846994640062688e-04 +-9.4420926297317546e-04 +-9.3809213204671239e-04 +-9.3033361454265427e-04 +-9.2118335389436304e-04 +-9.1090841211029325e-04 +-8.9977800941668429e-04 +-8.8805122479971123e-04 +-8.7596806685235197e-04 +-8.6374381165958464e-04 +-8.5156617367045703e-04 +-8.3959471724283103e-04 +-8.2796189088608159e-04 +-8.1677512487649852e-04 +-8.0611953325748309e-04 +-7.9606087231092523e-04 +-7.8664851056820103e-04 +-7.7791825123657283e-04 +-7.6989491407008300e-04 +-7.6259463150690646e-04 +-7.5602684634791203e-04 +-7.5019601880828898e-04 +-7.4510306261763829e-04 +-7.4074653560607915e-04 +-7.3712361191404917e-04 +-7.3423086207994985e-04 +-7.3206486481381826e-04 +-7.3062267095419108e-04 +-7.2990213634674373e-04 +-8.7486160206675973e-04 +-8.7657737037840548e-04 +-8.7997857659420739e-04 +-8.8500435915224917e-04 +-8.9156287159750038e-04 +-8.9953047796125190e-04 +-9.0875047773770405e-04 +-9.1903127847989177e-04 +-9.3014408133805851e-04 +-9.4182044992696255e-04 +-9.5375060437533738e-04 +-9.6558384191311691e-04 +-9.7693293491399758e-04 +-9.8738440172580584e-04 +-9.9651590042504627e-04 +-1.0039205639139211e-03 +-1.0092361254360352e-03 +-1.0121747843359649e-03 +-1.0125486922272029e-03 +-1.0102862508068202e-03 +-1.0054361361005266e-03 +-9.9815855656763277e-04 +-9.8870584509488176e-04 +-9.7739628511659652e-04 +-9.6458568111700710e-04 +-9.5064067991755758e-04 +-9.3591663713642919e-04 +-9.2074140007260003e-04 +-9.0540513766939354e-04 +-8.9015549522774868e-04 +-8.7519691659372265e-04 +-8.6069288019729995e-04 +-8.4676991742697254e-04 +-8.3352250986462725e-04 +-8.2101821360387793e-04 +-8.0930258568727540e-04 +-7.9840366827342850e-04 +-7.8833591693182271e-04 +-7.7910354637048245e-04 +-7.7070331945270135e-04 +-7.6312683324364285e-04 +-7.5636236729103201e-04 +-7.5039636068074435e-04 +-7.4521458006234051e-04 +-7.4080303374838262e-04 +-7.3714867896444117e-04 +-7.3423996140250299e-04 +-7.3206721892462190e-04 +-7.3062297478714629e-04 +-7.2990214009063358e-04 +-9.6691635541423858e-04 +-9.6881016233377442e-04 +-9.7256057217382115e-04 +-9.7809289481948680e-04 +-9.8529422532240294e-04 +-9.9401195903386073e-04 +-1.0040511631600854e-03 +-1.0151704998006366e-03 +-1.0270767668445436e-03 +-1.0394188911866829e-03 +-1.0517833541069225e-03 +-1.0636942795171106e-03 +-1.0746221947681260e-03 +-1.0840050349294696e-03 +-1.0912827692200460e-03 +-1.0959432423334381e-03 +-1.0975725556700521e-03 +-1.0959003255704776e-03 +-1.0908300020533116e-03 +-1.0824475291619342e-03 +-1.0710069111087982e-03 +-1.0568967005033306e-03 +-1.0405951351211123e-03 +-1.0226226890411119e-03 +-1.0034994356175888e-03 +-9.8371188020481828e-04 +-9.6369097601806282e-04 +-9.4380070924340528e-04 +-9.2433525810167358e-04 +-9.0552223104667655e-04 +-8.8752960979702697e-04 +-8.7047447122566275e-04 +-8.5443210883469854e-04 +-8.3944467949387312e-04 +-8.2552890106596475e-04 +-8.1268260927044541e-04 +-8.0089016219356431e-04 +-7.9012678248240097e-04 +-7.8036197470949674e-04 +-7.7156216865095740e-04 +-7.6369273294923077e-04 +-7.5671948770716815e-04 +-7.5060982512629819e-04 +-7.4533352787061347e-04 +-7.4086335719304557e-04 +-7.3717546772486358e-04 +-7.3424969331946561e-04 +-7.3206973825361310e-04 +-7.3062330008343750e-04 +-7.2990214409998156e-04 +-1.0795737334898608e-03 +-1.0816852167167645e-03 +-1.0858635958509418e-03 +-1.0920192835267534e-03 +-1.1000164290949704e-03 +-1.1096699825397841e-03 +-1.1207400591923054e-03 +-1.1329227979007895e-03 +-1.1458378661284166e-03 +-1.1590146922549642e-03 +-1.1718822230221350e-03 +-1.1837696303666381e-03 +-1.1939263252578622e-03 +-1.2015671577893601e-03 +-1.2059421519029299e-03 +-1.2064210952313658e-03 +-1.2025754939901190e-03 +-1.1942379435012109e-03 +-1.1815238279847284e-03 +-1.1648107401680064e-03 +-1.1446825823513444e-03 +-1.1218533102068850e-03 +-1.0970873628156656e-03 +-1.0711306345254636e-03 +-1.0446599143093922e-03 +-1.0182527451703964e-03 +-9.9237534932037708e-04 +-9.6738410337734223e-04 +-9.4353565879915738e-04 +-9.2100148905486969e-04 +-8.9988376312350479e-04 +-8.8023056490830901e-04 +-8.6204938817865766e-04 +-8.4531847940412801e-04 +-8.2999600269124593e-04 +-8.1602721979185679e-04 +-8.0334997337074086e-04 +-7.9189878189808770e-04 +-7.8160783423485299e-04 +-7.7241313353592863e-04 +-7.6425399668178442e-04 +-7.5707407407825074e-04 +-7.5082201851448731e-04 +-7.4545190181530294e-04 +-7.4092345408598051e-04 +-7.3720218171339786e-04 +-7.3425940607760223e-04 +-7.3207225425746519e-04 +-7.3062362509656925e-04 +-7.2990214810691426e-04 +-1.2115490000555341e-03 +-1.2139154382057866e-03 +-1.2185978506648195e-03 +-1.2254946738157375e-03 +-1.2344509088611172e-03 +-1.2452520988257684e-03 +-1.2576121728649049e-03 +-1.2711533366390182e-03 +-1.2853786529681110e-03 +-1.2996426649018069e-03 +-1.3131315715389324e-03 +-1.3248694135212344e-03 +-1.3337663379141456e-03 +-1.3387159185262651e-03 +-1.3387313879989697e-03 +-1.3330920167666967e-03 +-1.3214606707570354e-03 +-1.3039388480326603e-03 +-1.2810449470152907e-03 +-1.2536258022271920e-03 +-1.2227293584909096e-03 +-1.1894714261262227e-03 +-1.1549228677564145e-03 +-1.1200311869417148e-03 +-1.0855785151003036e-03 +-1.0521700327010190e-03 +-1.0202435472201888e-03 +-9.9009109622698061e-04 +-9.6188538204159486e-04 +-9.3570624384910650e-04 +-9.1156447781522393e-04 +-8.8942184764230112e-04 +-8.6920709276878873e-04 +-8.5082826390335813e-04 +-8.3418194066490982e-04 +-8.1915993432906081e-04 +-8.0565403501163145e-04 +-7.9355928031215966e-04 +-7.8277613155394124e-04 +-7.7321185929288001e-04 +-7.6478136781525565e-04 +-7.5740763019943060e-04 +-7.5102186016567712e-04 +-7.4556351247142519e-04 +-7.4098017794888167e-04 +-7.3722742051090043e-04 +-7.3426858994852606e-04 +-7.3207463477994474e-04 +-7.3062393274444290e-04 +-7.2990215190080860e-04 +-1.3589555542496683e-03 +-1.3616072665318067e-03 +-1.3668597753362763e-03 +-1.3746102105355222e-03 +-1.3846992671959488e-03 +-1.3968988215659751e-03 +-1.4108862799663516e-03 +-1.4262020348708602e-03 +-1.4421924923022405e-03 +-1.4579520896869170e-03 +-1.4722907284380605e-03 +-1.4837607522720114e-03 +-1.4907704661896088e-03 +-1.4917844081738056e-03 +-1.4855717061903516e-03 +-1.4714328951170462e-03 +-1.4493331956345740e-03 +-1.4199015250384171e-03 +-1.3843032245482230e-03 +-1.3440346934199586e-03 +-1.3007023555588061e-03 +-1.2558367815534118e-03 +-1.2107680529381620e-03 +-1.1665646692963062e-03 +-1.1240233631358916e-03 +-1.0836919820413253e-03 +-1.0459090626617857e-03 +-1.0108481353759604e-03 +-9.7855951374705092e-04 +-9.4900606176532025e-04 +-9.2209189631588706e-04 +-8.9768436117967996e-04 +-8.7563023344917391e-04 +-8.5576729571853007e-04 +-8.3793234587973035e-04 +-8.2196655686719107e-04 +-8.0771891633628378e-04 +-7.9504830713724394e-04 +-7.8382464733337941e-04 +-7.7392939572534976e-04 +-7.6525564256446524e-04 +-7.5770794082025540e-04 +-7.5120198635451288e-04 +-7.4566422155641736e-04 +-7.4103141308188127e-04 +-7.3725023770837800e-04 +-7.3427689898540149e-04 +-7.3207678982873249e-04 +-7.3062421136822937e-04 +-7.2990215533774987e-04 +-1.5143498148318998e-03 +-1.5173039739964690e-03 +-1.5231724888988703e-03 +-1.5318739801718085e-03 +-1.5432769067009334e-03 +-1.5571748850793880e-03 +-1.5732350734383976e-03 +-1.5909132564009120e-03 +-1.6093433379678001e-03 +-1.6272326605524675e-03 +-1.6428195198658390e-03 +-1.6539572581166363e-03 +-1.6583611855806749e-03 +-1.6539885824001916e-03 +-1.6394474074223899e-03 +-1.6142943114016788e-03 +-1.5791173982159441e-03 +-1.5353870451222148e-03 +-1.4851460972944814e-03 +-1.4306521626147194e-03 +-1.3740703681919886e-03 +-1.3172688260845711e-03 +-1.2617224314023798e-03 +-1.2085017185606592e-03 +-1.1583143787786930e-03 +-1.1115708665603980e-03 +-1.0684543927424563e-03 +-1.0289843237504485e-03 +-9.9306842075821164e-04 +-9.6054323291576828e-04 +-9.3120389169016704e-04 +-9.0482525576986790e-04 +-8.8117639640381007e-04 +-8.6003015947886611e-04 +-8.4116919905329274e-04 +-8.2438954721884741e-04 +-8.0950250608711756e-04 +-7.9633542763720387e-04 +-7.8473178090651447e-04 +-7.7455078388737400e-04 +-7.6566678955645475e-04 +-7.5796855311565682e-04 +-7.5135846391762614e-04 +-7.4575179548231317e-04 +-7.4107600663392932e-04 +-7.3727011328875169e-04 +-7.3428414178029950e-04 +-7.3207866934425769e-04 +-7.3062445445869250e-04 +-7.2990215833722023e-04 +-1.6665402723659217e-03 +-1.6697943779276951e-03 +-1.6762926100950888e-03 +-1.6860119735869067e-03 +-1.6989007041094584e-03 +-1.7148321346106973e-03 +-1.7335081836656499e-03 +-1.7543027114822222e-03 +-1.7760644807508291e-03 +-1.7969460859151686e-03 +-1.8143678534157501e-03 +-1.8252248423573827e-03 +-1.8263679769489828e-03 +-1.8152529482943192e-03 +-1.7905326393246642e-03 +-1.7523628521516582e-03 +-1.7023161521628389e-03 +-1.6429733933190549e-03 +-1.5773758050199509e-03 +-1.5085231337373935e-03 +-1.4390280322253953e-03 +-1.3709484853848236e-03 +-1.3057622524374878e-03 +-1.2444281458838186e-03 +-1.1874854396740002e-03 +-1.1351587627937388e-03 +-1.0874512284639332e-03 +-1.0442193731478777e-03 +-1.0052296368842075e-03 +-9.7019891056059006e-04 +-9.3882249032781651e-04 +-9.1079262001261558e-04 +-8.8581026949182686e-04 +-8.6359219771587920e-04 +-8.4387481506742240e-04 +-8.2641593111945839e-04 +-8.1099514920634423e-04 +-7.9741343193296982e-04 +-7.8549219232924969e-04 +-7.7507214638184710e-04 +-7.6601208019261139e-04 +-7.5818762849787029e-04 +-7.5149012305027695e-04 +-7.4582554391738464e-04 +-7.4111359020736568e-04 +-7.3728687635605660e-04 +-7.3429025399543359e-04 +-7.3208025621159065e-04 +-7.3062465976490778e-04 +-7.2990216087124888e-04 +-1.8021138079334935e-03 +-1.8056414190292212e-03 +-1.8127391136163518e-03 +-1.8234868965640596e-03 +-1.8379758059174074e-03 +-1.8562297318596137e-03 +-1.8780423553197252e-03 +-1.9027159249579641e-03 +-1.9287428157682359e-03 +-1.9535525304881789e-03 +-1.9735120942660921e-03 +-1.9843415320118787e-03 +-1.9819400611291007e-03 +-1.9633738596863334e-03 +-1.9276254881590152e-03 +-1.8757911491631722e-03 +-1.8106902261592120e-03 +-1.7361184530832149e-03 +-1.6560650127842645e-03 +-1.5741248253328332e-03 +-1.4931834672536665e-03 +-1.4153358194175152e-03 +-1.3419531172509619e-03 +-1.2738179545507282e-03 +-1.2112724731615458e-03 +-1.1543508731149015e-03 +-1.1028855577093163e-03 +-1.0565863508932335e-03 +-1.0150966542054121e-03 +-9.7803160363136243e-04 +-9.4500296116211194e-04 +-9.1563461169917506e-04 +-8.8957160821514581e-04 +-8.6648490551381946e-04 +-8.4607329357433154e-04 +-8.2806357405987470e-04 +-8.1220968780275815e-04 +-7.9829126507403988e-04 +-7.8611190709744515e-04 +-7.7549739556505011e-04 +-7.6629395136143476e-04 +-7.5836661321048338e-04 +-7.5159777372480992e-04 +-7.4588588893202635e-04 +-7.4114436403506859e-04 +-7.3730061034543639e-04 +-7.3429526425047365e-04 +-7.3208155749512774e-04 +-7.3062482816823758e-04 +-7.2990216295046556e-04 +-1.9091944233890069e-03 +-1.9129464340616358e-03 +-1.9205617250786543e-03 +-1.9322556611135612e-03 +-1.9483085904211193e-03 +-1.9689499911055980e-03 +-1.9941168794465102e-03 +-2.0230685652965117e-03 +-2.0539241849870109e-03 +-2.0833162400783561e-03 +-2.1064488935434314e-03 +-2.1177859791388018e-03 +-2.1122989951542761e-03 +-2.0868192420887533e-03 +-2.0408795283680787e-03 +-1.9766854399457211e-03 +-1.8983343356346067e-03 +-1.8107263110217504e-03 +-1.7186077578918559e-03 +-1.6259729111008600e-03 +-1.5358294347747779e-03 +-1.4502195786486702e-03 +-1.3703726380893066e-03 +-1.2968970895969041e-03 +-1.2299611597509923e-03 +-1.1694407698057683e-03 +-1.1150311807470144e-03 +-1.0663265893185109e-03 +-1.0228743847029024e-03 +-9.8421063075532916e-04 +-9.4988222820610840e-04 +-9.1945992962712123e-04 +-8.9254524719725010e-04 +-8.6877339805405520e-04 +-8.4781376554280568e-04 +-8.2936887603551922e-04 +-8.1317255523895673e-04 +-7.9898769627352118e-04 +-7.8660391407423685e-04 +-7.7583525450188766e-04 +-7.6651805595897692e-04 +-7.5850901503378345e-04 +-7.5168347796279603e-04 +-7.4593396114084806e-04 +-7.4116889288375831e-04 +-7.3731156265697021e-04 +-7.3429926137496225e-04 +-7.3208259597747310e-04 +-7.3062496259139931e-04 +-7.2990216461080680e-04 +-1.9821983553621127e-03 +-1.9861116317813638e-03 +-1.9941141100403314e-03 +-2.0065488712457695e-03 +-2.0238776897769551e-03 +-2.0465363476827457e-03 +-2.0746298041843117e-03 +-2.1074387169938368e-03 +-2.1428157361690859e-03 +-2.1767260238498712e-03 +-2.2033339759324477e-03 +-2.2159515790866357e-03 +-2.2087151795328517e-03 +-2.1782914049304366e-03 +-2.1247630079750559e-03 +-2.0513284004757917e-03 +-1.9631401018683956e-03 +-1.8659395260358879e-03 +-1.7650025261849423e-03 +-1.6645741356935955e-03 +-1.5677192604923666e-03 +-1.4764264231809643e-03 +-1.3918194978021475e-03 +-1.3143854258705768e-03 +-1.2441733573572962e-03 +-1.1809509249895123e-03 +-1.1243187196060874e-03 +-1.0737900216820600e-03 +-1.0288439996393433e-03 +-9.8895969333319704e-04 +-9.5363659826790581e-04 +-9.2240618802883617e-04 +-8.9483748320102541e-04 +-8.7053883254109273e-04 +-8.4915738262559062e-04 +-8.3037722264963439e-04 +-8.1391685074563467e-04 +-7.9952637539877213e-04 +-7.8698470847355761e-04 +-7.7609690176616054e-04 +-7.6669171034383411e-04 +-7.5861942164191700e-04 +-7.5174996142041226e-04 +-7.4597127076246085e-04 +-7.4118793868407657e-04 +-7.3732007009917285e-04 +-7.3430236725031484e-04 +-7.3208340311386208e-04 +-7.3062506708727144e-04 +-7.2990216590214873e-04 +-2.0242430917348552e-03 +-2.0282543535308228e-03 +-2.0364870016230359e-03 +-2.0493527406273125e-03 +-2.0674164148526248e-03 +-2.0912485092802408e-03 +-2.1211047808144183e-03 +-2.1563822051035024e-03 +-2.1949062683164350e-03 +-2.2323258489512958e-03 +-2.2621308546094273e-03 +-2.2767509251941718e-03 +-2.2695905486960792e-03 +-2.2370653826302078e-03 +-2.1795492630914282e-03 +-2.1008660773348610e-03 +-2.0068469405330205e-03 +-1.9037786469180958e-03 +-1.7972929344800927e-03 +-1.6918258718944717e-03 +-1.5905183740715140e-03 +-1.4953647627561054e-03 +-1.4074560107483836e-03 +-1.3272272358479085e-03 +-1.2546686059639078e-03 +-1.1894883941720102e-03 +-1.1312312013515794e-03 +-1.0793595734681209e-03 +-1.0333079374696536e-03 +-9.9251662704208550e-04 +-9.5645211053189158e-04 +-9.2461795370640798e-04 +-8.9655975098601774e-04 +-8.7186626761128220e-04 +-8.5016831236930425e-04 +-8.3113634895457639e-04 +-8.1447749991082614e-04 +-7.9993235613288528e-04 +-7.8727184345472943e-04 +-7.7629429123368882e-04 +-7.6682277861414669e-04 +-7.5870279006696789e-04 +-7.5180018453547377e-04 +-7.4599946632838195e-04 +-7.4120233703624239e-04 +-7.3732650359364070e-04 +-7.3430471658113131e-04 +-7.3208401376677443e-04 +-7.3062514615652486e-04 +-7.2990216687996280e-04 +-2.0445766419060155e-03 +-2.0486355313672467e-03 +-2.0569548202142335e-03 +-2.0699311630877435e-03 +-2.0881182063238980e-03 +-2.1121055588817911e-03 +-2.1422395401212726e-03 +-2.1781050023184055e-03 +-2.2177627591584812e-03 +-2.2569835896801382e-03 +-2.2890787231131578e-03 +-2.3059726720835536e-03 +-2.3004542849018230e-03 +-2.2685060163648340e-03 +-2.2103932456524595e-03 +-2.1301010164544868e-03 +-2.0337516579365051e-03 +-1.9279373520093934e-03 +-1.8185489205789827e-03 +-1.7102159424039255e-03 +-1.6062089961153601e-03 +-1.5085984378323731e-03 +-1.4185102862501742e-03 +-1.3363858956632537e-03 +-1.2622031953735196e-03 +-1.1956477283845874e-03 +-1.1362365585650886e-03 +-1.0834036266786670e-03 +-1.0365559360799074e-03 +-9.9510877588363769e-04 +-9.5850645281123580e-04 +-9.2623333222270046e-04 +-8.9781860805504597e-04 +-8.7283716591070868e-04 +-8.5090813418700498e-04 +-8.3169217492957764e-04 +-8.1488819147451869e-04 +-8.0022987632312654e-04 +-7.8748235381910178e-04 +-7.7643906150159881e-04 +-7.6691894275600218e-04 +-7.5876397847019579e-04 +-7.5183705798180598e-04 +-7.4602017358140556e-04 +-7.4121291429572950e-04 +-7.3733123086992672e-04 +-7.3430644319318831e-04 +-7.3208446262830950e-04 +-7.3062520428292569e-04 +-7.2990216759955115e-04 +-2.0529830949179650e-03 +-2.0570582532054450e-03 +-2.0653707852738897e-03 +-2.0782414966149403e-03 +-2.0961255345444559e-03 +-2.1195300940173262e-03 +-2.1488066450433990e-03 +-2.1837162548223794e-03 +-2.2226925406419115e-03 +-2.2619569278056945e-03 +-2.2950988150171581e-03 +-2.3139433450469170e-03 +-2.3108256004332542e-03 +-2.2811463981437840e-03 +-2.2247047876278983e-03 +-2.1452559522532285e-03 +-2.0489199986116406e-03 +-1.9424366439608853e-03 +-1.8319064689834709e-03 +-1.7221659642450301e-03 +-1.6166547650147661e-03 +-1.5175635764223818e-03 +-1.4260935991902220e-03 +-1.3427258629857184e-03 +-1.2674530700209725e-03 +-1.1999597093269594e-03 +-1.1397527644655975e-03 +-1.0862517184292151e-03 +-1.0388476816887210e-03 +-9.9694033514882447e-04 +-9.5995956679715330e-04 +-9.2737690618388590e-04 +-8.9871038601421923e-04 +-8.7352533189021995e-04 +-8.5143276024435960e-04 +-8.3208648670867326e-04 +-8.1517965035399524e-04 +-8.0044109191343914e-04 +-7.8763184708259765e-04 +-7.7654190065750306e-04 +-7.6698727353599161e-04 +-7.5880746847740413e-04 +-7.5186327260604317e-04 +-7.4603489851265080e-04 +-7.4122043736047369e-04 +-7.3733459375418641e-04 +-7.3430767165560604e-04 +-7.3208478202546612e-04 +-7.3062524564764929e-04 +-7.2990216811250302e-04 +-2.0560405120496786e-03 +-2.0601172308397212e-03 +-2.0683864756902716e-03 +-2.0810780269734457e-03 +-2.0985214022547090e-03 +-2.1210940657658234e-03 +-2.1490789432157919e-03 +-2.1823303726385239e-03 +-2.2196260392630921e-03 +-2.2577516224709681e-03 +-2.2908527933945622e-03 +-2.3109817964430436e-03 +-2.3102118967529340e-03 +-2.2833320428310246e-03 +-2.2294882857393514e-03 +-2.1519902639200832e-03 +-2.0567951702578509e-03 +-1.9507013079518296e-03 +-1.8399823583389976e-03 +-1.7296732979102630e-03 +-1.6233866787113348e-03 +-1.5234419157172214e-03 +-1.4311251710810674e-03 +-1.3469672453764910e-03 +-1.2709855603873590e-03 +-1.2028730531791212e-03 +-1.1421354579234818e-03 +-1.0881858039823522e-03 +-1.0404064076370834e-03 +-9.9818752513501706e-04 +-9.6094993609564111e-04 +-9.2815684589187225e-04 +-8.9931892951658021e-04 +-8.7399514276546625e-04 +-8.5179105818658409e-04 +-8.3235587418849352e-04 +-8.1537882910650747e-04 +-8.0058547251173095e-04 +-7.8773406180565153e-04 +-7.7661223261788197e-04 +-7.6703401552154183e-04 +-7.5883722424052182e-04 +-7.5188121209188706e-04 +-7.4604497705064955e-04 +-7.4122558738357307e-04 +-7.3733689618961883e-04 +-7.3430851283478032e-04 +-7.3208500075002899e-04 +-7.3062527397649605e-04 +-7.2990216846482710e-04 +-2.0570060206988156e-03 +-2.0610796445145502e-03 +-2.0693051036433725e-03 +-2.0818375663534377e-03 +-2.0988992309625733e-03 +-2.1207431651469239e-03 +-2.1475522106222267e-03 +-2.1791886428615954e-03 +-2.2146587512599097e-03 +-2.2512455866055695e-03 +-2.2837078072819894e-03 +-2.3044861167547666e-03 +-2.3055547641803614e-03 +-2.2811753439695515e-03 +-2.2298467004860847e-03 +-2.1543989665709423e-03 +-2.0605822779415622e-03 +-1.9552102211987340e-03 +-1.8446900446968716e-03 +-1.7342213399163715e-03 +-1.6275630871639280e-03 +-1.5271449662194140e-03 +-1.4343270710315814e-03 +-1.3496848971413561e-03 +-1.2732597572554748e-03 +-1.2047549097400231e-03 +-1.1436782082969730e-03 +-1.0894402470321936e-03 +-1.0414186743662424e-03 +-9.9899824189767297e-04 +-9.6159417558715980e-04 +-9.2866448568991130e-04 +-8.9971519077353720e-04 +-8.7430117946204176e-04 +-8.5202452781892393e-04 +-8.3253145678102681e-04 +-8.1550868221138542e-04 +-8.0067962117997887e-04 +-7.8780072832795596e-04 +-7.7665811335723414e-04 +-7.6706451294973220e-04 +-7.5885664207149376e-04 +-7.5189292077774820e-04 +-7.4605155603205348e-04 +-7.4122894961016830e-04 +-7.3733839952096268e-04 +-7.3430906211910429e-04 +-7.3208514358637559e-04 +-7.3062529247776005e-04 +-7.2990216869615009e-04 +-2.0572330618369565e-03 +-2.0613032652032079e-03 +-2.0694969821975621e-03 +-2.0819195255445755e-03 +-2.0987192275717594e-03 +-2.1200567612339109e-03 +-2.1460242016751933e-03 +-2.1764490250088713e-03 +-2.2104562211563718e-03 +-2.2456812529264166e-03 +-2.2773910909562873e-03 +-2.2984105780121168e-03 +-2.3007093035843900e-03 +-2.2781648337274296e-03 +-2.2287630203891751e-03 +-2.1549407583580133e-03 +-2.0622692956009671e-03 +-1.9575601801236926e-03 +-1.8473129252089210e-03 +-1.7368452015888577e-03 +-1.6300218765358170e-03 +-1.5293526580085284e-03 +-1.4362516221497949e-03 +-1.3513273477668874e-03 +-1.2746393918153941e-03 +-1.2058995689209885e-03 +-1.1446183957965035e-03 +-1.0902058028517227e-03 +-1.0420370802904288e-03 +-9.9949391111689629e-04 +-9.6198830334088788e-04 +-9.2897519687663507e-04 +-8.9995782639521404e-04 +-8.7448863116525069e-04 +-8.5216757139804534e-04 +-8.3263906026562835e-04 +-8.1558827853396489e-04 +-8.0073734330740587e-04 +-7.8784160890654396e-04 +-7.7668625280057080e-04 +-7.6708322061468180e-04 +-7.5886855514791971e-04 +-7.5190010522965714e-04 +-7.4605559342831855e-04 +-7.4123101319009449e-04 +-7.3733932229234770e-04 +-7.3430939930901992e-04 +-7.3208523127562262e-04 +-7.3062530383695835e-04 +-7.2990216883971168e-04 +-2.0572420216072610e-03 +-2.0613097602554492e-03 +-2.0694841128386233e-03 +-2.0818413330559254e-03 +-2.0984859326831592e-03 +-2.1195212348980069e-03 +-2.1449765059924214e-03 +-2.1746403536030425e-03 +-2.2076885994262124e-03 +-2.2419682240273028e-03 +-2.2730881554320101e-03 +-2.2941576237896413e-03 +-2.2971738819668693e-03 +-2.2757755187762193e-03 +-2.2276106499988088e-03 +-2.1548522354028830e-03 +-2.0629482008596989e-03 +-1.9587034430634518e-03 +-1.8486731169486184e-03 +-1.7382480178025558e-03 +-1.6313589856430696e-03 +-1.5305657460226445e-03 +-1.4373162659407003e-03 +-1.3522400805644663e-03 +-1.2754085200591182e-03 +-1.2065391660013316e-03 +-1.1451446294896488e-03 +-1.0906348389380239e-03 +-1.0423839891768451e-03 +-9.9977218128433510e-04 +-9.6220970341194686e-04 +-9.2914982513299361e-04 +-9.0009425100005802e-04 +-8.7459406524089615e-04 +-8.5224805237474571e-04 +-8.3269961795993540e-04 +-8.1563308520657722e-04 +-8.0076984379992360e-04 +-7.8786463157436094e-04 +-7.7670210316917187e-04 +-7.6709376020188999e-04 +-7.5887526793978917e-04 +-7.5190415418569857e-04 +-7.4605786913028115e-04 +-7.4123217649525112e-04 +-7.3733984254899774e-04 +-7.3430958943497451e-04 +-7.3208528072362766e-04 +-7.3062531024335265e-04 +-7.2990216892263103e-04 +-2.0572136790356654e-03 +-2.0612800020557952e-03 +-2.0694441811930702e-03 +-2.0817676373904477e-03 +-2.0983322953585680e-03 +-2.1192111715998886e-03 +-2.1443982899643690e-03 +-2.1736558222022425e-03 +-2.2061780526149983e-03 +-2.2399203493536249e-03 +-2.2706811679761669e-03 +-2.2917367440122424e-03 +-2.2951110570899741e-03 +-2.2743175369024649e-03 +-2.2268196559766186e-03 +-2.1546436881993269e-03 +-2.0631673262164313e-03 +-1.9591892500651193e-03 +-1.8492928514385635e-03 +-1.7389071924187708e-03 +-1.6319979666289514e-03 +-1.5311514859814449e-03 +-1.4378338532442506e-03 +-1.3526859292898692e-03 +-1.2757855162226254e-03 +-1.2068534774228861e-03 +-1.1454037408326269e-03 +-1.0908464165269012e-03 +-1.0425552759210604e-03 +-9.9990971424005642e-04 +-9.6231921847064891e-04 +-9.2923626395916481e-04 +-9.0016181901008850e-04 +-8.7464631082012981e-04 +-8.5228795080229244e-04 +-8.3272965144188442e-04 +-8.1565531509142787e-04 +-8.0078597365007369e-04 +-7.8787606120005584e-04 +-7.7670997441283221e-04 +-7.6709899557636735e-04 +-7.5887860328095096e-04 +-7.5190616645265233e-04 +-7.4605900037133402e-04 +-7.4123275488612603e-04 +-7.3734010126473397e-04 +-7.3430968399607738e-04 +-7.3208530532031812e-04 +-7.3062531343111119e-04 +-7.2990216896654545e-04 +-2.0571951350832262e-03 +-2.0612608144700054e-03 +-2.0694206041006404e-03 +-2.0817296308504132e-03 +-2.0982601534443989e-03 +-2.1190719959923833e-03 +-2.1441432697439284e-03 +-2.1732229226733156e-03 +-2.2055105222010484e-03 +-2.2390066598056125e-03 +-2.2695935388005184e-03 +-2.2906245165156638e-03 +-2.2941400280290240e-03 +-2.2736017034536596e-03 +-2.2263927729254066e-03 +-2.1544742216562090e-03 +-2.0631912553104857e-03 +-1.9593381214239951e-03 +-1.8495092259201000e-03 +-1.7391494787713751e-03 +-1.6322393143944249e-03 +-1.5313764507038884e-03 +-1.4380348805661210e-03 +-1.3528604781083116e-03 +-1.2759339839946695e-03 +-1.2069778202145596e-03 +-1.1455066109854000e-03 +-1.0909306544253095e-03 +-1.0426236303798134e-03 +-9.9996470381311900e-04 +-9.6236307589489263e-04 +-9.2927092718848403e-04 +-9.0018894653886986e-04 +-8.7466730811957551e-04 +-8.5230400040260765e-04 +-8.3274174263934999e-04 +-8.1566427131833869e-04 +-8.0079247671166107e-04 +-7.8788067224340973e-04 +-7.7671315182284309e-04 +-7.6710111016111185e-04 +-7.5887995115794620e-04 +-7.5190698005636256e-04 +-7.4605945796817508e-04 +-7.4123298894813029e-04 +-7.3734020599988865e-04 +-7.3430972228908699e-04 +-7.3208531528376182e-04 +-7.3062531472371491e-04 +-7.2990216898805287e-04 +-2.0571887360121364e-03 +-2.0612542093860330e-03 +-2.0694126398964879e-03 +-2.0817172128985754e-03 +-2.0982371546775153e-03 +-2.1190280483170567e-03 +-2.1440626901285263e-03 +-2.1730851809914110e-03 +-2.2052956578848008e-03 +-2.2387078928268263e-03 +-2.2692303748218421e-03 +-2.2902422692166005e-03 +-2.2937918031071080e-03 +-2.2733266425359567e-03 +-2.2262058083152357e-03 +-2.1543694157412775e-03 +-2.0631513261557210e-03 +-1.9593431095428801e-03 +-1.8495415810201581e-03 +-1.7391959309927675e-03 +-1.6322908436967772e-03 +-1.5314274667728113e-03 +-1.4380822578858089e-03 +-1.3529027257211893e-03 +-1.2759706245387956e-03 +-1.2070089626358750e-03 +-1.1455326733607815e-03 +-1.0909521927848713e-03 +-1.0426412380931363e-03 +-9.9997895595930705e-04 +-9.6237450128181347e-04 +-9.2927999674873810e-04 +-9.0019607100867130e-04 +-8.7467284065125927e-04 +-8.5230824152355015e-04 +-8.3274494606383595e-04 +-8.1566664979456748e-04 +-8.0079420748567606e-04 +-7.8788190196124738e-04 +-7.7671400082372148e-04 +-7.6710167619052584e-04 +-7.5888031256396177e-04 +-7.5190719855059676e-04 +-7.4605958103429498e-04 +-7.4123305197926811e-04 +-7.3734023423691379e-04 +-7.3430973262343169e-04 +-7.3208531797544008e-04 +-7.3062531507489927e-04 +-7.2990216899986244e-04 +-2.0571877673401934e-03 +-2.0612532082802029e-03 +-2.0694114317236908e-03 +-2.0817153187304149e-03 +-2.0982335890017321e-03 +-2.1190210600676332e-03 +-2.1440494729008403e-03 +-2.1730617707594541e-03 +-2.2052576182001443e-03 +-2.2386523556681736e-03 +-2.2691586413023648e-03 +-2.2901606364591344e-03 +-2.2937093571408903e-03 +-2.2732516618261599e-03 +-2.2261433464018945e-03 +-2.1543209796679313e-03 +-2.0631158970550521e-03 +-1.9593184321211980e-03 +-1.8495251273266803e-03 +-1.7391854256004491e-03 +-1.6322844601418971e-03 +-1.5314238390002094e-03 +-1.4380804119258008e-03 +-1.3529019910394479e-03 +-1.2759705522413238e-03 +-1.2070092596448163e-03 +-1.1455331531896498e-03 +-1.0909527403367993e-03 +-1.0426417852189564e-03 +-9.9997946483470980e-04 +-9.6237495327925967e-04 +-9.2928038508534848e-04 +-9.0019639594968149e-04 +-8.7467310642255964e-04 +-8.5230845435658694e-04 +-8.3274511298324068e-04 +-8.1566677788818219e-04 +-8.0079430348336676e-04 +-7.8788197200829063e-04 +-7.7671405037368381e-04 +-7.6710170996970950e-04 +-7.5888033457705429e-04 +-7.5190721210972855e-04 +-7.4605958880144150e-04 +-7.4123305601765958e-04 +-7.3734023607000183e-04 +-7.3430973330218508e-04 +-7.3208531815481060e-04 +-7.3062531510107559e-04 +-7.2990216900944028e-04 +-2.0571877672771036e-03 +-2.0612532075412423e-03 +-2.0694114277790289e-03 +-2.0817153011106148e-03 +-2.0982335247309194e-03 +-2.1190208663778996e-03 +-2.1440489740227942e-03 +-2.1730606434890464e-03 +-2.2052553595455840e-03 +-2.2386483498633329e-03 +-2.2691523851448448e-03 +-2.2901520326498088e-03 +-2.2936988523061257e-03 +-2.2732401070787688e-03 +-2.2261316926626318e-03 +-2.1543100105408529e-03 +-2.0631061072386571e-03 +-1.9593100363054800e-03 +-1.8495181340008949e-03 +-1.7391797207240772e-03 +-1.6322798736445592e-03 +-1.5314201880663059e-03 +-1.4380775248403735e-03 +-1.3528997178149508e-03 +-1.2759687674361172e-03 +-1.2070078611446638e-03 +-1.1455320592584225e-03 +-1.0909518862070703e-03 +-1.0426411198477896e-03 +-9.9997894808224563e-04 +-9.6237455357491822e-04 +-9.2928007755522135e-04 +-9.0019616094257624e-04 +-8.7467292836388235e-04 +-8.5230832086375318e-04 +-8.3274501418558887e-04 +-8.1566670590464707e-04 +-8.0079425202063089e-04 +-7.8788193605025764e-04 +-7.7671402593972960e-04 +-7.6710169392448207e-04 +-7.5888032447875156e-04 +-7.5190720608704349e-04 +-7.4605958545187609e-04 +-7.4123305432183685e-04 +-7.3734023531805699e-04 +-7.3430973302938160e-04 +-7.3208531808426698e-04 +-7.3062531509197090e-04 +-7.2990216900931364e-04 +-2.0571887354066112e-03 +-2.0612541939449684e-03 +-2.0694125334062147e-03 +-2.0817167777535078e-03 +-2.0982358143201876e-03 +-2.1190245938588286e-03 +-2.1440548488784873e-03 +-2.1730691266000977e-03 +-2.2052658624164383e-03 +-2.2386581197000885e-03 +-2.2691562269441905e-03 +-2.2901440689623844e-03 +-2.2936754976518236e-03 +-2.2732018494691798e-03 +-2.2260824964839736e-03 +-2.1542553098555738e-03 +-2.0630509362275793e-03 +-1.9592580526061835e-03 +-1.8494714620618776e-03 +-1.7391392368555755e-03 +-1.6322456122730643e-03 +-1.5313917006783250e-03 +-1.4380541383328727e-03 +-1.3528806969644439e-03 +-1.2759534054494603e-03 +-1.2069955229369817e-03 +-1.1455221965266185e-03 +-1.0909440371729136e-03 +-1.0426349016271579e-03 +-9.9997404625876076e-04 +-9.6237071142216840e-04 +-9.2927708608646754e-04 +-9.0019385025527480e-04 +-8.7467116037139676e-04 +-8.5230698332440763e-04 +-8.3274401586498831e-04 +-8.1566597268825029e-04 +-8.0079372380270544e-04 +-7.8788156424525408e-04 +-7.7671377148601402e-04 +-7.6710152567290935e-04 +-7.5888021787930018e-04 +-7.5190714210393594e-04 +-7.4605954965246371e-04 +-7.4123303609617195e-04 +-7.3734022719602215e-04 +-7.3430973006955520e-04 +-7.3208531731515163e-04 +-7.3062531498971741e-04 +-7.2990216899879818e-04 +-2.0571951340126069e-03 +-2.0612607302650807e-03 +-2.0694199329591117e-03 +-2.0817269172622799e-03 +-2.0982522370954115e-03 +-2.1190529301478708e-03 +-2.1441028878338752e-03 +-2.1731454854517444e-03 +-2.2053751145443439e-03 +-2.2387921180741822e-03 +-2.2692884031464567e-03 +-2.2902363432483444e-03 +-2.2936960307698021e-03 +-2.2731394543731155e-03 +-2.2259477913631068e-03 +-2.1540717041261784e-03 +-2.0628440609951871e-03 +-1.9590490019952369e-03 +-1.8492744729434506e-03 +-1.7389621887766377e-03 +-1.6320916412746987e-03 +-1.5312608898416214e-03 +-1.4379448597104493e-03 +-1.3527905303449086e-03 +-1.2758797036093263e-03 +-1.2069357257386405e-03 +-1.1454739835441278e-03 +-1.0909053843069442e-03 +-1.0426040849132257e-03 +-9.9994961948284716e-04 +-9.6235147300003971e-04 +-9.2926204365153110e-04 +-9.0018218719542151e-04 +-8.7466220615525629e-04 +-8.5230018814487420e-04 +-8.3273892946505448e-04 +-8.1566222692966558e-04 +-8.0079101843731041e-04 +-7.8787965534477130e-04 +-7.7671246203440784e-04 +-7.6710065788738178e-04 +-7.5887966689507059e-04 +-7.5190681071887777e-04 +-7.4605936388509272e-04 +-7.4123294135676129e-04 +-7.3734018491262315e-04 +-7.3430971464314603e-04 +-7.3208531330751345e-04 +-7.3062531446882440e-04 +-7.2990216898490077e-04 +-2.0572136831925499e-03 +-2.0612797540119319e-03 +-2.0694418596014343e-03 +-2.0817580573830505e-03 +-2.0983046605163175e-03 +-2.1191461696304591e-03 +-2.1442646199974322e-03 +-2.1734076433974252e-03 +-2.2057582203932821e-03 +-2.2392764006776804e-03 +-2.2697930415634979e-03 +-2.2906386881073140e-03 +-2.2938874458839098e-03 +-2.2730735227387030e-03 +-2.2256476484268620e-03 +-2.1536040450941775e-03 +-2.0622863272333762e-03 +-1.9584673087491480e-03 +-1.8487151422680338e-03 +-1.7384523322315484e-03 +-1.6316435877816746e-03 +-1.5308771582708150e-03 +-1.4376222408833252e-03 +-1.3525229552138781e-03 +-1.2756600555625050e-03 +-1.2067568831013332e-03 +-1.1453293559237146e-03 +-1.0907891406346586e-03 +-1.0425112065632638e-03 +-9.9987586229664436e-04 +-9.6229328799740047e-04 +-9.2921648442186272e-04 +-9.0014681865430472e-04 +-8.7463502159437431e-04 +-8.5227953714522744e-04 +-8.3272345695227848e-04 +-8.1565082252159989e-04 +-8.0078277478326217e-04 +-7.8787383403972685e-04 +-7.7670846576570625e-04 +-7.6709800760749256e-04 +-7.5887798298774982e-04 +-7.5190579728479957e-04 +-7.4605879542946835e-04 +-7.4123265128915312e-04 +-7.3734005538842763e-04 +-7.3430966736971856e-04 +-7.3208530102440955e-04 +-7.3062531287717235e-04 +-7.2990216895970912e-04 +-2.0572420565065559e-03 +-2.0613092903158520e-03 +-2.0694783707146838e-03 +-2.0818166356995453e-03 +-2.0984142470904833e-03 +-2.1193536785101587e-03 +-2.1446363205629717e-03 +-2.1740193085413458e-03 +-2.2066580943943689e-03 +-2.2404191855132918e-03 +-2.2709935398299739e-03 +-2.2916156395704317e-03 +-2.2943896494934846e-03 +-2.2729896150450080e-03 +-2.2250245434237009e-03 +-2.1525896350905083e-03 +-2.0610554569946197e-03 +-1.9571710666775807e-03 +-1.8474606946219537e-03 +-1.7373034707390219e-03 +-1.6306303284554411e-03 +-1.5300068465515205e-03 +-1.4368887989502149e-03 +-1.3519134501832379e-03 +-1.2751588935505679e-03 +-1.2063482520934289e-03 +-1.1449985059871211e-03 +-1.0905229490206804e-03 +-1.0422983323732959e-03 +-9.9970668387889443e-04 +-9.6215973883560747e-04 +-9.2911185331635057e-04 +-9.0006554923769419e-04 +-8.7457252813946023e-04 +-8.5223204336106004e-04 +-8.3268785899164597e-04 +-8.1562457466918966e-04 +-8.0076379513649562e-04 +-7.8786042713949764e-04 +-7.7669925924019035e-04 +-7.6709190015949861e-04 +-7.5887410142147906e-04 +-7.5190346060966071e-04 +-7.4605748442075682e-04 +-7.4123198216754799e-04 +-7.3733975654608288e-04 +-7.3430955828125656e-04 +-7.3208527267712485e-04 +-7.3062530920605653e-04 +-7.2990216890984492e-04 +-2.0572332019263254e-03 +-2.0613027609543994e-03 +-2.0694856482610319e-03 +-2.0818674861160678e-03 +-2.0985655961680495e-03 +-2.1196969670127532e-03 +-2.1452978092380811e-03 +-2.1751368651258644e-03 +-2.2083085288421181e-03 +-2.2425002404051356e-03 +-2.2731501900032629e-03 +-2.2933285613822569e-03 +-2.2952039773796143e-03 +-2.2727094381602688e-03 +-2.2237432736580283e-03 +-2.1505849490726088e-03 +-2.0586540504177160e-03 +-1.9546554339295251e-03 +-1.8450315961515817e-03 +-1.7350806139379317e-03 +-1.6286700172886072e-03 +-1.5283226387808114e-03 +-1.4354688335167865e-03 +-1.3507328278851401e-03 +-1.2741876247240682e-03 +-1.2055559096837214e-03 +-1.1443566778812472e-03 +-1.0900063293740262e-03 +-1.0418850275923778e-03 +-9.9937810035049678e-04 +-9.6190027357098262e-04 +-9.2890851389125940e-04 +-8.9990757075190855e-04 +-8.7445102024363331e-04 +-8.5213968063216578e-04 +-8.3261861732207055e-04 +-8.1557351095758342e-04 +-8.0072686526576776e-04 +-7.8783433649457185e-04 +-7.7668134017783738e-04 +-7.6708001133245262e-04 +-7.5886654453920417e-04 +-7.5189891086589495e-04 +-7.4605493146507143e-04 +-7.4123067903865349e-04 +-7.3733917449137051e-04 +-7.3430934579385562e-04 +-7.3208521745827301e-04 +-7.3062530205614316e-04 +-7.2990216881777166e-04 +-2.0570064389722753e-03 +-2.0610799383692789e-03 +-2.0692864532954394e-03 +-2.0817429126191267e-03 +-2.0986123026960272e-03 +-2.1200666527509387e-03 +-2.1461900146793472e-03 +-2.1767491384901425e-03 +-2.2107142436006014e-03 +-2.2454792156680072e-03 +-2.2761097329754886e-03 +-2.2954647847013977e-03 +-2.2958477060887601e-03 +-2.2716031128022242e-03 +-2.2210718377965377e-03 +-2.1468092704431522e-03 +-2.0543025332640423e-03 +-1.9501807973431925e-03 +-1.8407534347473988e-03 +-1.7311873318420841e-03 +-1.6252474340266848e-03 +-1.5253874114750359e-03 +-1.4329965904179970e-03 +-1.3486783474036569e-03 +-1.2724978266304603e-03 +-1.2041774686686766e-03 +-1.1432400258640418e-03 +-1.0891074155776510e-03 +-1.0411657816371224e-03 +-9.9880620447153679e-04 +-9.6144861072394684e-04 +-9.2855450194419069e-04 +-8.9963249559285292e-04 +-8.7423942279381630e-04 +-8.5197881970380676e-04 +-8.3249801244201095e-04 +-8.1548456026817907e-04 +-8.0066252974313277e-04 +-7.8778888052536561e-04 +-7.7665011881915334e-04 +-7.6705929544316587e-04 +-7.5885337613525096e-04 +-7.5189098217891737e-04 +-7.4605048229093175e-04 +-7.4122840790296588e-04 +-7.3733816002725364e-04 +-7.3430897543711447e-04 +-7.3208512121196055e-04 +-7.3062528959465126e-04 +-7.2990216866064583e-04 +-2.0560415460604427e-03 +-2.0601204086562845e-03 +-2.0683610070546302e-03 +-2.0809262398285466e-03 +-2.0980437489063449e-03 +-2.1199559669494825e-03 +-2.1467902700753219e-03 +-2.1782654824387131e-03 +-2.2131320855127718e-03 +-2.2483766956296297e-03 +-2.2786270152736795e-03 +-2.2965640268240019e-03 +-2.2947489044572340e-03 +-2.2680936517988763e-03 +-2.2155066781832599e-03 +-2.1398785721832192e-03 +-2.0467585922787292e-03 +-1.9426536877851256e-03 +-1.8336793507203496e-03 +-1.7248151296218664e-03 +-1.6196804772974850e-03 +-1.5206315401305080e-03 +-1.4290004521939500e-03 +-1.3453623721047900e-03 +-1.2697728864630759e-03 +-1.2019557739753996e-03 +-1.1414407798016322e-03 +-1.0876592046530479e-03 +-1.0400070786578375e-03 +-9.9788487212328428e-04 +-9.6072094550421028e-04 +-9.2798412818086140e-04 +-8.9918927537964866e-04 +-8.7389846175513035e-04 +-8.5171959934604992e-04 +-8.3230365332010760e-04 +-8.1534120690230564e-04 +-8.0055884258197244e-04 +-7.8771561867200472e-04 +-7.7659979782845824e-04 +-7.6702590599049395e-04 +-7.5883215124260088e-04 +-7.5187820253036172e-04 +-7.4604331093502268e-04 +-7.4122474716751933e-04 +-7.3733652485039730e-04 +-7.3430837847005622e-04 +-7.3208496607500095e-04 +-7.3062526950898408e-04 +-7.2990216840982107e-04 +-2.0529852811367291e-03 +-2.0570681946575509e-03 +-2.0653440081540610e-03 +-2.0780280994293224e-03 +-2.0954175922541112e-03 +-2.1178172509090307e-03 +-2.1453595039287294e-03 +-2.1776366952389711e-03 +-2.2130844569834079e-03 +-2.2482376480605177e-03 +-2.2773534434313717e-03 +-2.2930974031021450e-03 +-2.2884592106652739e-03 +-2.2590233227027931e-03 +-2.2042913668471322e-03 +-2.1274588233999858e-03 +-2.0340783909488899e-03 +-1.9304678145302292e-03 +-1.8224865140118182e-03 +-1.7148766908069851e-03 +-1.6110770332830595e-03 +-1.5133246777183334e-03 +-1.4228840721375231e-03 +-1.3402994081569816e-03 +-1.2656188279554384e-03 +-1.1985722235463669e-03 +-1.1387022619748078e-03 +-1.0854557684046701e-03 +-1.0382444805046951e-03 +-9.9648350008339488e-04 +-9.5961419146458368e-04 +-9.2711661410487098e-04 +-8.9851514838885200e-04 +-8.7337985884321429e-04 +-8.5132531711014240e-04 +-8.3200802294017251e-04 +-8.1512315731455890e-04 +-8.0040112776389892e-04 +-7.8760418343983821e-04 +-7.7652325787149336e-04 +-7.6697512039681701e-04 +-7.5879986872977030e-04 +-7.5185876548044888e-04 +-7.4603240401828746e-04 +-7.4121917968841768e-04 +-7.3733403802454529e-04 +-7.3430747060228274e-04 +-7.3208473014637395e-04 +-7.3062523896408153e-04 +-7.2990216803022498e-04 +-2.0445805958398669e-03 +-2.0486574192613172e-03 +-2.0569391586888596e-03 +-2.0696749273207858e-03 +-2.0872001092323640e-03 +-2.1098328096014868e-03 +-2.1376415891765110e-03 +-2.1700214003854659e-03 +-2.2050749433051879e-03 +-2.2389911394335659e-03 +-2.2658993917521681e-03 +-2.2787313243361673e-03 +-2.2710794265950909e-03 +-2.2391996850665953e-03 +-2.1830581457262114e-03 +-2.1059901244595324e-03 +-2.0134128244364011e-03 +-1.9113600166919880e-03 +-1.8053780698693532e-03 +-1.6999409896350818e-03 +-1.5982927631348935e-03 +-1.5025484440730945e-03 +-1.4139086010253599e-03 +-1.3328943483869348e-03 +-1.2595563421238204e-03 +-1.1936412048927751e-03 +-1.1347148843789180e-03 +-1.0822492949825895e-03 +-1.0356803935450691e-03 +-9.9444529641827453e-04 +-9.5800466229297831e-04 +-9.2585507452060307e-04 +-8.9753485736134594e-04 +-8.7262573521855902e-04 +-8.5075198015905598e-04 +-8.3157814510607757e-04 +-8.1480609749068626e-04 +-8.0017180640834127e-04 +-7.8744216042588185e-04 +-7.7641197683657177e-04 +-7.6690128756392478e-04 +-7.5875293872485329e-04 +-7.5183051101441469e-04 +-7.4601655024933477e-04 +-7.4121108753307506e-04 +-7.3733042368937256e-04 +-7.3430615117255852e-04 +-7.3208438727686708e-04 +-7.3062519457544749e-04 +-7.2990216748005808e-04 +-2.0242491554066586e-03 +-2.0282921568645748e-03 +-2.0364984438951709e-03 +-2.0490996147181574e-03 +-2.0663961174380639e-03 +-2.0886353036418791e-03 +-2.1157533372193060e-03 +-2.1469434300291391e-03 +-2.1800963547984921e-03 +-2.2113315333140426e-03 +-2.2350237074402817e-03 +-2.2446913779118113e-03 +-2.2346503986506810e-03 +-2.2017095445399939e-03 +-2.1460273237611312e-03 +-2.0707849312083825e-03 +-1.9810388509488830e-03 +-1.8824072168600024e-03 +-1.7800675198092618e-03 +-1.6782164554329693e-03 +-1.5799174594448337e-03 +-1.4871867782143785e-03 +-1.4011864003326607e-03 +-1.3224385818674700e-03 +-1.2510184474342552e-03 +-1.1867086946935786e-03 +-1.1291152921332171e-03 +-1.0777495391293618e-03 +-1.0320836924166954e-03 +-9.9158700661204158e-04 +-9.5574786387028711e-04 +-9.2408635699895206e-04 +-8.9616052632430208e-04 +-8.7156851916772127e-04 +-8.4994823858889463e-04 +-8.3097553860179551e-04 +-8.1436166339246541e-04 +-7.9985037930248185e-04 +-7.8721507925726109e-04 +-7.7625602615737511e-04 +-7.6679782726353388e-04 +-7.5868718344261382e-04 +-7.5179092677799713e-04 +-7.4599434152096129e-04 +-7.4119975273329172e-04 +-7.3732536147458685e-04 +-7.3430430332418562e-04 +-7.3208390711959875e-04 +-7.3062513241611588e-04 +-7.2990216671082314e-04 +-1.9822062284703371e-03 +-1.9861647601044021e-03 +-1.9941627770110270e-03 +-2.0063530877120900e-03 +-2.0229186979933882e-03 +-2.0439560454748669e-03 +-2.0692359149434283e-03 +-2.0978232755152039e-03 +-2.1276201773857053e-03 +-2.1550304670700311e-03 +-2.1750566780907592e-03 +-2.1820721565355473e-03 +-2.1711673151336101e-03 +-2.1395302128681356e-03 +-2.0871933428211076e-03 +-2.0168369899368405e-03 +-1.9328764837855269e-03 +-1.8403407804895792e-03 +-1.7439639529372014e-03 +-1.6476589605279831e-03 +-1.5543387093624303e-03 +-1.4659646524287655e-03 +-1.3837056552233227e-03 +-1.3081264163013868e-03 +-1.2393619299450021e-03 +-1.1772604956010815e-03 +-1.1214924285075133e-03 +-1.0716283511022894e-03 +-1.0271931301814897e-03 +-9.8770149389620985e-04 +-9.5268045237172246e-04 +-9.2168253020516054e-04 +-8.9429279238622584e-04 +-8.7013180595322528e-04 +-8.4885603676683344e-04 +-8.3015670782385852e-04 +-8.1375780720200957e-04 +-7.9941369666528244e-04 +-7.8690660863625530e-04 +-7.7604420837368174e-04 +-7.6665732405251780e-04 +-7.5859789865751642e-04 +-7.5173718617522480e-04 +-7.4596419488404456e-04 +-7.4118436878821382e-04 +-7.3731849175312145e-04 +-7.3430179595872658e-04 +-7.3208325564510298e-04 +-7.3062504808404482e-04 +-7.2990216566821563e-04 +-1.9092031742724495e-03 +-1.9130088927184134e-03 +-1.9206442834014009e-03 +-1.9321496790944274e-03 +-1.9475484182860908e-03 +-1.9667550313555125e-03 +-1.9893902510407261e-03 +-2.0144928058183085e-03 +-2.0401823601604073e-03 +-2.0634229730553729e-03 +-2.0801059183842407e-03 +-2.0856188048638774e-03 +-2.0758422017961246e-03 +-2.0482210700741585e-03 +-2.0024360383462253e-03 +-1.9403906967799972e-03 +-1.8655965768518046e-03 +-1.7822946595617553e-03 +-1.6946608980481280e-03 +-1.6062849484651184e-03 +-1.5199411633406157e-03 +-1.4375756202709587e-03 +-1.3604133109323298e-03 +-1.2891102253065453e-03 +-1.2239049509886145e-03 +-1.1647485295830889e-03 +-1.1114063318554089e-03 +-1.0635333653310605e-03 +-1.0207274522672006e-03 +-9.8256529238803470e-04 +-9.4862591651062925e-04 +-9.1850517716333599e-04 +-8.9182405441590759e-04 +-8.6823281288971228e-04 +-8.4741246086682102e-04 +-8.2907452286230061e-04 +-8.1295981695099853e-04 +-7.9883670016905276e-04 +-7.8649908567404432e-04 +-7.7576442514658652e-04 +-7.6647177485742010e-04 +-7.5848001341973165e-04 +-7.5166624597825004e-04 +-7.4592440811966417e-04 +-7.4116406941678015e-04 +-7.3730942863938366e-04 +-7.3429848852969498e-04 +-7.3208239639696463e-04 +-7.3062493686550957e-04 +-7.2990216429406343e-04 +-1.8021223087817337e-03 +-1.8057046626873956e-03 +-1.8128407786817530e-03 +-1.8234680472777964e-03 +-1.8374671600338633e-03 +-1.8546009959125680e-03 +-1.8743925429855382e-03 +-1.8959351517765690e-03 +-1.9176693276975127e-03 +-1.9372203793600396e-03 +-1.9514372388462803e-03 +-1.9567490914378823e-03 +-1.9498287791378142e-03 +-1.9283676760502976e-03 +-1.8916553141418312e-03 +-1.8407244396965378e-03 +-1.7780343353163549e-03 +-1.7068697052182531e-03 +-1.6307033612069199e-03 +-1.5527062419611974e-03 +-1.4754715351922088e-03 +-1.4009284112255222e-03 +-1.3303816232167695e-03 +-1.2646137863998905e-03 +-1.2040051799833923e-03 +-1.1486455674952290e-03 +-1.0984271204893812e-03 +-1.0531162148682016e-03 +-1.0124061010874515e-03 +-9.7595397164079571e-04 +-9.4340607328062727e-04 +-9.1441404062914079e-04 +-8.8864498804261806e-04 +-8.6578728355583758e-04 +-8.4555341463767345e-04 +-8.2768095333667297e-04 +-8.1193232670297589e-04 +-7.9809387819446945e-04 +-7.8597454819981469e-04 +-7.7540439073418615e-04 +-7.6623306607228117e-04 +-7.5832839597621369e-04 +-7.5157503219687915e-04 +-7.4587326497660986e-04 +-7.4113798273231545e-04 +-7.3729778437187370e-04 +-7.3429424000154460e-04 +-7.3208129283189869e-04 +-7.3062479403919174e-04 +-7.2990216253018695e-04 +-1.6665476723162118e-03 +-1.6698512013770513e-03 +-1.6763958981133142e-03 +-1.6860535131549745e-03 +-1.6986162348111883e-03 +-1.7137609571459447e-03 +-1.7309785720732106e-03 +-1.7494636134591916e-03 +-1.7679816510432240e-03 +-1.7847656136129664e-03 +-1.7975216703486621e-03 +-1.8036213984658684e-03 +-1.8004966792700024e-03 +-1.7861505453412745e-03 +-1.7596111376058554e-03 +-1.7211549941921415e-03 +-1.6722227446438027e-03 +-1.6150832847799058e-03 +-1.5523885362481375e-03 +-1.4867631759248852e-03 +-1.4205166448355534e-03 +-1.3554968659250418e-03 +-1.2930596527566493e-03 +-1.2341115455854501e-03 +-1.1791875146302975e-03 +-1.1285366830599195e-03 +-1.0822010284371713e-03 +-1.0400806858331764e-03 +-1.0019846781123766e-03 +-9.6766847927298575e-04 +-9.3686076843757580e-04 +-9.0928181933652827e-04 +-8.8465567521640051e-04 +-8.6271784682211280e-04 +-8.4321986828671182e-04 +-8.2593170224066592e-04 +-8.1064271256042840e-04 +-7.9716171543760153e-04 +-7.8531646566306918e-04 +-7.7495282339749708e-04 +-7.6593376689455350e-04 +-7.5813836032198199e-04 +-7.5146074657746859e-04 +-7.4580920802852881e-04 +-7.4110531990597339e-04 +-7.3728320909088884e-04 +-7.3428892342594458e-04 +-7.3207991211886780e-04 +-7.3062461536894528e-04 +-7.2990216032437665e-04 +-1.5143557317074076e-03 +-1.5173505457441749e-03 +-1.5232645752091673e-03 +-1.5319444351987834e-03 +-1.5431513009828508e-03 +-1.5565418563892009e-03 +-1.5716312595786381e-03 +-1.5877352645982863e-03 +-1.6038991288449618e-03 +-1.6188379097236661e-03 +-1.6309297570858503e-03 +-1.6383075300688103e-03 +-1.6390710056183161e-03 +-1.6315919129397843e-03 +-1.6148294756294158e-03 +-1.5885506583946641e-03 +-1.5533782829139993e-03 +-1.5106578680931088e-03 +-1.4622005803700728e-03 +-1.4099904147732930e-03 +-1.3559322232634605e-03 +-1.3016816859427599e-03 +-1.2485623093425259e-03 +-1.1975518654789553e-03 +-1.1493130826962380e-03 +-1.1042458628627752e-03 +-1.0625448943911086e-03 +-1.0242532591778308e-03 +-9.8930774428882613e-04 +-9.5757479238069631e-04 +-9.2887773722018707e-04 +-9.0301668814198456e-04 +-8.7978257901716631e-04 +-8.5896677343808697e-04 +-8.4036738942128814e-04 +-8.2379326328385931e-04 +-8.0906625356360511e-04 +-7.9602240538717279e-04 +-7.8451235405757830e-04 +-7.7440123900103606e-04 +-7.6556831923481642e-04 +-7.5790642309168444e-04 +-7.5132132285600582e-04 +-7.4573109505984977e-04 +-7.4106550623368058e-04 +-7.3726544946418470e-04 +-7.3428244737045855e-04 +-7.3207823071322689e-04 +-7.3062439782599581e-04 +-7.2990215763938922e-04 +-1.3589599961563276e-03 +-1.3616429209805348e-03 +-1.3669346920531862e-03 +-1.3746858028690209e-03 +-1.3846671639930410e-03 +-1.3965604950669137e-03 +-1.4099402755692264e-03 +-1.4242458050440472e-03 +-1.4387464760685119e-03 +-1.4525111310727378e-03 +-1.4644011359627182e-03 +-1.4731111653036079e-03 +-1.4772749381589227e-03 +-1.4756323193972048e-03 +-1.4672254739533713e-03 +-1.4515701084129708e-03 +-1.4287481154388153e-03 +-1.3993930954550287e-03 +-1.3645775932738550e-03 +-1.3256409969445303e-03 +-1.2840071503674034e-03 +-1.2410312811936604e-03 +-1.1978965685459104e-03 +-1.1555622114331188e-03 +-1.1147531720734514e-03 +-1.0759775481534767e-03 +-1.0395584882874679e-03 +-1.0056708904779745e-03 +-9.7437677863622060e-04 +-9.4565622367327696e-04 +-9.1943269463381182e-04 +-8.9559290570684314e-04 +-8.7400180371627052e-04 +-8.5451354440252642e-04 +-8.3697930387101761e-04 +-8.2125267382425634e-04 +-8.0719325930298945e-04 +-7.9466896863866125e-04 +-7.8355737177116642e-04 +-7.7374640956801401e-04 +-7.6513466288388233e-04 +-7.5763133333656011e-04 +-7.5115604507105605e-04 +-7.4563854518398288e-04 +-7.4101835743458006e-04 +-7.3724442728713424e-04 +-7.3427478456814660e-04 +-7.3207624179271390e-04 +-7.3062414055075997e-04 +-7.2990215446475104e-04 +-1.2115521878331586e-03 +-1.2139414302518524e-03 +-1.2186549953684871e-03 +-1.2255621944903218e-03 +-1.2344642938834471e-03 +-1.2450897615430951e-03 +-1.2570858502799695e-03 +-1.2700059477420472e-03 +-1.2832939880967195e-03 +-1.2962705354676418e-03 +-1.3081292507229672e-03 +-1.3179553697853302e-03 +-1.3247766436895933e-03 +-1.3276497133718201e-03 +-1.3257719620288775e-03 +-1.3185955435301867e-03 +-1.3059137894308891e-03 +-1.2878954082682378e-03 +-1.2650573986962065e-03 +-1.2381861634355325e-03 +-1.2082295290191008e-03 +-1.1761857257532823e-03 +-1.1430099045610189e-03 +-1.1095490019149838e-03 +-1.0765064101532305e-03 +-1.0444316829078964e-03 +-1.0137278730633144e-03 +-9.8466915858564904e-04 +-9.5742288798011986e-04 +-9.3207204783187371e-04 +-9.0863582701901683e-04 +-8.8708719654199129e-04 +-8.6736723135435914e-04 +-8.4939635845794170e-04 +-8.3308293150829689e-04 +-8.1832959885399126e-04 +-8.0503791654325967e-04 +-7.9311160400422260e-04 +-7.8245877358815218e-04 +-7.7299339970412877e-04 +-7.6463623521603845e-04 +-7.5731533427302728e-04 +-7.5096630176738868e-04 +-7.4553235912886697e-04 +-7.4096429280279253e-04 +-7.3722033413873677e-04 +-7.3426600630236523e-04 +-7.3207396415799180e-04 +-7.3062384600204263e-04 +-7.2990215083098479e-04 +-1.0795759508447213e-03 +-1.0817035231172230e-03 +-1.0859052414343910e-03 +-1.0920737022242989e-03 +-1.1000462276997151e-03 +-1.1096024727885205e-03 +-1.1204605556542821e-03 +-1.1322715881688147e-03 +-1.1446132271383279e-03 +-1.1569842193395108e-03 +-1.1688037011090607e-03 +-1.1794205710279838e-03 +-1.1881384458579363e-03 +-1.1942593881035552e-03 +-1.1971444589383277e-03 +-1.1962825069041093e-03 +-1.1913532444784156e-03 +-1.1822695434089067e-03 +-1.1691882339102818e-03 +-1.1524870280299811e-03 +-1.1327140216312735e-03 +-1.1105221041006045e-03 +-1.0866018770076980e-03 +-1.0616239574545939e-03 +-1.0361967949637247e-03 +-1.0108414223833474e-03 +-9.8598117982678837e-04 +-9.6194274738046191e-04 +-9.3896450418323371e-04 +-9.1720876055495970e-04 +-8.9677528853102171e-04 +-8.7771446866643165e-04 +-8.6003910791933530e-04 +-8.4373451483370947e-04 +-8.2876676018625865e-04 +-8.1508924600241089e-04 +-8.0264779864248697e-04 +-7.9138453038042774e-04 +-7.8124070625182611e-04 +-7.7215882738629088e-04 +-7.6408410987646822e-04 +-7.5696550584487203e-04 +-7.5075638393641130e-04 +-7.4541496126470359e-04 +-7.4090455808519754e-04 +-7.3719372982374660e-04 +-7.3425631799895342e-04 +-7.3207145141091878e-04 +-7.3062352113883447e-04 +-7.2990214682406402e-04 +-9.6691786406963504e-04 +-9.6882273780119800e-04 +-9.7258991133988544e-04 +-9.7813386793688573e-04 +-9.8532536638110558e-04 +-9.9399017227012041e-04 +-1.0039072419437709e-03 +-1.0148064168569552e-03 +-1.0263659864923871e-03 +-1.0382110180662584e-03 +-1.0499140946162856e-03 +-1.0610008373746257e-03 +-1.0709629003235995e-03 +-1.0792805113254845e-03 +-1.0854547785360904e-03 +-1.0890470883178414e-03 +-1.0897198711540277e-03 +-1.0872711019781925e-03 +-1.0816552045445895e-03 +-1.0729857366485634e-03 +-1.0615194459422347e-03 +-1.0476254528585488e-03 +-1.0317460265139263e-03 +-1.0143560328918378e-03 +-9.9592691187869956e-04 +-9.7689880411573875e-04 +-9.5766209866579056e-04 +-9.3854783131740052e-04 +-9.1982527371612126e-04 +-9.0170465927964533e-04 +-8.8434308728951578e-04 +-8.6785200358568883e-04 +-8.5230509524690718e-04 +-8.3774584653407795e-04 +-8.2419433271265635e-04 +-8.1165306563386799e-04 +-8.0011186005889189e-04 +-7.8955178080967862e-04 +-7.7994827666371714e-04 +-7.7127362329639545e-04 +-7.6349879639638139e-04 +-7.5659488555795040e-04 +-7.5053414497872983e-04 +-7.4529076152713585e-04 +-7.4084140612150698e-04 +-7.3716562139282014e-04 +-7.3424608755301782e-04 +-7.3206879920877186e-04 +-7.3062317834992111e-04 +-7.2990214259690883e-04 +-8.7486260945523954e-04 +-8.7658582294655827e-04 +-8.7999863131739040e-04 +-8.8503354309660807e-04 +-8.9158869352777277e-04 +-8.9952711805362895e-04 +-9.0867584634245387e-04 +-9.1882492568376949e-04 +-9.2972660976758557e-04 +-9.4109516573646207e-04 +-9.5260805408036060e-04 +-9.6390955713738906e-04 +-9.7461812878220757e-04 +-9.8433860962840285e-04 +-9.9267982207000799e-04 +-9.9927689938037302e-04 +-1.0038162357664409e-03 +-1.0060596366638619e-03 +-1.0058636474712032e-03 +-1.0031905068742684e-03 +-9.9810867189855626e-04 +-9.9078294204204696e-04 +-9.8145619901835878e-04 +-9.7042609247688838e-04 +-9.5802036996816707e-04 +-9.4457406039576456e-04 +-9.3041070411375797e-04 +-9.1582866784614041e-04 +-9.0109258990593132e-04 +-8.8642932405066878e-04 +-8.7202740755443415e-04 +-8.5803900586386159e-04 +-8.4458338719661948e-04 +-8.3175116671000153e-04 +-8.1960876615317269e-04 +-8.0820272228836665e-04 +-7.9756362823341770e-04 +-7.8770960277565907e-04 +-7.7864925784065016e-04 +-7.7038418096378642e-04 +-7.6291097543907055e-04 +-7.5622291244222125e-04 +-7.5031125201773039e-04 +-7.4516628712006829e-04 +-7.4077815944660391e-04 +-7.3713748921094423e-04 +-7.3423585425079539e-04 +-7.3206614746023128e-04 +-7.3062283572712422e-04 +-7.2990213837262363e-04 +-8.0313974055165442e-04 +-8.0472152357066924e-04 +-8.0785824518921339e-04 +-8.1249603566765243e-04 +-8.1855365987206202e-04 +-8.2592206217898200e-04 +-8.3446386678778415e-04 +-8.4401294114039489e-04 +-8.5437418897708851e-04 +-8.6532382979215305e-04 +-8.7661054379562637e-04 +-8.8795799619459045e-04 +-8.9906935261933115e-04 +-9.0963438277837918e-04 +-9.1933954068529810e-04 +-9.2788096208127030e-04 +-9.3497967056924939e-04 +-9.4039757660147711e-04 +-9.4395230940267402e-04 +-9.4552876108238381e-04 +-9.4508556216482784e-04 +-9.4265549710121743e-04 +-9.3833989577184293e-04 +-9.3229801540247403e-04 +-9.2473310743560594e-04 +-9.1587711946877206e-04 +-9.0597583157955700e-04 +-8.9527579342604357e-04 +-8.8401387714579015e-04 +-8.7240973478315336e-04 +-8.6066103831566171e-04 +-8.4894111869342236e-04 +-8.3739849786892983e-04 +-8.2615779164100654e-04 +-8.1532151233596839e-04 +-8.0497238475732110e-04 +-7.9517588165693991e-04 +-7.8598277106579450e-04 +-7.7743153978787128e-04 +-7.6955061312206357e-04 +-7.6236033141031500e-04 +-7.5587467172946808e-04 +-7.5010272074696037e-04 +-7.4504991506485041e-04 +-7.4071907047449758e-04 +-7.3711122313554231e-04 +-7.3422630503662718e-04 +-7.3206367406836496e-04 +-7.3062251624724938e-04 +-7.2990213443441037e-04 +-7.5076490807220197e-04 +-7.5224339625821416e-04 +-7.5517826674246136e-04 +-7.5952517333445642e-04 +-7.6521728327039033e-04 +-7.7216496386176047e-04 +-7.8025546930554103e-04 +-7.8935271976269042e-04 +-7.9929729566609905e-04 +-8.0990681075700081e-04 +-8.2097687848981047e-04 +-8.3228294222166630e-04 +-8.4358328332144667e-04 +-8.5462352473184152e-04 +-8.6514287606399571e-04 +-8.7488219210031331e-04 +-8.8359363616750497e-04 +-8.9105138917444681e-04 +-8.9706250145148668e-04 +-9.0147674858670956e-04 +-9.0419431374068565e-04 +-9.0517031835863357e-04 +-9.0441563151315773e-04 +-9.0199391222130785e-04 +-8.9801535437461044e-04 +-8.9262799711050484e-04 +-8.8600766663543432e-04 +-8.7834761891960786e-04 +-8.6984879539153258e-04 +-8.6071135121732465e-04 +-8.5112783574837862e-04 +-8.4127815034662793e-04 +-8.3132621122931818e-04 +-8.2141811460097300e-04 +-8.1168153345772805e-04 +-8.0222605711289044e-04 +-7.9314420022550465e-04 +-7.8451284364169178e-04 +-7.7639491342434291e-04 +-7.6884114925250893e-04 +-7.6189185419612844e-04 +-7.5557855237793638e-04 +-7.4992550851594563e-04 +-7.4495108408983589e-04 +-7.4066891971177689e-04 +-7.3708894322259899e-04 +-7.3421820910677651e-04 +-7.3206157794303576e-04 +-7.3062224557359173e-04 +-7.2990213109834663e-04 +-7.1661650779501350e-04 +-7.1802753712785130e-04 +-7.2083045553461729e-04 +-7.2498687585319254e-04 +-7.3043897115722205e-04 +-7.3710923589502487e-04 +-7.4490026015114937e-04 +-7.5369459459091975e-04 +-7.6335480270658734e-04 +-7.7372381797500027e-04 +-7.8462574698121663e-04 +-7.9586728362749325e-04 +-8.0723991838394871e-04 +-8.1852312936605946e-04 +-8.2948871411129546e-04 +-8.3990634735149324e-04 +-8.4955032214929598e-04 +-8.5820725436015115e-04 +-8.6568432684439760e-04 +-8.7181746097593602e-04 +-8.7647867820491517e-04 +-8.7958189696499885e-04 +-8.8108652143667953e-04 +-8.8099840827088034e-04 +-8.7936810407089757e-04 +-8.7628656949288242e-04 +-8.7187888274879797e-04 +-8.6629659884098105e-04 +-8.5970950945521234e-04 +-8.5229750755091711e-04 +-8.4424313636616223e-04 +-8.3572523104079538e-04 +-8.2691387842955108e-04 +-8.1796675547863781e-04 +-8.0902677640310523e-04 +-8.0022089066356680e-04 +-7.9165982578310108e-04 +-7.8343855449870196e-04 +-7.7563727548129232e-04 +-7.6832272176858435e-04 +-7.6154964337632339e-04 +-7.5536234447460150e-04 +-7.4979618719307945e-04 +-7.4487900139395607e-04 +-7.4063236174174492e-04 +-7.3707271007564647e-04 +-7.3421231294078823e-04 +-7.3206005188190457e-04 +-7.3062204855945366e-04 +-7.2990212867048219e-04 +-6.9978952011403022e-04 +-7.0116707971071388e-04 +-7.0390447760539023e-04 +-7.0796617817206063e-04 +-7.1329866422941541e-04 +-7.1983023255525877e-04 +-7.2747080598364563e-04 +-7.3611183148382354e-04 +-7.4562634813136650e-04 +-7.5586932287307284e-04 +-7.6667836577513991e-04 +-7.7787494938768057e-04 +-7.8926626646695023e-04 +-8.0064786149705385e-04 +-8.1180715652693204e-04 +-8.2252795157896014e-04 +-8.3259590627014486e-04 +-8.4180489944627693e-04 +-8.4996402400841031e-04 +-8.5690482305489162e-04 +-8.6248824023672885e-04 +-8.6661067640184792e-04 +-8.6920854651763410e-04 +-8.7026083102724927e-04 +-8.6978930740680015e-04 +-8.6785640078306154e-04 +-8.6456086080043744e-04 +-8.6003170543878793e-04 +-8.5442103076665155e-04 +-8.4789634759684324e-04 +-8.4063307294284222e-04 +-8.3280769593384503e-04 +-8.2459198490060590e-04 +-8.1614843677617875e-04 +-8.0762701832924101e-04 +-7.9916312828048983e-04 +-7.9087662735702585e-04 +-7.8287173899825829e-04 +-7.7523761063163783e-04 +-7.6804933566471481e-04 +-7.6136926088782037e-04 +-7.5524843538192705e-04 +-7.4972808966747404e-04 +-7.4484106402306549e-04 +-7.4061313061378313e-04 +-7.3706417450460776e-04 +-7.3420921384343188e-04 +-7.3205925000445753e-04 +-7.3062194505858118e-04 +-7.2990212739513930e-04 +-6.9978945542015507e-04 +-7.0116649672644061e-04 +-7.0390285445886581e-04 +-7.0796298755493238e-04 +-7.1329337497495662e-04 +-7.1982231627999824e-04 +-7.2745975022031216e-04 +-7.3609716031507893e-04 +-7.4560765061078250e-04 +-7.5584628843652858e-04 +-7.6665082442112578e-04 +-7.7784291277277549e-04 +-7.8922996449611916e-04 +-8.0060776788627795e-04 +-8.1176399663304829e-04 +-8.2248268691178324e-04 +-8.3254969267762807e-04 +-8.4175901978023591e-04 +-8.4991980050841734e-04 +-8.5686351878604442e-04 +-8.6245096165889538e-04 +-8.6657828974500534e-04 +-8.6918161881125052e-04 +-8.7023960273180346e-04 +-8.6977369850993057e-04 +-8.6784604710370529e-04 +-8.6455517316412923e-04 +-8.6002994205134319e-04 +-8.5442237272309921e-04 +-8.4789996875050738e-04 +-8.4063819775238033e-04 +-8.3281364173290733e-04 +-8.2459818770744611e-04 +-8.1615446188142301e-04 +-8.0763255828960874e-04 +-7.9916799161038271e-04 +-7.9088072127624000e-04 +-7.8287504924524876e-04 +-7.7524018077215805e-04 +-7.6805124766853093e-04 +-7.6137061811992605e-04 +-7.5524934862281859e-04 +-7.4972866636629544e-04 +-7.4484140069844479e-04 +-7.4061330813496090e-04 +-7.3706425588761888e-04 +-7.3420924415971230e-04 +-7.3205925800019019e-04 +-7.3062194610384423e-04 +-7.2990212740810982e-04 +-7.1661630360172449e-04 +-7.1802569705998098e-04 +-7.2082533250145933e-04 +-7.2497680608176623e-04 +-7.3042228015684249e-04 +-7.3708426126261651e-04 +-7.4486539590876383e-04 +-7.5364836026367045e-04 +-7.6329593779340889e-04 +-7.7365139865850463e-04 +-7.8453931697123962e-04 +-7.9576698547011474e-04 +-8.0712660643207927e-04 +-8.1839844235999880e-04 +-8.2935508554426258e-04 +-8.3976693670547570e-04 +-8.4940885992904947e-04 +-8.5806780747987941e-04 +-8.6555100576008565e-04 +-8.7169410253493172e-04 +-8.7636854512692015e-04 +-8.7948743402213451e-04 +-8.8100919963630616e-04 +-8.8093867367407871e-04 +-8.7932543081282739e-04 +-8.7625960099364016e-04 +-8.7186563412140945e-04 +-8.6629468868879012e-04 +-8.5971639048452043e-04 +-8.5231067127075144e-04 +-8.4426027551625683e-04 +-8.3574435220453770e-04 +-8.2693336495653273e-04 +-8.1798538645169673e-04 +-8.0904371068166961e-04 +-8.0023562624692915e-04 +-7.9167214436130383e-04 +-7.8344845967155403e-04 +-7.7564493125186124e-04 +-7.6832839595964027e-04 +-7.6155365884111479e-04 +-7.5536503951673844e-04 +-7.4979788551854929e-04 +-7.4487999117268141e-04 +-7.4063288290284889e-04 +-7.3707294873206683e-04 +-7.3421240176717718e-04 +-7.3206007529454976e-04 +-7.3062205161883345e-04 +-7.2990212870839978e-04 +-7.5076453235986063e-04 +-7.5224001058054669e-04 +-7.5516884082891221e-04 +-7.5950664801955172e-04 +-7.6518658517842281e-04 +-7.7211905430671259e-04 +-7.8019143670292129e-04 +-7.8926792146190024e-04 +-7.9918954930941724e-04 +-8.0977462673527227e-04 +-8.2081971420391842e-04 +-8.3210144714520825e-04 +-8.4337949393815481e-04 +-8.5440096377222767e-04 +-8.6490651450473670e-04 +-8.7463824711806924e-04 +-8.8334920289742040e-04 +-8.9081393452544386e-04 +-8.9683927735610496e-04 +-9.0127420201843375e-04 +-9.0401757555186573e-04 +-9.0502284055426932e-04 +-9.0429901602940156e-04 +-9.0190794057547934e-04 +-8.9795819508402361e-04 +-8.9259654361991585e-04 +-8.8599794651596122e-04 +-8.7835521547280338e-04 +-8.6986923276454668e-04 +-8.6074040951132440e-04 +-8.5116177919042173e-04 +-8.4131386620121395e-04 +-8.3136126794778253e-04 +-8.2145075423873477e-04 +-8.1171061605436246e-04 +-8.0225097444819749e-04 +-7.9316477418978819e-04 +-7.8452922133789014e-04 +-7.7640746777777258e-04 +-7.6885039081649035e-04 +-7.6189835726531705e-04 +-7.5558289654669938e-04 +-7.4992823542811306e-04 +-7.4495266823862405e-04 +-7.4066975165867639e-04 +-7.3708932340284380e-04 +-7.3421835037842692e-04 +-7.3206161513485093e-04 +-7.3062225042974270e-04 +-7.2990213115853276e-04 +-8.0313913433236578e-04 +-8.0471606075837926e-04 +-8.0784303726679299e-04 +-8.1246615203877401e-04 +-8.1850416090809822e-04 +-8.2584809556386207e-04 +-8.3436084369330036e-04 +-8.4387680144706878e-04 +-8.5420175234323151e-04 +-8.6511321145340170e-04 +-8.7636159194906863e-04 +-8.8767268559775841e-04 +-8.9875205302604900e-04 +-9.0929191870099603e-04 +-9.1898097700342728e-04 +-9.2751708978420740e-04 +-9.3462222272522441e-04 +-9.4005826352297917e-04 +-9.4364180715955594e-04 +-9.4525580449341653e-04 +-9.4485627587574954e-04 +-9.4247305106874850e-04 +-9.3820450833102364e-04 +-9.3220726562729577e-04 +-9.2468247343719615e-04 +-9.1586063819426306e-04 +-9.0598677816427229e-04 +-8.9530729793471566e-04 +-8.8405942493344452e-04 +-8.7246352572977479e-04 +-8.6071820436159970e-04 +-8.4899781586549625e-04 +-8.3745189816676483e-04 +-8.2620600304259071e-04 +-8.1536345366637155e-04 +-8.0500763810301406e-04 +-7.9520453989942778e-04 +-7.8600529298861004e-04 +-7.7744862068787374e-04 +-7.6956307520462943e-04 +-7.6236903551902928e-04 +-7.5588045007352869e-04 +-7.5010632910036085e-04 +-7.4505200225988180e-04 +-7.4072016274648561e-04 +-7.3711172086576165e-04 +-7.3422648958130880e-04 +-7.3206372257359105e-04 +-7.3062252257379587e-04 +-7.2990213451275634e-04 +-8.7486167854632438e-04 +-8.7657743436217331e-04 +-8.7997528017922798e-04 +-8.8498766976334066e-04 +-8.9151275459415735e-04 +-8.9941377191754448e-04 +-9.0851828159535758e-04 +-9.1861734474970149e-04 +-9.2946485372408466e-04 +-9.4077742899357076e-04 +-9.5223559401462574e-04 +-9.6348726417374772e-04 +-9.7415480202851237e-04 +-9.8384679788204193e-04 +-9.9217514903553357e-04 +-9.9877689021502284e-04 +-1.0033387771761040e-03 +-1.0056213000298011e-03 +-1.0054781500323233e-03 +-1.0028675619067073e-03 +-9.9785339198619127e-04 +-9.9059583870174470e-04 +-9.8133370490405248e-04 +-9.7036145031362394e-04 +-9.5800469963703140e-04 +-9.4459742862657763e-04 +-9.3046306460375970e-04 +-9.1590059455650319e-04 +-9.0117577746248387e-04 +-8.8651686773137596e-04 +-8.7211389868483422e-04 +-8.5812048825583765e-04 +-8.4465722026217326e-04 +-8.3181583503613666e-04 +-8.1966366691046608e-04 +-8.0824795310879642e-04 +-7.9759979041428195e-04 +-7.8773762840097063e-04 +-7.7867026474751761e-04 +-7.7039935625439649e-04 +-7.6292148617963318e-04 +-7.5622984101342912e-04 +-7.5031555303123028e-04 +-7.4516876268330425e-04 +-7.4077944968403025e-04 +-7.3713807521580280e-04 +-7.3423607096592062e-04 +-7.3206620431265704e-04 +-7.3062284313307150e-04 +-7.2990213846429487e-04 +-9.6691646889601572e-04 +-9.6881016584271441e-04 +-9.7255491873328339e-04 +-9.7806514858287644e-04 +-9.8521169903774321e-04 +-9.9382077382725279e-04 +-1.0036723737718973e-03 +-1.0144982566254001e-03 +-1.0259797211595986e-03 +-1.0377460367832119e-03 +-1.0493750763677109e-03 +-1.0603984638985649e-03 +-1.0703139151507851e-03 +-1.0786069202306432e-03 +-1.0847821503598293e-03 +-1.0884021344791976e-03 +-1.0891276886109259e-03 +-1.0867525800165193e-03 +-1.0812250709266019e-03 +-1.0726515589061208e-03 +-1.0612816681714906e-03 +-1.0474783204011220e-03 +-1.0316790986850152e-03 +-1.0143559356453051e-03 +-9.9597902480136444e-04 +-9.7698867171816875e-04 +-9.5777646368583910e-04 +-9.3867527826311365e-04 +-9.1995653079895642e-04 +-9.0183263602575483e-04 +-8.8446273057519705e-04 +-8.6796004577215872e-04 +-8.5239975243756776e-04 +-8.3782650823192850e-04 +-8.2426126937265934e-04 +-8.1170716901393766e-04 +-8.0015442297514294e-04 +-7.8958431743627276e-04 +-7.7997238123623234e-04 +-7.7129086334886939e-04 +-7.6351063596228480e-04 +-7.5660263369983001e-04 +-7.5053892530302976e-04 +-7.4529349880601739e-04 +-7.4084282666681597e-04 +-7.3716626434002311e-04 +-7.3424632467689759e-04 +-7.3206886128901504e-04 +-7.3062318642598046e-04 +-7.2990214269679865e-04 +-1.0795738980408991e-03 +-1.0816850256079307e-03 +-1.0858537628642068e-03 +-1.0919726527794636e-03 +-1.0998792584788761e-03 +-1.1093541385562319e-03 +-1.1201174206922182e-03 +-1.1318237748725781e-03 +-1.1440562865360302e-03 +-1.1563210466726472e-03 +-1.1680460658242049e-03 +-1.1785897450578464e-03 +-1.1872644717191919e-03 +-1.1933787721210309e-03 +-1.1962964720057092e-03 +-1.1955047026000699e-03 +-1.1906770903470916e-03 +-1.1817170719795112e-03 +-1.1687703390104284e-03 +-1.1522035741042063e-03 +-1.1325554819395089e-03 +-1.1104721519382588e-03 +-1.0866402822798363e-03 +-1.0617292520112003e-03 +-1.0363483747481738e-03 +-1.0110209639867833e-03 +-9.8617340756605135e-04 +-9.6213567672292003e-04 +-9.3914931709497508e-04 +-9.1737945835034928e-04 +-8.9692823823400486e-04 +-8.7784792451071100e-04 +-8.6015275883200547e-04 +-8.4382908498994004e-04 +-8.2884367332660487e-04 +-8.1515035401148804e-04 +-8.0269516928873524e-04 +-7.9142028660094462e-04 +-7.8126690873894973e-04 +-7.7217739264617922e-04 +-7.6409675683232849e-04 +-7.5697372511719099e-04 +-7.5076142496797852e-04 +-7.4541783338261060e-04 +-7.4090604237415849e-04 +-7.3719439932370978e-04 +-7.3425656424802675e-04 +-7.3207151575021656e-04 +-7.3062352949753871e-04 +-7.2990214692738209e-04 +-1.2115492324832307e-03 +-1.2139148007324007e-03 +-1.2185808985757723e-03 +-1.2254168306770374e-03 +-1.2342244237484063e-03 +-1.2447339208223069e-03 +-1.2565963231089929e-03 +-1.2693714493345054e-03 +-1.2825127570193235e-03 +-1.2953532312271188e-03 +-1.3071007944219974e-03 +-1.3168548086150700e-03 +-1.3236544056740734e-03 +-1.3265622690241052e-03 +-1.3247747457299764e-03 +-1.3177356638204758e-03 +-1.3052242346836393e-03 +-1.2873920138697429e-03 +-1.2647389768909176e-03 +-1.2380372972256393e-03 +-1.2082249505862782e-03 +-1.1762950790113859e-03 +-1.1432019439660598e-03 +-1.1097947017560819e-03 +-1.0767808595741732e-03 +-1.0447149158862999e-03 +-1.0140049106507271e-03 +-9.8492955654300510e-04 +-9.5766003538344199e-04 +-9.3228239229883501e-04 +-9.0881813535445934e-04 +-8.8724190721543893e-04 +-8.6749591950510316e-04 +-8.4950131268731670e-04 +-8.3316683071224117e-04 +-8.1839527310305772e-04 +-8.0508817568109264e-04 +-7.9314911925719553e-04 +-7.8248599985130361e-04 +-7.7301252861888879e-04 +-7.6464917135682831e-04 +-7.5732368859133745e-04 +-7.5097139789267282e-04 +-7.4553524923681063e-04 +-7.4096578059289220e-04 +-7.3722100307534026e-04 +-7.3426625172012805e-04 +-7.3207402815831984e-04 +-7.3062385430615741e-04 +-7.2990215093355899e-04 +-1.3589558709693919e-03 +-1.3616057517415790e-03 +-1.3668312916443762e-03 +-1.3744830987995318e-03 +-1.3843332413639069e-03 +-1.3960667438501740e-03 +-1.4092647898149002e-03 +-1.4233778492449996e-03 +-1.4376913354833441e-03 +-1.4512941042562754e-03 +-1.4630690582640882e-03 +-1.4717300007710385e-03 +-1.4759228588851381e-03 +-1.4743891621765419e-03 +-1.4661609386783839e-03 +-1.4507337695559507e-03 +-1.4281638009162414e-03 +-1.3990586627750305e-03 +-1.3644693696066061e-03 +-1.3257209529454730e-03 +-1.2842306147884521e-03 +-1.2413535112764079e-03 +-1.1982773264394616e-03 +-1.1559682521779938e-03 +-1.1151590192815283e-03 +-1.0763651086908080e-03 +-1.0399160285846313e-03 +-1.0059917720634263e-03 +-9.7465820771622897e-04 +-9.4589815011854685e-04 +-9.1963691234066877e-04 +-8.9576235624813216e-04 +-8.7414005997531088e-04 +-8.5462444164029986e-04 +-8.3706668542529131e-04 +-8.2132022265605587e-04 +-8.0724439205889635e-04 +-7.9470677428524308e-04 +-7.8358458151131310e-04 +-7.7376538846901102e-04 +-7.6514741647078655e-04 +-7.5763952446745466e-04 +-7.5116101787322859e-04 +-7.4564135384160295e-04 +-7.4101979830444164e-04 +-7.3724507327821778e-04 +-7.3427502102775164e-04 +-7.3207630335135479e-04 +-7.3062414852891045e-04 +-7.2990215456325276e-04 +-1.5143502250194309e-03 +-1.5173009307900133e-03 +-1.5231265908685781e-03 +-1.5316741789892254e-03 +-1.5427070364742207e-03 +-1.5558876163783732e-03 +-1.5707424029697290e-03 +-1.5866054957344440e-03 +-1.6025475576273340e-03 +-1.6173137954574729e-03 +-1.6293121959559973e-03 +-1.6366981343980454e-03 +-1.6375797711936421e-03 +-1.6303192826688244e-03 +-1.6138496254952128e-03 +-1.5879009368421262e-03 +-1.5530574073083251e-03 +-1.5106321993563617e-03 +-1.4624152999198421e-03 +-1.4103817127756088e-03 +-1.3564374850569330e-03 +-1.3022462353181638e-03 +-1.2491426698439442e-03 +-1.1981163175343972e-03 +-1.1498405336757187e-03 +-1.1047239213758425e-03 +-1.0629677714870708e-03 +-1.0246198527379070e-03 +-9.8962006200118530e-04 +-9.5783674286074860e-04 +-9.2909425331377728e-04 +-9.0319312087695628e-04 +-8.7992429774274759e-04 +-8.5907891547822609e-04 +-8.4045471395348187e-04 +-8.2386007545096800e-04 +-8.0911637445554505e-04 +-7.9605917106935877e-04 +-7.8453863240143167e-04 +-7.7441945702630421e-04 +-7.6558049637786652e-04 +-7.5791420760294422e-04 +-7.5132602967388441e-04 +-7.4573374421393315e-04 +-7.4106686124773239e-04 +-7.3726605546701378e-04 +-7.3428266875491847e-04 +-7.3207828826151529e-04 +-7.3062440527692913e-04 +-7.2990215773132208e-04 +-1.6665407673256956e-03 +-1.6697889909318784e-03 +-1.6762229435590247e-03 +-1.6857151405420864e-03 +-1.6980614340204169e-03 +-1.7129480079152522e-03 +-1.7298834943116576e-03 +-1.7480903727007647e-03 +-1.7663714610539226e-03 +-1.7830012885654040e-03 +-1.7957228928225893e-03 +-1.8019289805588645e-03 +-1.7990482238218032e-03 +-1.7850543768643471e-03 +-1.7589270854285661e-03 +-1.7208880505565174e-03 +-1.6723301679641535e-03 +-1.6154906734892683e-03 +-1.5530083465737957e-03 +-1.4875103090386062e-03 +-1.4213184806892703e-03 +-1.3562976821592805e-03 +-1.2938208272247806e-03 +-1.2348093055191717e-03 +-1.1798097014005112e-03 +-1.1290794883985484e-03 +-1.0826661908343083e-03 +-1.0404733114709858e-03 +-1.0023116673754130e-03 +-9.6793745880005718e-04 +-9.3707940861473954e-04 +-9.0945742727527638e-04 +-8.8479497463396831e-04 +-8.6282687886002764e-04 +-8.4330396684304985e-04 +-8.2599551260689589e-04 +-8.1069023324690278e-04 +-7.9719635077923326e-04 +-7.8534108194193268e-04 +-7.7496980452602981e-04 +-7.6594506774240367e-04 +-7.5814555696373316e-04 +-7.5146508338757906e-04 +-7.4581164186099500e-04 +-7.4110656170946827e-04 +-7.3728376331823060e-04 +-7.3428912556038929e-04 +-7.3207996459735366e-04 +-7.3062462215776013e-04 +-7.2990216040811739e-04 +-1.8021143507188160e-03 +-1.8056329689340764e-03 +-1.8126415408406117e-03 +-1.8230787732345464e-03 +-1.8368308852957456e-03 +-1.8536742740955768e-03 +-1.8731571427676864e-03 +-1.8944115141933881e-03 +-1.9159274084971456e-03 +-1.9353816995750592e-03 +-1.9496627042015718e-03 +-1.9552117706144257e-03 +-1.9486781720831497e-03 +-1.9276977715818862e-03 +-1.8914883204912203e-03 +-1.8410149476161832e-03 +-1.7786895083016379e-03 +-1.7077756869175818e-03 +-1.6317485879386066e-03 +-1.5537965993570001e-03 +-1.4765368228588233e-03 +-1.4019222887897487e-03 +-1.3312779122639467e-03 +-1.2654014867735893e-03 +-1.2046836638512158e-03 +-1.1492206309812937e-03 +-1.0989080597779634e-03 +-1.0535138286719837e-03 +-1.0127314232816055e-03 +-9.7621753067841433e-04 +-9.4361750688991167e-04 +-9.1458193622727705e-04 +-8.8877685784825410e-04 +-8.6588961394918024e-04 +-8.4563175158248354e-04 +-8.2774000098047155e-04 +-8.1197604631800353e-04 +-7.9812558094891637e-04 +-7.8599697906021459e-04 +-7.7541980296964201e-04 +-7.6624328696414906e-04 +-7.5833488483772506e-04 +-7.5157893194022002e-04 +-7.4587544839927302e-04 +-7.4113909453663149e-04 +-7.3729827974718728e-04 +-7.3429442042748018e-04 +-7.3208133962636163e-04 +-7.3062480008850611e-04 +-7.2990216260476813e-04 +-1.9091949485606999e-03 +-1.9129347930173820e-03 +-1.9204384590650486e-03 +-1.9317481701020224e-03 +-1.9468945676393507e-03 +-1.9658095735035231e-03 +-1.9881457573801809e-03 +-2.0129895527226638e-03 +-2.0385193928710364e-03 +-2.0617560376306500e-03 +-2.0786259493989598e-03 +-2.0845124815360651e-03 +-2.0752468194484971e-03 +-2.0481919757578976e-03 +-2.0029399982140084e-03 +-1.9413253355679201e-03 +-1.8668241569870878e-03 +-1.7836753892751869e-03 +-1.6960759783389049e-03 +-1.6076469645876499e-03 +-1.5211945209943705e-03 +-1.4386913705971126e-03 +-1.3613820576392607e-03 +-1.2899353824820121e-03 +-1.2245973524150290e-03 +-1.1653225816533436e-03 +-1.1118775087747535e-03 +-1.0639167201784928e-03 +-1.0210368289009428e-03 +-9.8281298623123059e-04 +-9.4882260286264087e-04 +-9.1865998571269685e-04 +-8.9194471351900168e-04 +-8.6832581820917693e-04 +-8.4748324323036066e-04 +-8.2912760282243707e-04 +-8.1299894102012131e-04 +-7.9886495790713571e-04 +-7.8651900897300871e-04 +-7.7577807200665419e-04 +-7.6648080020779851e-04 +-7.5848572942009153e-04 +-7.5166967394313551e-04 +-7.4592632384952744e-04 +-7.4116504336304851e-04 +-7.3730986201310988e-04 +-7.3429864620359658e-04 +-7.3208243725716765e-04 +-7.3062494214477249e-04 +-7.2990216435914125e-04 +-1.9821987889402453e-03 +-1.9860977482212194e-03 +-1.9939767469614373e-03 +-2.0059908717909281e-03 +-2.0223314444079692e-03 +-2.0431143454851795e-03 +-2.0681455290734569e-03 +-2.0965418526842387e-03 +-2.1262673562238315e-03 +-2.1537812835907989e-03 +-2.1741114263784988e-03 +-2.1816070961593196e-03 +-2.1712847411674342e-03 +-2.1402313234712310e-03 +-2.0883859977766802e-03 +-2.0183709941580335e-03 +-1.9345870038894437e-03 +-1.8420825241045075e-03 +-1.7456288299594603e-03 +-1.6491790498417980e-03 +-1.5556803379069522e-03 +-1.4671191455149380e-03 +-1.3846803239595236e-03 +-1.3089373832435506e-03 +-1.2400291126431100e-03 +-1.1778044510966960e-03 +-1.1219325756518280e-03 +-1.0719821141747597e-03 +-1.0274756488072986e-03 +-9.8792565204342659e-04 +-9.5285706721413746e-04 +-9.2182060495620119e-04 +-8.9439977928687108e-04 +-8.7021385194104375e-04 +-8.4891819999590671e-04 +-8.3020314197727082e-04 +-8.1379191509530033e-04 +-7.9943825671407564e-04 +-7.8692387843937867e-04 +-7.7605600959940668e-04 +-7.6666511239455984e-04 +-7.5860282206611910e-04 +-7.5174013398661161e-04 +-7.4596583992974307e-04 +-7.4118520409477970e-04 +-7.3731886305386486e-04 +-7.3430193093600865e-04 +-7.3208329060142727e-04 +-7.3062505259856552e-04 +-7.2990216572384583e-04 +-2.0242433861244751e-03 +-2.0282401953181256e-03 +-2.0363542987397384e-03 +-2.0488196172171879e-03 +-2.0659447395899237e-03 +-2.0879958534941261e-03 +-2.1149431125385013e-03 +-2.1460297400689460e-03 +-2.1792053061619292e-03 +-2.2106382753559650e-03 +-2.2347166305504884e-03 +-2.2449172334544003e-03 +-2.2354646561735607e-03 +-2.2030589559613061e-03 +-2.1477728470390978e-03 +-2.0727490006100741e-03 +-1.9830519459736692e-03 +-1.8843372122258782e-03 +-1.7818291376025010e-03 +-1.6797668107628879e-03 +-1.5812453879305538e-03 +-1.4883014895829892e-03 +-1.4021081867550040e-03 +-1.3231922975796852e-03 +-1.2516294569785873e-03 +-1.1872006536475235e-03 +-1.1295091381240509e-03 +-1.0780632093928188e-03 +-1.0323322357853352e-03 +-9.9178288091375673e-04 +-9.5590129672686454e-04 +-9.2420570443449391e-04 +-8.9625259786813970e-04 +-8.7163885774836853e-04 +-8.5000135400071239e-04 +-8.3101509840381846e-04 +-8.1439064712500995e-04 +-7.9987120230247367e-04 +-7.8722969194628713e-04 +-7.7626599392751738e-04 +-7.6680439524373330e-04 +-7.5869132961465873e-04 +-7.5179340618445624e-04 +-7.4599572368623361e-04 +-7.4120045390851496e-04 +-7.3732567291055729e-04 +-7.3430441646776270e-04 +-7.3208393640739045e-04 +-7.3062513619733763e-04 +-7.2990216675741456e-04 +-2.0445767988107621e-03 +-2.0486232262670887e-03 +-2.0568444046769152e-03 +-2.0694915118773982e-03 +-2.0869069413430043e-03 +-2.1094249623191904e-03 +-2.1371435389061426e-03 +-2.1695013918392554e-03 +-2.2046527094527393e-03 +-2.2388269490134353e-03 +-2.2661560969309998e-03 +-2.2795182940541776e-03 +-2.2724072007022961e-03 +-2.2409735910117619e-03 +-2.1851133261810945e-03 +-2.1081444485119591e-03 +-2.0155104773690205e-03 +-1.9132928814464480e-03 +-1.8070871253727746e-03 +-1.7014065010947947e-03 +-1.5995212994431790e-03 +-1.5035613666758232e-03 +-1.4147336813957448e-03 +-1.3335604657190750e-03 +-1.2600905549742462e-03 +-1.1940674117772428e-03 +-1.1350534389389510e-03 +-1.0825171355145404e-03 +-1.0358914106032542e-03 +-9.9461077899571184e-04 +-9.5813373840440718e-04 +-9.2595510715550171e-04 +-8.9761178210143264e-04 +-8.7268433898664863e-04 +-8.5079612669128010e-04 +-8.3161095498713558e-04 +-8.1483009084494474e-04 +-8.0018901565787363e-04 +-7.8745421948958031e-04 +-7.7642019204238546e-04 +-7.6690669452071853e-04 +-7.5875634850243966e-04 +-7.5183254822680794e-04 +-7.4601768501790934e-04 +-7.4121166281357473e-04 +-7.3733067906179401e-04 +-7.3430624390549508e-04 +-7.3208441127278864e-04 +-7.3062519767271754e-04 +-7.2990216751821473e-04 +-2.0529831542710347e-03 +-2.0570490470222130e-03 +-2.0652910456543170e-03 +-2.0779262142133540e-03 +-2.0952572444217004e-03 +-2.1176017464027684e-03 +-2.1451158491061387e-03 +-2.1774278955288590e-03 +-2.2130163295684927e-03 +-2.2484480753529232e-03 +-2.2779752429223990e-03 +-2.2942049064234799e-03 +-2.2900297300827792e-03 +-2.2609404405410129e-03 +-2.2063865887700278e-03 +-2.1295636653424202e-03 +-2.0360611163312051e-03 +-1.9322466686721336e-03 +-1.8240253066301659e-03 +-1.7161724431051769e-03 +-1.6121469136277031e-03 +-1.5141956468804787e-03 +-1.4235859757096142e-03 +-1.3408609858054073e-03 +-1.2660657698241107e-03 +-1.1989264931175523e-03 +-1.1389821184474300e-03 +-1.0856761245614651e-03 +-1.0384173831956677e-03 +-9.9661861978597721e-04 +-9.5971926734750301e-04 +-9.2719783470731872e-04 +-8.9857746554363675e-04 +-8.7342724063205809e-04 +-8.5136094869612243e-04 +-8.3203446457076841e-04 +-8.1514246803795749e-04 +-8.0041496219460681e-04 +-7.8761386762855174e-04 +-7.7652984914498412e-04 +-7.6697945500552457e-04 +-7.5880260028119394e-04 +-7.5186039643839256e-04 +-7.4603331198803264e-04 +-7.4121963976971712e-04 +-7.3733424217605208e-04 +-7.3430754471102435e-04 +-7.3208474931820994e-04 +-7.3062524143826407e-04 +-7.2990216806070429e-04 +-2.0560405208134521e-03 +-2.0601111836566917e-03 +-2.0683355859430477e-03 +-2.0808779511464906e-03 +-2.0979701901383948e-03 +-2.1198645838280128e-03 +-2.1467069127336868e-03 +-2.1782445061471860e-03 +-2.2132621658409795e-03 +-2.2487710879787329e-03 +-2.2793896787696908e-03 +-2.2977420263845319e-03 +-2.2963017241912583e-03 +-2.2699028494913482e-03 +-2.2174180473371148e-03 +-2.1417484635570107e-03 +-2.0484824939523147e-03 +-1.9441730900058420e-03 +-1.8349744081261807e-03 +-1.7258922453479021e-03 +-1.6205606672289826e-03 +-1.5213418765838206e-03 +-1.4295687227170578e-03 +-1.3458142266581938e-03 +-1.2701306222546443e-03 +-1.2022380736347736e-03 +-1.1416629384119698e-03 +-1.0878335634600610e-03 +-1.0401435095042546e-03 +-9.9799123524033258e-04 +-9.6080348845836510e-04 +-9.2804781781630620e-04 +-8.9923806622622753e-04 +-8.7393550913384701e-04 +-8.5174742661479343e-04 +-8.3232428222689708e-04 +-8.1535625886160266e-04 +-8.0056961736607016e-04 +-7.8772315575399720e-04 +-7.7660492451506863e-04 +-7.6702927556736799e-04 +-7.5883427360860995e-04 +-7.5187946920233888e-04 +-7.4604401583386727e-04 +-7.4122510423203238e-04 +-7.3733668324625135e-04 +-7.3430843595610274e-04 +-7.3208498094400249e-04 +-7.3062527142764907e-04 +-7.2990216843345592e-04 +-2.0570060116994302e-03 +-2.0610760983621247e-03 +-2.0692759569898079e-03 +-2.0817235273254617e-03 +-2.0985849909449313e-03 +-2.1200397342811201e-03 +-2.1461856688408613e-03 +-2.1768113199148605e-03 +-2.2109133871156951e-03 +-2.2459040356054166e-03 +-2.2768385483562595e-03 +-2.2965260543212035e-03 +-2.2971969899577118e-03 +-2.2731351620349735e-03 +-2.2226581546613308e-03 +-2.1483358607568104e-03 +-2.0556908146130287e-03 +-1.9513904529652930e-03 +-1.8417746168535654e-03 +-1.7320298362750489e-03 +-1.6259312554593522e-03 +-1.5259361366092481e-03 +-1.4334334682099801e-03 +-1.3490243200417913e-03 +-1.2727707957445665e-03 +-1.2043922489059743e-03 +-1.1434086297997428e-03 +-1.0892394618736113e-03 +-1.0412689162950270e-03 +-9.9888648383133463e-04 +-9.6151082747822998e-04 +-9.2860245208180846e-04 +-8.9966919173036116e-04 +-8.7426726203502689e-04 +-8.5199971443869254e-04 +-8.3251349170066684e-04 +-8.1549584808360449e-04 +-8.0067060578548576e-04 +-7.8779452719600883e-04 +-7.7665395808209324e-04 +-7.6706181792633070e-04 +-7.5885496443651090e-04 +-7.5189192983946310e-04 +-7.4605100952907541e-04 +-7.4122867491626299e-04 +-7.3733827845428473e-04 +-7.3430901841104758e-04 +-7.3208513232608753e-04 +-7.3062529102868286e-04 +-7.2990216867830813e-04 +-2.0572330512131009e-03 +-2.0613014101904391e-03 +-2.0694820267670071e-03 +-2.0818612583759408e-03 +-2.0985587209009461e-03 +-2.1196966736632405e-03 +-2.1453213010548563e-03 +-2.1752171681837028e-03 +-2.2084980563008990e-03 +-2.2428644505876573e-03 +-2.2737453092211558e-03 +-2.2941714008914982e-03 +-2.2962556100075910e-03 +-2.2738865053133698e-03 +-2.2249478410641126e-03 +-2.1517328295488506e-03 +-2.0596893031104096e-03 +-1.9555511808809849e-03 +-1.8457833228800772e-03 +-1.7356977332568769e-03 +-1.6291688136218412e-03 +-1.5287214863490238e-03 +-1.4357854430580587e-03 +-1.3509829303401167e-03 +-1.2743845351065181e-03 +-1.2057105658690309e-03 +-1.1444778979691620e-03 +-1.0901011415576185e-03 +-1.0419589975057091e-03 +-9.9943562255469976e-04 +-9.6194481641779541e-04 +-9.2894281817792156e-04 +-8.9993380739342708e-04 +-8.7447091367934379e-04 +-8.5215460457809704e-04 +-8.3262966870972148e-04 +-8.1558156693311938e-04 +-8.0073262718324356e-04 +-7.8783836400950376e-04 +-7.7668407785838384e-04 +-7.6708180964710204e-04 +-7.5886767663656902e-04 +-7.5189958621332679e-04 +-7.4605530714179033e-04 +-7.4123086927016643e-04 +-7.3733925885428506e-04 +-7.3430937640405283e-04 +-7.3208522537428168e-04 +-7.3062530307748243e-04 +-7.2990216883035382e-04 +-2.0572420146247423e-03 +-2.0613089178331805e-03 +-2.0694774268344876e-03 +-2.0818153763959494e-03 +-2.0984144672430640e-03 +-2.1193607031164230e-03 +-2.1446621726380942e-03 +-2.1740867041301600e-03 +-2.2068029204067277e-03 +-2.2406860590899413e-03 +-2.2714201509061666e-03 +-2.2922117504093355e-03 +-2.2951262944906842e-03 +-2.2738078121354124e-03 +-2.2258564771028234e-03 +-2.1533780759320806e-03 +-2.0617632163435606e-03 +-1.9577810231608491e-03 +-1.8479708648879750e-03 +-1.7377211043936448e-03 +-1.6309670845920327e-03 +-1.5302755844019357e-03 +-1.4371017659744459e-03 +-1.3520814415106202e-03 +-1.2752909966698819e-03 +-1.2064519014210293e-03 +-1.1450796758189356e-03 +-1.0905863886140333e-03 +-1.0423477946350374e-03 +-9.9974512677179859e-04 +-9.6218949336848594e-04 +-9.2913475914619390e-04 +-9.0008306189034114e-04 +-8.7458580268164076e-04 +-8.5224199916861883e-04 +-8.3269522966538973e-04 +-8.1562994645170250e-04 +-8.0076763652129788e-04 +-7.8786311178879781e-04 +-7.7670108385303137e-04 +-7.6709309854949175e-04 +-7.5887485576134242e-04 +-7.5190391056254068e-04 +-7.4605773469487715e-04 +-7.4123210888930196e-04 +-7.3733981274041148e-04 +-7.3430957866971592e-04 +-7.3208527794951241e-04 +-7.3062530988629159e-04 +-7.2990216891822451e-04 +-2.0572136757945410e-03 +-2.0612796903194449e-03 +-2.0694417385397402e-03 +-2.0817581793686093e-03 +-2.0983062564856117e-03 +-2.1191526034613551e-03 +-2.1442833087912555e-03 +-2.1734524981671800e-03 +-2.2058511755993610e-03 +-2.2394446690228130e-03 +-2.2700594109830324e-03 +-2.2910085789243080e-03 +-2.2943424363104721e-03 +-2.2735769854620516e-03 +-2.2261579258610891e-03 +-2.1540863154240718e-03 +-2.0627182264889563e-03 +-1.9588387787888724e-03 +-1.8490253140305238e-03 +-1.7387058804021647e-03 +-1.6318477882821057e-03 +-1.5310399488490381e-03 +-1.4377511374182891e-03 +-1.3526245571507257e-03 +-1.2757399032941753e-03 +-1.2068194998494316e-03 +-1.1453783706606769e-03 +-1.0908274344346028e-03 +-1.0425410536266649e-03 +-9.9989905348733376e-04 +-9.6231123352183976e-04 +-9.2923029650497852e-04 +-9.0015737678815564e-04 +-8.7464302338142574e-04 +-8.5228553760802639e-04 +-8.3272789879921139e-04 +-8.1565405942115926e-04 +-8.0078508928961914e-04 +-7.8787545145859235e-04 +-7.7670956495898421e-04 +-7.6709872950149894e-04 +-7.5887843736586991e-04 +-7.5190606830107323e-04 +-7.4605894616824333e-04 +-7.4123272761006289e-04 +-7.3734008923157857e-04 +-7.3430967964838775e-04 +-7.3208530419956988e-04 +-7.3062531328682199e-04 +-7.2990216896475662e-04 +-2.0571951340663678e-03 +-2.0612607322577493e-03 +-2.0694199671458485e-03 +-2.0817271676686431e-03 +-2.0982533616113273e-03 +-2.1190566725346992e-03 +-2.1441130567819472e-03 +-2.1731692033324242e-03 +-2.2054236036688421e-03 +-2.2388792894349201e-03 +-2.2694258624938292e-03 +-2.2904267456072898e-03 +-2.2939297962866669e-03 +-2.2733977206804310e-03 +-2.2262092033655985e-03 +-2.1543184830208795e-03 +-2.0630648458316698e-03 +-1.9592387353264355e-03 +-1.8494327840471653e-03 +-1.7390915212314121e-03 +-1.6321957490548849e-03 +-1.5313438500612364e-03 +-1.4380105234052809e-03 +-1.3528422736137163e-03 +-1.2759203575402895e-03 +-1.2069675996579919e-03 +-1.1454989289601662e-03 +-1.0909248703414684e-03 +-1.0426192707053581e-03 +-9.9996141747397656e-04 +-9.6236060145713192e-04 +-9.2926906891398881e-04 +-9.0018755699049343e-04 +-8.7466627554216728e-04 +-8.5230323956365125e-04 +-8.3274118816642462e-04 +-8.1566387283648679e-04 +-8.0079219527739369e-04 +-7.8788047771347828e-04 +-7.7671302089672093e-04 +-7.6710102490961383e-04 +-7.5887989790245091e-04 +-7.5190694850153046e-04 +-7.4605944051812803e-04 +-7.4123298015638908e-04 +-7.3734020211739342e-04 +-7.3430972088515695e-04 +-7.3208531492163027e-04 +-7.3062531467707025e-04 +-7.2990216898746491e-04 +-2.0571887358419591e-03 +-2.0612541984025121e-03 +-2.0694125561029186e-03 +-2.0817168881788919e-03 +-2.0982362522143751e-03 +-2.1190259890612197e-03 +-2.1440585732178503e-03 +-2.1730777432049414e-03 +-2.2052834090303965e-03 +-2.2386896001779753e-03 +-2.2692058111919147e-03 +-2.2902126993337196e-03 +-2.2937597104698538e-03 +-2.2732948448049599e-03 +-2.2261765864242953e-03 +-2.1543441018389291e-03 +-2.0631303515762302e-03 +-1.9593262813796045e-03 +-1.8495283789390225e-03 +-1.7391857266586066e-03 +-1.6322830290549904e-03 +-1.5314215130677810e-03 +-1.4380777325034883e-03 +-1.3528992875536906e-03 +-1.2759680106622828e-03 +-1.2070069731085591e-03 +-1.1455311572431816e-03 +-1.0909510364712379e-03 +-1.0426403560718487e-03 +-9.9997828372001981e-04 +-9.6237398997186109e-04 +-9.2927960919228611e-04 +-9.0019577875983018e-04 +-8.7467262181910896e-04 +-8.5230807916795201e-04 +-8.3274482701080539e-04 +-8.1566656375909967e-04 +-8.0079414641936455e-04 +-7.8788185956411979e-04 +-7.7671397217586493e-04 +-7.6710165747108014e-04 +-7.5888030083375230e-04 +-7.5190719158119081e-04 +-7.4605957717095695e-04 +-7.4123305002883415e-04 +-7.3734023337410526e-04 +-7.3430973231100052e-04 +-7.3208531789476460e-04 +-7.3062531506449678e-04 +-7.2990216899971954e-04 +-2.0571877673335533e-03 +-2.0612532080990782e-03 +-2.0694114304713202e-03 +-2.0817153137045498e-03 +-2.0982335738867226e-03 +-2.1190210220454185e-03 +-2.1440493884942917e-03 +-2.1730616012729481e-03 +-2.2052573088235292e-03 +-2.2386518460371990e-03 +-2.2691578909779112e-03 +-2.2901596525345203e-03 +-2.2937082015050563e-03 +-2.2732504305926784e-03 +-2.2261421370722810e-03 +-2.1543198663493916e-03 +-2.0631149218642429e-03 +-1.9593176090049818e-03 +-1.8495244509946726e-03 +-1.7391848803174114e-03 +-1.6322840261902354e-03 +-1.5314234966074393e-03 +-1.4380801432496504e-03 +-1.3529017809141707e-03 +-1.2759703882378576e-03 +-1.2070091318059405e-03 +-1.1455330536489174e-03 +-1.0909526629291973e-03 +-1.0426417251316658e-03 +-9.9997941831412077e-04 +-9.6237491739458391e-04 +-9.2928035754244063e-04 +-9.0019637494661957e-04 +-8.7467309053867591e-04 +-8.5230844246766664e-04 +-8.3274510419688254e-04 +-8.1566677149452261e-04 +-8.0079429891742832e-04 +-7.8788196882106747e-04 +-7.7671404820976416e-04 +-7.6710170854977122e-04 +-7.5888033368397766e-04 +-7.5190721157739515e-04 +-7.4605958850552532e-04 +-7.4123305586790502e-04 +-7.3734023600362188e-04 +-7.3430973327810831e-04 +-7.3208531814858402e-04 +-7.3062531510026743e-04 +-7.2990216900941393e-04 +-2.0571877672820268e-03 +-2.0612532074700454e-03 +-2.0694114270350707e-03 +-2.0817152985155149e-03 +-2.0982335193821919e-03 +-2.1190208598918371e-03 +-2.1440489746215497e-03 +-2.1730606720153788e-03 +-2.2052554553584638e-03 +-2.2386485697624510e-03 +-2.2691527869207755e-03 +-2.2901526465555736e-03 +-2.2936996603075696e-03 +-2.2732410468870568e-03 +-2.2261326820404511e-03 +-2.1543109737391878e-03 +-2.0631069904640735e-03 +-1.9593108106717213e-03 +-1.8495187908918753e-03 +-1.7391802648307432e-03 +-1.6322803167584223e-03 +-1.5314205446827721e-03 +-1.4380778095081286e-03 +-1.3528999437777448e-03 +-1.2759689460962581e-03 +-1.2070080019894068e-03 +-1.1455321700143868e-03 +-1.0909519730842251e-03 +-1.0426411877987826e-03 +-9.9997900104167674e-04 +-9.6237459466488786e-04 +-9.2928010925473167e-04 +-9.0019618522358790e-04 +-8.7467294679880641e-04 +-8.5230833470950065e-04 +-8.3274502444889860e-04 +-8.1566671339273675e-04 +-8.0079425738049015e-04 +-7.8788193979924704e-04 +-7.7671402848957004e-04 +-7.6710169560025867e-04 +-7.5888032553417110e-04 +-7.5190720671688797e-04 +-7.4605958580235452e-04 +-7.4123305449935739e-04 +-7.3734023539680086e-04 +-7.3430973305795857e-04 +-7.3208531809165929e-04 +-7.3062531509292868e-04 +-7.2990216900934086e-04 +-2.0571887353203759e-03 +-2.0612541832536512e-03 +-2.0694124493822299e-03 +-2.0817164570327072e-03 +-2.0982349514845678e-03 +-2.1190227112210741e-03 +-2.1440512885828739e-03 +-2.1730631053714605e-03 +-2.2052566769676968e-03 +-2.2386455503789686e-03 +-2.2691409401650662e-03 +-2.2901276126015553e-03 +-2.2936597545433197e-03 +-2.2731883310616163e-03 +-2.2260719511038164e-03 +-2.1542477604468142e-03 +-2.0630459529757026e-03 +-1.9592550367504816e-03 +-1.8494698338845791e-03 +-1.7391385218413105e-03 +-1.6322454595711154e-03 +-1.5313918685685062e-03 +-1.4380544692217001e-03 +-1.3528810930743089e-03 +-1.2759538092555558e-03 +-1.2069959028910501e-03 +-1.1455225372470873e-03 +-1.0909443329765662e-03 +-1.0426351523953944e-03 +-9.9997425486489594e-04 +-9.6237088217103570e-04 +-9.2927722379509503e-04 +-9.0019395973153554e-04 +-8.7467124613491945e-04 +-8.5230704947195709e-04 +-8.3274406601977901e-04 +-8.1566600999643385e-04 +-8.0079375095502793e-04 +-7.8788158351110569e-04 +-7.7671378475258545e-04 +-7.6710153448556265e-04 +-7.5888022348113819e-04 +-7.5190714547369755e-04 +-7.4605955154041022e-04 +-7.4123303705796769e-04 +-7.3734022762469477e-04 +-7.3430973022571924e-04 +-7.3208531735565949e-04 +-7.3062531499495790e-04 +-7.2990216899887646e-04 +-2.0571951329443929e-03 +-2.0612606434135491e-03 +-2.0694192641435120e-03 +-2.0817243565995971e-03 +-2.0982452709519847e-03 +-2.1190374757632164e-03 +-2.1440730240287267e-03 +-2.1730936139175198e-03 +-2.2052933870300010e-03 +-2.2386758622625715e-03 +-2.2691403000121989e-03 +-2.2900678120622215e-03 +-2.2935237082179266e-03 +-2.2729790991770291e-03 +-2.2258097936499965e-03 +-2.1539600696029023e-03 +-2.0627579075229510e-03 +-1.9589847807128472e-03 +-1.8492277722922921e-03 +-1.7389288055323535e-03 +-1.6320680478879974e-03 +-1.5312443347397129e-03 +-1.4379332919834070e-03 +-1.3527824650066942e-03 +-1.2758740850878814e-03 +-1.2069318122138707e-03 +-1.1454712571291488e-03 +-1.0909034846541602e-03 +-1.0426027615702434e-03 +-9.9994869831507554e-04 +-9.6235083278013917e-04 +-9.2926159983308546e-04 +-9.0018188069619924e-04 +-8.7466199560660421e-04 +-8.5230004453101631e-04 +-8.3273883240792565e-04 +-8.1566216210799639e-04 +-8.0079097578844810e-04 +-7.8787962780834135e-04 +-7.7671244467159006e-04 +-7.6710064726158097e-04 +-7.5887966063456101e-04 +-7.5190680720675510e-04 +-7.4605936203825146e-04 +-7.4123294046765968e-04 +-7.3734018453535234e-04 +-7.3430971451122497e-04 +-7.3208531327436830e-04 +-7.3062531446463602e-04 +-7.2990216898486217e-04 +-2.0572136781408764e-03 +-2.0612794091771401e-03 +-2.0694392398802530e-03 +-2.0817480423304447e-03 +-2.0982773623610738e-03 +-2.1190853880774904e-03 +-2.1441466119728669e-03 +-2.1732015367258903e-03 +-2.2054314064940445e-03 +-2.2388079940241345e-03 +-2.2691908967110534e-03 +-2.2899461009014185e-03 +-2.2931704287536491e-03 +-2.2723968572106977e-03 +-2.2250561514343217e-03 +-2.1531172492972256e-03 +-2.0619035222308952e-03 +-1.9581760654483705e-03 +-1.8484986083437069e-03 +-1.7382937855830480e-03 +-1.6315285890517437e-03 +-1.5307941718434559e-03 +-1.4375624767979092e-03 +-1.3524799108710296e-03 +-1.2756290078161259e-03 +-1.2067344381588214e-03 +-1.1453130888761116e-03 +-1.0907773223138586e-03 +-1.0425026032190353e-03 +-9.9986959153558616e-04 +-9.6228871637428829e-04 +-9.2921315509443851e-04 +-9.0014440041626250e-04 +-8.7463327297895215e-04 +-8.5227828110970598e-04 +-8.3272256297819123e-04 +-8.1565019391588488e-04 +-8.0078233963028569e-04 +-7.8787353872257233e-04 +-7.7670827029759331e-04 +-7.6709788224235871e-04 +-7.5887790573508863e-04 +-7.5190575206633638e-04 +-7.4605877069166280e-04 +-7.4123263894207187e-04 +-7.3734004997908485e-04 +-7.3430966542633691e-04 +-7.3208530052561432e-04 +-7.3062531281315054e-04 +-7.2990216895893348e-04 +-2.0572420399769058e-03 +-2.0613083148394605e-03 +-2.0694710667238255e-03 +-2.0817888033526112e-03 +-2.0983384199717201e-03 +-2.1191847704408679e-03 +-2.1443082187474678e-03 +-2.1734461658712476e-03 +-2.2057492868484845e-03 +-2.2391159890628918e-03 +-2.2693154591365162e-03 +-2.2896794315287392e-03 +-2.2923760354254842e-03 +-2.2710785607348649e-03 +-2.2233431914891028e-03 +-2.1511961124404014e-03 +-2.0599513959400268e-03 +-1.9563244873096177e-03 +-1.8468261512867587e-03 +-1.7368349451256724e-03 +-1.6302875430562599e-03 +-1.5297572739125288e-03 +-1.4367074177483467e-03 +-1.3517815874363392e-03 +-1.2750628720891305e-03 +-1.2062781632939843e-03 +-1.1449472118838994e-03 +-1.0904853174183572e-03 +-1.0422706704714844e-03 +-9.9968632750046800e-04 +-9.6214475814326199e-04 +-9.2910084339612830e-04 +-9.0005748153065617e-04 +-8.7456664509267124e-04 +-8.5222778363526464e-04 +-8.3268480422717063e-04 +-8.1562241146600559e-04 +-8.0076228777802981e-04 +-7.8785939791940068e-04 +-7.7669857417442777e-04 +-7.6709145852272946e-04 +-7.5887382799999731e-04 +-7.5190329989096260e-04 +-7.4605739616494617e-04 +-7.4123193797236294e-04 +-7.3733973712947340e-04 +-7.3430955128950140e-04 +-7.3208527087942810e-04 +-7.3062530897502953e-04 +-7.2990216890701407e-04 +-2.0572331578424560e-03 +-2.0613004974760420e-03 +-2.0694689817924721e-03 +-2.0818042681926309e-03 +-2.0983936893224460e-03 +-2.1193145969578028e-03 +-2.1445566496636217e-03 +-2.1738464735488396e-03 +-2.2062707795334536e-03 +-2.2395888780034662e-03 +-2.2694089316088357e-03 +-2.2890111837159397e-03 +-2.2907042738589956e-03 +-2.2684232210769774e-03 +-2.2199547835206968e-03 +-2.1474288620869156e-03 +-2.0561401522084860e-03 +-1.9527174130494461e-03 +-1.8435712166053842e-03 +-1.7339966558747059e-03 +-1.6278728804941561e-03 +-1.5277393322096660e-03 +-1.4350428014782398e-03 +-1.3504215953725901e-03 +-1.2739599016980247e-03 +-1.2053889068389680e-03 +-1.1442338955839123e-03 +-1.0899158469408331e-03 +-1.0418182271403210e-03 +-9.9932873548801409e-04 +-9.6186379857162666e-04 +-9.2888160400398366e-04 +-8.9988778037661005e-04 +-8.7443653954410463e-04 +-8.5212916206919983e-04 +-8.3261105172602432e-04 +-8.1556813869593681e-04 +-8.0072311228259830e-04 +-7.8783176800726598e-04 +-7.7667962691921517e-04 +-7.6707890472540920e-04 +-7.5886585823356425e-04 +-7.5189850682092765e-04 +-7.4605470928365656e-04 +-7.4123056764425219e-04 +-7.3733912550143243e-04 +-7.3430932813820307e-04 +-7.3208521291580255e-04 +-7.3062530147211544e-04 +-7.2990216881059738e-04 +-2.0570063364172514e-03 +-2.0610753375963991e-03 +-2.0692532236028871e-03 +-2.0816176176911127e-03 +-2.0982727283916599e-03 +-2.1193139579924101e-03 +-2.1447382022324207e-03 +-2.1742386447314967e-03 +-2.2067810775541659e-03 +-2.2399004351238675e-03 +-2.2689750595008230e-03 +-2.2872442688766617e-03 +-2.2872675659632567e-03 +-2.2633999397201812e-03 +-2.2137847113888648e-03 +-2.1407041017749520e-03 +-2.0494112696100106e-03 +-1.9463885334547778e-03 +-1.8378803283067198e-03 +-1.7290439519551132e-03 +-1.6236637354390081e-03 +-1.5242234188883590e-03 +-1.4321429350554154e-03 +-1.3480523122802852e-03 +-1.2720381077094944e-03 +-1.2038391788869683e-03 +-1.1429905115235826e-03 +-1.0889229823913952e-03 +-1.0410292312550895e-03 +-9.9870502417367512e-04 +-9.6137366187947881e-04 +-9.2849907750727973e-04 +-8.9959164555932739e-04 +-8.7420947205670463e-04 +-8.5195702321831201e-04 +-8.3248230808317134e-04 +-8.1547339114625605e-04 +-8.0065471590615059e-04 +-7.8778352582142515e-04 +-7.7664654280647542e-04 +-7.6705698317335209e-04 +-7.5885194069538709e-04 +-7.5189013636490056e-04 +-7.4605001682592027e-04 +-7.4122817437782883e-04 +-7.3733805726726648e-04 +-7.3430893838586080e-04 +-7.3208511167598578e-04 +-7.3062528836829912e-04 +-7.2990216864556934e-04 +-2.0560413322097851e-03 +-2.0601119804382110e-03 +-2.0683014441393618e-03 +-2.0807033082633993e-03 +-2.0974425140707353e-03 +-2.1186307280286983e-03 +-2.1442537180207488e-03 +-2.1739228859045025e-03 +-2.2064037128667040e-03 +-2.2389275698116245e-03 +-2.2666220427441978e-03 +-2.2827629226097575e-03 +-2.2803174533391380e-03 +-2.2542286564215183e-03 +-2.2031068629629895e-03 +-2.1294111890635846e-03 +-2.0383077888307464e-03 +-1.9360530962326795e-03 +-1.8286441114540976e-03 +-1.7210351243485582e-03 +-1.6168716211973737e-03 +-1.5185565048833976e-03 +-1.4274716402900944e-03 +-1.3442365509301740e-03 +-1.2689430564256012e-03 +-1.2013430573273522e-03 +-1.1409874582835493e-03 +-1.0873231801852964e-03 +-1.0397576541803036e-03 +-9.9769962142659237e-04 +-9.6058342786250724e-04 +-9.2788223542309605e-04 +-8.9911404240391351e-04 +-8.7384321229371615e-04 +-8.5167933247081991e-04 +-8.3227460213810916e-04 +-8.1532052022344106e-04 +-8.0054435437206895e-04 +-7.8770568021002349e-04 +-7.7659315467147952e-04 +-7.6702160699106223e-04 +-7.5882948050330558e-04 +-7.5187662780387373e-04 +-7.4604244383697741e-04 +-7.4122431192294761e-04 +-7.3733633324431723e-04 +-7.3430830936017932e-04 +-7.3208494828328006e-04 +-7.3062526722048797e-04 +-7.2990216838167931e-04 +-2.0529848812189458e-03 +-2.0570542527649804e-03 +-2.0652478206106143e-03 +-2.0776711868269655e-03 +-2.0944608231281124e-03 +-2.1157230011940842e-03 +-2.1413878973024322e-03 +-2.1709147411009457e-03 +-2.2027960181894954e-03 +-2.2339403305963968e-03 +-2.2593073693102966e-03 +-2.2723802834426808e-03 +-2.2667198392008212e-03 +-2.2379856867875288e-03 +-2.1852970229496718e-03 +-2.1112549534014606e-03 +-2.0208566200242465e-03 +-1.9200356171488308e-03 +-1.8144535951315978e-03 +-1.7087951523023829e-03 +-1.6065237725052185e-03 +-1.5099384390963814e-03 +-1.4203744573578431e-03 +-1.3384416740281719e-03 +-1.2642431971052143e-03 +-1.1975523590680159e-03 +-1.1379449751911369e-03 +-1.0848926197731773e-03 +-1.0378252644979800e-03 +-9.9617134368879825e-04 +-9.5938193546706854e-04 +-9.2694417179627400e-04 +-8.9838759026715444e-04 +-8.7328602818999258e-04 +-8.5125683016135751e-04 +-8.3195854618222775e-04 +-8.1508788392434500e-04 +-8.0037639697631846e-04 +-7.8758720246820395e-04 +-7.7651189740676730e-04 +-7.6696776291426889e-04 +-7.5879529470311276e-04 +-7.5185606684034670e-04 +-7.4603091722981788e-04 +-7.4121843302560710e-04 +-7.3733370918877504e-04 +-7.3430735195541058e-04 +-7.3208469959394108e-04 +-7.3062523503350150e-04 +-7.2990216798188442e-04 +-2.0445799359658135e-03 +-2.0486369124753877e-03 +-2.0568013061259562e-03 +-2.0691682259914991e-03 +-2.0858502910059288e-03 +-2.1068980175075187e-03 +-2.1321226529694877e-03 +-2.1607734588772491e-03 +-2.1910633759999812e-03 +-2.2196770445164450e-03 +-2.2416158709613861e-03 +-2.2508125527933116e-03 +-2.2415867300911167e-03 +-2.2103504357745287e-03 +-2.1566620867920893e-03 +-2.0831448392219639e-03 +-1.9945006622313416e-03 +-1.8962313142998591e-03 +-1.7935802136646464e-03 +-1.6909064711540542e-03 +-1.5914595358801078e-03 +-1.4974208841718423e-03 +-1.4100784673170129e-03 +-1.3300395199484334e-03 +-1.2574295962186105e-03 +-1.1920561322446763e-03 +-1.1335324451014139e-03 +-1.0813663989469732e-03 +-1.0350207928360874e-03 +-9.9395258957610971e-04 +-9.5763704452718132e-04 +-9.2558145503326300e-04 +-8.9733201299366260e-04 +-8.7247623410027341e-04 +-8.5064267041304797e-04 +-8.3149905506957886e-04 +-8.1474963429228550e-04 +-8.0013217030004951e-04 +-7.8741491491281191e-04 +-7.7639373120620431e-04 +-7.6688946046031764e-04 +-7.5874558014141170e-04 +-7.5182616641606196e-04 +-7.4601415512907064e-04 +-7.4120988404694464e-04 +-7.3732989341768131e-04 +-7.3430595977257542e-04 +-7.3208433797553811e-04 +-7.3062518823152937e-04 +-7.2990216740202805e-04 +-2.0242482122207819e-03 +-2.0282658151302038e-03 +-2.0363261783566027e-03 +-2.0484726515077522e-03 +-2.0647353825172070e-03 +-2.0850427297588381e-03 +-2.1090349761585998e-03 +-2.1357528742421135e-03 +-2.1632315866168274e-03 +-2.1881527421597543e-03 +-2.2058475174114066e-03 +-2.2109375245948819e-03 +-2.1985899335271925e-03 +-2.1658921675845994e-03 +-2.1126643644101342e-03 +-2.0413557806233645e-03 +-1.9562103803616470e-03 +-1.8621839448666288e-03 +-1.7640315078161642e-03 +-1.6657498575571603e-03 +-1.5703608047015435e-03 +-1.4799300009368272e-03 +-1.3957090624674797e-03 +-1.3183186332978666e-03 +-1.2479247132242595e-03 +-1.1843868446512972e-03 +-1.1273726813917180e-03 +-1.0764414506722194e-03 +-1.0311018806062170e-03 +-9.9085061791386151e-04 +-9.5519645829123499e-04 +-9.2367464735644230e-04 +-8.9585446101248596e-04 +-8.7134238725785251e-04 +-8.4978253948282928e-04 +-8.3085541713466288e-04 +-8.1427576015470800e-04 +-7.9978998445581068e-04 +-7.8717350749171852e-04 +-7.7622815242170634e-04 +-7.6677973918041586e-04 +-7.5867591830815358e-04 +-7.5178426985381250e-04 +-7.4599066879078651e-04 +-7.4119790602980974e-04 +-7.3732454732349417e-04 +-7.3430400931992468e-04 +-7.3208383136173468e-04 +-7.3062512266544707e-04 +-7.2990216659087320e-04 +-1.9822050695157377e-03 +-1.9861354341206968e-03 +-1.9939764471050988e-03 +-2.0056818179059995e-03 +-2.0211492160511725e-03 +-2.0401396468927814e-03 +-2.0621140306936372e-03 +-2.0859745967763601e-03 +-2.1097549755516014e-03 +-2.1303955029073757e-03 +-2.1438209366329169e-03 +-2.1455010802892910e-03 +-2.1314452172689663e-03 +-2.0992661396663287e-03 +-2.0488236680805483e-03 +-1.9821734414358760e-03 +-1.9029289455140929e-03 +-1.8153873461860546e-03 +-1.7237549014115631e-03 +-1.6316433506312156e-03 +-1.5418480779420261e-03 +-1.4563338489120368e-03 +-1.3763378153184163e-03 +-1.3025185552779201e-03 +-1.2351070948355305e-03 +-1.1740382183012168e-03 +-1.1190548251394361e-03 +-1.0697858742740728e-03 +-1.0258018323974186e-03 +-9.8665243490081780e-04 +-9.5189126159186781e-04 +-9.2109086711947990e-04 +-8.9385136707840411e-04 +-8.6980463099613876e-04 +-8.4861562623884620e-04 +-8.2998199271317992e-04 +-8.1363258659803339e-04 +-7.9932548656427860e-04 +-7.8684578417856691e-04 +-7.7600336171283789e-04 +-7.6663078015490088e-04 +-7.5858134647661750e-04 +-7.5172739398562819e-04 +-7.4595878701651664e-04 +-7.4118164728101345e-04 +-7.3731729104754048e-04 +-7.3430136210193679e-04 +-7.3208314379897654e-04 +-7.3062503368398620e-04 +-7.2990216549103889e-04 +-1.9092019414429693e-03 +-1.9129804048883140e-03 +-1.9204686119904976e-03 +-1.9315234819325855e-03 +-1.9459048231314834e-03 +-1.9632150128969347e-03 +-1.9827796553232900e-03 +-2.0034641993461281e-03 +-2.0234638870642893e-03 +-2.0401671881559078e-03 +-2.0502399180664758e-03 +-2.0500453030567172e-03 +-2.0363664080810819e-03 +-2.0071953780828682e-03 +-1.9622566765673866e-03 +-1.9030446589889470e-03 +-1.8324032585220282e-03 +-1.7538706440439018e-03 +-1.6710437172782391e-03 +-1.5871226286405863e-03 +-1.5046747318785327e-03 +-1.4255781423036869e-03 +-1.3510783652188813e-03 +-1.2818982846960088e-03 +-1.2183607280998857e-03 +-1.1605010937751031e-03 +-1.1081605740136963e-03 +-1.0610582126697277e-03 +-1.0188438371732207e-03 +-9.8113531372553725e-04 +-9.4754371549569851e-04 +-9.1768956772854729e-04 +-8.9121272760344999e-04 +-8.6777785909123025e-04 +-8.4707695064766626e-04 +-8.2882991571163684e-04 +-8.1278400597488713e-04 +-7.9871253909007676e-04 +-7.8641327821237991e-04 +-7.7570668472294602e-04 +-7.6643418479238742e-04 +-7.5845653517178277e-04 +-7.5165233634820721e-04 +-7.4591671656695985e-04 +-7.4116019436060610e-04 +-7.3730771738987199e-04 +-7.3429786972009289e-04 +-7.3208223677687046e-04 +-7.3062491630636426e-04 +-7.2990216404105119e-04 +-1.8021211529090598e-03 +-1.8056800863725090e-03 +-1.8126938194646908e-03 +-1.8229500123590897e-03 +-1.8361130993858547e-03 +-1.8516861219291488e-03 +-1.8689368876081888e-03 +-1.8867863450421237e-03 +-1.9036831422605237e-03 +-1.9175263139945822e-03 +-1.9257267890059071e-03 +-1.9254823958304503e-03 +-1.9142575506555487e-03 +-1.8903368141969263e-03 +-1.8532440867318780e-03 +-1.8038582490124077e-03 +-1.7441953559720897e-03 +-1.6769703276361442e-03 +-1.6051103903613783e-03 +-1.5313584935612585e-03 +-1.4580279307763342e-03 +-1.3869024775375331e-03 +-1.3192421451696200e-03 +-1.2558490440344545e-03 +-1.1971572600931117e-03 +-1.1433238020751692e-03 +-1.0943087995005187e-03 +-1.0499406076168027e-03 +-1.0099657123563903e-03 +-9.7408531716141700e-04 +-9.4198114542658575e-04 +-9.1333295215117571e-04 +-8.8782990001173086e-04 +-8.6517753302648402e-04 +-8.4510167861015257e-04 +-8.2735026700725921e-04 +-8.1169378483429569e-04 +-7.9792487131220325e-04 +-7.8585741109784971e-04 +-7.7532536510488393e-04 +-7.6618150023549940e-04 +-7.5829612225136787e-04 +-7.5155587664710506e-04 +-7.4586265548190088e-04 +-7.4113263008865934e-04 +-7.3729541779359107e-04 +-7.3429338338418877e-04 +-7.3208107170539985e-04 +-7.3062476554357268e-04 +-7.2990216217941079e-04 +-1.6665466948783964e-03 +-1.6698319412935382e-03 +-1.6762842878176960e-03 +-1.6856647147637730e-03 +-1.6976044199068124e-03 +-1.7115836136262061e-03 +-1.7268918100307358e-03 +-1.7425688486628213e-03 +-1.7573395387699949e-03 +-1.7695752230967774e-03 +-1.7773326639493432e-03 +-1.7785164496941933e-03 +-1.7711713626996205e-03 +-1.7538443884104651e-03 +-1.7259003042427779e-03 +-1.6876737962241669e-03 +-1.6404042814699951e-03 +-1.5859887486378364e-03 +-1.5266487504750831e-03 +-1.4646137010461530e-03 +-1.4018869854091724e-03 +-1.3401150909472675e-03 +-1.2805462524326041e-03 +-1.2240505439466676e-03 +-1.1711732621076942e-03 +-1.1222002508370469e-03 +-1.0772218709559933e-03 +-1.0361888722011461e-03 +-9.9895779486788459e-04 +-9.6532601345317159e-04 +-9.3505771059597149e-04 +-9.0790245761915777e-04 +-8.8360805022749472e-04 +-8.6192903579214550e-04 +-8.4263210117448487e-04 +-8.2549923132307673e-04 +-8.1032932564780173e-04 +-7.9693877846517347e-04 +-7.8516138933030089e-04 +-7.7484786289595993e-04 +-7.6586507935114980e-04 +-7.5809525929264863e-04 +-7.5143510585760215e-04 +-7.4579497793021796e-04 +-7.4109812802410936e-04 +-7.3728002460442417e-04 +-7.3428776936038803e-04 +-7.3207961393381411e-04 +-7.3062457691900305e-04 +-7.2990215985091120e-04 +-1.5143549686207341e-03 +-1.5173365155954435e-03 +-1.5231858115789310e-03 +-1.5316734820165990e-03 +-1.5424495691702316e-03 +-1.5550327515275787e-03 +-1.5687912854312942e-03 +-1.5829156954223853e-03 +-1.5963895763366470e-03 +-1.6079746865626317e-03 +-1.6162357817578318e-03 +-1.6196312922009762e-03 +-1.6166799923641795e-03 +-1.6061815708991510e-03 +-1.5874347696193641e-03 +-1.5603828639176400e-03 +-1.5256361468736323e-03 +-1.4843661112813964e-03 +-1.4381107245520239e-03 +-1.3885518478315604e-03 +-1.3373194241954273e-03 +-1.2858536927728716e-03 +-1.2353317411153959e-03 +-1.1866479043228454e-03 +-1.1404307892517638e-03 +-1.0970802487603275e-03 +-1.0568116243096024e-03 +-1.0196991888661822e-03 +-9.8571453675760164e-04 +-9.5475828884100439e-04 +-9.2668503718164894e-04 +-9.0132223834823836e-04 +-8.7848406350043138e-04 +-8.5798124107503305e-04 +-8.3962782427546810e-04 +-8.2324566333151277e-04 +-8.0866720558604493e-04 +-7.9573710535351457e-04 +-7.8431300748730269e-04 +-7.7426577425972589e-04 +-7.6547935202557005e-04 +-7.5785041870424122e-04 +-7.5128791182747269e-04 +-7.4571250660027545e-04 +-7.4105609148798952e-04 +-7.3726127316791159e-04 +-7.3428093164250893e-04 +-7.3207783864275141e-04 +-7.3062434723137693e-04 +-7.2990215701613387e-04 +-1.3589594345316698e-03 +-1.3616332224832980e-03 +-1.3668819447776729e-03 +-1.3745067276125325e-03 +-1.3842058718125873e-03 +-1.3955696037826091e-03 +-1.4080716963890680e-03 +-1.4210583961661645e-03 +-1.4337378027337454e-03 +-1.4451771552242483e-03 +-1.4543199794692324e-03 +-1.4600365197189322e-03 +-1.4612154573921737e-03 +-1.4568911690298471e-03 +-1.4463828338374674e-03 +-1.4294089575704401e-03 +-1.4061424265683735e-03 +-1.3771885932466520e-03 +-1.3434938893341602e-03 +-1.3062125628304127e-03 +-1.2665660399053503e-03 +-1.2257232375219214e-03 +-1.1847170984136349e-03 +-1.1443997115617173e-03 +-1.1054297820769150e-03 +-1.0682826612720387e-03 +-1.0332733091351208e-03 +-1.0005846061662013e-03 +-9.7029593787787978e-04 +-9.4240916155949881e-04 +-9.1687065715525217e-04 +-8.9358917655168329e-04 +-8.7244976763307513e-04 +-8.5332430687667460e-04 +-8.3607924715490699e-04 +-8.2058116067940589e-04 +-8.0670058467942991e-04 +-7.9431459087674473e-04 +-7.8330841565514597e-04 +-7.7357641356571639e-04 +-7.6502253490769395e-04 +-7.5756047840711178e-04 +-7.5111363111582971e-04 +-7.4561487780934086e-04 +-7.4100633961782204e-04 +-7.3723908480598417e-04 +-7.3427284220392954e-04 +-7.3207573869740229e-04 +-7.3062407557063387e-04 +-7.2990215366391996e-04 +-1.2115517913417625e-03 +-1.2139349572745655e-03 +-1.2186208694269815e-03 +-1.2254479084564957e-03 +-1.2341716240392121e-03 +-1.2444621576662037e-03 +-1.2559007648971572e-03 +-1.2679759911605067e-03 +-1.2800811668376162e-03 +-1.2915166555614410e-03 +-1.3015022676495561e-03 +-1.3092062682669527e-03 +-1.3137958283897726e-03 +-1.3145084689043752e-03 +-1.3107358027532811e-03 +-1.3021029366434311e-03 +-1.2885237014557140e-03 +-1.2702162455557116e-03 +-1.2476743014772260e-03 +-1.2216018813340230e-03 +-1.1928278743522072e-03 +-1.1622191269037771e-03 +-1.1306067696865002e-03 +-1.0987337877387936e-03 +-1.0672252322535645e-03 +-1.0365779239208919e-03 +-1.0071644014918817e-03 +-9.7924568942418474e-04 +-9.5298836292313414e-04 +-9.2848266899892863e-04 +-9.0575967885028752e-04 +-8.8480640447549566e-04 +-8.6557847421060588e-04 +-8.4801036951813902e-04 +-8.3202344507226375e-04 +-8.1753204913448082e-04 +-8.0444808087027600e-04 +-7.9268430018072109e-04 +-7.8215666594332067e-04 +-7.7278593337064575e-04 +-7.6449869757072326e-04 +-7.5722803165892579e-04 +-7.5091383507254722e-04 +-7.4550298104646357e-04 +-7.4094933092855395e-04 +-7.3721366633318819e-04 +-7.3426357721747475e-04 +-7.3207333403671828e-04 +-7.3062376453140977e-04 +-7.2990214982639645e-04 +-1.0795756787363750e-03 +-1.0816992940560644e-03 +-1.0858835969287375e-03 +-1.0920021998901939e-03 +-1.0998642508966820e-03 +-1.1092130878854684e-03 +-1.1197248105227580e-03 +-1.1310072753170366e-03 +-1.1426004770888091e-03 +-1.1539799768339042e-03 +-1.1645658394756726e-03 +-1.1737400557058318e-03 +-1.1808750086401702e-03 +-1.1853736274296213e-03 +-1.1867184128539600e-03 +-1.1845224472116184e-03 +-1.1785725668259212e-03 +-1.1688548253096596e-03 +-1.1555558178123044e-03 +-1.1390392709868030e-03 +-1.1198032371976527e-03 +-1.0984270526548383e-03 +-1.0755179116195546e-03 +-1.0516649087995297e-03 +-1.0274050321178304e-03 +-1.0032022298077188e-03 +-9.7943821201521442e-04 +-9.5641234223180877e-04 +-9.3434765404547487e-04 +-9.1340033971455475e-04 +-8.9367065632254313e-04 +-8.7521383998739627e-04 +-8.5805017636882250e-04 +-8.4217379791683145e-04 +-8.2756006609763970e-04 +-8.1417157403423479e-04 +-8.0196290111952799e-04 +-7.9088429290872565e-04 +-7.8088444780748069e-04 +-7.7191258152184167e-04 +-7.6391992064578785e-04 +-7.5686075410622542e-04 +-7.5069314885141945e-04 +-7.4537941587385359e-04 +-7.4088639510026355e-04 +-7.3718561296587501e-04 +-7.3425335442048290e-04 +-7.3207068134015696e-04 +-7.3062342146048057e-04 +-7.2990214559425567e-04 +-9.6691768088049172e-04 +-9.6882000511912497e-04 +-9.7257629259399835e-04 +-9.7808945227611708e-04 +-9.8521300726035028e-04 +-9.9375031922230295e-04 +-1.0034539584689221e-03 +-1.0140256182963230e-03 +-1.0251171689878418e-03 +-1.0363337191086179e-03 +-1.0472398594559428e-03 +-1.0573704760709131e-03 +-1.0662474045942025e-03 +-1.0734025065193269e-03 +-1.0784063632072916e-03 +-1.0808999106074139e-03 +-1.0806245648204171e-03 +-1.0774455074860053e-03 +-1.0713634093421343e-03 +-1.0625119908048996e-03 +-1.0511417980028190e-03 +-1.0375933835085715e-03 +-1.0222648238814333e-03 +-1.0055787999783247e-03 +-9.8795351416621955e-04 +-9.6978008633975636e-04 +-9.5140736794673063e-04 +-9.3313376632893916e-04 +-9.1520485275022891e-04 +-8.9781520557549374e-04 +-8.8111297846298368e-04 +-8.6520592485668393e-04 +-8.5016792614767752e-04 +-8.3604537842093759e-04 +-8.2286304958711161e-04 +-8.1062921178394226e-04 +-7.9933998676752960e-04 +-7.8898292556737483e-04 +-7.7953989059893693e-04 +-7.7098933012816507e-04 +-7.6330804053117984e-04 +-7.5647250782031770e-04 +-7.5045991094798673e-04 +-7.4524885836992690e-04 +-7.4081991800956657e-04 +-7.3715599008165075e-04 +-7.3424256266980178e-04 +-7.3206788164582198e-04 +-7.3062305943737474e-04 +-7.2990214112890397e-04 +-8.7486248803244726e-04 +-8.7658406502226732e-04 +-8.7999004890729833e-04 +-8.8500583916709412e-04 +-8.9151895536143818e-04 +-8.9937854008763634e-04 +-9.0839502748905009e-04 +-9.1834026845599660e-04 +-9.2894849586996041e-04 +-9.3991862274995575e-04 +-9.5091847953522081e-04 +-9.6159167003490259e-04 +-9.7156767861947615e-04 +-9.8047559445624700e-04 +-9.8796126123487107e-04 +-9.9370683915806423e-04 +-9.9745085314574436e-04 +-9.9900609906711495e-04 +-9.9827261037919741e-04 +-9.9524343329712500e-04 +-9.9000214313418660e-04 +-9.8271252698559747e-04 +-9.7360221097488801e-04 +-9.6294285215595479e-04 +-9.5102968898112990e-04 +-9.3816282954645982e-04 +-9.2463188771829555e-04 +-9.1070472193886169e-04 +-8.9662029731507847e-04 +-8.8258518504960614e-04 +-8.6877294891379321e-04 +-8.5532560246973435e-04 +-8.4235638671738722e-04 +-8.2995325225738233e-04 +-8.1818258482707303e-04 +-8.0709285814355332e-04 +-7.9671801853846891e-04 +-7.8708049759007158e-04 +-7.7819381364427993e-04 +-7.7006476537382160e-04 +-7.6269524566234450e-04 +-7.5608371702370750e-04 +-7.5022639449557607e-04 +-7.4511818153031358e-04 +-7.4075340102325868e-04 +-7.3712635873623912e-04 +-7.3423177093551574e-04 +-7.3206508261887166e-04 +-7.3062269756166934e-04 +-7.2990213666590271e-04 +-8.0313966168584514e-04 +-8.0472039548868800e-04 +-8.0785278484473864e-04 +-8.1247848535985316e-04 +-8.1850956484096624e-04 +-8.2582815471347111e-04 +-8.3428623191218027e-04 +-8.4370573753953144e-04 +-8.5387928689342231e-04 +-8.6457177292095604e-04 +-8.7552320631742746e-04 +-8.8645315501949663e-04 +-8.9706711563063797e-04 +-9.0706503199169150e-04 +-9.1615193875703980e-04 +-9.2405034505556891e-04 +-9.3051353039691194e-04 +-9.3533850527618772e-04 +-9.3837713146022314e-04 +-9.3954392503500773e-04 +-9.3881942740294834e-04 +-9.3624866474131883e-04 +-9.3193496852842276e-04 +-9.2603010448916786e-04 +-9.1872209573157682e-04 +-9.1022225571438643e-04 +-9.0075279227859548e-04 +-8.9053599804261928e-04 +-8.7978562122791840e-04 +-8.6870061467630966e-04 +-8.5746115229349933e-04 +-8.4622660441602813e-04 +-8.3513506948577096e-04 +-8.2430404529103209e-04 +-8.1383186067121821e-04 +-8.0379955280837948e-04 +-7.9427294732508941e-04 +-7.8530476653717197e-04 +-7.7693664924304289e-04 +-7.6920101127607259e-04 +-7.6212271005474152e-04 +-7.5572050013746257e-04 +-7.5000828235589076e-04 +-7.4499615845956225e-04 +-7.4069130809154785e-04 +-7.3709870671799364e-04 +-7.3422170291275205e-04 +-7.3206247190694322e-04 +-7.3062236008848312e-04 +-7.2990213250433112e-04 +-7.5076485895520211e-04 +-7.5224267774788686e-04 +-7.5517473285927061e-04 +-7.5951371850489454e-04 +-7.6518836403967805e-04 +-7.7210317055643996e-04 +-7.8013824067638463e-04 +-7.8914934932598204e-04 +-7.9896843190901089e-04 +-8.0940468960889538e-04 +-8.2024652684291484e-04 +-8.3126453724672005e-04 +-8.4221573184122304e-04 +-8.5284914241596783e-04 +-8.6291282097295376e-04 +-8.7216208612532367e-04 +-8.8036864997602013e-04 +-8.8733002731200615e-04 +-8.9287843674089632e-04 +-8.9688831188878106e-04 +-8.9928159690543300e-04 +-9.0003021575194074e-04 +-8.9915544522010992e-04 +-8.9672431598972321e-04 +-8.9284352829122342e-04 +-8.8765162607211076e-04 +-8.8131028684111819e-04 +-8.7399555434385155e-04 +-8.6588970058414311e-04 +-8.5717420115495027e-04 +-8.4802409185189107e-04 +-8.3860378215813789e-04 +-8.2906425357693095e-04 +-8.1954147436064193e-04 +-8.1015581275987883e-04 +-8.0101221857685923e-04 +-7.9220095594327643e-04 +-7.8379869819409612e-04 +-7.7586983005638321e-04 +-7.6846783726057489e-04 +-7.6163669553944440e-04 +-7.5541219802161398e-04 +-7.4982318169464972e-04 +-7.4489263011177779e-04 +-7.4063864145695359e-04 +-7.3707525923184640e-04 +-7.3421316796889828e-04 +-7.3206025920771983e-04 +-7.3062207410792314e-04 +-7.2990212897805972e-04 +-7.1661648041507469e-04 +-7.1802709105217501e-04 +-7.2082810554495967e-04 +-7.2497899792040531e-04 +-7.3041872922102009e-04 +-7.3706553317829954e-04 +-7.4481676965805022e-04 +-7.5354895817604170e-04 +-7.6311812323977941e-04 +-7.7336059697315088e-04 +-7.8409443073004944e-04 +-7.9512156355936593e-04 +-8.0623087746656524e-04 +-8.1720223217085107e-04 +-8.2781150996520149e-04 +-8.3783661084913322e-04 +-8.4706422110991295e-04 +-8.5529704526447975e-04 +-8.6236106185343553e-04 +-8.6811226569457342e-04 +-8.7244232173775771e-04 +-8.7528259961503743e-04 +-8.7660618798437756e-04 +-8.7642768799508141e-04 +-8.7480082192085116e-04 +-8.7181412328676572e-04 +-8.6758515818436137e-04 +-8.6225383619694133e-04 +-8.5597539394157048e-04 +-8.4891358299950986e-04 +-8.4123448796496005e-04 +-8.3310126595107902e-04 +-8.2466996125383888e-04 +-8.1608642715054914e-04 +-8.0748429232311669e-04 +-7.9898384602241094e-04 +-7.9069168202424963e-04 +-7.8270093142820800e-04 +-7.7509192178023515e-04 +-7.6793311834372582e-04 +-7.6128222708896195e-04 +-7.5518736399097228e-04 +-7.4968821877302832e-04 +-7.4481716173918644e-04 +-7.4060025913270477e-04 +-7.3705817547008135e-04 +-7.3420695083992302e-04 +-7.3205864770395054e-04 +-7.3062186585624010e-04 +-7.2990212641044173e-04 +-6.9978951001372811e-04 +-7.0116682283485128e-04 +-7.0390284047308909e-04 +-7.0796024834979742e-04 +-7.1328285483628442e-04 +-7.1979540110118489e-04 +-7.2740342686835311e-04 +-7.3599328773504835e-04 +-7.4543243536924334e-04 +-7.5557008203785893e-04 +-7.6623837423779064e-04 +-7.7725419514460437e-04 +-7.8842170016341171e-04 +-7.9953566160425986e-04 +-8.1038565477216081e-04 +-8.2076105653631462e-04 +-8.3045674867159491e-04 +-8.3927932560753796e-04 +-8.4705350855905019e-04 +-8.5362837988652018e-04 +-8.5888299157488301e-04 +-8.6273088880046360e-04 +-8.6512313722945510e-04 +-8.6604955374083425e-04 +-8.6553800351988047e-04 +-8.6365181774057903e-04 +-8.6048557338549178e-04 +-8.5615962844229668e-04 +-8.5081389830357190e-04 +-8.4460138269628888e-04 +-8.3768191131519416e-04 +-8.3021648634377108e-04 +-8.2236248292914067e-04 +-8.1426984628077848e-04 +-8.0607831395860835e-04 +-7.9791560517234047e-04 +-7.8989645994013134e-04 +-7.8212237879151487e-04 +-7.7468190393464907e-04 +-7.6765128948117726e-04 +-7.6109542538713301e-04 +-7.5506890202678076e-04 +-7.4961712582227800e-04 +-7.4477741846241724e-04 +-7.4058005144687336e-04 +-7.3704918333600755e-04 +-7.3420367911665441e-04 +-7.3205779980540381e-04 +-7.3062175629691624e-04 +-7.2990212505971925e-04 +-6.9978946091583320e-04 +-7.0116638039256546e-04 +-7.0390160862394491e-04 +-7.0795782690534080e-04 +-7.1327884067958890e-04 +-7.1978939322704780e-04 +-7.2739503634975441e-04 +-7.3598215338199996e-04 +-7.4541824529749821e-04 +-7.5555260054290451e-04 +-7.6621747228839798e-04 +-7.7722988157153435e-04 +-7.8839414942991277e-04 +-7.9950523320842343e-04 +-8.1035289919233438e-04 +-8.2072670348056214e-04 +-8.3042167534661438e-04 +-8.3924450561891214e-04 +-8.4701994541694012e-04 +-8.5359703220152768e-04 +-8.5885469911039971e-04 +-8.6270630900161106e-04 +-8.6510270046282487e-04 +-8.6603344251950519e-04 +-8.6552615712810830e-04 +-8.6364395978677825e-04 +-8.6048125671485398e-04 +-8.5615829006713338e-04 +-8.5081491671313192e-04 +-8.4460413088555857e-04 +-8.3768580068863379e-04 +-8.3022099879570945e-04 +-8.2236719043120537e-04 +-8.1427441891644681e-04 +-8.0608251839955479e-04 +-7.9791929609518571e-04 +-7.8989956693242141e-04 +-7.8212489103092052e-04 +-7.7468385448542726e-04 +-7.6765274055318427e-04 +-7.6109645542738358e-04 +-7.5506959510989943e-04 +-7.4961756349448258e-04 +-7.4477767397436749e-04 +-7.4058018617243577e-04 +-7.3704924509974696e-04 +-7.3420370212449006e-04 +-7.3205780587358091e-04 +-7.3062175709019683e-04 +-7.2990212506956543e-04 +-7.1661632544735721e-04 +-7.1802569457565606e-04 +-7.2082421753856530e-04 +-7.2497135570213618e-04 +-7.3040606197399935e-04 +-7.3704657925717640e-04 +-7.4479031023614889e-04 +-7.5351386966811533e-04 +-7.6307344899579634e-04 +-7.7330563585028297e-04 +-7.8402883639238166e-04 +-7.9504544413327549e-04 +-8.0614488128197118e-04 +-8.1710760285318097e-04 +-8.2771009431379706e-04 +-8.3773080666305912e-04 +-8.4695685959071908e-04 +-8.5519121296680884e-04 +-8.6225987841656538e-04 +-8.6801864313631495e-04 +-8.7235873636366985e-04 +-8.7521090695568749e-04 +-8.7654750452299530e-04 +-8.7638235231304006e-04 +-8.7476843493382306e-04 +-8.7179365541949314e-04 +-8.6757510299534520e-04 +-8.6225238630965645e-04 +-8.5598061607531392e-04 +-8.4892357333083660e-04 +-8.4124749540368730e-04 +-8.3311577760647449e-04 +-8.2468475018667527e-04 +-8.1610056676466747e-04 +-8.0749714425208381e-04 +-7.9899502928618322e-04 +-7.9070103094505803e-04 +-7.8270844874182583e-04 +-7.7509773195624592e-04 +-7.6793742464245120e-04 +-7.6128527453402269e-04 +-7.5518940933103074e-04 +-7.4968950767776365e-04 +-7.4481791290872186e-04 +-7.4060065465577350e-04 +-7.3705835659279996e-04 +-7.3420701825263482e-04 +-7.3205866547242896e-04 +-7.3062186817808290e-04 +-7.2990212643921646e-04 +-7.5076457381712718e-04 +-7.5224010826693485e-04 +-7.5516757928224647e-04 +-7.5949965914873523e-04 +-7.6516506643452091e-04 +-7.7206832855425324e-04 +-7.8008964458047914e-04 +-7.8908499352584808e-04 +-7.9888666010187524e-04 +-8.0930437121201604e-04 +-8.2012724995868475e-04 +-8.3112679465311464e-04 +-8.4206106894942859e-04 +-8.5268023260670883e-04 +-8.6273343678521951e-04 +-8.7197694594549273e-04 +-8.8018313858744966e-04 +-8.8714981173876903e-04 +-8.9270902092768081e-04 +-8.9673458890974264e-04 +-8.9914746098304968e-04 +-8.9991828693065750e-04 +-8.9906693939169596e-04 +-8.9665906738512911e-04 +-8.9280014690550525e-04 +-8.8762775414995537e-04 +-8.8130290945829311e-04 +-8.7400131940169965e-04 +-8.6590521110488491e-04 +-8.5719625443811506e-04 +-8.4804985264396251e-04 +-8.3863088807401183e-04 +-8.2909085922533193e-04 +-8.1956624558252348e-04 +-8.1017788441062626e-04 +-8.0103112906847478e-04 +-7.9221657011147224e-04 +-7.8381112768653412e-04 +-7.7587935790187452e-04 +-7.6847485093583905e-04 +-7.6164163089474841e-04 +-7.5541549492821555e-04 +-7.4982525122138622e-04 +-7.4489383236464026e-04 +-7.4063927284365909e-04 +-7.3707554776077252e-04 +-7.3421327518372102e-04 +-7.3206028743358191e-04 +-7.3062207779338805e-04 +-7.2990212902373911e-04 +-8.0313920160990815e-04 +-8.0471624961492728e-04 +-8.0784124314693684e-04 +-8.1245580587501669e-04 +-8.1847199874591689e-04 +-8.2577201943694891e-04 +-8.3420804482913055e-04 +-8.4360241724199220e-04 +-8.5374841961399317e-04 +-8.6441192808662734e-04 +-8.7533426849539960e-04 +-8.8623662265023312e-04 +-8.9682630479121016e-04 +-9.0680512180766649e-04 +-9.1587980875675826e-04 +-9.2377418493422747e-04 +-9.3024224500967169e-04 +-9.3508098236963282e-04 +-9.3814147395590716e-04 +-9.3933676257983785e-04 +-9.3864540861192218e-04 +-9.3611019566829275e-04 +-9.3183221496959806e-04 +-9.2596122905995329e-04 +-9.1868366644361709e-04 +-9.1020974677490432e-04 +-9.0076109972496085e-04 +-8.9055990784490046e-04 +-8.7982018904884365e-04 +-8.6874143851028052e-04 +-8.5750453755465176e-04 +-8.4626963376779342e-04 +-8.3517559667005328e-04 +-8.2434063440643408e-04 +-8.1386369119842007e-04 +-8.0382630759726168e-04 +-7.9429469688037846e-04 +-7.8532185905365131e-04 +-7.7694961240865371e-04 +-7.6921046909022629e-04 +-7.6212931583823692e-04 +-7.5572488547816100e-04 +-7.5001102083194866e-04 +-7.4499774248764359e-04 +-7.4069213704590071e-04 +-7.3709908445872372e-04 +-7.3422184296862661e-04 +-7.3206250871884972e-04 +-7.3062236488986583e-04 +-7.2990213256378779e-04 +-8.7486178154092562e-04 +-8.7657769870212168e-04 +-8.7997232710565357e-04 +-8.8497102466584903e-04 +-8.9146132325199534e-04 +-8.9929251858741237e-04 +-9.0827544714333142e-04 +-9.1818272915766559e-04 +-9.2874984102884377e-04 +-9.3967748167303412e-04 +-9.5063580600828195e-04 +-9.6127117503670885e-04 +-9.7121603961488885e-04 +-9.8010233486306810e-04 +-9.8757823843101562e-04 +-9.9332735397272571e-04 +-9.9708848114662876e-04 +-9.9867341779901961e-04 +-9.9798003131280097e-04 +-9.9499832899570110e-04 +-9.8980839423433420e-04 +-9.8257052186163452e-04 +-9.7350924209563998e-04 +-9.6289379082594914e-04 +-9.5101779530666652e-04 +-9.3818056436611953e-04 +-9.2467162616104018e-04 +-9.1075930997975554e-04 +-8.9668343154769212e-04 +-8.8265162516023914e-04 +-8.6883859005464645e-04 +-8.5538744217337711e-04 +-8.4241242098843266e-04 +-8.3000233103793007e-04 +-8.1822425064527699e-04 +-8.0712718512294913e-04 +-7.9674546304193202e-04 +-7.8710176701737801e-04 +-7.7820975636300107e-04 +-7.7007628231461826e-04 +-7.6270322254717285e-04 +-7.5608897530253386e-04 +-7.5022965864987080e-04 +-7.4512006030138394e-04 +-7.4075438021886230e-04 +-7.3712680347094879e-04 +-7.3423193540640068e-04 +-7.3206512576569393e-04 +-7.3062270318224171e-04 +-7.2990213673547585e-04 +-9.6691662204612941e-04 +-9.6881046392488881e-04 +-9.7254973577065064e-04 +-9.7803729931219109e-04 +-9.8512674201564903e-04 +-9.9362175800203276e-04 +-1.0032757101475259e-03 +-1.0137917459066617e-03 +-1.0248240191780861e-03 +-1.0359808274721983e-03 +-1.0468307760562552e-03 +-1.0569133066795024e-03 +-1.0657548557615264e-03 +-1.0728912790486402e-03 +-1.0778958627767094e-03 +-1.0804104107739135e-03 +-1.0801751143763520e-03 +-1.0770519619851641e-03 +-1.0710369478277438e-03 +-1.0622583575458642e-03 +-1.0509613303111096e-03 +-1.0374817136059647e-03 +-1.0222140271844815e-03 +-1.0055787255122165e-03 +-9.8799306509398050e-04 +-9.6984829116850092e-04 +-9.5149416478429861e-04 +-9.3323049127764233e-04 +-9.1530446900891604e-04 +-8.9791233192946878e-04 +-8.8120377997526352e-04 +-8.6528792168177459e-04 +-8.5023976450460071e-04 +-8.3610659505050017e-04 +-8.2291384979816162e-04 +-8.1067027239656103e-04 +-7.9937228896407491e-04 +-7.8900761851521733e-04 +-7.7955818421898747e-04 +-7.7100241407174219e-04 +-7.6331702589689391e-04 +-7.5647838809311178e-04 +-7.5046353886399156e-04 +-7.4525093576396223e-04 +-7.4082099609928931e-04 +-7.3715647803142010e-04 +-7.3424274262943220e-04 +-7.3206792876017227e-04 +-7.3062306556651089e-04 +-7.2990214120471257e-04 +-1.0795741208089560e-03 +-1.0816852558033611e-03 +-1.0858445284657396e-03 +-1.0919255107386236e-03 +-1.0997375333457354e-03 +-1.1090246198931090e-03 +-1.1194643948649516e-03 +-1.1306674147445006e-03 +-1.1421777938515525e-03 +-1.1534766665374594e-03 +-1.1639908325075158e-03 +-1.1731094945410477e-03 +-1.1802116929706993e-03 +-1.1847052639583000e-03 +-1.1860748079356653e-03 +-1.1839321050134493e-03 +-1.1780593729533865e-03 +-1.1684355042265668e-03 +-1.1552386391627458e-03 +-1.1388241323248233e-03 +-1.1196829074927132e-03 +-1.0983891393568524e-03 +-1.0755470595156845e-03 +-1.0517448232518661e-03 +-1.0275200746868291e-03 +-1.0033384933801391e-03 +-9.7958410290777597e-04 +-9.5655876482597950e-04 +-9.3448791607213732e-04 +-9.1352988869743319e-04 +-8.9378673523237112e-04 +-8.7531512405419648e-04 +-8.5813642963363738e-04 +-8.4224557007376308e-04 +-8.2761843773478236e-04 +-8.1421795064805854e-04 +-8.0199885202950072e-04 +-7.9091142929080076e-04 +-7.8090433358975393e-04 +-7.7192667119997573e-04 +-7.6392951876090641e-04 +-7.5686699193230509e-04 +-7.5069697462505365e-04 +-7.4538159560079767e-04 +-7.4088752156673703e-04 +-7.3718612106724079e-04 +-7.3425354130546630e-04 +-7.3207073016896438e-04 +-7.3062342780412395e-04 +-7.2990214567266636e-04 +-1.2115495484480811e-03 +-1.2139147474224622e-03 +-1.2185646353864248e-03 +-1.2253375879055744e-03 +-1.2339895798435042e-03 +-1.2441920994896982e-03 +-1.2555292466083026e-03 +-1.2674944465768622e-03 +-1.2794882564905912e-03 +-1.2908204660570044e-03 +-1.3007217093628572e-03 +-1.3083709736447209e-03 +-1.3129440696216317e-03 +-1.3136831070231694e-03 +-1.3099789149384833e-03 +-1.3014502823094104e-03 +-1.2880003228082258e-03 +-1.2698341643484702e-03 +-1.2474326170002885e-03 +-1.2214888912629156e-03 +-1.1928243987544922e-03 +-1.1623021238459394e-03 +-1.1307525226858651e-03 +-1.0989202659077268e-03 +-1.0674335285321137e-03 +-1.0367928848034049e-03 +-1.0073746588422159e-03 +-9.7944331693782319e-04 +-9.5316834364936385e-04 +-9.2864230723455597e-04 +-9.0589803896360831e-04 +-8.8492381945833422e-04 +-8.6567613965101147e-04 +-8.4809002242177463e-04 +-8.3208711861107920e-04 +-8.1758189118173600e-04 +-8.0448622392774243e-04 +-7.9271277153572734e-04 +-7.8217732869439191e-04 +-7.7280045082038105e-04 +-7.6450851515546994e-04 +-7.5723437197478471e-04 +-7.5091770265818764e-04 +-7.4550517442649824e-04 +-7.4095046005212702e-04 +-7.3721417400700318e-04 +-7.3426376347155331e-04 +-7.3207338260827175e-04 +-7.3062377083362286e-04 +-7.2990214990424184e-04 +-1.3589563038175557e-03 +-1.3616050137567673e-03 +-1.3668034714302796e-03 +-1.3743528899241055e-03 +-1.3839524482756901e-03 +-1.3951948803726812e-03 +-1.4075590458667193e-03 +-1.4203996673835834e-03 +-1.4329370017939888e-03 +-1.4442534764663522e-03 +-1.4533089635653060e-03 +-1.4589882284098714e-03 +-1.4601892228348612e-03 +-1.4559475919102322e-03 +-1.4455748243012393e-03 +-1.4287741508438893e-03 +-1.4056989135879979e-03 +-1.3769347493894674e-03 +-1.3434117449538415e-03 +-1.3062732498799726e-03 +-1.2667356491201274e-03 +-1.2259678065115018e-03 +-1.1850060855244145e-03 +-1.1447078840340842e-03 +-1.1057378043092287e-03 +-1.0685768018881391e-03 +-1.0335446636537331e-03 +-1.0008281370717186e-03 +-9.7050952547500437e-04 +-9.4259276830644311e-04 +-9.1702564488073922e-04 +-8.9371777798284051e-04 +-8.7255469452922796e-04 +-8.5340847005665630e-04 +-8.3614556351962143e-04 +-8.2063242538265506e-04 +-8.0673939073997196e-04 +-7.9434328261414528e-04 +-7.8332906586381162e-04 +-7.7359081716471274e-04 +-7.6503221394685049e-04 +-7.5756669487545643e-04 +-7.5111740510819063e-04 +-7.4561700937453052e-04 +-7.4100743313237211e-04 +-7.3723957506583425e-04 +-7.3427302165942612e-04 +-7.3207578541589693e-04 +-7.3062408162546662e-04 +-7.2990215373867722e-04 +-1.5143507894487026e-03 +-1.5172988614831312e-03 +-1.5230810915432618e-03 +-1.5314683770515250e-03 +-1.5421124035426077e-03 +-1.5545362266590351e-03 +-1.5681166963942008e-03 +-1.5820582576838494e-03 +-1.5953637845369766e-03 +-1.6068179171068904e-03 +-1.6150080594807294e-03 +-1.6184097382240072e-03 +-1.6155480996279917e-03 +-1.6052155887245540e-03 +-1.5866910124650803e-03 +-1.5598896899608103e-03 +-1.5253925858248231e-03 +-1.4843466274073621e-03 +-1.4382737031922881e-03 +-1.3888488498754105e-03 +-1.3377029198991832e-03 +-1.2862821805732685e-03 +-1.2357722224577276e-03 +-1.1870763055713282e-03 +-1.1408311031716534e-03 +-1.0974430722985981e-03 +-1.0571325652900757e-03 +-1.0199774119452245e-03 +-9.8595156649079990e-04 +-9.5495709222786053e-04 +-9.2684935834920338e-04 +-9.0145613864704135e-04 +-8.7859161807931642e-04 +-8.5806634891866500e-04 +-8.3969409733337930e-04 +-8.2329636894184512e-04 +-8.0870524370571246e-04 +-7.9576500782872457e-04 +-7.8433295083174320e-04 +-7.7427960040855805e-04 +-7.6548859358555748e-04 +-7.5785632657788236e-04 +-7.5129148395718245e-04 +-7.4571451711395319e-04 +-7.4105711984426856e-04 +-7.3726173307960539e-04 +-7.3428109965707278e-04 +-7.3207788231767924e-04 +-7.3062435288608724e-04 +-7.2990215708590260e-04 +-1.6665414544973626e-03 +-1.6697847281261719e-03 +-1.6761530279246616e-03 +-1.6854079142175260e-03 +-1.6971833643464162e-03 +-1.7109666369235818e-03 +-1.7260607063298737e-03 +-1.7415266172972272e-03 +-1.7561174461243364e-03 +-1.7682361103423883e-03 +-1.7759673622685919e-03 +-1.7772318401435272e-03 +-1.7700719032339989e-03 +-1.7530123205889434e-03 +-1.7253810573633125e-03 +-1.6874711664812115e-03 +-1.6404858228095849e-03 +-1.5862979779284862e-03 +-1.5271192090388385e-03 +-1.4651807897258027e-03 +-1.4024955815352719e-03 +-1.3407229013524524e-03 +-1.2811239654173644e-03 +-1.2245801193201268e-03 +-1.1716454746231108e-03 +-1.1226122125069684e-03 +-1.0775749030097822e-03 +-1.0364868512600209e-03 +-9.9920595882355048e-04 +-9.6553015105530957e-04 +-9.3522364356301018e-04 +-9.0803573180855751e-04 +-8.8371376863409046e-04 +-8.6201178331449626e-04 +-8.4269592591969310e-04 +-8.2554765876789228e-04 +-8.1036539039215259e-04 +-7.9696506416300093e-04 +-7.8518007128682249e-04 +-7.7486075032975432e-04 +-7.6587365586687365e-04 +-7.5810072101626768e-04 +-7.5143839717849452e-04 +-7.4579682503056672e-04 +-7.4109907046187901e-04 +-7.3728044522232362e-04 +-7.3428792276560581e-04 +-7.3207965376113730e-04 +-7.3062458207121743e-04 +-7.2990215991446616e-04 +-1.8021151133233559e-03 +-1.8056256760684995e-03 +-1.8125426124533048e-03 +-1.8226545811253182e-03 +-1.8356302100461747e-03 +-1.8509827969675717e-03 +-1.8679992816590895e-03 +-1.8856299582291800e-03 +-1.9023610524215432e-03 +-1.9161307405348156e-03 +-1.9243798572915985e-03 +-1.9243154809965148e-03 +-1.9133841523125688e-03 +-1.8898282984137085e-03 +-1.8531173238648243e-03 +-1.8040787689664120e-03 +-1.7446926784998090e-03 +-1.6776580158988979e-03 +-1.6059037530197437e-03 +-1.5321860913418783e-03 +-1.4588364817966076e-03 +-1.3876568134684761e-03 +-1.3199224018111322e-03 +-1.2564468770690949e-03 +-1.1976721966840890e-03 +-1.1437602439530084e-03 +-1.0946738039104350e-03 +-1.0502423714620300e-03 +-1.0102126105204659e-03 +-9.7428534060334400e-04 +-9.4214160887693050e-04 +-9.1346037307889129e-04 +-8.8792997979165577e-04 +-8.6525519443649858e-04 +-8.4516113068364802e-04 +-8.2739507987823540e-04 +-8.1172696483545158e-04 +-7.9794893138708663e-04 +-7.8587443447997998e-04 +-7.7533706186297987e-04 +-7.6618925714345813e-04 +-7.5830104682155061e-04 +-7.5155883626632576e-04 +-7.4586431253955982e-04 +-7.4113347386658176e-04 +-7.3729579374711492e-04 +-7.3429352031423756e-04 +-7.3208110721896362e-04 +-7.3062477013455750e-04 +-7.2990216223601124e-04 +-1.9091956987314751e-03 +-1.9129241686458261e-03 +-1.9203124062974490e-03 +-1.9312187651596084e-03 +-1.9454085944959156e-03 +-1.9624974672616184e-03 +-1.9818351450377270e-03 +-2.0023232779120925e-03 +-2.0222017111601628e-03 +-2.0389019576981761e-03 +-2.0491165586525965e-03 +-2.0492055301505633e-03 +-2.0359144630814610e-03 +-2.0071732931939072e-03 +-1.9626392283806620e-03 +-1.9037541256535740e-03 +-1.8333350710282050e-03 +-1.7549186796409636e-03 +-1.6721177976713087e-03 +-1.5881564060090342e-03 +-1.5056260158481714e-03 +-1.4264249681929409e-03 +-1.3518136080905487e-03 +-1.2825245410166010e-03 +-1.2188862241055882e-03 +-1.1609367658489379e-03 +-1.1085181679616547e-03 +-1.0613491539890739e-03 +-1.0190786331694106e-03 +-9.8132329623929772e-04 +-9.4769298661130912e-04 +-9.1780705639951221e-04 +-8.9130429919796999e-04 +-8.6784844340678650e-04 +-8.4713066932228648e-04 +-8.2887019953481131e-04 +-8.1281369828684004e-04 +-7.9873398464683665e-04 +-7.8642839853772901e-04 +-7.7571704168991854e-04 +-7.6644103437176583e-04 +-7.5846087319693736e-04 +-7.5165493792215296e-04 +-7.4591817046541233e-04 +-7.4116093351438291e-04 +-7.3730804628874096e-04 +-7.3429798938301927e-04 +-7.3208226778676856e-04 +-7.3062492031293863e-04 +-7.2990216409044148e-04 +-1.9821994234584693e-03 +-1.9860845770127409e-03 +-1.9938352638392371e-03 +-2.0054069218090058e-03 +-2.0207035302275702e-03 +-2.0395008476079934e-03 +-2.0612864816029713e-03 +-2.0850020390603416e-03 +-2.1087281999101529e-03 +-2.1294473558554736e-03 +-2.1431034536445680e-03 +-2.1451480710281850e-03 +-2.1315343530852434e-03 +-2.0997983411095928e-03 +-2.0497289872275829e-03 +-1.9833378522654279e-03 +-1.9042273132669596e-03 +-1.8167093796158714e-03 +-1.7250185585476333e-03 +-1.6327970859302135e-03 +-1.5428663430235346e-03 +-1.4572100685221869e-03 +-1.3770775452659183e-03 +-1.3031340369161848e-03 +-1.2356134479995747e-03 +-1.1744510468530479e-03 +-1.1193888682096507e-03 +-1.0700543566376833e-03 +-1.0260162445448859e-03 +-9.8682255519487775e-04 +-9.5202529969738118e-04 +-9.2119565594642064e-04 +-8.9393256240755115e-04 +-8.6986689794631448e-04 +-8.4866280360309132e-04 +-8.3001723284638427e-04 +-8.1365847199538048e-04 +-7.9934412584364064e-04 +-7.8685889069407837e-04 +-7.7601231797823139e-04 +-7.6663669093548798e-04 +-7.5858508298269134e-04 +-7.5172963115826316e-04 +-7.4596003548553502e-04 +-7.4118228121742256e-04 +-7.3731757283756680e-04 +-7.3430146453979154e-04 +-7.3208317032826160e-04 +-7.3062503711017501e-04 +-7.2990216553325696e-04 +-2.0242438337591696e-03 +-2.0282263801255120e-03 +-2.0362167826903804e-03 +-2.0482601534403994e-03 +-2.0643928176435860e-03 +-2.0845574271787944e-03 +-2.1084200586736299e-03 +-2.1350594192684914e-03 +-2.1625552989527805e-03 +-2.1876265583642106e-03 +-2.2056144387741596e-03 +-2.2111089592102462e-03 +-2.1992080016220803e-03 +-2.1669164527620037e-03 +-2.1139893128022304e-03 +-2.0428465929293350e-03 +-1.9577383719421434e-03 +-1.8636488275712336e-03 +-1.7653685610794774e-03 +-1.6669265416994553e-03 +-1.5713686559029622e-03 +-1.4807760170856504e-03 +-1.3964086503350881e-03 +-1.3188906600003613e-03 +-1.2483884316100355e-03 +-1.1847602094815586e-03 +-1.1276715839662697e-03 +-1.0766795047462050e-03 +-1.0312905075607326e-03 +-9.9099927257386192e-04 +-9.5531290281556736e-04 +-9.2376522343781014e-04 +-8.9592433663198974e-04 +-8.7139576911886827e-04 +-8.4982285020380674e-04 +-8.3088544013241474e-04 +-8.1429775668644718e-04 +-7.9980578758759887e-04 +-7.8718459745178348e-04 +-7.7623571722847888e-04 +-7.6678472379575376e-04 +-7.5867906494864754e-04 +-7.5178615154145327e-04 +-7.4599171775284251e-04 +-7.4119843817036998e-04 +-7.3732478368055050e-04 +-7.3430409518760061e-04 +-7.3208385358902077e-04 +-7.3062512553511729e-04 +-7.2990216662623293e-04 +-2.0445770542996109e-03 +-2.0486109625000057e-03 +-2.0567293947501069e-03 +-2.0690290268866110e-03 +-2.0856277970492058e-03 +-2.1065884881654577e-03 +-2.1317446619407037e-03 +-2.1603787972662870e-03 +-2.1907429146262301e-03 +-2.2195524266883987e-03 +-2.2418107110554098e-03 +-2.2514098776994125e-03 +-2.2425945490422770e-03 +-2.2116968857054699e-03 +-2.1582220220346471e-03 +-2.0847800037824609e-03 +-1.9960927839174840e-03 +-1.8976983341582828e-03 +-1.7948773428110713e-03 +-1.6920187402656159e-03 +-1.5923919384601061e-03 +-1.4981896386800726e-03 +-1.4107046550808583e-03 +-1.3305450613674704e-03 +-1.2578350287856055e-03 +-1.1923795944248532e-03 +-1.1337893845603591e-03 +-1.0815696710476418e-03 +-1.0351809397456976e-03 +-9.9407817895988382e-04 +-9.5773500396351921e-04 +-9.2565737253950909e-04 +-8.9739039326844794e-04 +-8.7252071008238460e-04 +-8.5067617440345541e-04 +-8.3152395536794852e-04 +-8.1476784349075390e-04 +-8.0014523085927293e-04 +-7.8742406685809816e-04 +-7.7639996594500724e-04 +-7.6689356394397641e-04 +-7.5874816791250070e-04 +-7.5182771251083446e-04 +-7.4601501633517816e-04 +-7.4121032064264369e-04 +-7.3733008722661625e-04 +-7.3430603015007200e-04 +-7.3208435618668240e-04 +-7.3062519058212988e-04 +-7.2990216743098579e-04 +-2.0529832670842557e-03 +-2.0570397211142379e-03 +-2.0652076259473902e-03 +-2.0775938633371908e-03 +-2.0943391305208755e-03 +-2.1155594479940992e-03 +-2.1412029787910699e-03 +-2.1707562739037164e-03 +-2.2027443126739353e-03 +-2.2341000379180434e-03 +-2.2597793027886591e-03 +-2.2732208696260225e-03 +-2.2679118626436840e-03 +-2.2394407811855916e-03 +-2.1868872898348048e-03 +-2.1128525046485674e-03 +-2.0223614661542644e-03 +-1.9213857111131342e-03 +-1.8156214756840194e-03 +-1.7097785650631329e-03 +-1.6073357527739036e-03 +-1.5105994525164037e-03 +-1.4209071575626568e-03 +-1.3388678742565674e-03 +-1.2645823954864103e-03 +-1.1978212249884501e-03 +-1.1381573664626973e-03 +-1.0850598543469933e-03 +-1.0379564851891023e-03 +-9.9627388975995993e-04 +-9.5946168042497265e-04 +-9.2700581231388668e-04 +-8.9843488443680909e-04 +-8.7332198750274563e-04 +-8.5128387192684083e-04 +-8.3197861344294557e-04 +-8.1510253934816916e-04 +-8.0038689629499606e-04 +-7.8759455205730934e-04 +-7.7651689969994485e-04 +-7.6697105256434803e-04 +-7.5879736775028039e-04 +-7.5185730461778898e-04 +-7.4603160631225049e-04 +-7.4121878219356424e-04 +-7.3733386412479381e-04 +-7.3430740819851006e-04 +-7.3208471414395863e-04 +-7.3062523691122484e-04 +-7.2990216800501620e-04 +-2.0560405541228768e-03 +-2.0601049793404595e-03 +-2.0682821513776273e-03 +-2.0806666606725702e-03 +-2.0973866882631098e-03 +-2.1185613746695178e-03 +-2.1441904554298104e-03 +-2.1739069662338683e-03 +-2.2065024364902757e-03 +-2.2392268945333484e-03 +-2.2672008743421929e-03 +-2.2836569874429206e-03 +-2.2814960028900988e-03 +-2.2556017919876975e-03 +-2.2045575386673046e-03 +-2.1308303739836767e-03 +-2.0396161608691359e-03 +-1.9372062511673407e-03 +-1.8296269913908407e-03 +-1.7218525926883193e-03 +-1.6175396307815265e-03 +-1.5190956040437706e-03 +-1.4279029193549990e-03 +-1.3445794773536302e-03 +-1.2692145527661782e-03 +-1.2015573026917113e-03 +-1.1411560607270676e-03 +-1.0874555059280854e-03 +-1.0398611952950969e-03 +-9.9778034329098026e-04 +-9.6064607194299529e-04 +-9.2793057120237044e-04 +-8.9915107108693272e-04 +-8.7387132854150555e-04 +-8.5170045132903994e-04 +-8.3229025796636362e-04 +-8.1533194355699304e-04 +-8.0055253164307467e-04 +-7.8771140030248091e-04 +-7.7659704545058889e-04 +-7.6702416425274709e-04 +-7.5883109122342320e-04 +-7.5187758911498821e-04 +-7.4604297880349305e-04 +-7.4122458290872104e-04 +-7.3733645345515212e-04 +-7.3430835298787236e-04 +-7.3208495956776209e-04 +-7.3062526867661421e-04 +-7.2990216839961678e-04 +-2.0570060121488510e-03 +-2.0610724233129825e-03 +-2.0692452576765272e-03 +-2.0816029056704055e-03 +-2.0982520007563274e-03 +-2.1192935288049199e-03 +-2.1447349040484283e-03 +-2.1742858362338510e-03 +-2.2069322147521475e-03 +-2.2402228483312794e-03 +-2.2695281912120048e-03 +-2.2880497206954169e-03 +-2.2882916107577552e-03 +-2.2645626960509043e-03 +-2.2149886516845164e-03 +-2.1418627073492807e-03 +-2.0504649000374739e-03 +-1.9473065917923187e-03 +-1.8386553425747329e-03 +-1.7296833584153459e-03 +-1.6241827101721310e-03 +-1.5246398636028786e-03 +-1.4324744947429473e-03 +-1.3483148809826551e-03 +-1.2722452717232435e-03 +-1.2040021816015569e-03 +-1.1431184696936983e-03 +-1.0890231959277447e-03 +-1.0411075029414590e-03 +-9.9876595034438086e-04 +-9.6142087984593661e-04 +-9.2853546815178727e-04 +-8.9961949523977209e-04 +-8.7423060000065738e-04 +-8.5197288079036913e-04 +-8.3249405570549797e-04 +-8.1548195777036969e-04 +-8.0066084502997397e-04 +-7.8778781123026859e-04 +-7.7664945652542935e-04 +-7.6705889755304018e-04 +-7.5885314609953360e-04 +-7.5189085556973904e-04 +-7.4605041696099606e-04 +-7.4122837702133486e-04 +-7.3733814714469620e-04 +-7.3430897099992373e-04 +-7.3208512011079278e-04 +-7.3062528945662354e-04 +-7.2990216865897344e-04 +-2.0572330434625212e-03 +-2.0612994723456291e-03 +-2.0694662333444018e-03 +-2.0817995417942528e-03 +-2.0983884714969440e-03 +-2.1193143743274772e-03 +-2.1445744782687751e-03 +-2.1739074179133698e-03 +-2.2064146178764235e-03 +-2.2398652894602914e-03 +-2.2698605894652525e-03 +-2.2896508478239116e-03 +-2.2915024010674158e-03 +-2.2693165461139765e-03 +-2.2208689785425404e-03 +-2.1483000330802539e-03 +-2.0569258434153044e-03 +-1.9533972263569175e-03 +-1.8441417265953205e-03 +-1.7344650069591174e-03 +-1.6282514319803521e-03 +-1.5280420292206355e-03 +-1.4352830854472722e-03 +-1.3506114051025772e-03 +-1.2741093424100533e-03 +-1.2055062796373973e-03 +-1.1443258927934634e-03 +-1.0899878024636734e-03 +-1.0418743648952407e-03 +-9.9937239063061629e-04 +-9.6189760332985848e-04 +-9.2890763844379629e-04 +-8.9990769206430238e-04 +-8.7445163720322003e-04 +-8.5214048824975501e-04 +-8.3261943891873506e-04 +-8.1557425259049161e-04 +-8.0072748515532444e-04 +-7.8783482459567045e-04 +-7.7668170461793018e-04 +-7.6708026951431371e-04 +-7.5886671741242024e-04 +-7.5189901936008970e-04 +-7.4605499439472998e-04 +-7.4123071201601782e-04 +-7.3733918952669755e-04 +-7.3430935136909858e-04 +-7.3208521892347337e-04 +-7.3062530224723738e-04 +-7.2990216882014671e-04 +-2.0572420081920268e-03 +-2.0613080321527839e-03 +-2.0694703503883337e-03 +-2.0817878476338432e-03 +-2.0983385870517951e-03 +-2.1191901016047458e-03 +-2.1443278385952142e-03 +-2.1734973142660497e-03 +-2.2058591994738507e-03 +-2.2393185273928318e-03 +-2.2696392275813734e-03 +-2.2901318393443509e-03 +-2.2929350997366350e-03 +-2.2716995177677951e-03 +-2.2239745733326119e-03 +-2.1517944855070086e-03 +-2.0604885365502579e-03 +-1.9567874016998030e-03 +-1.8472133344766657e-03 +-1.7371518992779318e-03 +-1.6305431167606753e-03 +-1.5299612265169678e-03 +-1.4368690442625506e-03 +-1.3519090806239998e-03 +-1.2751631287185056e-03 +-1.2063568255595565e-03 +-1.1450088138481773e-03 +-1.0905334634249946e-03 +-1.0423082087047029e-03 +-9.9971550283883153e-04 +-9.6216733965247281e-04 +-9.2911822724145302e-04 +-9.0007077234974578e-04 +-8.7457671949661394e-04 +-8.5223533936297784e-04 +-8.3269039802790303e-04 +-8.1562648825490023e-04 +-8.0076520310731519e-04 +-7.8786143537128899e-04 +-7.7669995892173081e-04 +-7.6709236801282793e-04 +-7.5887440048862077e-04 +-7.5190364137219434e-04 +-7.4605758610464654e-04 +-7.4123203414488037e-04 +-7.3733977977684807e-04 +-7.3430956676284753e-04 +-7.3208527488078398e-04 +-7.3062530949127835e-04 +-7.2990216891337357e-04 +-2.0572136725266772e-03 +-2.0612793608395627e-03 +-2.0694391480036568e-03 +-2.0817481349088901e-03 +-2.0982785735851445e-03 +-2.1190902708843962e-03 +-2.1441607954016595e-03 +-2.1732355782268114e-03 +-2.2055019527477599e-03 +-2.2389356975517742e-03 +-2.2693930519996981e-03 +-2.2902268216712643e-03 +-2.2935157341932373e-03 +-2.2727789497139091e-03 +-2.2254434157422866e-03 +-2.1534832580615468e-03 +-2.0622313027918275e-03 +-1.9584579844388566e-03 +-1.8487340062640998e-03 +-1.7384862102314195e-03 +-1.6316835623621071e-03 +-1.5309177180141001e-03 +-1.4376602998486926e-03 +-1.3525570193082901e-03 +-1.2756896063984922e-03 +-1.2067819596836046e-03 +-1.1453502874694084e-03 +-1.0908063845008335e-03 +-1.0425252549517243e-03 +-9.9988719194865757e-04 +-9.6230233571121659e-04 +-9.2922363745247499e-04 +-9.0015241326543000e-04 +-8.7463934574838400e-04 +-8.5228283502082061e-04 +-8.3272593401418845e-04 +-8.1565265048521153e-04 +-8.0078409617083336e-04 +-7.8787476622484880e-04 +-7.7670910450466349e-04 +-7.6709843010695853e-04 +-7.5887825057475435e-04 +-7.5190595774781083e-04 +-7.4605888509133829e-04 +-7.4123269686404594e-04 +-7.3734007566355567e-04 +-7.3430967474494746e-04 +-7.3208530293532900e-04 +-7.3062531312404518e-04 +-7.2990216896276462e-04 +-2.0571951329855392e-03 +-2.0612606449261842e-03 +-2.0694192900890846e-03 +-2.0817245466400081e-03 +-2.0982461243774383e-03 +-2.1190403159607597e-03 +-2.1440807415153574e-03 +-2.1731116140521994e-03 +-2.2053301867282476e-03 +-2.2387420189572561e-03 +-2.2692446216318950e-03 +-2.2902123135883708e-03 +-2.2937011192408320e-03 +-2.2731751045217533e-03 +-2.2260081863382467e-03 +-2.1541473568082443e-03 +-2.0629254671112921e-03 +-1.9591287744562210e-03 +-1.8493479188469882e-03 +-1.7390269594025202e-03 +-1.6321470580705102e-03 +-1.5313072954689731e-03 +-1.4379831259155927e-03 +-1.3528217343546276e-03 +-1.2759049384407043e-03 +-1.2069560021813013e-03 +-1.1454901888704554e-03 +-1.0909182731251802e-03 +-1.0426142864726300e-03 +-9.9995765212495939e-04 +-9.6235776060948496e-04 +-9.2926693149196992e-04 +-9.0018595597676841e-04 +-8.7466508397276792e-04 +-8.5230236033403842e-04 +-8.3274054659658538e-04 +-8.1566341123054463e-04 +-8.0079186892375058e-04 +-7.8788025192587092e-04 +-7.7671286880709564e-04 +-7.6710092580453682e-04 +-7.5887983595222103e-04 +-7.5190691177368465e-04 +-7.4605942019710626e-04 +-7.4123296991373275e-04 +-7.3734019759251186e-04 +-7.3430971924845392e-04 +-7.3208531449936464e-04 +-7.3062531462267930e-04 +-7.2990216898680788e-04 +-2.0571887356511192e-03 +-2.0612541866369457e-03 +-2.0694124666077109e-03 +-2.0817165408378224e-03 +-2.0982352838144857e-03 +-2.1190237700777020e-03 +-2.1440541150836300e-03 +-2.1730696447429276e-03 +-2.2052699935612924e-03 +-2.2386694417538765e-03 +-2.2691785709746770e-03 +-2.2901796980238183e-03 +-2.2937236659013832e-03 +-2.2732589077072382e-03 +-2.2261433584735714e-03 +-2.1543151470545807e-03 +-2.0631062234040039e-03 +-1.9593068173873957e-03 +-1.8495130296209631e-03 +-1.7391738041926160e-03 +-1.6322738561645115e-03 +-1.5314144939855741e-03 +-1.4380723754666546e-03 +-1.3528952019679576e-03 +-1.2759648935407996e-03 +-1.2070045927314015e-03 +-1.1455293377736831e-03 +-1.0909496449305915e-03 +-1.0426392919188302e-03 +-9.9997747078717594e-04 +-9.6237337034977579e-04 +-9.2927913864734879e-04 +-9.0019542332504582e-04 +-8.7467235526654519e-04 +-8.5230788113683663e-04 +-8.3274468161996604e-04 +-8.1566645857586223e-04 +-8.0079407169008157e-04 +-7.8788180763647055e-04 +-7.7671393706146819e-04 +-7.6710163451071238e-04 +-7.5888028643748731e-04 +-7.5190718302330822e-04 +-7.4605957242493122e-04 +-7.4123304763183847e-04 +-7.3734023231340805e-04 +-7.3430973192681261e-04 +-7.3208531779554373e-04 +-7.3062531505171003e-04 +-7.2990216899957577e-04 +-2.0571877673252123e-03 +-2.0612532078937472e-03 +-2.0694114290786686e-03 +-2.0817153080737363e-03 +-2.0982335566881918e-03 +-2.1190209780324173e-03 +-2.1440492891753667e-03 +-2.1730613989034550e-03 +-2.2052569347177880e-03 +-2.2386512231023043e-03 +-2.2691569654445377e-03 +-2.2901584294894493e-03 +-2.2937067556640664e-03 +-2.2732488816771296e-03 +-2.2261406085814952e-03 +-2.1543184535751385e-03 +-2.0631136801185124e-03 +-1.9593165577953381e-03 +-1.8495235850269369e-03 +-1.7391841805837486e-03 +-1.6322834682361096e-03 +-1.5314230556229076e-03 +-1.4380797966887955e-03 +-1.3529015095188016e-03 +-1.2759701761659618e-03 +-1.2070089663281740e-03 +-1.1455329246838886e-03 +-1.0909525625593952e-03 +-1.0426416471648900e-03 +-9.9997935791321622e-04 +-9.6237487077736113e-04 +-9.2928032174452294e-04 +-9.0019634763698476e-04 +-8.7467306987760107e-04 +-8.5230842699797027e-04 +-8.3274509276088445e-04 +-8.1566676317065497e-04 +-8.0079429297173104e-04 +-7.8788196466989772e-04 +-7.7671404539090075e-04 +-7.6710170669978654e-04 +-7.5888033252026748e-04 +-7.5190721088366579e-04 +-7.4605958811985293e-04 +-7.4123305567271155e-04 +-7.3734023591709528e-04 +-7.3430973324672445e-04 +-7.3208531814047126e-04 +-7.3062531509922497e-04 +-7.2990216900941653e-04 +-2.0571877672884635e-03 +-2.0612532074347667e-03 +-2.0694114265331124e-03 +-2.0817152969013252e-03 +-2.0982335170449460e-03 +-2.1190208611556430e-03 +-2.1440489927998033e-03 +-2.1730607365248382e-03 +-2.2052556179488784e-03 +-2.2386489012165851e-03 +-2.2691533548907807e-03 +-2.2901534805755993e-03 +-2.2937007290133619e-03 +-2.2732422664300941e-03 +-2.2261339478356216e-03 +-2.1543121927202922e-03 +-2.0631080987270622e-03 +-1.9593117757050896e-03 +-1.8495196049647836e-03 +-1.7391809360259589e-03 +-1.6322808612656990e-03 +-1.5314209814748570e-03 +-1.4380781572107151e-03 +-1.3529002191219617e-03 +-1.2759691633562143e-03 +-1.2070081729618515e-03 +-1.1455323042562887e-03 +-1.0909520782438843e-03 +-1.0426412699543258e-03 +-9.9997906500728538e-04 +-9.6237464425068524e-04 +-9.2928014747916451e-04 +-9.0019621448294196e-04 +-8.7467296900048126e-04 +-8.5230835137580863e-04 +-8.3274503679747975e-04 +-8.1566672239873051e-04 +-8.0079426382464872e-04 +-7.8788194430531487e-04 +-7.7671403155353199e-04 +-7.6710169761346153e-04 +-7.5888032680185324e-04 +-7.5190720747327468e-04 +-7.4605958622318575e-04 +-7.4123305471248595e-04 +-7.3734023549133006e-04 +-7.3430973309226099e-04 +-7.3208531810053034e-04 +-7.3062531509407024e-04 +-7.2990216900934042e-04 +-2.0571887352674053e-03 +-2.0612541745803573e-03 +-2.0694123806921792e-03 +-2.0817161958568949e-03 +-2.0982342548504333e-03 +-2.1190212099820712e-03 +-2.1440484958820047e-03 +-2.1730584811979264e-03 +-2.2052498105321998e-03 +-2.2386364730548522e-03 +-2.2691303823227631e-03 +-2.2901168976767650e-03 +-2.2936502956938999e-03 +-2.2731810912271265e-03 +-2.2260672226910765e-03 +-2.1542452897613867e-03 +-2.0630452096869990e-03 +-1.9592554472542562e-03 +-1.8494709122319644e-03 +-1.7391399123933458e-03 +-1.6322469292283893e-03 +-1.5313932795918642e-03 +-1.4380557500977625e-03 +-1.3528822145607792e-03 +-1.2759547671007667e-03 +-1.2069967063638460e-03 +-1.1455232019905348e-03 +-1.0909448768058948e-03 +-1.0426355929835012e-03 +-9.9997460858123536e-04 +-9.6237116359413743e-04 +-9.2927744559862468e-04 +-9.0019413276312351e-04 +-8.7467137958268629e-04 +-8.5230715106034854e-04 +-8.3274414220412256e-04 +-8.1566606614187436e-04 +-8.0079379149448394e-04 +-7.8788161208175435e-04 +-7.7671380431265657e-04 +-7.6710154741419553e-04 +-7.5888023166417360e-04 +-7.5190715037809497e-04 +-7.4605955427955019e-04 +-7.4123303844971183e-04 +-7.3734022824364334e-04 +-7.3430973045080709e-04 +-7.3208531741396777e-04 +-7.3062531500248703e-04 +-7.2990216899895659e-04 +-2.0571951320610539e-03 +-2.0612605714961187e-03 +-2.0694187111347738e-03 +-2.0817222444200812e-03 +-2.0982395437943685e-03 +-2.1190248232939917e-03 +-2.1440486999050436e-03 +-2.1730516227734587e-03 +-2.2052277011969570e-03 +-2.2385832017120036e-03 +-2.2690233824601003e-03 +-2.2899362176781860e-03 +-2.2933908206101629e-03 +-2.2728571780938375e-03 +-2.2257065417729221e-03 +-2.1538780493088440e-03 +-2.0626959028155357e-03 +-1.9589396337224541e-03 +-1.8491958098920203e-03 +-1.7389066473738183e-03 +-1.6320529296810740e-03 +-1.5312341492871018e-03 +-1.4379265033127638e-03 +-1.3527779860513440e-03 +-1.2758711615266994e-03 +-1.2069299275759631e-03 +-1.1454700610594763e-03 +-1.0909027410890939e-03 +-1.0426023123281090e-03 +-9.9994843795935982e-04 +-9.6235069145219276e-04 +-9.2926153160234701e-04 +-9.0018185568248158e-04 +-8.7466199466143383e-04 +-8.5230005564877146e-04 +-8.3273884830411670e-04 +-8.1566217858564094e-04 +-8.0079099063694759e-04 +-7.8787964006324016e-04 +-7.7671245411915736e-04 +-7.6710065411016506e-04 +-7.5887966529951509e-04 +-7.5190681017310481e-04 +-7.4605936377644027e-04 +-7.4123294138581639e-04 +-7.3734018495656445e-04 +-7.3430971466815196e-04 +-7.3208531331575002e-04 +-7.3062531447004304e-04 +-7.2990216898491758e-04 +-2.0572136736372332e-03 +-2.0612791205820366e-03 +-2.0694370628922239e-03 +-2.0817397447710395e-03 +-2.0982547994992276e-03 +-2.1190352729109551e-03 +-2.1440495772270824e-03 +-2.1730325819139806e-03 +-2.2051644338485291e-03 +-2.2384268496530345e-03 +-2.2687030643100052e-03 +-2.2893877052035270e-03 +-2.2925954102325590e-03 +-2.2718573592964129e-03 +-2.2245875516648246e-03 +-2.1527342553089497e-03 +-2.0616045909527874e-03 +-1.9579504636297886e-03 +-1.8483323277762606e-03 +-1.7381731625449876e-03 +-1.6314419632736566e-03 +-1.5307323185888057e-03 +-1.4375184295676250e-03 +-1.3524485603619582e-03 +-1.2756066747643066e-03 +-1.2067185019794360e-03 +-1.1453016940671283e-03 +-1.0907691582561060e-03 +-1.0424967441189140e-03 +-9.9986538226455135e-04 +-9.6228569194957187e-04 +-9.2921098422986230e-04 +-9.0014284605272391e-04 +-8.7463216469432315e-04 +-8.5227749580856632e-04 +-8.3272201134357174e-04 +-8.1564981087447390e-04 +-8.0078207761612977e-04 +-7.8787336289757475e-04 +-7.7670815514207223e-04 +-7.6709780910809325e-04 +-7.5887786107483462e-04 +-7.5190572614087430e-04 +-7.4605875661404428e-04 +-7.4123263196194705e-04 +-7.3734004693838261e-04 +-7.3430966433904411e-04 +-7.3208530024755549e-04 +-7.3062531277754675e-04 +-7.2990216895848527e-04 +-2.0572420244865672e-03 +-2.0613074902511345e-03 +-2.0694649712404501e-03 +-2.0817656758207086e-03 +-2.0982755665148647e-03 +-2.1190450404690400e-03 +-2.1440373156719141e-03 +-2.1729738887873431e-03 +-2.2050020362014743e-03 +-2.2380469833605497e-03 +-2.2679424752158985e-03 +-2.2880996806313920e-03 +-2.2907381064125984e-03 +-2.2695291363006398e-03 +-2.2219847850423035e-03 +-2.1500744718974032e-03 +-2.0590662876912354e-03 +-1.9556486680232894e-03 +-1.8463218599872454e-03 +-1.7364643401468558e-03 +-1.6300177303029350e-03 +-1.5295618356252149e-03 +-1.4365661329402647e-03 +-1.3516794361608016e-03 +-1.2749889032434264e-03 +-1.2062244794972176e-03 +-1.1449081504247703e-03 +-1.0904568261676684e-03 +-1.0422498480952955e-03 +-9.9967109151016548e-04 +-9.6213360809250658e-04 +-9.2909269305341431e-04 +-9.0005154028602416e-04 +-8.7456233418989424e-04 +-8.5222467692996050e-04 +-8.3268258618368846e-04 +-8.1562084727672445e-04 +-8.0076120201378806e-04 +-7.8785865919752697e-04 +-7.7669808407593863e-04 +-7.6709114351826565e-04 +-7.5887363350699726e-04 +-7.5190318584620567e-04 +-7.4605733367541125e-04 +-7.4123190673942483e-04 +-7.3733972342988115e-04 +-7.3430954636293834e-04 +-7.3208526961401324e-04 +-7.3062530881251770e-04 +-7.2990216890500526e-04 +-2.0572331148659881e-03 +-2.0612985633626500e-03 +-2.0694550103178299e-03 +-2.0817515930447125e-03 +-2.0982508802886842e-03 +-2.1189975884814615e-03 +-2.1439432083082185e-03 +-2.1727801244246004e-03 +-2.2045895034747843e-03 +-2.2371907930600408e-03 +-2.2663326742435896e-03 +-2.2854678590892782e-03 +-2.2870186943878602e-03 +-2.2649199812015308e-03 +-2.2168653572639443e-03 +-2.1448613113555243e-03 +-2.0541002016667602e-03 +-1.9511489387527886e-03 +-1.8423925823559647e-03 +-1.7331243467267870e-03 +-1.6272333085014705e-03 +-1.5272727686800351e-03 +-1.4347031151920446e-03 +-1.3501742441713639e-03 +-1.2737795131420493e-03 +-1.2052570544962983e-03 +-1.1441372769427256e-03 +-1.0898448792284186e-03 +-1.0417660033141508e-03 +-9.9929026458474464e-04 +-9.6183546001680576e-04 +-9.2886075840929933e-04 +-8.9987249288358087e-04 +-8.7442538331366810e-04 +-8.5212107855748578e-04 +-8.3260525109923119e-04 +-8.1556402861733220e-04 +-8.0072024676421463e-04 +-7.8782981047762401e-04 +-7.7667832337234978e-04 +-7.6707806403530194e-04 +-7.5886533756351897e-04 +-7.5189820066742059e-04 +-7.4605454111583737e-04 +-7.4123048341066800e-04 +-7.3733908848642115e-04 +-7.3430931480703964e-04 +-7.3208520948767324e-04 +-7.3062530103150825e-04 +-7.2990216880516802e-04 +-2.0570062331681212e-03 +-2.0610713596048540e-03 +-2.0692252274540444e-03 +-2.0815129175963693e-03 +-2.0979900462281460e-03 +-2.1186888030061265e-03 +-2.1435344183488563e-03 +-2.1721600124952403e-03 +-2.2035288304250115e-03 +-2.2352935132761110e-03 +-2.2630911682874383e-03 +-2.2804743075145600e-03 +-2.2802117197719364e-03 +-2.2566644134406656e-03 +-2.2078109670469791e-03 +-2.1357077360580207e-03 +-2.0454154110201529e-03 +-1.9432961908673462e-03 +-1.8355419755442766e-03 +-1.7273029543884157e-03 +-1.6223799678261803e-03 +-1.5232818404245533e-03 +-1.4314538657371164e-03 +-1.3475480696997415e-03 +-1.2716686321998215e-03 +-1.2035678895020890e-03 +-1.1427908497319973e-03 +-1.0887757152175008e-03 +-1.0409204269235008e-03 +-9.9862456763307817e-04 +-9.6131418139634608e-04 +-9.2845517468598184e-04 +-8.9955934522490170e-04 +-8.7418582970311251e-04 +-8.5193984470973013e-04 +-8.3246994908948763e-04 +-8.1546461318033833e-04 +-8.0064858254824288e-04 +-7.8777932751439891e-04 +-7.7664374197857302e-04 +-7.6705517384856813e-04 +-7.5885081843406665e-04 +-7.5188947558954967e-04 +-7.4604965343490551e-04 +-7.4122799217001055e-04 +-7.3733797712857870e-04 +-7.3430890950264684e-04 +-7.3208510424453580e-04 +-7.3062528741279326e-04 +-7.2990216863380683e-04 +-2.0560411111830122e-03 +-2.0601045996545245e-03 +-2.0682509802818884e-03 +-2.0805164314827264e-03 +-2.0969409343498092e-03 +-2.1175281647112191e-03 +-2.1421472731595610e-03 +-2.1703218102490816e-03 +-2.2008311383321100e-03 +-2.2311105684343982e-03 +-2.2567017142287684e-03 +-2.2713711017079189e-03 +-2.2684189523936291e-03 +-2.2428107163314304e-03 +-2.1929080631708279e-03 +-2.1208128033044027e-03 +-2.0313751098744990e-03 +-1.9306456731191227e-03 +-1.8245249075352159e-03 +-1.7179472896560932e-03 +-1.6145805202058233e-03 +-1.5168665297597876e-03 +-1.4262284465630566e-03 +-1.3433224854850446e-03 +-1.2682703629141336e-03 +-1.2008471398840381e-03 +-1.1406211188141040e-03 +-1.0870520444035232e-03 +-1.0395566943524656e-03 +-9.9755058084003995e-04 +-9.6047294317812976e-04 +-9.2780048049440739e-04 +-8.9905375360130205e-04 +-8.7379898940606582e-04 +-8.5164713723347651e-04 +-8.3225139793874803e-04 +-8.1530401251540992e-04 +-8.0053280290115123e-04 +-7.8769776248477472e-04 +-7.7658786601701745e-04 +-7.6701818674913564e-04 +-7.5882735692758471e-04 +-7.5187537634883550e-04 +-7.4604175506001399e-04 +-7.4122396632569443e-04 +-7.3733618115481869e-04 +-7.3430825451856240e-04 +-7.3208493416777019e-04 +-7.3062526540511004e-04 +-7.2990216835934062e-04 +-2.0529844589406675e-03 +-2.0570418776748212e-03 +-2.0651658189268758e-03 +-2.0773709492544314e-03 +-2.0936607914049266e-03 +-2.1139776040904217e-03 +-2.1380848885082689e-03 +-2.1653330271881842e-03 +-2.1942634241122038e-03 +-2.2220958590424334e-03 +-2.2443722335185501e-03 +-2.2552511157203398e-03 +-2.2487627284667189e-03 +-2.2206251459672118e-03 +-2.1696382586449971e-03 +-2.0979103057126242e-03 +-2.0099793194138928e-03 +-1.9114624999588571e-03 +-1.8078594756614549e-03 +-1.7038085207648566e-03 +-1.6027945538047567e-03 +-1.5071682649946015e-03 +-1.4183238365759329e-03 +-1.3369255050689980e-03 +-1.2631218206935405e-03 +-1.1967219726197360e-03 +-1.1373291001702695e-03 +-1.0844351532908090e-03 +-1.0374850982760677e-03 +-9.9591832129379055e-04 +-9.5919387118808055e-04 +-9.2680467713293006e-04 +-8.9828449945819578e-04 +-8.7321026126580719e-04 +-8.5120157261789873e-04 +-8.3191865657579857e-04 +-8.1505946510143006e-04 +-8.0035648464553898e-04 +-7.8757353790057409e-04 +-7.7650276045130695e-04 +-7.6696184827246662e-04 +-7.5879161923675484e-04 +-7.5185389916991954e-04 +-7.4602972337516548e-04 +-7.4121783364862188e-04 +-7.3733344528396298e-04 +-7.3430725675536427e-04 +-7.3208467508300320e-04 +-7.3062523188048892e-04 +-7.2990216794309296e-04 +-2.0445792269249328e-03 +-2.0486184530456421e-03 +-2.0566829800431653e-03 +-2.0687403307210112e-03 +-2.0847187413878397e-03 +-2.1044475685585789e-03 +-2.1275259666280188e-03 +-2.1530842288439880e-03 +-2.1794288105454304e-03 +-2.2036569922741049e-03 +-2.2214932528738466e-03 +-2.2276981211326822e-03 +-2.2171901134135537e-03 +-2.1865062980080938e-03 +-2.1348641111570651e-03 +-2.0642953800860189e-03 +-1.9789100536877430e-03 +-1.8837707588244450e-03 +-1.7838718238789829e-03 +-1.6834788027697081e-03 +-1.5858468282600297e-03 +-1.4932131048296020e-03 +-1.4069383226045760e-03 +-1.3277011742960163e-03 +-1.2556892379767745e-03 +-1.1907602361413520e-03 +-1.1325666080536957e-03 +-1.0806458770990244e-03 +-1.0344829661129221e-03 +-9.9355118064583668e-04 +-9.5733778516447386e-04 +-9.2535888404885716e-04 +-8.9716713086922121e-04 +-8.7235479349419894e-04 +-8.5055393285525277e-04 +-8.3143488688486560e-04 +-8.1470384828030999e-04 +-8.0010004500769461e-04 +-7.8739284206339572e-04 +-7.7637895553167352e-04 +-7.6687988612337752e-04 +-7.5873962513237211e-04 +-7.5182265153083273e-04 +-7.4601221791709507e-04 +-7.4120891086500152e-04 +-7.3732946470192115e-04 +-7.3430580505266666e-04 +-7.3208429812703503e-04 +-7.3062518310437296e-04 +-7.2990216733895144e-04 +-2.0242471841673201e-03 +-2.0282417603304220e-03 +-2.0361772158025734e-03 +-2.0479409348672819e-03 +-2.0633393210858389e-03 +-2.0820370641965206e-03 +-2.1034305589931451e-03 +-2.1264362153500761e-03 +-2.1492112979383210e-03 +-2.1689055410399490e-03 +-2.1816436687213982e-03 +-2.1829603011169294e-03 +-2.1687248531488588e-03 +-2.1362513646757033e-03 +-2.0850757633799487e-03 +-2.0170386150117725e-03 +-1.9357103359275974e-03 +-1.8454989994289820e-03 +-1.7508113362180010e-03 +-1.6554802243994762e-03 +-1.5624943637524650e-03 +-1.4739612810288740e-03 +-1.3912074067924298e-03 +-1.3149351719907033e-03 +-1.2453859526334607e-03 +-1.1824829344347749e-03 +-1.1259447997430600e-03 +-1.0753703844780904e-03 +-1.0302985310776060e-03 +-9.9024848550995407e-04 +-9.5474587225179066e-04 +-9.2333841946842061e-04 +-8.9560465185230449e-04 +-8.7115791810800315e-04 +-8.4964743613612985e-04 +-8.3075752067330883e-04 +-8.1420578040249244e-04 +-7.9974080374358954e-04 +-7.8713966671155539e-04 +-7.7620546954045141e-04 +-7.6676502384414908e-04 +-7.5866675607281651e-04 +-7.5177885684933675e-04 +-7.4598768295816424e-04 +-7.4119640497324435e-04 +-7.3732388565539084e-04 +-7.3430377040889971e-04 +-7.3208376980577058e-04 +-7.3062511474317594e-04 +-7.2990216649340407e-04 +-1.9822037913288021e-03 +-1.9861082632244014e-03 +-1.9938140378907574e-03 +-2.0051098619011652e-03 +-2.0196572010805344e-03 +-2.0369397848458565e-03 +-2.0561630918857349e-03 +-2.0760965476110367e-03 +-2.0948853790079005e-03 +-2.1099169616548442e-03 +-2.1178817525499497e-03 +-2.1151578240280861e-03 +-2.0985135078553153e-03 +-2.0659097301465807e-03 +-2.0170592164820943e-03 +-1.9534970387169123e-03 +-1.8781709639584419e-03 +-1.7947720438537655e-03 +-1.7070704139143034e-03 +-1.6184297856361111e-03 +-1.5315496143437734e-03 +-1.4483985349744719e-03 +-1.3702710436707681e-03 +-1.2979039613894056e-03 +-1.2316081146531753e-03 +-1.1713900294312344e-03 +-1.1170527405722419e-03 +-1.0682734900602953e-03 +-1.0246604538864928e-03 +-9.8579229498084366e-04 +-9.5124453298574578e-04 +-9.2060625119132753e-04 +-8.9348997670542186e-04 +-8.6953689361926156e-04 +-8.4841897093003156e-04 +-8.2983912980830470e-04 +-8.1353023022085673e-04 +-7.9925340563656393e-04 +-7.8679609572260376e-04 +-7.7597000212441063e-04 +-7.6660910676992994e-04 +-7.5856783428733434e-04 +-7.5171940173976762e-04 +-7.4595437392054411e-04 +-7.4117942670952970e-04 +-7.3731631146869503e-04 +-7.3430100818064738e-04 +-7.3208305256664539e-04 +-7.3062502193852288e-04 +-7.2990216534651344e-04 +-1.9092005684720696e-03 +-1.9129536264689375e-03 +-1.9203141945187600e-03 +-1.9309872161556749e-03 +-1.9445143310346184e-03 +-1.9602398529449017e-03 +-1.9772460208458786e-03 +-1.9942565670671452e-03 +-2.0095317668411233e-03 +-2.0208142590494730e-03 +-2.0254135164124529e-03 +-2.0205016490164908e-03 +-2.0036082164764089e-03 +-1.9731758681600770e-03 +-1.9289617623068943e-03 +-1.8721178878827579e-03 +-1.8049328991728232e-03 +-1.7303619202122466e-03 +-1.6515225019075822e-03 +-1.5712931483869267e-03 +-1.4920709729666834e-03 +-1.4156789328503457e-03 +-1.3433804280816154e-03 +-1.2759543920771990e-03 +-1.2137938392702934e-03 +-1.1570042768621305e-03 +-1.1054898149809567e-03 +-1.0590225759980101e-03 +-1.0172954545711798e-03 +-9.7996038194946532e-04 +-9.4665492787978386e-04 +-9.1702000700115524e-04 +-8.9071106690465866e-04 +-8.6740465674158191e-04 +-8.4680182258285177e-04 +-8.2862939378206696e-04 +-8.1263992271113090e-04 +-7.9861081151572175e-04 +-7.8634299133223764e-04 +-7.7565939845995649e-04 +-7.6640340659223430e-04 +-7.5843731488879195e-04 +-7.5164095111109974e-04 +-7.4591042177880418e-04 +-7.4115702337879434e-04 +-7.3730631720371671e-04 +-7.3429736343593496e-04 +-7.3208210619042961e-04 +-7.3062489948746772e-04 +-7.2990216383405910e-04 +-1.8021198551558142e-03 +-1.8056566533520776e-03 +-1.8125634862350126e-03 +-1.8225039384933259e-03 +-1.8349633920697632e-03 +-1.8492300360045083e-03 +-1.8643611614102252e-03 +-1.8791363648232684e-03 +-1.8920130515595384e-03 +-1.9011192895253977e-03 +-1.9043335949302613e-03 +-1.8994916968079741e-03 +-1.8847135462695549e-03 +-1.8587734367797571e-03 +-1.8213867042598155e-03 +-1.7733017645326194e-03 +-1.7161649983152103e-03 +-1.6522177976637297e-03 +-1.5839349646474233e-03 +-1.5137052565756034e-03 +-1.4436109122972418e-03 +-1.3753162079224426e-03 +-1.3100449638610045e-03 +-1.2486161430508823e-03 +-1.1915089169494283e-03 +-1.1389363426637753e-03 +-1.0909150558440009e-03 +-1.0473248698866498e-03 +-1.0079564215594997e-03 +-9.7254738334935208e-04 +-9.4080885433426350e-04 +-9.1244385878190277e-04 +-8.8715979304212068e-04 +-8.6467639724014343e-04 +-8.4473051814531075e-04 +-8.2707863748567381e-04 +-8.1149789188319946e-04 +-7.9778611223948125e-04 +-7.8576125802160500e-04 +-7.7526050811058556e-04 +-7.6613918672513112e-04 +-7.5826964323876390e-04 +-7.5154016251996816e-04 +-7.4585395305698337e-04 +-7.4112824002603526e-04 +-7.3729347696633316e-04 +-7.3429268092127834e-04 +-7.3208089038156586e-04 +-7.3062474217796614e-04 +-7.2990216189177596e-04 +-1.6665455899782422e-03 +-1.6698133201519226e-03 +-1.6761843811670203e-03 +-1.6853279536447258e-03 +-1.6967419229993487e-03 +-1.7097438296068206e-03 +-1.7234569715251602e-03 +-1.7367940863155871e-03 +-1.7484477095205942e-03 +-1.7569056344439848e-03 +-1.7605168179586220e-03 +-1.7576286958389767e-03 +-1.7467942015734726e-03 +-1.7270102607546021e-03 +-1.6979188611591521e-03 +-1.6599006272088131e-03 +-1.6140260552721818e-03 +-1.5618822959289763e-03 +-1.5053333742497681e-03 +-1.4462809903749783e-03 +-1.3864752623917881e-03 +-1.3273963861485294e-03 +-1.2702041557988892e-03 +-1.2157390763064141e-03 +-1.1645555304364082e-03 +-1.1169701858914061e-03 +-1.0731137699339975e-03 +-1.0329791499880971e-03 +-9.9646234480698661e-04 +-9.6339550207065526e-04 +-9.3357224312206244e-04 +-9.0676641440070043e-04 +-8.8274547943022490e-04 +-8.6127973910181876e-04 +-8.4214841257677865e-04 +-8.2514342251796579e-04 +-8.1007154611207938e-04 +-7.9675543488745277e-04 +-7.8503387677015017e-04 +-7.7476157207961220e-04 +-7.6580861752895894e-04 +-7.5805983433073563e-04 +-7.5141403398566915e-04 +-7.4578328460474447e-04 +-7.4109221872666173e-04 +-7.3727740821874358e-04 +-7.3428682123058051e-04 +-7.3207936896873627e-04 +-7.3062454533252754e-04 +-7.2990215946195400e-04 +-1.5143541010772864e-03 +-1.5173227675601823e-03 +-1.5231146276545673e-03 +-1.5314373242251401e-03 +-1.5418488579970236e-03 +-1.5537537380663970e-03 +-1.5663989050702857e-03 +-1.5788718212979738e-03 +-1.5901060046182303e-03 +-1.5989031683947504e-03 +-1.6039840096999487e-03 +-1.6040778389378961e-03 +-1.5980512264256155e-03 +-1.5850583769057029e-03 +-1.5646785257710557e-03 +-1.5369996406050515e-03 +-1.5026199930329993e-03 +-1.4625653572084274e-03 +-1.4181461994668793e-03 +-1.3707934129895971e-03 +-1.3219090070397640e-03 +-1.2727549123809658e-03 +-1.2243872992014383e-03 +-1.1776318418097176e-03 +-1.1330893301510808e-03 +-1.0911599661806155e-03 +-1.0520765110508706e-03 +-1.0159393083960788e-03 +-9.8274895037618343e-04 +-9.5243447976955627e-04 +-9.2487645038984980e-04 +-8.9992501086362325e-04 +-8.7741359912147363e-04 +-8.5716898870085117e-04 +-8.3901842799525780e-04 +-8.2279453712452233e-04 +-8.0833852140984490e-04 +-7.9550215185489543e-04 +-7.8414886452307393e-04 +-7.7415424731844295e-04 +-7.6540611516352222e-04 +-7.5780432156937578e-04 +-7.5126041393329456e-04 +-7.4569720925520228e-04 +-7.4104834420293689e-04 +-7.3725783675252161e-04 +-7.3427968450553202e-04 +-7.3207751606027614e-04 +-7.3062430560486707e-04 +-7.2990215650334700e-04 +-1.3589587929426976e-03 +-1.3616235964620802e-03 +-1.3668338045669780e-03 +-1.3743496213134978e-03 +-1.3838092006731423e-03 +-1.3947270571713600e-03 +-1.4064937549349537e-03 +-1.4183788609944301e-03 +-1.4295403243271732e-03 +-1.4390448821678368e-03 +-1.4459050679570989e-03 +-1.4491374869752311e-03 +-1.4478427363165422e-03 +-1.4412994811107548e-03 +-1.4290562017180910e-03 +-1.4109987469842855e-03 +-1.3873743834938454e-03 +-1.3587639336328494e-03 +-1.3260083166630873e-03 +-1.2901076203242785e-03 +-1.2521151183377574e-03 +-1.2130452246165884e-03 +-1.1738065004128562e-03 +-1.1351625289880093e-03 +-1.0977174218611324e-03 +-1.0619197068989991e-03 +-1.0280778373219111e-03 +-9.9638153830993912e-04 +-9.6692476042691835e-04 +-9.3972754536560815e-04 +-9.1475534966697838e-04 +-8.9193524688261033e-04 +-8.7116897804791248e-04 +-8.5234312303114005e-04 +-8.3533680068076626e-04 +-8.2002733804444419e-04 +-8.0629432436702558e-04 +-7.9402241426863353e-04 +-7.8310318466644669e-04 +-7.7343629167175062e-04 +-7.6493012169687039e-04 +-7.5750208709528580e-04 +-7.5107868088594601e-04 +-7.4559537670371775e-04 +-7.4099643797554185e-04 +-7.3723468329613237e-04 +-7.3427124201648746e-04 +-7.3207532424326960e-04 +-7.3062402204062109e-04 +-7.2990215300419779e-04 +-1.2115513365598192e-03 +-1.2139284549402658e-03 +-1.2185894169732395e-03 +-1.2253469605853098e-03 +-1.2339187587133323e-03 +-1.2439266732385084e-03 +-1.2548974034282720e-03 +-1.2662660075808388e-03 +-1.2773842610305512e-03 +-1.2875362974524036e-03 +-1.2959642001484780e-03 +-1.3019056612365641e-03 +-1.3046439231757143e-03 +-1.3035667394775618e-03 +-1.2982267372231133e-03 +-1.2883920940760620e-03 +-1.2740759723703374e-03 +-1.2555367934841887e-03 +-1.2332482702626288e-03 +-1.2078454799923377e-03 +-1.1800582568997377e-03 +-1.1506442781170131e-03 +-1.1203317966127519e-03 +-1.0897776997334169e-03 +-1.0595422621611931e-03 +-1.0300787994653334e-03 +-1.0017347704150761e-03 +-9.7476049382941331e-04 +-9.4932207276256437e-04 +-9.2551590841932405e-04 +-9.0338302534493547e-04 +-8.8292214992461251e-04 +-8.6410102605572543e-04 +-8.4686581848465617e-04 +-8.3114867761088817e-04 +-8.1687365826055584e-04 +-8.0396123382295227e-04 +-7.9233165330783422e-04 +-7.8190737148395295e-04 +-7.7261475388534057e-04 +-7.6438522680085741e-04 +-7.5715601170730422e-04 +-7.5087055609571391e-04 +-7.4547874907621853e-04 +-7.4093699058054476e-04 +-7.3720816707061705e-04 +-7.3426157390692865e-04 +-7.3207281437861972e-04 +-7.3062369734420486e-04 +-7.2990214899792830e-04 +-1.0795753655753768e-03 +-1.0816949989148783e-03 +-1.0858634568687610e-03 +-1.0919386114816342e-03 +-1.0997062636086642e-03 +-1.1088796815170029e-03 +-1.1191002150173380e-03 +-1.1299400102409863e-03 +-1.1409080667560789e-03 +-1.1514610312782830e-03 +-1.1610201099907722e-03 +-1.1689951269111783e-03 +-1.1748158461497335e-03 +-1.1779690985985059e-03 +-1.1780381930598252e-03 +-1.1747391518190072e-03 +-1.1679473819502801e-03 +-1.1577092214834289e-03 +-1.1442354739418089e-03 +-1.1278777978400588e-03 +-1.1090923454332945e-03 +-1.0883971689159822e-03 +-1.0663301330004935e-03 +-1.0434126825734356e-03 +-1.0201225907405932e-03 +-9.9687657467097254e-04 +-9.7402196183176901e-04 +-9.5183561165404474e-04 +-9.3052797362844241e-04 +-9.1025029113714101e-04 +-8.9110332693918457e-04 +-8.7314642524026021e-04 +-8.5640613464690407e-04 +-8.4088394828226972e-04 +-8.2656296057705971e-04 +-8.1341340319579438e-04 +-8.0139712164611302e-04 +-7.9047110680826671e-04 +-7.8059021706210490e-04 +-7.7170922862961218e-04 +-7.6378434260532865e-04 +-7.5677426256850241e-04 +-7.5064094022107592e-04 +-7.4535007026164479e-04 +-7.4087140079102411e-04 +-7.3717891242175784e-04 +-7.3425090803503213e-04 +-7.3207004567441610e-04 +-7.3062333918088652e-04 +-7.2990214457910546e-04 +-9.6691746949145263e-04 +-9.6881720331093641e-04 +-9.7256350943264751e-04 +-9.7804969875560995e-04 +-9.8511500906767343e-04 +-9.9354424708913308e-04 +-1.0030681524986643e-03 +-1.0133651638229815e-03 +-1.0240653758206352e-03 +-1.0347575274912237e-03 +-1.0449998061722978e-03 +-1.0543350312722964e-03 +-1.0623103159849705e-03 +-1.0685005520348343e-03 +-1.0725340717416150e-03 +-1.0741178162730854e-03 +-1.0730586244723998e-03 +-1.0692772252854270e-03 +-1.0628123746536742e-03 +-1.0538142063392490e-03 +-1.0425278196574137e-03 +-1.0292698133774576e-03 +-1.0144014192876344e-03 +-9.9830192203180295e-04 +-9.8134532864558081e-04 +-9.6388212184882042e-04 +-9.4622676590334443e-04 +-9.2865069616084701e-04 +-9.1137992761744513e-04 +-8.9459615445643223e-04 +-8.7844020256926483e-04 +-8.6301684193113633e-04 +-8.4840017959881392e-04 +-8.3463907673409876e-04 +-8.2176222995500303e-04 +-8.0978271391976401e-04 +-7.9870189657231809e-04 +-7.8851271590443448e-04 +-7.7920235500868759e-04 +-7.7075437837277518e-04 +-7.6315040353713988e-04 +-7.5637138372369186e-04 +-7.5039857275482663e-04 +-7.4521423623566038e-04 +-7.4080216435598633e-04 +-7.3714803287990298e-04 +-7.3423965055746871e-04 +-7.3206712360849170e-04 +-7.3062296120003048e-04 +-7.2990213991613623e-04 +-8.7486234765564105e-04 +-8.7658224978450037e-04 +-8.7998193765324720e-04 +-8.8498091479739772e-04 +-8.9145790074739628e-04 +-8.9925052908396380e-04 +-9.0815549824400650e-04 +-9.1792961668068726e-04 +-9.2829224675577016e-04 +-9.3892967180862871e-04 +-9.4950186787383839e-04 +-9.5965202948844626e-04 +-9.6901895077031142e-04 +-9.7725198275011452e-04 +-9.8402779256467183e-04 +-9.8906761058627918e-04 +-9.9215319914570401e-04 +-9.9313957572932758e-04 +-9.9196271000353956e-04 +-9.8864102151784540e-04 +-9.8327042446204370e-04 +-9.7601366958333503e-04 +-9.6708555893308343e-04 +-9.5673606097150543e-04 +-9.4523336848172448e-04 +-9.3284859066870829e-04 +-9.1984320788912393e-04 +-9.0645981122190321e-04 +-8.9291612913049655e-04 +-8.7940197783983529e-04 +-8.6607857202016620e-04 +-8.5307957175197689e-04 +-8.4051327822772415e-04 +-8.2846548179830461e-04 +-8.1700257790553326e-04 +-8.0617467643540855e-04 +-7.9601852548676706e-04 +-7.8656014643986908e-04 +-7.7781713330673618e-04 +-7.6980060801306292e-04 +-7.6251684788081035e-04 +-7.5596861562120894e-04 +-7.5015622867568926e-04 +-7.4507840623729894e-04 +-7.4073293062927831e-04 +-7.3711715625604003e-04 +-7.3422839499646215e-04 +-7.3206420226052803e-04 +-7.3062258333452890e-04 +-7.2990213525488178e-04 +-8.0313957044169727e-04 +-8.0471922722557111e-04 +-8.0784760927289591e-04 +-8.1246266077706145e-04 +-8.1847089709992426e-04 +-8.2574714717997127e-04 +-8.3413457224233364e-04 +-8.4344524852627753e-04 +-8.5346164112090042e-04 +-8.6393930776170933e-04 +-8.7461114514140190e-04 +-8.8519341433391022e-04 +-8.9539364568282272e-04 +-9.0492032170388492e-04 +-9.1349397629474679e-04 +-9.2085905705431158e-04 +-9.2679562618574920e-04 +-9.3112979438374720e-04 +-9.3374176171856353e-04 +-9.3457052315233354e-04 +-9.3361467539151348e-04 +-9.3092926816468072e-04 +-9.2661916610120153e-04 +-9.2082981034555906e-04 +-9.1373650769321847e-04 +-9.0553340166717611e-04 +-8.9642312356526721e-04 +-8.8660784848362687e-04 +-8.7628216839642835e-04 +-8.6562790589976145e-04 +-8.5481076818549981e-04 +-8.4397859574964385e-04 +-8.3326088937333838e-04 +-8.2276928618843427e-04 +-8.1259868183377638e-04 +-8.0282874308577120e-04 +-7.9352561021160510e-04 +-7.8474364153449183e-04 +-7.7652709920928938e-04 +-7.6891171286908901e-04 +-7.6192608644325480e-04 +-7.5559293398465288e-04 +-7.4993014417108750e-04 +-7.4495168174496050e-04 +-7.4066833888400256e-04 +-7.3708835148583371e-04 +-7.3421789549418955e-04 +-7.3206147735026315e-04 +-7.3062223089832834e-04 +-7.2990213090757205e-04 +-7.5076480220740577e-04 +-7.5224193764473492e-04 +-7.5517140104715188e-04 +-7.5950343180933896e-04 +-7.6516307954719253e-04 +-7.7204998356102236e-04 +-7.8003832300716424e-04 +-7.8897713159294461e-04 +-7.9869119726606245e-04 +-8.0898277631394171e-04 +-8.1963433675657550e-04 +-8.3041250212659724e-04 +-8.4107328899755637e-04 +-8.5136861815159135e-04 +-8.6105393367269599e-04 +-8.6989659826419664e-04 +-8.7768456838876227e-04 +-8.8423472001344006e-04 +-8.8940012904877323e-04 +-8.9307563844605417e-04 +-8.9520117806403995e-04 +-8.9576253103721250e-04 +-8.9478952401392264e-04 +-8.9235190508962564e-04 +-8.8855340866217044e-04 +-8.8352465144816441e-04 +-8.7741554313511597e-04 +-8.7038783793389255e-04 +-8.6260832688798354e-04 +-8.5424300994595863e-04 +-8.4545242395349732e-04 +-8.3638816165815613e-04 +-8.2719051046505770e-04 +-8.1798707121199426e-04 +-8.0889218293732812e-04 +-8.0000697211390025e-04 +-7.9141985571868387e-04 +-7.8320734913363700e-04 +-7.7543505615292583e-04 +-7.6815874504863576e-04 +-7.6142543909375347e-04 +-7.5527447082106996e-04 +-7.4973846617122446e-04 +-7.4484423768026830e-04 +-7.4061357541410492e-04 +-7.3706393103343724e-04 +-7.3420899474915867e-04 +-7.3205916752532192e-04 +-7.3062193216518129e-04 +-7.2990212722283767e-04 +-7.1661644900516193e-04 +-7.1802664274293632e-04 +-7.2082593878107417e-04 +-7.2497203729955174e-04 +-7.3040123601713519e-04 +-7.3702823692083118e-04 +-7.4474606627067895e-04 +-7.5342624891306179e-04 +-7.6291939767880463e-04 +-7.7305638624751915e-04 +-7.8365026580708489e-04 +-7.9449905883280999e-04 +-8.0538951494343988e-04 +-8.1610184340154149e-04 +-8.2641534654265118e-04 +-8.3611477419271167e-04 +-8.4499711140384188e-04 +-8.5287841532415197e-04 +-8.5960024909111587e-04 +-8.6503523810345742e-04 +-8.6909130873223293e-04 +-8.7171426409099213e-04 +-8.7288849673949865e-04 +-8.7263581383326550e-04 +-8.7101252882314185e-04 +-8.6810512721278120e-04 +-8.6402491986262739e-04 +-8.5890214427887426e-04 +-8.5287996267561063e-04 +-8.4610874598946306e-04 +-8.3874094225845153e-04 +-8.3092672419485085e-04 +-8.2281051040526362e-04 +-8.1452836894622233e-04 +-8.0620624687273055e-04 +-7.9795892658522704e-04 +-7.8988958715925600e-04 +-7.8208984256525772e-04 +-7.7464013417691139e-04 +-7.6761036786094652e-04 +-7.6106070258402398e-04 +-7.5504241512711545e-04 +-7.4959878232119955e-04 +-7.4476593712823741e-04 +-7.4057366738966069e-04 +-7.3704613605018857e-04 +-7.3420250929535609e-04 +-7.3205748459934008e-04 +-7.3062171452060217e-04 +-7.2990212453841099e-04 +-6.9978949888036207e-04 +-7.0116658500655115e-04 +-7.0390141399821098e-04 +-7.0795519624232666e-04 +-7.1326952275194979e-04 +-7.1976618711063964e-04 +-7.2734709599068246e-04 +-7.3589438563894619e-04 +-7.4527087834045313e-04 +-7.5532101978958576e-04 +-7.6587243292746646e-04 +-7.7673820381686379e-04 +-7.8771997894204080e-04 +-7.9861190065365372e-04 +-8.0920533990299086e-04 +-8.1929430685414337e-04 +-8.2868133697236446e-04 +-8.3718357182027030e-04 +-8.4463869094051562e-04 +-8.5091031523471103e-04 +-8.5589250298135191e-04 +-8.5951300292931869e-04 +-8.6173501442696546e-04 +-8.6255732453894033e-04 +-8.6201283179578676e-04 +-8.6016560623091147e-04 +-8.5710675556743290e-04 +-8.5294945133291319e-04 +-8.4782350687627819e-04 +-8.4186989092774258e-04 +-8.3523551254186803e-04 +-8.2806853843218670e-04 +-8.2051441629532368e-04 +-8.1271269110052462e-04 +-8.0479462561128408e-04 +-7.9688157758830514e-04 +-7.8908404620644927e-04 +-7.8150127812985474e-04 +-7.7422131642350227e-04 +-7.6732137919999406e-04 +-7.6086846576226073e-04 +-7.5492010268636317e-04 +-7.4952515822673165e-04 +-7.4472466884155212e-04 +-7.4055263544936143e-04 +-7.3703675870286523e-04 +-7.3419909196417580e-04 +-7.3205659789028613e-04 +-7.3062159985272422e-04 +-7.2990212312413170e-04 +-6.9978946823184103e-04 +-7.0116630881939316e-04 +-7.0390064503705798e-04 +-7.0795368469620001e-04 +-7.1326701698169184e-04 +-7.1976243679500954e-04 +-7.2734185834750120e-04 +-7.3588743519953901e-04 +-7.4526202041317810e-04 +-7.5531010723513183e-04 +-7.6585938519375658e-04 +-7.7672302640821318e-04 +-7.8770278075501678e-04 +-7.9859290608980690e-04 +-8.0918489258180329e-04 +-8.1927286227982741e-04 +-8.2865944272798127e-04 +-8.3716183567061734e-04 +-8.4461773932411547e-04 +-8.5089074656721948e-04 +-8.5587484149246573e-04 +-8.5949765903888550e-04 +-8.6172225680109633e-04 +-8.6254726711934278e-04 +-8.6200543668569672e-04 +-8.6016070089499569e-04 +-8.5710406086924305e-04 +-8.5294861582631374e-04 +-8.4782414258224891e-04 +-8.4187160643842184e-04 +-8.3523794042779788e-04 +-8.2807135526838859e-04 +-8.2051735488833399e-04 +-8.1271554550342009e-04 +-8.0479725017203250e-04 +-7.9688388159129906e-04 +-7.8908598569836866e-04 +-7.8150284635563098e-04 +-7.7422253402348404e-04 +-7.6732228500806356e-04 +-7.6086910874794431e-04 +-7.5492053533201804e-04 +-7.4952543143631985e-04 +-7.4472482834062167e-04 +-7.4055271954954203e-04 +-7.3703679725784833e-04 +-7.3419910632643534e-04 +-7.3205660167824783e-04 +-7.3062160034792034e-04 +-7.2990212313028195e-04 +-7.1661635226917889e-04 +-7.1802577101591264e-04 +-7.2082351175829719e-04 +-7.2496726677278125e-04 +-7.3039332869959117e-04 +-7.3701640524982670e-04 +-7.4472954941037100e-04 +-7.5340434547726805e-04 +-7.6289151048330886e-04 +-7.7302207759849192e-04 +-7.8360931948677417e-04 +-7.9445154230849753e-04 +-8.0533583289249403e-04 +-8.1604277210612817e-04 +-8.2635203881376539e-04 +-8.3604872680791598e-04 +-8.4493009170464293e-04 +-8.5281235007419489e-04 +-8.5953708572707806e-04 +-8.6497679447198857e-04 +-8.6903913069832678e-04 +-8.7166951000465444e-04 +-8.7285186359662521e-04 +-8.7260751301540865e-04 +-8.7099231121300991e-04 +-8.6809235009944151e-04 +-8.6401864284528496e-04 +-8.5890123909622819e-04 +-8.5288322247253445e-04 +-8.4611498230360242e-04 +-8.3874906197583133e-04 +-8.3093578290134292e-04 +-8.2281974219420521e-04 +-8.1453719540053955e-04 +-8.0621426950162238e-04 +-7.9796590756915609e-04 +-7.8989542307845203e-04 +-7.8209453512943913e-04 +-7.7464376108582781e-04 +-7.6761305599773065e-04 +-7.6106260490143435e-04 +-7.5504369189673560e-04 +-7.4959958689850570e-04 +-7.4476640603326355e-04 +-7.4057391428831065e-04 +-7.3704624911300669e-04 +-7.3420255137660788e-04 +-7.3205749569101150e-04 +-7.3062171596997069e-04 +-7.2990212455637015e-04 +-7.5076462421479293e-04 +-7.5224033368940461e-04 +-7.5516693554668270e-04 +-7.5949465549157117e-04 +-7.6514853640531166e-04 +-7.7202823401653577e-04 +-7.8000798768485175e-04 +-7.8893695850723979e-04 +-7.9864015247013351e-04 +-8.0892015401976729e-04 +-8.1955987978981010e-04 +-8.3032651803101624e-04 +-8.4097674240259004e-04 +-8.5126317781166166e-04 +-8.6094195449696383e-04 +-8.6978102562897770e-04 +-8.7756876370454612e-04 +-8.8412222092220348e-04 +-8.8929437143014532e-04 +-8.9297967687175744e-04 +-8.9511744358303821e-04 +-8.9569265928520045e-04 +-8.9473427406326351e-04 +-8.9231117348417030e-04 +-8.8852632769191131e-04 +-8.8350974926812420e-04 +-8.7741093765586920e-04 +-8.7039143658721558e-04 +-8.6261800909823811e-04 +-8.5425677642582323e-04 +-8.4546850480424869e-04 +-8.3640508217609701e-04 +-8.2720711868311341e-04 +-8.1800253429958696e-04 +-8.0890596084333768e-04 +-8.0001877670313551e-04 +-7.9142960262119694e-04 +-7.8321510804739739e-04 +-7.7544100375694992e-04 +-7.6816312322094016e-04 +-7.6142851990797971e-04 +-7.5527652886032580e-04 +-7.4973975803880341e-04 +-7.4484498816652532e-04 +-7.4061396954668696e-04 +-7.3706411114278698e-04 +-7.3420906167621783e-04 +-7.3205918514484701e-04 +-7.3062193446577503e-04 +-7.2990212725135631e-04 +-8.0313928324706027e-04 +-8.0471663923347477e-04 +-8.0784040456154517e-04 +-8.1244850348775855e-04 +-8.1844744708885685e-04 +-8.2571210565381343e-04 +-8.3408576520956556e-04 +-8.4338075243079944e-04 +-8.5337994914609964e-04 +-8.6383952680575682e-04 +-8.7449320303059424e-04 +-8.8505824631226614e-04 +-8.9524332162875054e-04 +-9.0475807450715552e-04 +-9.1332410035946724e-04 +-9.2068666472547582e-04 +-9.2662627633389658e-04 +-9.3096903528319252e-04 +-9.3359465177596463e-04 +-9.3444120110349935e-04 +-9.3350604329350156e-04 +-9.3084282810594935e-04 +-9.2655502162689409e-04 +-9.2078681445810322e-04 +-9.1371251792462724e-04 +-9.0552559272589724e-04 +-8.9642830924144626e-04 +-8.8662277387559912e-04 +-8.7630374698128123e-04 +-8.6565338972690057e-04 +-8.5483785092732947e-04 +-8.4400545628554699e-04 +-8.3328618793083965e-04 +-8.2279212643251271e-04 +-8.1261855157581213e-04 +-8.0284544435819179e-04 +-7.9353918703329565e-04 +-7.8475431126627916e-04 +-7.7653519125598454e-04 +-7.6891761675488136e-04 +-7.6193020999459037e-04 +-7.5559567146076076e-04 +-7.4993185361909773e-04 +-7.4495267054800059e-04 +-7.4066885634487044e-04 +-7.3708858728414905e-04 +-7.3421798292171733e-04 +-7.3206150032947533e-04 +-7.3062223389550767e-04 +-7.2990213094468364e-04 +-8.7486190664024497e-04 +-8.7657827571602643e-04 +-8.7997087511553624e-04 +-8.8495918242576758e-04 +-8.9142192485470128e-04 +-8.9919683155504162e-04 +-9.0808085208415824e-04 +-9.1783127510771474e-04 +-9.2816823917987170e-04 +-9.3877914239962751e-04 +-9.4932541177286938e-04 +-9.5945196295554966e-04 +-9.6879944188739387e-04 +-9.7701897624802650e-04 +-9.8378869028108704e-04 +-9.8883071561002025e-04 +-9.9192698624745606e-04 +-9.9293189679045251e-04 +-9.9178006477544656e-04 +-9.8848801266489326e-04 +-9.8314947469662251e-04 +-9.7592502142986579e-04 +-9.6702752216893707e-04 +-9.5670543387746149e-04 +-9.4522594351537992e-04 +-9.3285966135656106e-04 +-9.1986801429308983e-04 +-9.0649388737927387e-04 +-8.9295554012305811e-04 +-8.7944345241919200e-04 +-8.6611954777255642e-04 +-8.5311817443185485e-04 +-8.4054825688348984e-04 +-8.2849611854082111e-04 +-8.1702858718195890e-04 +-8.0619610453062126e-04 +-7.9603565728919492e-04 +-7.8657342354043487e-04 +-7.7782708529046429e-04 +-7.6980779727452218e-04 +-7.6252182731930622e-04 +-7.5597189801435540e-04 +-7.5015826626954136e-04 +-7.4507957902871511e-04 +-7.4073354187573323e-04 +-7.3711743387422899e-04 +-7.3422849766465641e-04 +-7.3206422919421064e-04 +-7.3062258684307934e-04 +-7.2990213529831405e-04 +-9.6691680853196714e-04 +-9.6881124738056848e-04 +-9.7254693178027416e-04 +-9.7801714313494798e-04 +-9.8506115939999859e-04 +-9.9346399478581426e-04 +-1.0029568836596276e-03 +-1.0132191721932318e-03 +-1.0238823805427729e-03 +-1.0345372382444262e-03 +-1.0447444385361466e-03 +-1.0540496446811295e-03 +-1.0620028419992896e-03 +-1.0681814158686965e-03 +-1.0722153874799622e-03 +-1.0738122401456334e-03 +-1.0727780484252618e-03 +-1.0690315479784075e-03 +-1.0626085753238331e-03 +-1.0536558713025545e-03 +-1.0424151596178420e-03 +-1.0292001016081003e-03 +-1.0143697085501265e-03 +-9.9830187520442309e-04 +-9.8137001818821294e-04 +-9.6392469855798187e-04 +-9.4628094849972199e-04 +-9.2871107615669633e-04 +-9.1144211230740312e-04 +-8.9465678467376940e-04 +-8.7849688442575105e-04 +-8.6306802745206757e-04 +-8.4844502374311660e-04 +-8.3467729035272475e-04 +-8.2179394123617756e-04 +-8.0980834537841160e-04 +-7.9872206071046918e-04 +-7.8852813008102531e-04 +-7.7921377450330595e-04 +-7.7076254580942590e-04 +-7.6315601250287295e-04 +-7.5637505438611008e-04 +-7.5040083742080840e-04 +-7.4521553301412288e-04 +-7.4080283733543172e-04 +-7.3714833747436483e-04 +-7.3423976289424932e-04 +-7.3206715301883402e-04 +-7.3062296502604020e-04 +-7.2990213996345775e-04 +-1.0795743930654606e-03 +-1.0816862357711850e-03 +-1.0858390690338807e-03 +-1.0918907395469448e-03 +-1.0996271622202086e-03 +-1.1087620332617854e-03 +-1.1189376541908599e-03 +-1.1297278563598028e-03 +-1.1406442106401630e-03 +-1.1511468426330434e-03 +-1.1606611625502917e-03 +-1.1686014966400080e-03 +-1.1744017651791527e-03 +-1.1775518629319212e-03 +-1.1776364101740043e-03 +-1.1743706169059678e-03 +-1.1676270072937783e-03 +-1.1574474488043793e-03 +-1.1440374664766133e-03 +-1.1277434918615008e-03 +-1.1090172266085730e-03 +-1.0883735004827684e-03 +-1.0663483286611915e-03 +-1.0434625696970515e-03 +-1.0201944065317105e-03 +-9.9696163733503998e-04 +-9.7411303391649827e-04 +-9.5192701524929465e-04 +-9.3061553118287891e-04 +-9.1033116088837544e-04 +-8.9117578792681387e-04 +-8.7320965057057062e-04 +-8.5645997708990308e-04 +-8.4092875102613723e-04 +-8.2659939819880023e-04 +-8.1344235307985815e-04 +-8.0141956343191597e-04 +-7.9048804625697687e-04 +-7.8060263043672955e-04 +-7.7171802387884900e-04 +-7.6379033406942065e-04 +-7.5677815642748061e-04 +-7.5064332839633264e-04 +-7.4535143091969890e-04 +-7.4087210396884260e-04 +-7.3717922959551580e-04 +-7.3425102469484881e-04 +-7.3207007615498046e-04 +-7.3062334314079953e-04 +-7.2990214462805209e-04 +-1.2115499364712399e-03 +-1.2139158392790847e-03 +-1.2185543138115232e-03 +-1.2252780947907798e-03 +-1.2338051204922402e-03 +-1.2437580933454290e-03 +-1.2546654877770437e-03 +-1.2659654079145114e-03 +-1.2770141398264928e-03 +-1.2871017009940095e-03 +-1.2954769314119823e-03 +-1.3013842169994137e-03 +-1.3041121947370683e-03 +-1.3030514842171752e-03 +-1.2977542245050315e-03 +-1.2879846499908303e-03 +-1.2737492324338901e-03 +-1.2552982640713672e-03 +-1.2330973894876225e-03 +-1.2077749418638757e-03 +-1.1800560868488272e-03 +-1.1506960905891179e-03 +-1.1204227852279946e-03 +-1.0898941107846142e-03 +-1.0596722924324478e-03 +-1.0302129892420012e-03 +-1.0018660232186348e-03 +-9.7488386185252756e-04 +-9.4943442439023105e-04 +-9.2561556105642058e-04 +-9.0346939508033634e-04 +-8.8299544473964520e-04 +-8.6416199236564084e-04 +-8.4691554065086040e-04 +-8.3118842485160166e-04 +-8.1690477137929065e-04 +-8.0398504401708903e-04 +-7.9234942608910424e-04 +-7.8192026986722532e-04 +-7.7262381616325444e-04 +-7.6439135526491363e-04 +-7.5715996954369270e-04 +-7.5087297037137015e-04 +-7.4548011825697070e-04 +-7.4093769541700805e-04 +-7.3720848397748173e-04 +-7.3426169017291236e-04 +-7.3207284469859607e-04 +-7.3062370127825434e-04 +-7.2990214904652051e-04 +-1.3589568386471657e-03 +-1.3616059876375116e-03 +-1.3667848188849596e-03 +-1.3742535906297111e-03 +-1.3836510048900455e-03 +-1.3944931410978675e-03 +-1.4061737381415634e-03 +-1.4179676533564822e-03 +-1.4290404239887869e-03 +-1.4384682680736855e-03 +-1.4452739237448475e-03 +-1.4484830627772378e-03 +-1.4472020719649822e-03 +-1.4407104109582620e-03 +-1.4285517607858177e-03 +-1.4106024345595717e-03 +-1.3870974963175117e-03 +-1.3586054582712247e-03 +-1.3259570339478536e-03 +-1.2901455064632261e-03 +-1.2522210023843561e-03 +-1.2131979030545164e-03 +-1.1739869060172292e-03 +-1.1353549094549715e-03 +-1.0979097068041933e-03 +-1.0621033247293992e-03 +-1.0282472297929212e-03 +-9.9653356114612910e-04 +-9.6705809074901618e-04 +-9.3984215999894365e-04 +-9.1485209891368439e-04 +-8.9201552463477162e-04 +-8.7123447718084467e-04 +-8.5239566064561692e-04 +-8.3537819764954800e-04 +-8.2005933922466891e-04 +-8.0631854842507867e-04 +-7.9404032461730513e-04 +-7.8311607521896120e-04 +-7.7344528287958271e-04 +-7.6493616367586791e-04 +-7.5750596762182187e-04 +-7.5108103673752731e-04 +-7.4559670729758005e-04 +-7.4099712058367062e-04 +-7.3723498933262507e-04 +-7.3427135403857449e-04 +-7.3207535340650935e-04 +-7.3062402582025167e-04 +-7.2990215305086651e-04 +-1.5143514922995316e-03 +-1.5172992626115453e-03 +-1.5230492579068468e-03 +-1.5313092907223444e-03 +-1.5416383872571572e-03 +-1.5534437883180814e-03 +-1.5659777979318437e-03 +-1.5783365666936426e-03 +-1.5894656462501849e-03 +-1.5981810338218353e-03 +-1.6032175666738460e-03 +-1.6033152315195560e-03 +-1.5973445810358315e-03 +-1.5844553015273936e-03 +-1.5642141842850722e-03 +-1.5366917420901976e-03 +-1.5024679334264468e-03 +-1.4625531930778973e-03 +-1.4182479476682087e-03 +-1.3709788299421436e-03 +-1.3221484180207640e-03 +-1.2730224074586508e-03 +-1.2246622779700507e-03 +-1.1778992762882772e-03 +-1.1333392283633060e-03 +-1.0913864589995794e-03 +-1.0522768573620151e-03 +-1.0161129873110482e-03 +-9.8289691402223813e-04 +-9.5255858058128254e-04 +-9.2497902581324145e-04 +-9.0000859629059112e-04 +-8.7748073850225884e-04 +-8.5722211597986985e-04 +-8.3905979791433049e-04 +-8.2282618929081883e-04 +-8.0836226608833016e-04 +-7.9551956951703408e-04 +-7.8416131382602128e-04 +-7.7416287806202045e-04 +-7.6541188405318918e-04 +-7.5780800946072290e-04 +-7.5126264377545530e-04 +-7.4569846428467119e-04 +-7.4104898613709983e-04 +-7.3725812384468122e-04 +-7.3427978938580348e-04 +-7.3207754332361519e-04 +-7.3062430913472273e-04 +-7.2990215654689648e-04 +-1.6665423187586449e-03 +-1.6697838481228825e-03 +-1.6761024443428443e-03 +-1.6851676499247468e-03 +-1.6964790848571297e-03 +-1.7093586881767858e-03 +-1.7229381586260258e-03 +-1.7361434689433526e-03 +-1.7476847990621008e-03 +-1.7560696539356926e-03 +-1.7596644676972828e-03 +-1.7568267022955910e-03 +-1.7461077851061873e-03 +-1.7264907754304742e-03 +-1.6975946774818111e-03 +-1.6597741187464737e-03 +-1.6140769638093493e-03 +-1.5620753536023286e-03 +-1.5056270853128502e-03 +-1.4466350219210079e-03 +-1.3868552001638746e-03 +-1.3277758272847396e-03 +-1.2705648027956796e-03 +-1.2160696687039424e-03 +-1.1648503106995651e-03 +-1.1172273523857397e-03 +-1.0733341483686540e-03 +-1.0331651610052644e-03 +-9.9661725859336091e-04 +-9.6352293251336912e-04 +-9.3367582456825604e-04 +-9.0684960891197568e-04 +-8.8281147256211395e-04 +-8.6133139296000157e-04 +-8.4218825416029612e-04 +-8.2517365256790467e-04 +-8.1009405893889979e-04 +-7.9677184330075837e-04 +-7.8504553867155208e-04 +-7.7476961684548357e-04 +-7.6581397127565198e-04 +-7.5806324372032204e-04 +-7.5141608853760724e-04 +-7.4578443762617910e-04 +-7.4109280702763932e-04 +-7.3727767078241621e-04 +-7.3428691699121789e-04 +-7.3207939383027791e-04 +-7.3062454854871386e-04 +-7.2990215950162994e-04 +-1.8021160850461573e-03 +-1.8056226886305194e-03 +-1.8124690977404643e-03 +-1.8223195200926948e-03 +-1.8346619546951624e-03 +-1.8487909914601285e-03 +-1.8637758622337094e-03 +-1.8784144799143024e-03 +-1.8911877069082623e-03 +-1.9002480483653488e-03 +-1.9034926970030600e-03 +-1.8987631656937683e-03 +-1.8841682529654969e-03 +-1.8584559487133095e-03 +-1.8213075607214752e-03 +-1.7734394441017384e-03 +-1.7164754923750618e-03 +-1.6526471348568543e-03 +-1.5844302660799484e-03 +-1.5142219205582339e-03 +-1.4441156759558249e-03 +-1.3757871183369096e-03 +-1.3104696228445811e-03 +-1.2489893438712646e-03 +-1.1918303663313958e-03 +-1.1392087898135206e-03 +-1.0911429072274225e-03 +-1.0475132430451690e-03 +-1.0081105448817387e-03 +-9.7267224538627646e-04 +-9.4090902139169069e-04 +-9.1252339940948687e-04 +-8.8722226630610055e-04 +-8.6472487614918606e-04 +-8.4476763014570803e-04 +-8.2710661118978561e-04 +-8.1151860395291622e-04 +-7.9780113134272207e-04 +-7.8577188458468078e-04 +-7.7526780961663616e-04 +-7.6614402884521773e-04 +-7.5827271731924572e-04 +-7.5154201001267039e-04 +-7.4585498744744424e-04 +-7.4112876674025177e-04 +-7.3729371164901367e-04 +-7.3429276639756325e-04 +-7.3208091255031089e-04 +-7.3062474504380966e-04 +-7.2990216192710599e-04 +-1.9091966715646075e-03 +-1.9129185219356156e-03 +-1.9202166856733395e-03 +-1.9307970013559192e-03 +-1.9442045665848549e-03 +-1.9597919306602396e-03 +-1.9766564101588221e-03 +-1.9935443335984426e-03 +-2.0087438199869914e-03 +-2.0200243831648475e-03 +-2.0247121893557248e-03 +-2.0199773548043995e-03 +-2.0033260490006219e-03 +-1.9731620797416964e-03 +-1.9292006069550364e-03 +-1.8725608352960648e-03 +-1.8055146551080863e-03 +-1.7310162232462530e-03 +-1.6521930501413897e-03 +-1.5719385219740061e-03 +-1.4926648361148320e-03 +-1.4162075772608232e-03 +-1.3438394093204004e-03 +-1.2763453337528560e-03 +-1.2141218786415710e-03 +-1.1572762423289996e-03 +-1.1057130397108964e-03 +-1.0592041928463572e-03 +-1.0174420229780018e-03 +-9.8007772742709858e-04 +-9.4674810818153011e-04 +-9.1709334750813935e-04 +-8.9076822903287460e-04 +-8.6744871786858353e-04 +-8.4683535559179786e-04 +-8.2865454029699395e-04 +-8.1265845764576391e-04 +-7.9862419854811800e-04 +-7.8635242994321832e-04 +-7.7566586362351139e-04 +-7.6640768232752790e-04 +-7.5844002282832569e-04 +-7.5164257510002962e-04 +-7.4591132935053646e-04 +-7.4115748478314558e-04 +-7.3730652251332175e-04 +-7.3429743813351197e-04 +-7.3208212554784057e-04 +-7.3062490198850638e-04 +-7.2990216386489186e-04 +-1.9822002668727634e-03 +-1.9860765165259698e-03 +-1.9937259065515812e-03 +-2.0049382622188681e-03 +-2.0193789874064032e-03 +-2.0365410195522810e-03 +-2.0556464946880960e-03 +-2.0754894179689470e-03 +-2.0942443882593477e-03 +-2.1093250406400191e-03 +-2.1174338208155407e-03 +-2.1149374315378618e-03 +-2.0985691587487461e-03 +-2.0662420048795115e-03 +-2.0176244407481836e-03 +-1.9542240135086114e-03 +-1.8789815561655564e-03 +-1.7955973930776480e-03 +-1.7078593019095930e-03 +-1.6191500367930287e-03 +-1.5321852841407128e-03 +-1.4489455231641555e-03 +-1.3707328221078078e-03 +-1.2982881743885343e-03 +-1.2319242025237342e-03 +-1.1716477339552766e-03 +-1.1172612632572064e-03 +-1.0684410867806532e-03 +-1.0247942977118893e-03 +-9.8589849008481781e-04 +-9.5132820422951306e-04 +-9.2067166397233010e-04 +-8.9354066158954624e-04 +-8.6957576275150912e-04 +-8.4844842062557215e-04 +-8.2986112787910768e-04 +-8.1354638875025893e-04 +-7.9926504089608747e-04 +-7.8680427724598094e-04 +-7.7597559292324017e-04 +-7.6661279647571769e-04 +-7.5857016673862971e-04 +-7.5172079825727570e-04 +-7.4595515325639127e-04 +-7.4117982243369993e-04 +-7.3731648737139174e-04 +-7.3430107212575895e-04 +-7.3208306912710532e-04 +-7.3062502407726226e-04 +-7.2990216537286562e-04 +-2.0242444509866362e-03 +-2.0282171436892564e-03 +-2.0361089273586513e-03 +-2.0478082862531431e-03 +-2.0631254795728262e-03 +-2.0817341186700066e-03 +-2.1030466985879803e-03 +-2.1260033215070606e-03 +-2.1487891123249331e-03 +-2.1685770527899179e-03 +-2.1814981578649984e-03 +-2.1830673301869215e-03 +-2.1691107268518380e-03 +-2.1368908511612598e-03 +-2.0859029562850968e-03 +-2.0179693474586908e-03 +-1.9366642626333173e-03 +-1.8464135095622545e-03 +-1.7516460285957932e-03 +-1.6562147901974268e-03 +-1.5631235242978478e-03 +-1.4744894089745097e-03 +-1.3916441229225459e-03 +-1.3152922561534886e-03 +-1.2456754246603537e-03 +-1.1827160032744151e-03 +-1.1261313858817068e-03 +-1.0755189864409601e-03 +-1.0304162786881855e-03 +-9.9034128091217096e-04 +-9.5481856091770428e-04 +-9.2339496013646623e-04 +-8.9564827057275775e-04 +-8.7119124085897675e-04 +-8.4967259943772081e-04 +-8.3077626203119132e-04 +-8.1421951137097121e-04 +-7.9975066858470497e-04 +-7.8714658943363066e-04 +-7.7621019174441033e-04 +-7.6676813540675019e-04 +-7.5866872031039574e-04 +-7.5178003146129469e-04 +-7.4598833775513685e-04 +-7.4119673715306543e-04 +-7.3732403319732057e-04 +-7.3430382401035740e-04 +-7.3208378368078218e-04 +-7.3062511653452014e-04 +-7.2990216651547723e-04 +-2.0445774280936808e-03 +-2.0486022542086472e-03 +-2.0566380905571355e-03 +-2.0686534378920661e-03 +-2.0845798527328032e-03 +-2.1042543484175512e-03 +-2.1272900082353954e-03 +-2.1528378610863952e-03 +-2.1792287591865540e-03 +-2.2035791968497797e-03 +-2.2216148887281881e-03 +-2.2280710287748023e-03 +-2.2178192977849675e-03 +-2.1873468927847417e-03 +-2.1358379801808144e-03 +-2.0653162028106938e-03 +-1.9799039901986768e-03 +-1.8846865820729220e-03 +-1.7846815771135280e-03 +-1.6841731457508202e-03 +-1.5864288823409787e-03 +-1.4936929975743103e-03 +-1.4073292161708966e-03 +-1.3280167537868847e-03 +-1.2559423246298377e-03 +-1.1909621532335121e-03 +-1.1327269989164777e-03 +-1.0807727667040622e-03 +-1.0345829353634551e-03 +-9.9362957783956092e-04 +-9.5739893476988480e-04 +-9.2540627431711604e-04 +-8.9720357379712273e-04 +-8.7238255689086968e-04 +-8.5057484716487318e-04 +-8.3145043048125434e-04 +-8.1471521506837482e-04 +-8.0010819784334642e-04 +-7.8739855501200730e-04 +-7.7638284746290762e-04 +-7.6688244765426585e-04 +-7.5874124050508412e-04 +-7.5182361665456648e-04 +-7.4601275551056459e-04 +-7.4120918340254472e-04 +-7.3732958568389895e-04 +-7.3430584898463876e-04 +-7.3208430949503629e-04 +-7.3062518457169565e-04 +-7.2990216735702737e-04 +-2.0529834513447064e-03 +-2.0570328065359156e-03 +-2.0651407280772786e-03 +-2.0773226813195558e-03 +-2.0935848266477870e-03 +-2.1138755081861250e-03 +-2.1379694550010737e-03 +-2.1652341048700682e-03 +-2.1942311468775978e-03 +-2.2221955580288763e-03 +-2.2446668472995675e-03 +-2.2557758750204999e-03 +-2.2495068883244935e-03 +-2.2215335380414221e-03 +-2.1706310322319729e-03 +-2.0989076178845891e-03 +-2.0109187476818552e-03 +-1.9123053118506748e-03 +-1.8085885312970548e-03 +-1.7044224161508964e-03 +-1.6033014289942409e-03 +-1.5075808975973106e-03 +-1.4186563693045855e-03 +-1.3371915554761377e-03 +-1.2633335607774498e-03 +-1.1968898083350664e-03 +-1.1374616822406366e-03 +-1.0845395468830896e-03 +-1.0375670107114344e-03 +-9.9598233402516004e-04 +-9.5924365067695484e-04 +-9.2684315521191440e-04 +-8.9831402206088057e-04 +-8.7323270826916450e-04 +-8.5121845298924837e-04 +-8.3193118322811156e-04 +-8.1506861350460536e-04 +-8.0036303866942455e-04 +-7.8757812575843105e-04 +-7.7650588304897360e-04 +-7.6696390178137197e-04 +-7.5879291330168601e-04 +-7.5185467183173037e-04 +-7.4603015352331847e-04 +-7.4121805161086476e-04 +-7.3733354200017571e-04 +-7.3430729186417694e-04 +-7.3208468416560853e-04 +-7.3062523305262672e-04 +-7.2990216795753280e-04 +-2.0560406254758520e-03 +-2.0601002293371769e-03 +-2.0682389370979084e-03 +-2.0804935548271652e-03 +-2.0969060859751566e-03 +-2.1174848718989990e-03 +-2.1421077822986129e-03 +-2.1703118725564926e-03 +-2.2008927660352234e-03 +-2.2312974219739290e-03 +-2.2570630535748790e-03 +-2.2719292323429988e-03 +-2.2691546801089152e-03 +-2.2436679183235170e-03 +-2.1938136680311002e-03 +-2.1216987442602944e-03 +-2.0321918687374830e-03 +-1.9313655314996932e-03 +-1.8251384674932434e-03 +-1.7184575891020125e-03 +-1.6149975191547187e-03 +-1.5172030564205535e-03 +-1.4264976670566084e-03 +-1.3435365525685773e-03 +-1.2684398405284211e-03 +-1.2009808792855115e-03 +-1.1407263662448950e-03 +-1.0871346466314784e-03 +-1.0396213282136363e-03 +-9.9760097014133658e-04 +-9.6051204771178673e-04 +-9.2783065330312355e-04 +-8.9907686814049651e-04 +-8.7381654050470276e-04 +-8.5166032032778585e-04 +-8.3226117082757576e-04 +-8.1531114334007656e-04 +-8.0053790742555520e-04 +-7.8770133315660671e-04 +-7.7659029477064069e-04 +-7.6701978307685962e-04 +-7.5882836239260639e-04 +-7.5187597643117793e-04 +-7.4604208900389099e-04 +-7.4122413548402067e-04 +-7.3733625619441800e-04 +-7.3430828175241928e-04 +-7.3208494121191974e-04 +-7.3062526631407295e-04 +-7.2990216837053804e-04 +-2.0570060307495497e-03 +-2.0610695404128460e-03 +-2.0692202548583212e-03 +-2.0815037338620958e-03 +-2.0979771073396528e-03 +-2.1186760504063804e-03 +-2.1435323595073129e-03 +-2.1721894711868531e-03 +-2.2036231762579935e-03 +-2.2354947774375191e-03 +-2.2634364588804573e-03 +-2.2809771107716236e-03 +-2.2808509818694027e-03 +-2.2573902670095713e-03 +-2.2085625284007223e-03 +-2.1364309945304874e-03 +-2.0460731359696368e-03 +-1.9438692829356443e-03 +-1.8360257713895100e-03 +-1.7277020969740610e-03 +-1.6227039313892481e-03 +-1.5235418003921393e-03 +-1.4316608370818420e-03 +-1.3477119742471416e-03 +-1.2717979511087287e-03 +-1.2036696413520321e-03 +-1.1428707255514031e-03 +-1.0888382718800553e-03 +-1.0409692867348486e-03 +-9.9866259978638504e-04 +-9.6134365642706703e-04 +-9.2847789093926532e-04 +-8.9957672992281427e-04 +-8.7419901846878616e-04 +-8.5194974353362991e-04 +-8.3247728234593600e-04 +-8.1546996075187192e-04 +-8.0065240855103903e-04 +-7.8778200260901348e-04 +-7.7664556081876877e-04 +-7.6705636886798380e-04 +-7.5885157088739026e-04 +-7.5188992454110963e-04 +-7.4604990321251730e-04 +-7.4122811866682195e-04 +-7.3733803323305794e-04 +-7.3430892986142921e-04 +-7.3208510950982259e-04 +-7.3062528809216107e-04 +-7.2990216864217341e-04 +-2.0572330434667735e-03 +-2.0612979234427274e-03 +-2.0694532946457138e-03 +-2.0817486426699360e-03 +-2.0982476231479188e-03 +-2.1189974495088122e-03 +-2.1439543375367186e-03 +-2.1728181680434645e-03 +-2.2046792926160726e-03 +-2.2373633396444974e-03 +-2.2666146172025982e-03 +-2.2858671642408501e-03 +-2.2875169197692433e-03 +-2.2654776333821320e-03 +-2.2174360368254235e-03 +-2.1454051324361480e-03 +-2.0545906615817662e-03 +-1.9515733044701417e-03 +-1.8427487159999850e-03 +-1.7334167084790064e-03 +-1.6274696137751764e-03 +-1.5274617227106586e-03 +-1.4348531087149195e-03 +-1.3502927298734012e-03 +-1.2738727990909773e-03 +-1.2053303225479509e-03 +-1.1441947046860778e-03 +-1.0898897962723511e-03 +-1.0418010463747076e-03 +-9.9931751558000599e-04 +-9.6185656207267288e-04 +-9.2887700997303297e-04 +-8.9988492242135305e-04 +-8.7443480777450093e-04 +-8.5212814873590473e-04 +-8.3261048666369135e-04 +-8.1556784511350295e-04 +-8.0072297645668929e-04 +-7.8783171850167928e-04 +-7.7667962034093136e-04 +-7.6707891598189030e-04 +-7.5886587389151423e-04 +-7.5189852061140043e-04 +-7.4605471909164702e-04 +-7.4123057353232445e-04 +-7.3733912845312178e-04 +-7.3430932930853838e-04 +-7.3208521323786220e-04 +-7.3062530151536611e-04 +-7.2990216881112973e-04 +-2.0572420046459281e-03 +-2.0613073137892585e-03 +-2.0694645240805724e-03 +-2.0817650792298108e-03 +-2.0982756708123806e-03 +-2.1190483683605934e-03 +-2.1440495630430209e-03 +-2.1730058173600581e-03 +-2.2050706474727221e-03 +-2.2381734149619129e-03 +-2.2681445832368322e-03 +-2.2883820903899202e-03 +-2.2910870954126351e-03 +-2.2699167611383120e-03 +-2.2223789172623513e-03 +-2.1504479984745029e-03 +-2.0594015903539695e-03 +-1.9559376356857133e-03 +-1.8465635533139297e-03 +-1.7366621938965912e-03 +-1.6301772681594575e-03 +-1.5296891497671651e-03 +-1.4366670256660738e-03 +-1.3517590216928972e-03 +-1.2750514867896894e-03 +-1.2062735831121333e-03 +-1.1449466044260548e-03 +-1.0904868805093515e-03 +-1.0422732807102663e-03 +-9.9968930372714370e-04 +-9.6214770422160269e-04 +-9.2910354462766591e-04 +-9.0005983685711619e-04 +-8.7456862296768226e-04 +-8.5222939346630796e-04 +-8.3268607802000042e-04 +-8.1562339214382947e-04 +-8.0076302185920739e-04 +-7.8785993104270324e-04 +-7.7669894848122415e-04 +-7.6709171125221155e-04 +-7.5887399087342419e-04 +-7.5190339901014193e-04 +-7.4605745224208759e-04 +-7.4123196677350887e-04 +-7.3733975005179188e-04 +-7.3430955602191671e-04 +-7.3208527211179343e-04 +-7.3062530913477783e-04 +-7.2990216890897539e-04 +-2.0572136701332046e-03 +-2.0612790904086568e-03 +-2.0694370055403437e-03 +-2.0817398025621296e-03 +-2.0982555555861364e-03 +-2.1190383209222573e-03 +-2.1440584309976537e-03 +-2.1730538317611520e-03 +-2.2052084712011824e-03 +-2.2385065665403523e-03 +-2.2688292565853467e-03 +-2.2895629408356379e-03 +-2.2928109619210577e-03 +-2.2720958747678589e-03 +-2.2248292955170863e-03 +-2.1529627306380475e-03 +-2.0618092028362378e-03 +-1.9581264470789608e-03 +-1.8484792711376083e-03 +-1.7382932805003048e-03 +-1.6315387028199709e-03 +-1.5308094402462957e-03 +-1.4375794939848743e-03 +-1.3524966940210265e-03 +-1.2756445024187581e-03 +-1.2067481664974366e-03 +-1.1453249146668460e-03 +-1.0907872998398448e-03 +-1.0425108840836439e-03 +-9.9987636902749239e-04 +-9.6229419359237362e-04 +-9.2921752766613635e-04 +-9.0014784793946963e-04 +-8.7463595551881556e-04 +-8.5228033851121956e-04 +-8.3272411565626838e-04 +-8.1565134434668672e-04 +-8.0078317410711675e-04 +-7.8787412914529324e-04 +-7.7670867588185361e-04 +-7.6709815110338904e-04 +-7.5887807633521934e-04 +-7.5190585453409104e-04 +-7.4605882802612799e-04 +-7.4123266811877166e-04 +-7.3734006297148562e-04 +-7.3430967015603239e-04 +-7.3208530175178062e-04 +-7.3062531297161829e-04 +-7.2990216896087745e-04 +-2.0571951320872768e-03 +-2.0612605724408938e-03 +-2.0694187273314025e-03 +-2.0817223630501631e-03 +-2.0982400765314465e-03 +-2.1190265962402755e-03 +-2.1440535174175020e-03 +-2.1730628590575581e-03 +-2.2052506727966836e-03 +-2.2386244989329378e-03 +-2.2690885035118557e-03 +-2.2900264203854748e-03 +-2.2935015665398652e-03 +-2.2729795312269037e-03 +-2.2258303851607855e-03 +-2.1539949602710252e-03 +-2.0628004991262994e-03 +-1.9590295194341204e-03 +-1.8492708093842487e-03 +-1.7389679182934854e-03 +-1.6321022504696503e-03 +-1.5312734514705498e-03 +-1.4379576113114773e-03 +-1.3528024992844850e-03 +-1.2758904212154605e-03 +-1.2069450277578269e-03 +-1.1454818788816943e-03 +-1.0909119725442291e-03 +-1.0426095065552096e-03 +-9.9995402722505939e-04 +-9.6235501603350614e-04 +-9.2926485980101246e-04 +-9.0018439960805080e-04 +-8.7466392252223517e-04 +-8.5230150124998658e-04 +-8.3273991835765466e-04 +-8.1566295832945701e-04 +-8.0079154816169445e-04 +-7.8788002965815237e-04 +-7.7671271887864350e-04 +-7.6710082798594223e-04 +-7.5887977473863095e-04 +-7.5190687544726242e-04 +-7.4605940008113400e-04 +-7.4123295976703655e-04 +-7.3734019310727926e-04 +-7.3430971762528878e-04 +-7.3208531408043359e-04 +-7.3062531456869872e-04 +-7.2990216898613167e-04 +-2.0571887354744042e-03 +-2.0612541766928615e-03 +-2.0694123914454373e-03 +-2.0817162481713766e-03 +-2.0982344623023588e-03 +-2.1190218709561154e-03 +-2.1440502602782597e-03 +-2.1730625632914889e-03 +-2.2052581231931374e-03 +-2.2386513868460091e-03 +-2.2691538727262865e-03 +-2.2901494111307796e-03 +-2.2936901912908900e-03 +-2.2732251475184786e-03 +-2.2261117975477906e-03 +-2.1542873547241823e-03 +-2.0630828324933012e-03 +-1.9592877704499500e-03 +-1.8494978764469416e-03 +-1.7391619368100394e-03 +-1.6322646553259598e-03 +-1.5314074031292629e-03 +-1.4380669277710340e-03 +-1.3528910218011374e-03 +-1.2759616862800269e-03 +-1.2070021308510229e-03 +-1.1455274471052748e-03 +-1.0909481927041649e-03 +-1.0426381770116330e-03 +-9.9997661606683022e-04 +-9.6237271679802813e-04 +-9.2927864091306737e-04 +-9.0019504638685997e-04 +-8.7467207193953241e-04 +-8.5230767021322840e-04 +-8.3274452648223851e-04 +-8.1566634616007938e-04 +-8.0079399170797946e-04 +-7.8788175198826933e-04 +-7.7671389938893448e-04 +-7.6710160985322766e-04 +-7.5888027096362672e-04 +-7.5190717381781605e-04 +-7.4605956731636693e-04 +-7.4123304505027655e-04 +-7.3734023117049622e-04 +-7.3430973151268760e-04 +-7.3208531768855878e-04 +-7.3062531503791399e-04 +-7.2990216899939309e-04 +-2.0571877673159584e-03 +-2.0612532076997934e-03 +-2.0694114278093341e-03 +-2.0817153028684279e-03 +-2.0982335403331377e-03 +-2.1190209349034707e-03 +-2.1440491891553037e-03 +-2.1730611902730885e-03 +-2.2052565414146879e-03 +-2.2386505575200492e-03 +-2.2691559632647160e-03 +-2.2901570904756258e-03 +-2.2937051581711750e-03 +-2.2732471571668823e-03 +-2.2261388958463761e-03 +-2.1543168618828410e-03 +-2.0631122746320113e-03 +-1.9593153632509385e-03 +-1.8495225976234719e-03 +-1.7391833803693450e-03 +-1.6322828285230049e-03 +-1.5314225488873119e-03 +-1.4380793976750824e-03 +-1.3529011965097001e-03 +-1.2759699312067220e-03 +-1.2070087749342631e-03 +-1.1455327753461641e-03 +-1.0909524462139569e-03 +-1.0426415567059870e-03 +-9.9997928777842285e-04 +-9.6237481660932161e-04 +-9.2928028012240150e-04 +-9.0019631586682317e-04 +-8.7467304583039099e-04 +-8.5230840898536898e-04 +-8.3274507944011786e-04 +-8.1566675347178349e-04 +-8.0079428604190269e-04 +-7.8788195983041679e-04 +-7.7671404210391678e-04 +-7.6710170454216567e-04 +-7.5888033116281426e-04 +-7.5190721007432166e-04 +-7.4605958766984929e-04 +-7.4123305544493521e-04 +-7.3734023581611681e-04 +-7.3430973321009544e-04 +-7.3208531813100022e-04 +-7.3062531509799993e-04 +-7.2990216900938704e-04 +-2.0571877672962645e-03 +-2.0612532074570354e-03 +-2.0694114264537288e-03 +-2.0817152969448086e-03 +-2.0982335194529205e-03 +-2.1190208736747260e-03 +-2.1440490344973953e-03 +-2.1730608455886435e-03 +-2.2052558575903071e-03 +-2.2386493535260250e-03 +-2.2691540931652735e-03 +-2.2901545294094577e-03 +-2.2937020415179743e-03 +-2.2732437379999735e-03 +-2.2261354546917241e-03 +-2.1543136285029074e-03 +-2.0631093930277770e-03 +-1.9593128949412686e-03 +-1.8495205437259463e-03 +-1.7391817063315905e-03 +-1.6322814836603379e-03 +-1.5314214790369553e-03 +-1.4380785521272827e-03 +-1.3529005310653976e-03 +-1.2759694089575111e-03 +-1.2070083658714354e-03 +-1.1455324554729455e-03 +-1.0909521965307670e-03 +-1.0426413622496471e-03 +-9.9997913678899226e-04 +-9.6237469984227257e-04 +-9.2928019029750117e-04 +-9.0019624723482248e-04 +-8.7467299383638640e-04 +-8.5230837000917420e-04 +-8.3274505059677912e-04 +-8.1566673245845787e-04 +-8.0079427102010704e-04 +-7.8788194933508075e-04 +-7.7671403497260854e-04 +-7.6710169985943100e-04 +-7.5888032821579371e-04 +-7.5190720831676727e-04 +-7.4605958669240189e-04 +-7.4123305495008463e-04 +-7.3734023559669966e-04 +-7.3430973313049364e-04 +-7.3208531811041859e-04 +-7.3062531509534981e-04 +-7.2990216900937143e-04 +-2.0571887352703938e-03 +-2.0612541700206518e-03 +-2.0694123436253899e-03 +-2.0817160567502863e-03 +-2.0982338946835474e-03 +-2.1190204680708808e-03 +-2.1440472013448462e-03 +-2.1730565234843332e-03 +-2.2052472638928967e-03 +-2.2386337346895799e-03 +-2.2691281808963227e-03 +-2.2901160519745380e-03 +-2.2936513410197197e-03 +-2.2731840556393648e-03 +-2.2260716882678299e-03 +-2.1542506284451717e-03 +-2.0630508126903255e-03 +-1.9592608534110783e-03 +-1.8494758376322452e-03 +-1.7391442233180769e-03 +-1.6322505967399305e-03 +-1.5313963372898772e-03 +-1.4380582627250666e-03 +-1.3528842577208424e-03 +-1.2759564156116733e-03 +-1.2069980284307273e-03 +-1.1455242569236453e-03 +-1.0909457147105517e-03 +-1.0426362554307920e-03 +-9.9997512967978661e-04 +-9.6237157114789000e-04 +-9.2927776219479258e-04 +-9.0019437672518078e-04 +-8.7467156577173723e-04 +-8.5230729153223472e-04 +-8.3274424673984758e-04 +-8.1566614267191112e-04 +-8.0079384643684721e-04 +-7.8788165061151794e-04 +-7.7671383057781958e-04 +-7.6710156471008724e-04 +-7.5888024257609503e-04 +-7.5190715689977996e-04 +-7.4605955791324206e-04 +-7.4123304029222973e-04 +-7.3734022906168505e-04 +-7.3430973074789649e-04 +-7.3208531749085093e-04 +-7.3062531501241442e-04 +-7.2990216899909233e-04 +-2.0571951315662114e-03 +-2.0612605310367325e-03 +-2.0694184014539143e-03 +-2.0817210707031663e-03 +-2.0982363950597235e-03 +-2.1190179625036562e-03 +-2.1440357357346532e-03 +-2.1730297099028812e-03 +-2.2051942869974563e-03 +-2.2385374889997097e-03 +-2.2689677860384507e-03 +-2.2898763486412033e-03 +-2.2933335099087656e-03 +-2.2728079180838433e-03 +-2.2256680624741041e-03 +-2.1538504493281568e-03 +-2.0626776339051221e-03 +-1.9589285291446608e-03 +-1.8491897673878366e-03 +-1.7389039434429795e-03 +-1.6320522880778326e-03 +-1.5312346893196151e-03 +-1.4379276497033669e-03 +-1.3527793809922041e-03 +-1.2758725937722191e-03 +-1.2069312806203931e-03 +-1.1454712774793250e-03 +-1.0909037989994710e-03 +-1.0426032103139982e-03 +-9.9994918568078214e-04 +-9.6235130393344630e-04 +-9.2926202585753360e-04 +-9.0018224879369812e-04 +-8.7466230274298564e-04 +-8.5230029334107914e-04 +-8.3273902857639601e-04 +-8.1566231271297572e-04 +-8.0079108827112427e-04 +-7.8787970935036361e-04 +-7.7671250183716540e-04 +-7.6710068581175705e-04 +-7.5887968545292213e-04 +-7.5190682229734078e-04 +-7.4605937056967627e-04 +-7.4123294484677632e-04 +-7.3734018649919322e-04 +-7.3430971523014827e-04 +-7.3208531346152957e-04 +-7.3062531448889341e-04 +-7.2990216898516206e-04 +-2.0572136705329443e-03 +-2.0612789527874832e-03 +-2.0694358244076902e-03 +-2.0817350685496836e-03 +-2.0982421797195918e-03 +-2.1190074617671120e-03 +-2.1439962008860656e-03 +-2.1729405780555977e-03 +-2.2050207290118464e-03 +-2.2382243857762222e-03 +-2.2684477954689223e-03 +-2.2891004414332780e-03 +-2.2923052136766429e-03 +-2.2715908966682553e-03 +-2.2243616407720173e-03 +-2.1525545604325256e-03 +-2.0614685446742023e-03 +-1.9578512422680225e-03 +-1.8482619552389380e-03 +-1.7381242777022049e-03 +-1.6314085335855182e-03 +-1.5307097370085099e-03 +-1.4375033322388366e-03 +-1.3524385626506145e-03 +-1.2756001192351994e-03 +-1.2067142518724389e-03 +-1.1452989768312028e-03 +-1.0907674523056687e-03 +-1.0424956991476656e-03 +-9.9986476415008462e-04 +-9.6228534507272008e-04 +-9.2921080586893016e-04 +-9.0014276904416596e-04 +-8.7463214570901405e-04 +-8.5227750742884430e-04 +-8.3272203670810383e-04 +-8.1564984005922108e-04 +-8.0078210518993282e-04 +-7.8787338627482747e-04 +-7.7670817347687846e-04 +-7.6709782255776995e-04 +-7.5887787031529588e-04 +-7.5190573205466686e-04 +-7.4605876009644929e-04 +-7.4123263380844830e-04 +-7.3734004778796094e-04 +-7.3430966465626269e-04 +-7.3208530033133971e-04 +-7.3062531278851248e-04 +-7.2990216895863240e-04 +-2.0572420125631098e-03 +-2.0613069963733950e-03 +-2.0694614576557244e-03 +-2.0817525206436997e-03 +-2.0982400910666004e-03 +-2.1189666703491489e-03 +-2.1438863023997114e-03 +-2.1727123138945061e-03 +-2.2045910608093776e-03 +-2.2374635742105973e-03 +-2.2671995286091587e-03 +-2.2872528303304637e-03 +-2.2898690615514449e-03 +-2.2687162533973461e-03 +-2.2212808088951791e-03 +-2.1495008953626932e-03 +-2.0586201583513253e-03 +-1.9553133033972745e-03 +-1.8460757865684330e-03 +-1.7362867391442337e-03 +-1.6298909111869720e-03 +-1.5294718559802065e-03 +-1.4365025031725755e-03 +-1.3516344934716305e-03 +-1.2749571529319724e-03 +-1.2062020258765069e-03 +-1.1448922489505783e-03 +-1.0904455488559973e-03 +-1.0422418412326892e-03 +-9.9966540348220279e-04 +-9.6212956840572791e-04 +-9.2908982785022177e-04 +-9.0004951350876631e-04 +-8.7456090662433911e-04 +-8.5222367766445443e-04 +-8.3268189267633936e-04 +-8.1562037139581165e-04 +-8.0076088022757721e-04 +-7.8785844565464698e-04 +-7.7669794570222510e-04 +-7.6709105652512325e-04 +-7.5887358088836765e-04 +-7.5190315557096957e-04 +-7.4605731736912615e-04 +-7.4123189871314152e-04 +-7.3733971995566371e-04 +-7.3430954512722726e-04 +-7.3208526929930664e-04 +-7.3062530877234129e-04 +-7.2990216890452290e-04 +-2.0572330791680557e-03 +-2.0612973687662590e-03 +-2.0694468462463637e-03 +-2.0817213760960978e-03 +-2.0981697173367230e-03 +-2.1188185575119448e-03 +-2.1435985908716867e-03 +-2.1721840661946853e-03 +-2.2036544890442615e-03 +-2.2358642540550038e-03 +-2.2646406904336461e-03 +-2.2835309126882494e-03 +-2.2850172513620890e-03 +-2.2630310159161963e-03 +-2.2152121542498744e-03 +-2.1434985072177706e-03 +-2.0530267858284920e-03 +-1.9503311794992024e-03 +-1.8417840378245637e-03 +-1.7326785707109254e-03 +-1.6269099818119353e-03 +-1.5270395568770928e-03 +-1.4345353118752099e-03 +-1.3500535369847515e-03 +-1.2736925845098378e-03 +-1.2051943288596289e-03 +-1.1440919113705659e-03 +-1.0898119955156577e-03 +-1.0417421232730903e-03 +-9.9927290318952843e-04 +-9.6182283583213255e-04 +-9.2885158888052666e-04 +-8.9986585007171356e-04 +-8.7442059228860075e-04 +-8.5211764576008961e-04 +-8.3260281371493256e-04 +-8.1556231868621602e-04 +-8.0071906563492954e-04 +-7.8782901053803397e-04 +-7.7667779490545106e-04 +-7.6707772569483063e-04 +-7.5886512940745736e-04 +-7.5189807900559913e-04 +-7.4605447464537282e-04 +-7.4123045027240893e-04 +-7.3733907398269133e-04 +-7.3430930960061082e-04 +-7.3208520815221069e-04 +-7.3062530086016495e-04 +-7.2990216880307194e-04 +-2.0570061424615717e-03 +-2.0610688220898225e-03 +-2.0692086225438402e-03 +-2.0814523253023017e-03 +-2.0978283496588630e-03 +-2.1183337480337725e-03 +-2.1428543332554289e-03 +-2.1709909589025518e-03 +-2.2017074375119848e-03 +-2.2327242609486877e-03 +-2.2598238687480507e-03 +-2.2767318530341704e-03 +-2.2763296634416468e-03 +-2.2529771002056625e-03 +-2.2045579479745524e-03 +-2.1330021128862439e-03 +-2.0432642822168011e-03 +-1.9416417253927316e-03 +-1.8342989877347636e-03 +-1.7263837354432694e-03 +-1.6217069060804931e-03 +-1.5227917621612823e-03 +-1.4310978929064958e-03 +-1.3472895712310158e-03 +-1.2714806978176504e-03 +-1.2034309860795378e-03 +-1.1426908911462477e-03 +-1.0887025704180054e-03 +-1.0408668087533641e-03 +-9.9858522361434424e-04 +-9.6128531231972681e-04 +-9.2843402006119978e-04 +-8.9954388881808135e-04 +-8.7417459060020483e-04 +-8.5193172895661794e-04 +-8.3246414412349666e-04 +-8.1546051248010648e-04 +-8.0064573163201127e-04 +-7.8777738504485714e-04 +-7.7664245156795558e-04 +-7.6705434345840113e-04 +-7.5885030516869027e-04 +-7.5188917433134531e-04 +-7.4604948821981141e-04 +-7.4122790953058269e-04 +-7.3733794085710166e-04 +-7.3430889645191880e-04 +-7.3208510089101488e-04 +-7.3062528698199442e-04 +-7.2990216862851918e-04 +-2.0560409086203628e-03 +-2.0600997322595600e-03 +-2.0682205564139414e-03 +-2.0804072435736789e-03 +-2.0966521229924058e-03 +-2.1168986363673797e-03 +-2.1409514764393930e-03 +-2.1682867432214347e-03 +-2.1976942333812241e-03 +-2.2267262770220356e-03 +-2.2511575796452573e-03 +-2.2650274805668716e-03 +-2.2618176119183495e-03 +-2.2365001920130823e-03 +-2.1872937546096819e-03 +-2.1160991264248829e-03 +-2.0275910033077833e-03 +-1.9277073772048948e-03 +-1.8222970546086983e-03 +-1.7162853174562383e-03 +-1.6133535220424411e-03 +-1.5159660989776244e-03 +-1.4255695330295136e-03 +-1.3428405968396247e-03 +-1.2679176352051057e-03 +-1.2005885136093101e-03 +-1.1404311019069093e-03 +-1.0869121622207013e-03 +-1.0394535628349137e-03 +-9.9747448685779034e-04 +-9.6041681450408903e-04 +-9.2775914516380568e-04 +-8.9902340988397495e-04 +-8.7377682719924242e-04 +-8.5163106757309940e-04 +-8.3223985943371617e-04 +-8.1529583244442205e-04 +-8.0052709714849822e-04 +-7.8769386309675824e-04 +-7.7658526841453560e-04 +-7.6701651094713988e-04 +-7.5882631874175813e-04 +-7.5187476573843992e-04 +-7.4604141957920896e-04 +-7.4122379825272136e-04 +-7.3733610728526802e-04 +-7.3430822791019628e-04 +-7.3208492732465200e-04 +-7.3062526452551124e-04 +-7.2990216834853308e-04 +-2.0529840591903001e-03 +-2.0570334375751812e-03 +-2.0651154975552042e-03 +-2.0771936839209079e-03 +-2.0931968673704579e-03 +-2.1129756638016998e-03 +-2.1362012482404810e-03 +-2.1621652586452942e-03 +-2.1894399531872046e-03 +-2.2154232472028123e-03 +-2.2359854309761860e-03 +-2.2456620771985239e-03 +-2.2387412022506397e-03 +-2.2109667931580353e-03 +-2.1609544670893785e-03 +-2.0905341069071886e-03 +-2.0039872415523502e-03 +-1.9067561804988859e-03 +-1.8042525144383315e-03 +-1.7010908838761744e-03 +-1.6007698465320805e-03 +-1.5056700392664343e-03 +-1.4172191139614676e-03 +-1.3361119386864136e-03 +-1.2625224942077967e-03 +-1.1962799354656049e-03 +-1.1370025506552276e-03 +-1.0841935419015820e-03 +-1.0373061254405423e-03 +-9.9578569157839992e-04 +-9.5909564363846574e-04 +-9.2673206678786180e-04 +-8.9823101207513688e-04 +-8.7317107048802119e-04 +-8.5117307198067835e-04 +-8.3189813696817006e-04 +-8.1504488202971414e-04 +-8.0034628971415171e-04 +-7.8756655621390573e-04 +-7.7649810085892205e-04 +-7.6695883711713785e-04 +-7.5878975092767763e-04 +-7.5185279881712010e-04 +-7.4602911808724283e-04 +-7.4121753008372677e-04 +-7.3733331174448348e-04 +-7.3430720861800526e-04 +-7.3208466269610614e-04 +-7.3062523028768274e-04 +-7.2990216792351336e-04 +-2.0445785385829265e-03 +-2.0486054362218111e-03 +-2.0566089775683350e-03 +-2.0684847962336730e-03 +-2.0840575414765262e-03 +-2.1030329065261045e-03 +-2.1248924996249540e-03 +-2.1487027329278527e-03 +-2.1728267434262651e-03 +-2.1945978763653817e-03 +-2.2101491325072094e-03 +-2.2147045235395035e-03 +-2.2035133473188749e-03 +-2.1731753555192016e-03 +-2.1227100921976405e-03 +-2.0538140857179160e-03 +-1.9702649033938890e-03 +-1.8768807782345292e-03 +-1.7785190960208717e-03 +-1.6793955685221872e-03 +-1.5827705462068224e-03 +-1.4909138360183060e-03 +-1.4052276970652417e-03 +-1.3264312625875440e-03 +-1.2547469995808267e-03 +-1.1900607885008941e-03 +-1.1320468923487861e-03 +-1.0802593240456569e-03 +-1.0341952684614199e-03 +-9.9333706243850744e-04 +-9.5717858795340009e-04 +-9.2524078873744723e-04 +-8.9707985891323986e-04 +-8.7229066271217275e-04 +-8.5050717245156097e-04 +-8.3140114058556571e-04 +-8.1467981341229912e-04 +-8.0008320959158285e-04 +-7.8738129248781313e-04 +-7.7637123501913847e-04 +-7.6687488973353464e-04 +-7.5873652104484278e-04 +-7.5182082124135915e-04 +-7.4601121006960959e-04 +-7.4120840495613919e-04 +-7.3732924198137277e-04 +-7.3430572471801204e-04 +-7.3208427744515987e-04 +-7.3062518044405959e-04 +-7.2990216730624031e-04 +-2.0242461661127719e-03 +-2.0282242363715178e-03 +-2.0360821677369721e-03 +-2.0476194495579283e-03 +-2.0625167563644129e-03 +-2.0802913102763629e-03 +-2.1002043466048208e-03 +-2.1211058207226872e-03 +-2.1412263621980502e-03 +-2.1579837284433426e-03 +-2.1679517808257803e-03 +-2.1671776510138437e-03 +-2.1519205228521000e-03 +-2.1196142497842928e-03 +-2.0696277466763823e-03 +-2.0034548395823880e-03 +-1.9242861018082791e-03 +-1.8362230884649982e-03 +-1.7434793772163758e-03 +-1.6497985100123380e-03 +-1.5581529135010673e-03 +-1.4706753244599709e-03 +-1.3887352748389863e-03 +-1.3130817350210226e-03 +-1.2439986894022701e-03 +-1.1814451358920220e-03 +-1.1251683676211117e-03 +-1.0747893603843186e-03 +-1.0298637431780918e-03 +-9.8992332717596251e-04 +-9.5450307079250401e-04 +-9.2315760900758912e-04 +-8.9547057189682134e-04 +-8.7105908624518264e-04 +-8.4957517403622454e-04 +-8.3070524056157267e-04 +-8.1416846225356452e-04 +-7.9971461151914043e-04 +-7.8712166567369195e-04 +-7.7619341689149561e-04 +-7.6675721248072167e-04 +-7.5866189677309187e-04 +-7.5177598826362967e-04 +-7.4598610173688836e-04 +-7.4119561053136564e-04 +-7.3732353564289355e-04 +-7.3430364408104745e-04 +-7.3208373726743560e-04 +-7.3062511055638419e-04 +-7.2990216644191119e-04 +-1.9822025053599754e-03 +-1.9860878382733467e-03 +-1.9937082202546173e-03 +-2.0047594186738881e-03 +-2.0187701473649193e-03 +-2.0350690282437550e-03 +-2.0527199412162136e-03 +-2.0704212138452690e-03 +-2.0863857388683416e-03 +-2.0982574953723313e-03 +-2.1031612647201118e-03 +-2.0979863018460005e-03 +-2.0799241219842746e-03 +-2.0471246956345612e-03 +-1.9992106157615481e-03 +-1.9374184963262264e-03 +-1.8643189385009794e-03 +-1.7832621085309280e-03 +-1.6977746424065845e-03 +-1.6110832352265693e-03 +-1.5258357874639293e-03 +-1.4440050378336513e-03 +-1.3669190963289963e-03 +-1.2953596492549680e-03 +-1.2296828825808664e-03 +-1.1699358880073350e-03 +-1.1159555749739765e-03 +-1.0674463007949316e-03 +-1.0240373630854276e-03 +-9.8532358918752470e-04 +-9.5089273136416861e-04 +-9.2034306894109123e-04 +-8.9329402005366900e-04 +-8.6939192961496049e-04 +-8.4831263776900378e-04 +-8.2976197933829670e-04 +-8.1347501821642915e-04 +-7.9921456550950969e-04 +-7.8676934731669395e-04 +-7.7595205958977788e-04 +-7.6659745888008827e-04 +-7.5856057759643382e-04 +-7.5171511222902156e-04 +-7.4595200668747732e-04 +-7.4117823614369357e-04 +-7.3731578647815289e-04 +-7.3430081856454006e-04 +-7.3208300370052818e-04 +-7.3062501564846033e-04 +-7.2990216526913425e-04 +-1.9091991693579071e-03 +-1.9129328856139502e-03 +-1.9202113884974913e-03 +-1.9306539465771299e-03 +-1.9436795547161272e-03 +-1.9584881127090083e-03 +-1.9740268279929691e-03 +-1.9889429860351525e-03 +-2.0015379903065549e-03 +-2.0097587355800929e-03 +-2.0112808443800024e-03 +-2.0037329700888494e-03 +-1.9850626224303365e-03 +-1.9539607713705050e-03 +-1.9101963661684299e-03 +-1.8547227587147315e-03 +-1.7895122387626150e-03 +-1.7171904189394495e-03 +-1.6406056862283164e-03 +-1.5624572706154831e-03 +-1.4850485729697011e-03 +-1.4101734445455697e-03 +-1.3391068949402604e-03 +-1.2726604972287088e-03 +-1.2112674749138136e-03 +-1.1550732039213737e-03 +-1.1040174092714447e-03 +-1.0579021570776897e-03 +-1.0164445714400711e-03 +-9.7931570315419559e-04 +-9.4616796183221092e-04 +-9.1665365874694005e-04 +-8.9043693901696584e-04 +-8.6720096975024218e-04 +-8.4665183098391343e-04 +-8.2852018835510746e-04 +-8.1256152874411148e-04 +-7.9855551091890435e-04 +-7.8630481262658846e-04 +-7.7563373176871709e-04 +-7.6638671120047859e-04 +-7.5842689505574217e-04 +-7.5163478205737583e-04 +-7.4590701251853230e-04 +-7.4115530664870400e-04 +-7.3730555941181695e-04 +-7.3429708950471567e-04 +-7.3208203554954237e-04 +-7.3062489039053087e-04 +-7.2990216372212152e-04 +-1.8021185188136538e-03 +-1.8056379840429319e-03 +-1.8124747796456656e-03 +-1.8222225266078514e-03 +-1.8342659163791319e-03 +-1.8477728330063767e-03 +-1.8616835881037023e-03 +-1.8747008609612708e-03 +-1.8852907147227759e-03 +-1.8917144227960148e-03 +-1.8921175279315969e-03 +-1.8846969579700908e-03 +-1.8679411685602132e-03 +-1.8408969180858867e-03 +-1.8033822744214136e-03 +-1.7560668403456326e-03 +-1.7003845669182950e-03 +-1.6383077532403619e-03 +-1.5720558145758932e-03 +-1.5038187796535608e-03 +-1.4355502168304733e-03 +-1.3688487416260067e-03 +-1.3049192843091373e-03 +-1.2445914926392291e-03 +-1.1883707978153761e-03 +-1.1365024038679720e-03 +-1.0890351267344453e-03 +-1.0458779556090200e-03 +-1.0068464789450573e-03 +-9.7169892590221211e-04 +-9.4016291685428111e-04 +-9.1195453668327007e-04 +-8.8679139672428022e-04 +-8.6440117575670074e-04 +-8.4452687175159611e-04 +-8.2692973151151121e-04 +-8.1139059048248089e-04 +-7.9771016192323511e-04 +-7.8570866333762472e-04 +-7.7522505344653219e-04 +-7.6611606823257135e-04 +-7.5825518315283057e-04 +-7.5153158480402763e-04 +-7.4584920455184208e-04 +-7.4112584535935124e-04 +-7.3729241858688636e-04 +-7.3429229793716354e-04 +-7.3208079154029248e-04 +-7.3062472944262775e-04 +-7.2990216173502212e-04 +-1.6665444423997209e-03 +-1.6697980872167231e-03 +-1.6761148491834870e-03 +-1.6851121290846417e-03 +-1.6962128098565452e-03 +-1.7086432753100564e-03 +-1.7214342991476212e-03 +-1.7334289461296427e-03 +-1.7433043234211349e-03 +-1.7496171079817375e-03 +-1.7508840395673499e-03 +-1.7457042529067910e-03 +-1.7329174544998324e-03 +-1.7117725178127079e-03 +-1.6820643657130126e-03 +-1.6441954294571751e-03 +-1.5991371659754546e-03 +-1.5482992965818539e-03 +-1.4933428885865606e-03 +-1.4359847209761099e-03 +-1.3778328164619762e-03 +-1.3202747453428393e-03 +-1.2644216650563652e-03 +-1.2110985216185735e-03 +-1.1608657214525072e-03 +-1.1140579811356579e-03 +-1.0708292501524930e-03 +-1.0311964394899781e-03 +-9.9507800005599703e-04 +-9.6232577248524568e-04 +-9.3275000622265096e-04 +-9.0613822864426912e-04 +-8.8226896554281071e-04 +-8.6092136203226393e-04 +-8.4188166054827011e-04 +-8.2494734325995976e-04 +-8.0992958678499150e-04 +-7.9665453094707021e-04 +-7.8496373972057512e-04 +-7.7471413312769194e-04 +-7.6577759165755686e-04 +-7.5804037631558923e-04 +-7.5140246400046498e-04 +-7.4577686618614697e-04 +-7.4108897603617310e-04 +-7.3727597282767249e-04 +-7.3428630116942502e-04 +-7.3207923462154112e-04 +-7.3062452801110384e-04 +-7.2990215924867885e-04 +-1.5143531935744024e-03 +-1.5173112415954565e-03 +-1.5230639669422254e-03 +-1.5312834744580911e-03 +-1.5414759543034302e-03 +-1.5529818814820108e-03 +-1.5649805452179638e-03 +-1.5765025908090703e-03 +-1.5864551685902870e-03 +-1.5936648212416078e-03 +-1.5969425535313632e-03 +-1.5951723508599556e-03 +-1.5874178460917716e-03 +-1.5730327626851867e-03 +-1.5517527909448992e-03 +-1.5237448475986883e-03 +-1.4895974891821968e-03 +-1.4502517230297702e-03 +-1.4068878993904741e-03 +-1.3607944698120734e-03 +-1.3132447938314169e-03 +-1.2654007015840509e-03 +-1.2182509297878950e-03 +-1.1725832771694767e-03 +-1.1289836392101718e-03 +-1.0878530824331716e-03 +-1.0494347117313552e-03 +-1.0138439527374358e-03 +-9.8109801150946560e-04 +-9.5114212670434643e-04 +-9.2387159148503808e-04 +-8.9914940096244903e-04 +-8.7681987465500037e-04 +-8.5671882924433934e-04 +-8.3868093574493918e-04 +-8.2254486152863069e-04 +-8.0815672074764817e-04 +-7.9537226632489110e-04 +-7.8405816902696508e-04 +-7.7409265181174020e-04 +-7.6536568320451971e-04 +-7.5777888176563281e-04 +-7.5124524335735943e-04 +-7.4568877204555660e-04 +-7.4104407222184965e-04 +-7.3725594223299511e-04 +-7.3427899706066308e-04 +-7.3207733826851436e-04 +-7.3062428266424382e-04 +-7.2990215622076944e-04 +-1.3589581178026272e-03 +-1.3616153419814701e-03 +-1.3667987789947173e-03 +-1.3742455335645904e-03 +-1.3835598833279172e-03 +-1.3942138392968124e-03 +-1.4055514849473179e-03 +-1.4167999296903807e-03 +-1.4270900098665071e-03 +-1.4354896863629128e-03 +-1.4410520838928915e-03 +-1.4428779036337151e-03 +-1.4401883440073883e-03 +-1.4324001662862843e-03 +-1.4191905970351601e-03 +-1.4005384841796523e-03 +-1.3767311587237336e-03 +-1.3483336190263722e-03 +-1.3161255524205841e-03 +-1.2810188812695266e-03 +-1.2439713993587787e-03 +-1.2059102532557353e-03 +-1.1676741010634031e-03 +-1.1299770765891082e-03 +-1.0933930544822479e-03 +-1.0583559797653734e-03 +-1.0251711180319278e-03 +-9.9403244980644139e-04 +-9.6504244494178821e-04 +-9.3823162390312717e-04 +-9.1357635690021168e-04 +-8.9101415152256845e-04 +-8.7045622371318950e-04 +-8.5179747642767666e-04 +-8.3492418165272099e-04 +-8.1971972750194779e-04 +-8.0606879463052106e-04 +-7.9386029478835450e-04 +-7.8298935817431106e-04 +-7.7335860684220033e-04 +-7.6487890493621188e-04 +-7.5746973584244165e-04 +-7.5105932229071180e-04 +-7.4558457780765002e-04 +-7.4099095598146193e-04 +-7.3723224683894543e-04 +-7.3427035635407751e-04 +-7.3207509487748575e-04 +-7.3062399241830055e-04 +-7.2990215263914551e-04 +-1.2115508556245203e-03 +-1.2139227636600136e-03 +-1.2185660369987705e-03 +-1.2252789330707680e-03 +-1.2337577788962772e-03 +-1.2435973079270462e-03 +-1.2542936956410351e-03 +-1.2652522825464946e-03 +-1.2758020969448145e-03 +-1.2852190443961597e-03 +-1.2927588613277315e-03 +-1.2976995118234556e-03 +-1.2993906465077246e-03 +-1.2973053194178426e-03 +-1.2910870157839928e-03 +-1.2805840888454865e-03 +-1.2658647350232116e-03 +-1.2472088227585216e-03 +-1.2250774663579672e-03 +-1.2000657277354617e-03 +-1.1728467462791322e-03 +-1.1441161548979548e-03 +-1.1145440367300902e-03 +-1.0847388244790220e-03 +-1.0552245250487825e-03 +-1.0264302631061912e-03 +-9.9868971531456873e-04 +-9.7224750142042350e-04 +-9.4726975077327887e-04 +-9.2385657354495927e-04 +-9.0205479207445909e-04 +-8.8186987547690101e-04 +-8.6327649602691177e-04 +-8.4622747041385843e-04 +-8.3066107511101160e-04 +-8.1650685773541616e-04 +-8.0369013197663234e-04 +-7.9213536536985353e-04 +-7.8176866443133717e-04 +-7.7251954279921209e-04 +-7.6432213308230473e-04 +-7.5711597699795101e-04 +-7.5084650376926903e-04 +-7.4546528492872380e-04 +-7.4093013505452192e-04 +-7.3720511247370938e-04 +-7.3426046128802084e-04 +-7.3207252579135214e-04 +-7.3062366003465162e-04 +-7.2990214853789785e-04 +-1.0795750330582496e-03 +-1.0816911707118965e-03 +-1.0858481801156819e-03 +-1.0918950408922638e-03 +-1.0996043884446093e-03 +-1.1086725796117002e-03 +-1.1187214935448509e-03 +-1.1293033802679410e-03 +-1.1399101469265903e-03 +-1.1499883142226312e-03 +-1.1589604029066565e-03 +-1.1662526721349692e-03 +-1.1713279523603210e-03 +-1.1737209445834710e-03 +-1.1730720972608197e-03 +-1.1691554389158059e-03 +-1.1618959380194291e-03 +-1.1513732652096919e-03 +-1.1378110520010171e-03 +-1.1215533041160942e-03 +-1.1030317962976224e-03 +-1.0827294524347864e-03 +-1.0611446856791263e-03 +-1.0387606414541952e-03 +-1.0160217178254002e-03 +-9.9331813312020451e-04 +-9.7097803069170151e-04 +-9.4926581273821031e-04 +-9.2838506402914266e-04 +-9.0848444841111671e-04 +-8.8966519466492729e-04 +-8.7198911075041122e-04 +-8.5548639131554293e-04 +-8.4016276491628047e-04 +-8.2600574603809620e-04 +-8.1298991238626188e-04 +-8.0108122902913359e-04 +-7.9024050008360365e-04 +-7.8042605768796625e-04 +-7.7159580708157001e-04 +-7.6370874339999910e-04 +-7.5672604578909657e-04 +-7.5061184131203847e-04 +-7.4533371717427346e-04 +-7.4086304635852772e-04 +-7.3717517952696216e-04 +-7.3424954528328421e-04 +-7.3206969160556916e-04 +-7.3062329335309075e-04 +-7.2990214401371517e-04 +-9.6691724431654212e-04 +-9.6881466774800459e-04 +-9.7255363724721845e-04 +-9.7802203914043964e-04 +-9.8505105098709218e-04 +-9.9341503502963250e-04 +-1.0028324826290627e-03 +-1.0129688457205365e-03 +-1.0234421503562709e-03 +-1.0338322095750315e-03 +-1.0436939946102362e-03 +-1.0525752585371531e-03 +-1.0600378470850258e-03 +-1.0656813495343897e-03 +-1.0691669809333880e-03 +-1.0702390441969414e-03 +-1.0687412029327184e-03 +-1.0646252377202619e-03 +-1.0579509463242392e-03 +-1.0488771890033010e-03 +-1.0376454482787670e-03 +-1.0245583240877324e-03 +-1.0099558840061455e-03 +-9.9419268191477516e-04 +-9.7761767138081321e-04 +-9.6055839879132952e-04 +-9.4331000057289996e-04 +-9.2612882097992718e-04 +-9.0922999480468969e-04 +-8.9278810673578800e-04 +-8.7693999994070779e-04 +-8.6178889568951935e-04 +-8.4740914150685336e-04 +-8.3385107993781552e-04 +-8.2114569318937245e-04 +-8.0930881515628276e-04 +-7.9834480677710073e-04 +-7.8824966485039781e-04 +-7.7901358309238834e-04 +-7.7062301303990716e-04 +-7.6306228682798184e-04 +-7.5631486848749157e-04 +-7.5036429878471008e-04 +-7.4519489337147393e-04 +-7.4079224694049701e-04 +-7.3714358836096639e-04 +-7.3423802412666064e-04 +-7.3206670026743699e-04 +-7.3062290633976474e-04 +-7.2990213923889509e-04 +-8.7486219778901099e-04 +-8.7658058857882247e-04 +-8.7997558647353149e-04 +-8.8496336152674322e-04 +-8.9141766528251065e-04 +-8.9916964767423142e-04 +-9.0800829098133622e-04 +-9.1768198620865310e-04 +-9.2790182260460636e-04 +-9.3834712978967789e-04 +-9.4867368024048680e-04 +-9.5852471220639617e-04 +-9.6754457264779353e-04 +-9.7539433816127652e-04 +-9.8176831478827427e-04 +-9.8640994032419670e-04 +-9.8912542159404091e-04 +-9.8979352020433912e-04 +-9.8837028391408920e-04 +-9.8488815794377216e-04 +-9.7944967568744184e-04 +-9.7221665335976454e-04 +-9.6339634099193569e-04 +-9.5322621637307847e-04 +-9.4195903743938343e-04 +-9.2984945695941254e-04 +-9.1714305921496370e-04 +-9.0406821371822915e-04 +-8.9083074176986429e-04 +-8.7761110466024481e-04 +-8.6456365744875922e-04 +-8.5181745363290104e-04 +-8.3947810509124327e-04 +-8.2763026795445766e-04 +-8.1634041260471410e-04 +-8.0565962616063833e-04 +-7.9562627716937503e-04 +-7.8626843929402836e-04 +-7.7760602215491681e-04 +-7.6965259423451111e-04 +-7.6241690717188365e-04 +-7.5590414551159133e-04 +-7.5011693356335683e-04 +-7.4505613363503817e-04 +-7.4072146924029306e-04 +-7.3711200423386939e-04 +-7.3422650510385191e-04 +-7.3206370945067868e-04 +-7.3062251939431163e-04 +-7.2990213446506673e-04 +-8.0313947294324351e-04 +-8.0471815323956693e-04 +-8.0784353338417421e-04 +-8.1245145861492192e-04 +-8.1844530824545737e-04 +-8.2569579424920903e-04 +-8.3404111974069652e-04 +-8.4328783049131208e-04 +-8.5321272656303999e-04 +-8.6356619233731032e-04 +-8.7407723851557579e-04 +-8.8446041978484404e-04 +-8.9442459618622777e-04 +-9.0368325776341138e-04 +-9.1196586038850961e-04 +-9.1902937105627124e-04 +-9.2466904770836344e-04 +-9.2872743257026754e-04 +-9.3110065046443039e-04 +-9.3174137291209577e-04 +-9.3065819489625355e-04 +-9.2791160248085981e-04 +-9.2360710202164082e-04 +-9.1788636256859811e-04 +-9.1091735011206328e-04 +-9.0288440246397974e-04 +-8.9397903785086940e-04 +-8.8439205977175527e-04 +-8.7430726958413470e-04 +-8.6389687076487108e-04 +-8.5331847209765388e-04 +-8.4271348116037362e-04 +-8.3220662101021964e-04 +-8.2190629054483739e-04 +-8.1190550841098326e-04 +-8.0228321799862945e-04 +-7.9310577611186271e-04 +-7.8442849274062423e-04 +-7.7629712940427214e-04 +-7.6874929664651323e-04 +-7.6181571694028101e-04 +-7.5552133803617196e-04 +-7.4988629468635524e-04 +-7.4492672488678843e-04 +-7.4065545144958030e-04 +-7.3708254183217333e-04 +-7.3421575951364130e-04 +-7.3206091942177177e-04 +-7.3062215842692555e-04 +-7.2990213001186471e-04 +-7.5076474166962818e-04 +-7.5224126295874328e-04 +-7.5516880479178353e-04 +-7.5949621818149503e-04 +-7.6514647378642282e-04 +-7.7201646817154151e-04 +-7.7997704525234717e-04 +-7.8887345246675075e-04 +-7.9852647658715465e-04 +-8.0873450470258417e-04 +-8.1927672435650768e-04 +-8.2991760747997811e-04 +-8.4041271410231668e-04 +-8.5051570890492612e-04 +-8.5998631986306440e-04 +-8.6859880527226895e-04 +-8.7615036124238260e-04 +-8.8246882519158181e-04 +-8.8741903496504352e-04 +-8.9090729781033003e-04 +-8.9288360050715986e-04 +-8.9334142527852482e-04 +-8.9231528658211250e-04 +-8.8987632885535479e-04 +-8.8612648912973259e-04 +-8.8119181063151973e-04 +-8.7521549182712312e-04 +-8.6835118374377221e-04 +-8.6075693075966071e-04 +-8.5259001317467117e-04 +-8.4400281713110654e-04 +-8.3513974522586381e-04 +-8.2613509781254634e-04 +-8.1711180198300326e-04 +-8.0818083917067818e-04 +-7.9944121732424380e-04 +-7.9098034308610211e-04 +-7.8287466739096164e-04 +-7.7519049960613395e-04 +-7.6798490739449774e-04 +-7.6130663978179146e-04 +-7.5519702835636325e-04 +-7.4969083574185497e-04 +-7.4481703154154655e-04 +-7.4059948419439724e-04 +-7.3705756304963020e-04 +-7.3420664892596044e-04 +-7.3205855389381325e-04 +-7.3062185238112411e-04 +-7.2990212623627051e-04 +-7.1661641578291591e-04 +-7.1802625004374729e-04 +-7.2082432672912282e-04 +-7.2496734309636672e-04 +-7.3039009212292044e-04 +-7.3700528240184073e-04 +-7.4470349736237935e-04 +-7.5335345096194889e-04 +-7.6280271681919540e-04 +-7.7287911182669848e-04 +-7.8339289906726405e-04 +-7.9413993472968604e-04 +-8.0490581819087092e-04 +-8.1547101546894124e-04 +-8.2561682031125506e-04 +-8.3513190552271684e-04 +-8.4381911501171867e-04 +-8.5150207155207369e-04 +-8.5803114214961303e-04 +-8.6328832274838935e-04 +-8.6719067905094980e-04 +-8.6969210278096422e-04 +-8.7078329598807701e-04 +-8.7049005729884679e-04 +-8.6887008960038136e-04 +-8.6600865874026040e-04 +-8.6201349544769114e-04 +-8.5700934520750434e-04 +-8.5113253916464782e-04 +-8.4452589515180158e-04 +-8.3733417598675741e-04 +-8.2970024604077700e-04 +-8.2176198766050336e-04 +-8.1364997341222241e-04 +-8.0548584154403258e-04 +-7.9738129063840148e-04 +-7.8943759314679539e-04 +-7.8174552324485568e-04 +-7.7438559880471387e-04 +-7.6742854709146318e-04 +-7.6093591643630447e-04 +-7.5496076965906190e-04 +-7.4954840806729984e-04 +-7.4473708663597149e-04 +-7.4055869106685163e-04 +-7.3703935572034423e-04 +-7.3420000797692626e-04 +-7.3205682959209318e-04 +-7.3062162929629453e-04 +-7.2990212348419666e-04 +-6.9978948768728664e-04 +-7.0116640649695386e-04 +-7.0390048539861565e-04 +-7.0795210144332496e-04 +-7.1326159325156081e-04 +-7.1974909017207781e-04 +-7.2731444856651277e-04 +-7.3583742486010633e-04 +-7.4517823212700326e-04 +-7.5517863205703270e-04 +-7.6566370384623854e-04 +-7.7644440312034184e-04 +-7.8732097610276339e-04 +-7.9808722782575582e-04 +-8.0853556221240086e-04 +-8.1846262361263500e-04 +-8.2767528411165948e-04 +-8.3599665072393219e-04 +-8.4327172343324239e-04 +-8.4937232849838153e-04 +-8.5420098634859671e-04 +-8.5769344827287518e-04 +-8.5981974282479696e-04 +-8.6058369775329985e-04 +-8.6002102956840446e-04 +-8.5819620390681177e-04 +-8.5519835223968777e-04 +-8.5113657623485655e-04 +-8.4613497871171217e-04 +-8.4032773394460277e-04 +-8.3385445860178705e-04 +-8.2685607837236020e-04 +-8.1947131469045479e-04 +-8.1183384950629807e-04 +-8.0407016971257466e-04 +-7.9629804973121803e-04 +-7.8862560156389781e-04 +-7.8115080517694735e-04 +-7.7396142621788367e-04 +-7.6713523010698171e-04 +-7.6074040890838619e-04 +-7.5483614779830598e-04 +-7.4947326962193932e-04 +-7.4469490767511515e-04 +-7.4053716762479554e-04 +-7.3702974892314902e-04 +-7.3419650398644861e-04 +-7.3205591979829841e-04 +-7.3062151159096565e-04 +-7.2990212203213477e-04 +-6.9978947726932273e-04 +-7.0116631261592070e-04 +-7.0390022401469637e-04 +-7.0795158764119380e-04 +-7.1326074149443580e-04 +-7.1974781537110502e-04 +-7.2731266819539933e-04 +-7.3583506227756831e-04 +-7.4517522115319281e-04 +-7.5517492267570272e-04 +-7.6565926867501900e-04 +-7.7643924402868796e-04 +-7.8731513010484402e-04 +-7.9808077119801122e-04 +-8.0852861175595241e-04 +-8.1845533416095709e-04 +-8.2766784179852696e-04 +-8.3598926214121085e-04 +-8.4326460152154604e-04 +-8.4936567667378638e-04 +-8.5419498281047999e-04 +-8.5768823253442705e-04 +-8.5981540621379838e-04 +-8.6058027900272685e-04 +-8.6001851579722605e-04 +-8.5819453646663159e-04 +-8.5519743624547521e-04 +-8.5113629222163020e-04 +-8.4613519479613314e-04 +-8.4032831707797162e-04 +-8.3385528388647270e-04 +-8.2685703586911190e-04 +-8.1947231357457745e-04 +-8.1183481977227208e-04 +-8.0407106185047120e-04 +-7.9629883290515866e-04 +-7.8862626083343694e-04 +-7.8115133824602678e-04 +-7.7396184010263902e-04 +-7.6713553800784016e-04 +-7.6074062747104115e-04 +-7.5483629486250447e-04 +-7.4947336249088850e-04 +-7.4469496189177409e-04 +-7.4053719621199185e-04 +-7.3702976202869952e-04 +-7.3419650886845020e-04 +-7.3205592108590276e-04 +-7.3062151175929888e-04 +-7.2990212203423227e-04 +-7.1661638290061312e-04 +-7.1802595372782931e-04 +-7.2082350173975477e-04 +-7.2496572150712992e-04 +-7.3038740428101609e-04 +-7.3700126059998673e-04 +-7.4469788297785295e-04 +-7.5334600557943872e-04 +-7.6279323744267034e-04 +-7.7286744967273047e-04 +-7.8337898063500294e-04 +-7.9412378294696658e-04 +-8.0488757060883862e-04 +-8.1545093595430246e-04 +-8.2559530072120991e-04 +-8.3510945463771886e-04 +-8.4379633358563379e-04 +-8.5147961453353749e-04 +-8.5800967151833786e-04 +-8.6326845643679379e-04 +-8.6717294254076357e-04 +-8.6967688982922289e-04 +-8.7077084352601270e-04 +-8.7048043718424982e-04 +-8.6886321715457784e-04 +-8.6600431549101783e-04 +-8.6201136172984528e-04 +-8.5700903749735434e-04 +-8.5113364722296664e-04 +-8.4452801499227943e-04 +-8.3733693603512348e-04 +-8.2970332527005936e-04 +-8.2176512572303031e-04 +-8.1365297369250834e-04 +-8.0548856858753039e-04 +-7.9738366360607063e-04 +-7.8943957688471162e-04 +-7.8174711833455934e-04 +-7.7438683165809575e-04 +-7.6742946083866598e-04 +-7.6093656306893320e-04 +-7.5496120365645971e-04 +-7.4954868155785285e-04 +-7.4473724602536315e-04 +-7.4055877499221222e-04 +-7.3703939415245784e-04 +-7.3420002228110791e-04 +-7.3205683336234997e-04 +-7.3062162978895610e-04 +-7.2990212349029605e-04 +-7.5076468116676883e-04 +-7.5224071774510092e-04 +-7.5516728688664893e-04 +-7.5949323495069256e-04 +-7.6514153030631860e-04 +-7.7200907510228175e-04 +-7.7996673371733764e-04 +-7.8885979688998644e-04 +-7.9850912550591499e-04 +-8.0871321819881012e-04 +-8.1925141500154106e-04 +-8.2988837980116587e-04 +-8.4037989598185613e-04 +-8.5047986757167912e-04 +-8.5994825578696195e-04 +-8.6855951964107060e-04 +-8.7611099667049509e-04 +-8.8243058420682335e-04 +-8.8738308551149670e-04 +-8.9087467822196464e-04 +-8.9285513716994729e-04 +-8.9331767419736463e-04 +-8.9229650579345377e-04 +-8.8986248319686148e-04 +-8.8611728364655325e-04 +-8.8118674500594631e-04 +-8.7521392628845123e-04 +-8.6835240697507123e-04 +-8.6076022192523179e-04 +-8.5259469266961115e-04 +-8.4400828332696002e-04 +-8.3514549683920956e-04 +-8.2614074326632170e-04 +-8.1711705818207614e-04 +-8.0818552254197638e-04 +-7.9944522992599868e-04 +-7.9098365624021211e-04 +-7.8287730478976783e-04 +-7.7519252130664386e-04 +-7.6798639561588631e-04 +-7.6130768700713458e-04 +-7.5519772792164038e-04 +-7.4969127487130435e-04 +-7.4481728664556161e-04 +-7.4059961816727582e-04 +-7.3705762427209815e-04 +-7.3420667167569851e-04 +-7.3205855988301913e-04 +-7.3062185316314504e-04 +-7.2990212624597162e-04 +-8.0313937532062237e-04 +-8.0471727353384872e-04 +-8.0784108437119222e-04 +-8.1244664629341698e-04 +-8.1843733715705291e-04 +-8.2568388299013112e-04 +-8.3402452932742472e-04 +-8.4326590706451838e-04 +-8.5318495791616988e-04 +-8.6353227487133725e-04 +-8.7403714767493568e-04 +-8.8441447345067160e-04 +-8.9437349792362254e-04 +-9.0362810647292538e-04 +-9.1190811581156510e-04 +-9.1897077098485025e-04 +-9.2461148173563184e-04 +-9.2867278670357280e-04 +-9.3105064420502201e-04 +-9.3169741314755577e-04 +-9.3062126813432179e-04 +-9.2788221933758606e-04 +-9.2358529770344120e-04 +-9.1787174718215665e-04 +-9.1090919537285635e-04 +-9.0288174797665426e-04 +-8.9398080053629627e-04 +-8.8439713320424840e-04 +-8.7431460457832670e-04 +-8.6390553322823760e-04 +-8.5332767805879105e-04 +-8.4272261158284574e-04 +-8.3221522047956437e-04 +-8.2191405438085223e-04 +-8.1191226251270279e-04 +-8.0228889507480796e-04 +-7.9311039112676181e-04 +-7.8443211958032671e-04 +-7.7629988004034977e-04 +-7.6875130348593617e-04 +-7.6181711861107477e-04 +-7.5552226855446394e-04 +-7.4988687575902038e-04 +-7.4492706099902348e-04 +-7.4065562734398536e-04 +-7.3708262198432615e-04 +-7.3421578923185086e-04 +-7.3206092723282078e-04 +-7.3062215944571607e-04 +-7.2990213002447398e-04 +-8.7486204787996541e-04 +-8.7657923772047779e-04 +-8.7997182611489308e-04 +-8.8495597429603132e-04 +-8.9140543641643918e-04 +-8.9915139489342097e-04 +-9.0798291736185835e-04 +-9.1764855805193753e-04 +-9.2785967004404256e-04 +-9.3829596187493421e-04 +-9.4861369922414132e-04 +-9.5845670537838027e-04 +-9.6746995677431992e-04 +-9.7531513394521899e-04 +-9.8168703826263652e-04 +-9.8632941391228138e-04 +-9.8904852611168977e-04 +-9.8972292475699836e-04 +-9.8830819799458083e-04 +-9.8483614617115483e-04 +-9.7940856164161296e-04 +-9.7218651949615019e-04 +-9.6337661275537416e-04 +-9.5321580539902708e-04 +-9.4195651345415808e-04 +-9.2985322009321949e-04 +-9.1715149143175526e-04 +-9.0407979692061643e-04 +-8.9084413838373374e-04 +-8.7762520271496584e-04 +-8.6457758592704945e-04 +-8.5183057544337441e-04 +-8.3948999501430241e-04 +-8.2764068196938812e-04 +-8.1634925365001328e-04 +-8.0566690997216654e-04 +-7.9563210058813364e-04 +-7.8627295242646850e-04 +-7.7760940501777872e-04 +-7.6965503799669873e-04 +-7.6241859977440262e-04 +-7.5590526125716279e-04 +-7.5011762617880370e-04 +-7.4505653228829560e-04 +-7.4072167701414360e-04 +-7.3711209860137159e-04 +-7.3422654000265266e-04 +-7.3206371860593423e-04 +-7.3062252058693640e-04 +-7.2990213447983432e-04 +-9.6691701964451201e-04 +-9.6881264321861541e-04 +-9.7254800220024948e-04 +-9.7801097288876767e-04 +-9.8503274649437808e-04 +-9.9338775578280535e-04 +-1.0027946602573113e-03 +-1.0129192203611281e-03 +-1.0233799466438640e-03 +-1.0337573287431134e-03 +-1.0436071896811256e-03 +-1.0524782492171913e-03 +-1.0599333294007906e-03 +-1.0655728672100361e-03 +-1.0690586518475704e-03 +-1.0701351705873199e-03 +-1.0686458272919808e-03 +-1.0645417249942057e-03 +-1.0578816690571566e-03 +-1.0488233663555771e-03 +-1.0376071518999152e-03 +-1.0245346270722515e-03 +-1.0099451046109158e-03 +-9.9419266593151921e-04 +-9.7762606391113170e-04 +-9.6057287158267011e-04 +-9.4332841844377497e-04 +-9.2614934544910533e-04 +-9.0925113269210310e-04 +-8.9280871619281256e-04 +-8.7695926724230767e-04 +-8.6180629465603775e-04 +-8.4742438489991397e-04 +-8.3386406947665655e-04 +-8.2115647245281631e-04 +-8.0931752776896974e-04 +-7.9835166094261996e-04 +-7.8825490441417176e-04 +-7.7901746478904689e-04 +-7.7062578930171127e-04 +-7.6306419341830073e-04 +-7.5631611621287378e-04 +-7.5036506858611597e-04 +-7.4519533417018819e-04 +-7.4079247569851356e-04 +-7.3714369189819141e-04 +-7.3423806231198534e-04 +-7.3206671026454918e-04 +-7.3062290764029430e-04 +-7.2990213925497923e-04 +-1.0795747024845992e-03 +-1.0816881919594574e-03 +-1.0858398902447673e-03 +-1.0918787683436317e-03 +-1.0995775004215896e-03 +-1.1086325887679359e-03 +-1.1186662360114568e-03 +-1.1292312649764339e-03 +-1.1398204567983291e-03 +-1.1498815146795615e-03 +-1.1588383883880549e-03 +-1.1661188675100029e-03 +-1.1711871953532143e-03 +-1.1735791145290942e-03 +-1.1729355194415355e-03 +-1.1690301626156952e-03 +-1.1617870325984435e-03 +-1.1512842803364724e-03 +-1.1377437429555006e-03 +-1.1215076492790384e-03 +-1.1030062610720402e-03 +-1.0827214067770186e-03 +-1.0611508708272804e-03 +-1.0387775993576382e-03 +-1.0160461297853303e-03 +-9.9334704793765678e-04 +-9.7100898816873476e-04 +-9.4929688282583845e-04 +-9.2841482669853278e-04 +-9.0851193770386158e-04 +-8.8968982560836015e-04 +-8.7201060228201755e-04 +-8.5550469340133352e-04 +-8.4017799422195130e-04 +-8.2601813187199453e-04 +-8.1299975299254973e-04 +-8.0108885740861658e-04 +-7.9024625811510848e-04 +-7.8043027722249695e-04 +-7.7159879674828147e-04 +-7.6371078000846777e-04 +-7.5672736938305453e-04 +-7.5061265309649984e-04 +-7.4533417968682819e-04 +-7.4086328538152443e-04 +-7.3717528734012128e-04 +-7.3424958493808925e-04 +-7.3206970196647075e-04 +-7.3062329469913772e-04 +-7.2990214403035301e-04 +-1.2115503797091279e-03 +-1.2139184753665200e-03 +-1.2185541047919466e-03 +-1.2252555243212125e-03 +-1.2337191511531029e-03 +-1.2435400044248546e-03 +-1.2542148629682802e-03 +-1.2651501025483973e-03 +-1.2756762846668750e-03 +-1.2850713148465796e-03 +-1.2925932262642509e-03 +-1.2975222584888652e-03 +-1.2992098960922338e-03 +-1.2971301676466514e-03 +-1.2909263927448308e-03 +-1.2804455843285873e-03 +-1.2657536644671925e-03 +-1.2471277381007056e-03 +-1.2250261766736143e-03 +-1.2000417493904438e-03 +-1.1728460085496373e-03 +-1.1441337674844791e-03 +-1.1145749663350386e-03 +-1.0847783957173851e-03 +-1.0552687256380670e-03 +-1.0264758774411139e-03 +-9.9873433115125511e-04 +-9.7228943691937035e-04 +-9.4730794146672716e-04 +-9.2389044751733267e-04 +-9.0208415087081513e-04 +-8.8189478981630777e-04 +-8.6329721964672579e-04 +-8.4624437192076687e-04 +-8.3067458594406703e-04 +-8.1651743366392574e-04 +-8.0369822550254268e-04 +-7.9214140666595775e-04 +-7.8177304882895925e-04 +-7.7252262323373989e-04 +-7.6432421625951153e-04 +-7.5711732233897633e-04 +-7.5084732442572285e-04 +-7.4546575033829449e-04 +-7.4093037464131927e-04 +-7.3720522019614420e-04 +-7.3426050080895229e-04 +-7.3207253609766459e-04 +-7.3062366137190474e-04 +-7.2990214855441274e-04 +-1.3589574535022668e-03 +-1.3616093564205543e-03 +-1.3667821278644989e-03 +-1.3742128909640361e-03 +-1.3835061096158581e-03 +-1.3941343267056447e-03 +-1.4054427047578211e-03 +-1.4166601513100412e-03 +-1.4269200819613369e-03 +-1.4352936802576515e-03 +-1.4408375398214191e-03 +-1.4426554440735567e-03 +-1.4399705599980074e-03 +-1.4321999194503638e-03 +-1.4190191178759628e-03 +-1.4004037617109995e-03 +-1.3766370336394732e-03 +-1.3482797469782073e-03 +-1.3161081194399524e-03 +-1.2810317600877039e-03 +-1.2440073928821219e-03 +-1.2059621534334197e-03 +-1.1677354261922404e-03 +-1.1300424719472625e-03 +-1.0934584170362157e-03 +-1.0584183958740783e-03 +-1.0252286983891998e-03 +-9.9408412567496426e-04 +-9.6508776670926747e-04 +-9.3827058374200997e-04 +-9.1360924388277412e-04 +-8.9104143948692263e-04 +-8.7047848811875272e-04 +-8.5181533495382348e-04 +-8.3493825325626277e-04 +-8.1973060529732665e-04 +-8.0607702883545929e-04 +-7.9386638284563991e-04 +-7.8299373990986076e-04 +-7.7336166311858876e-04 +-7.6488095871551757e-04 +-7.5747105490442011e-04 +-7.5106012308775462e-04 +-7.4558503010083708e-04 +-7.4099118801244945e-04 +-7.3723235086634964e-04 +-7.3427039443243851e-04 +-7.3207510479060946e-04 +-7.3062399370307112e-04 +-7.2990215265501389e-04 +-1.5143523068036485e-03 +-1.5173032518342134e-03 +-1.5230417465666845e-03 +-1.5312399534989944e-03 +-1.5414044113090685e-03 +-1.5528765234333348e-03 +-1.5648374020080266e-03 +-1.5763206454016345e-03 +-1.5862374942729805e-03 +-1.5934193467032219e-03 +-1.5966820144102348e-03 +-1.5949131126807849e-03 +-1.5871776289889919e-03 +-1.5728277515216680e-03 +-1.5515949405870244e-03 +-1.5236401790228006e-03 +-1.4895457973681740e-03 +-1.4502475879032519e-03 +-1.4069224876750116e-03 +-1.3608574999565760e-03 +-1.3133261778805738e-03 +-1.2654916316495123e-03 +-1.2183444031059912e-03 +-1.1726741853747300e-03 +-1.1290685858994108e-03 +-1.0879300726925757e-03 +-1.0495028139265118e-03 +-1.0139029899165488e-03 +-9.8114830740418158e-04 +-9.5118431105532092e-04 +-9.2390645887846458e-04 +-8.9917781325545476e-04 +-8.7684269660328522e-04 +-8.5673688820326113e-04 +-8.3869499815068100e-04 +-8.2255562068595705e-04 +-8.0816479200167594e-04 +-7.9537818690846691e-04 +-7.8406240077344154e-04 +-7.7409558555960431e-04 +-7.6536764415570705e-04 +-7.5778013534735940e-04 +-7.5124600132148070e-04 +-7.4568919865301419e-04 +-7.4104429042700336e-04 +-7.3725603982086518e-04 +-7.3427903271138146e-04 +-7.3207734753581819e-04 +-7.3062428386410207e-04 +-7.2990215623556847e-04 +-1.6665433304530091e-03 +-1.6697880691358092e-03 +-1.6760869973530385e-03 +-1.6850576388665671e-03 +-1.6961234661257245e-03 +-1.7085123579192105e-03 +-1.7212579431759923e-03 +-1.7332077851882357e-03 +-1.7430449886101252e-03 +-1.7493329310617626e-03 +-1.7505942940922923e-03 +-1.7454316219137282e-03 +-1.7326841103125397e-03 +-1.7115959197184685e-03 +-1.6819541596737196e-03 +-1.6441524230328193e-03 +-1.5991544722007587e-03 +-1.5483649254960765e-03 +-1.4934427331011640e-03 +-1.4361050696696052e-03 +-1.3779619703675615e-03 +-1.3204037292495880e-03 +-1.2645442592765337e-03 +-1.2112108986748599e-03 +-1.1609659244782380e-03 +-1.1141453979418470e-03 +-1.0709041615958835e-03 +-1.0312596685305279e-03 +-9.9513065838986552e-04 +-9.6236908860728061e-04 +-9.3278521555936115e-04 +-9.0616650804304483e-04 +-8.8229139785073022e-04 +-8.6093892014279920e-04 +-8.4189520344149808e-04 +-8.2495761901209004e-04 +-8.0993723930913657e-04 +-7.9666010846802301e-04 +-7.8496770381463951e-04 +-7.7471686769092275e-04 +-7.6577941149402306e-04 +-7.5804153522946946e-04 +-7.5140316238023999e-04 +-7.4577725811921750e-04 +-7.4108917601043616e-04 +-7.3727606207787098e-04 +-7.3428633372022236e-04 +-7.3207924307243930e-04 +-7.3062452910434967e-04 +-7.2990215926217023e-04 +-1.8021172372851794e-03 +-1.8056264388136795e-03 +-1.8124426952618713e-03 +-1.8221598393458483e-03 +-1.8341634519617044e-03 +-1.8476235926430415e-03 +-1.8614846314569614e-03 +-1.8744554733628267e-03 +-1.8850101549657133e-03 +-1.8914182570637455e-03 +-1.8918316724706593e-03 +-1.8844492969460481e-03 +-1.8677557963076637e-03 +-1.8407889874125258e-03 +-1.8033553694096426e-03 +-1.7561136446952439e-03 +-1.7004901188952110e-03 +-1.6384537041885586e-03 +-1.5722241877379564e-03 +-1.5039944127716244e-03 +-1.4357218027558987e-03 +-1.3690088182215820e-03 +-1.3050636375324144e-03 +-1.2447183530237859e-03 +-1.1884800660335332e-03 +-1.1365950147130587e-03 +-1.0891125782556993e-03 +-1.0459419874985700e-03 +-1.0068988685252582e-03 +-9.7174136893581672e-04 +-9.4019696555199461e-04 +-9.1198157404422315e-04 +-8.8681263255521562e-04 +-8.6441765463846803e-04 +-8.4453948680653741e-04 +-8.2693924028878079e-04 +-8.1139763089550061e-04 +-7.9771526719186678e-04 +-7.8571227550105842e-04 +-7.7522753536206747e-04 +-7.6611771415775829e-04 +-7.5825622808899616e-04 +-7.5153221280057150e-04 +-7.4584955616006714e-04 +-7.4112602439914009e-04 +-7.3729249835981789e-04 +-7.3429232699211340e-04 +-7.3208079907585179e-04 +-7.3062473041677733e-04 +-7.2990216174702814e-04 +-1.9091978447286497e-03 +-1.9129209529418914e-03 +-1.9201782434480385e-03 +-1.9305892890022977e-03 +-1.9435742597270593e-03 +-1.9583358545008011e-03 +-1.9738264054790658e-03 +-1.9887008786456631e-03 +-2.0012701422696230e-03 +-2.0094902275534072e-03 +-2.0110424334534695e-03 +-2.0035547375353026e-03 +-1.9849666992590672e-03 +-1.9539560839947527e-03 +-1.9102775621036340e-03 +-1.8548733389863955e-03 +-1.7897100050558530e-03 +-1.7174128446990941e-03 +-1.6408336315650520e-03 +-1.5626766555270925e-03 +-1.4852504456009071e-03 +-1.4103531457300093e-03 +-1.3392629145457914e-03 +-1.2727933876886199e-03 +-1.2113789828925759e-03 +-1.1551656508137513e-03 +-1.1040932879556830e-03 +-1.0579638922722481e-03 +-1.0164943929011992e-03 +-9.7935559113129355e-04 +-9.4619963557935271e-04 +-9.1667858855904317e-04 +-8.9045636948741861e-04 +-8.6721594694246710e-04 +-8.4666322947170281e-04 +-8.2852873611776389e-04 +-8.1256782910845001e-04 +-7.9856006141650233e-04 +-7.8630802098324703e-04 +-7.7563592939609307e-04 +-7.6638816460110305e-04 +-7.5842781553390505e-04 +-7.5163533408090645e-04 +-7.4590732101875972e-04 +-7.4115546348848258e-04 +-7.3730562920030986e-04 +-7.3429711489579217e-04 +-7.3208204212948393e-04 +-7.3062489124068285e-04 +-7.2990216373260510e-04 +-1.9822013073338206e-03 +-1.9860770469908502e-03 +-1.9936782627924888e-03 +-2.0047010887293314e-03 +-2.0186755771134761e-03 +-2.0349334795683712e-03 +-2.0525443377871454e-03 +-2.0702148342419779e-03 +-2.0861678460932110e-03 +-2.0980562798301734e-03 +-2.1030089939776475e-03 +-2.0979113801954065e-03 +-2.0799430405367210e-03 +-2.0472376528149340e-03 +-1.9994027638611305e-03 +-1.9376656296271608e-03 +-1.8645944943228457e-03 +-1.7835426774820637e-03 +-1.6980428135249547e-03 +-1.6113280715943084e-03 +-1.5260518699431755e-03 +-1.4441909734904123e-03 +-1.3670760660270071e-03 +-1.2954902519846136e-03 +-1.2297903276608688e-03 +-1.1700234871032955e-03 +-1.1160264560100359e-03 +-1.0675032701955144e-03 +-1.0240828591701178e-03 +-9.8535968691380741e-04 +-9.5092117278821426e-04 +-9.2036530396248564e-04 +-8.9331124878387386e-04 +-8.6940514194965750e-04 +-8.4832264826200396e-04 +-8.2976945688624916e-04 +-8.1348051079669303e-04 +-7.9921852054724754e-04 +-7.8677212836618642e-04 +-7.7595396000455135e-04 +-7.6659871307854940e-04 +-7.5856137043926991e-04 +-7.5171558693085095e-04 +-7.4595227159797754e-04 +-7.4117837065757245e-04 +-7.3731584627069425e-04 +-7.3430084030065091e-04 +-7.3208300932972917e-04 +-7.3062501637545421e-04 +-7.2990216527808879e-04 +-2.0242452370556256e-03 +-2.0282158687259960e-03 +-2.0360589552412974e-03 +-2.0475743598210318e-03 +-2.0624440675092765e-03 +-2.0801883328792343e-03 +-2.1000738638120371e-03 +-2.1209586690849351e-03 +-2.1410828489137426e-03 +-2.1578720641327641e-03 +-2.1679023160660294e-03 +-2.1672140348173337e-03 +-2.1520516989468118e-03 +-2.1198316409055287e-03 +-2.0699089469496867e-03 +-2.0037712351782633e-03 +-1.9246103788144410e-03 +-1.8365339628501334e-03 +-1.7437631157929314e-03 +-1.6500482101167416e-03 +-1.5583667817231841e-03 +-1.4708548479773103e-03 +-1.3888837245780179e-03 +-1.3132031156218658e-03 +-1.2440970869254516e-03 +-1.1815243606540676e-03 +-1.1252317918934620e-03 +-1.0748398730414199e-03 +-1.0299037678190609e-03 +-9.8995487007194887e-04 +-9.5452777902232185e-04 +-9.2317682822705188e-04 +-8.9548539870412073e-04 +-8.7107041326096933e-04 +-8.4958372750424467e-04 +-8.3071161109260299e-04 +-8.1417312966117130e-04 +-7.9971796475915042e-04 +-7.8712401883354957e-04 +-7.7619502205497301e-04 +-7.6675827015774078e-04 +-7.5866256445335711e-04 +-7.5177638753571045e-04 +-7.4598632431435339e-04 +-7.4119572344536313e-04 +-7.3732358579509604e-04 +-7.3430366230116536e-04 +-7.3208374198380753e-04 +-7.3062511116529598e-04 +-7.2990216644941517e-04 +-2.0445779271282415e-03 +-2.0485999299419163e-03 +-2.0565937188095559e-03 +-2.0684552597506349e-03 +-2.0840103305830131e-03 +-2.1029672271553083e-03 +-2.1248122923207356e-03 +-2.1486189867079399e-03 +-2.1727587406405440e-03 +-2.1945714313517314e-03 +-2.2101904807144989e-03 +-2.2148312888781246e-03 +-2.2037272320798869e-03 +-2.1734611074731994e-03 +-2.1230411483505779e-03 +-2.0541611009592354e-03 +-1.9706027761749604e-03 +-1.8771920949459727e-03 +-1.7787943540281349e-03 +-1.6796315936961660e-03 +-1.5829684003670374e-03 +-1.4910769623734891e-03 +-1.4053605701518988e-03 +-1.3265385345411127e-03 +-1.2548330287762582e-03 +-1.1901294240505818e-03 +-1.1321014122713071e-03 +-1.0803024562190725e-03 +-1.0342292498803684e-03 +-9.9336371110176898e-04 +-9.5719937383526130e-04 +-9.2525689756303123e-04 +-8.9709224653437369e-04 +-8.7230010000015985e-04 +-8.5051428160868746e-04 +-8.3140642413858322e-04 +-8.1468367719156136e-04 +-8.0008598088954664e-04 +-7.8738323442351576e-04 +-7.7637255795772353e-04 +-7.6687576044471434e-04 +-7.5873707013956039e-04 +-7.5182114930456227e-04 +-7.4601139280746026e-04 +-7.4120849759663494e-04 +-7.3732928310536055e-04 +-7.3430573965129354e-04 +-7.3208428130935161e-04 +-7.3062518094282869e-04 +-7.2990216731238383e-04 +-2.0529837166909665e-03 +-2.0570303541302157e-03 +-2.0651069687167740e-03 +-2.0771772767603737e-03 +-2.0931710455261254e-03 +-2.1129409594311211e-03 +-2.1361620100471988e-03 +-2.1621316327917047e-03 +-2.1894289813870018e-03 +-2.2154571375497933e-03 +-2.2360855788908884e-03 +-2.2458404596683115e-03 +-2.2389941671531431e-03 +-2.2112755863918318e-03 +-2.1612919435931950e-03 +-2.0908731245162832e-03 +-2.0043065806213912e-03 +-1.9070426750295438e-03 +-1.8045003387218929e-03 +-1.7012995612965475e-03 +-1.6009421446152256e-03 +-1.5058103017921520e-03 +-1.4173321485960863e-03 +-1.3362023744776233e-03 +-1.2625944687588949e-03 +-1.1963369860217060e-03 +-1.1370476177970171e-03 +-1.0842290272325178e-03 +-1.0373339689972482e-03 +-9.9580745068836058e-04 +-9.5911256460344801e-04 +-9.2674514619389302e-04 +-8.9824104734934984e-04 +-8.7317870063575575e-04 +-8.5117880992794791e-04 +-8.3190239500650302e-04 +-8.1504799173928776e-04 +-8.0034851754672205e-04 +-7.8756811571067649e-04 +-7.7649916228695985e-04 +-7.6695953514235979e-04 +-7.5879019080400927e-04 +-7.5185306145899959e-04 +-7.4602926430246852e-04 +-7.4121760417308197e-04 +-7.3733334462009555e-04 +-7.3430722055213495e-04 +-7.3208466578345119e-04 +-7.3062523068611446e-04 +-7.2990216792842219e-04 +-2.0560407435205683e-03 +-2.0600982467097718e-03 +-2.0682164627162814e-03 +-2.0803994673790362e-03 +-2.0966402773842183e-03 +-2.1168839203232113e-03 +-2.1409380527270903e-03 +-2.1682833651988191e-03 +-2.1977151819827772e-03 +-2.2267897929348609e-03 +-2.2512804080706090e-03 +-2.2652172042948774e-03 +-2.2620677064939198e-03 +-2.2367915793010890e-03 +-2.1876015948665713e-03 +-2.1164002813498441e-03 +-2.0278686402454798e-03 +-1.9279520742069155e-03 +-1.8225056174693977e-03 +-1.7164587792035055e-03 +-1.6134952685978557e-03 +-1.5160804911251730e-03 +-1.4256610463349922e-03 +-1.3429133623481574e-03 +-1.2679752438541319e-03 +-1.2006339741385142e-03 +-1.1404668774671874e-03 +-1.0869402402471947e-03 +-1.0394755330764367e-03 +-9.9749161510819971e-04 +-9.6043010685302010e-04 +-9.2776940145469073e-04 +-8.9903126693922995e-04 +-8.7378279313892989e-04 +-8.5163554874804950e-04 +-8.3224318141737470e-04 +-8.1529825634212277e-04 +-8.0052883226967549e-04 +-7.8769507683339808e-04 +-7.7658609399229887e-04 +-7.6701705356812221e-04 +-7.5882666051770660e-04 +-7.5187496971740461e-04 +-7.4604153309284344e-04 +-7.4122385575273360e-04 +-7.3733613279260341e-04 +-7.3430823716748468e-04 +-7.3208492971908886e-04 +-7.3062526483448523e-04 +-7.2990216835233982e-04 +-2.0570060736567427e-03 +-2.0610682037141602e-03 +-2.0692069322685715e-03 +-2.0814492035836508e-03 +-2.0978239514932054e-03 +-2.1183294131887089e-03 +-2.1428536334173833e-03 +-2.1710009724870646e-03 +-2.2017395075721018e-03 +-2.2327926749155149e-03 +-2.2599412407514766e-03 +-2.2769027676353198e-03 +-2.2765469640175086e-03 +-2.2532238354041161e-03 +-2.2048134216008067e-03 +-2.1332479651851983e-03 +-2.0434878576006442e-03 +-1.9418365316925038e-03 +-1.8344634399712005e-03 +-1.7265194120368076e-03 +-1.6218170276554396e-03 +-1.5228801275619724e-03 +-1.4311682463968400e-03 +-1.3473452854662199e-03 +-1.2715246557256665e-03 +-1.2034655734195897e-03 +-1.1427180424119592e-03 +-1.0887238345791705e-03 +-1.0408834171007819e-03 +-9.9859815144084626e-04 +-9.6129533142272935e-04 +-9.2844174173159922e-04 +-8.9954979819502790e-04 +-8.7417907370291388e-04 +-8.5193509374789308e-04 +-8.3246663683145510e-04 +-8.1546233021744538e-04 +-8.0064703216031427e-04 +-7.8777829435842765e-04 +-7.7664306982499565e-04 +-7.6705474966735400e-04 +-7.5885056094133747e-04 +-7.5188932693819402e-04 +-7.4604957312379282e-04 +-7.4122795252916504e-04 +-7.3733795992804213e-04 +-7.3430890337224206e-04 +-7.3208510268078211e-04 +-7.3062528721292320e-04 +-7.2990216863136218e-04 +-2.0572330548991069e-03 +-2.0612971512467349e-03 +-2.0694462630590051e-03 +-2.0817203732106794e-03 +-2.0981686101757837e-03 +-2.1188185102735866e-03 +-2.1436023739046864e-03 +-2.1721969979401276e-03 +-2.2036850101048965e-03 +-2.2359229060556597e-03 +-2.2647365285967435e-03 +-2.2836666448741790e-03 +-2.2851866087826435e-03 +-2.2632205738126973e-03 +-2.2154061403225770e-03 +-2.1436833633231237e-03 +-2.0531935031448088e-03 +-1.9504754298645898e-03 +-1.8419050946097593e-03 +-1.7327779500903356e-03 +-1.6269903064575280e-03 +-1.5271037859009083e-03 +-1.4345862974695540e-03 +-1.3500938124712649e-03 +-1.2737242941261793e-03 +-1.2052192340191769e-03 +-1.1441114321155159e-03 +-1.0898272636428179e-03 +-1.0417540350514992e-03 +-9.9928216630178895e-04 +-9.6183000880710251e-04 +-9.2885711308434630e-04 +-8.9987007509893390e-04 +-8.7442379583518154e-04 +-8.5212004904301481e-04 +-8.3260459337902379e-04 +-8.1556361598304945e-04 +-8.0071999350731751e-04 +-7.8782965911030484e-04 +-7.7667823576879505e-04 +-7.6707801528706266e-04 +-7.5886531171515874e-04 +-7.5189818776041646e-04 +-7.4605453514261209e-04 +-7.4123048090641371e-04 +-7.3733908756810841e-04 +-7.3430931452993882e-04 +-7.3208520942697082e-04 +-7.3062530102463853e-04 +-7.2990216880509961e-04 +-2.0572420058198606e-03 +-2.0613069363917260e-03 +-2.0694613056588618e-03 +-2.0817523178525035e-03 +-2.0982401265202026e-03 +-2.1189678015615353e-03 +-2.1438904655077893e-03 +-2.1727231670093639e-03 +-2.2046143830655222e-03 +-2.2375065507087249e-03 +-2.2672682290114272e-03 +-2.2873488269081195e-03 +-2.2899876897667514e-03 +-2.2688480147058827e-03 +-2.2214147821567332e-03 +-2.1496278642998516e-03 +-2.0587341341700180e-03 +-1.9554115290013646e-03 +-1.8461579426843041e-03 +-1.7363539933333639e-03 +-1.6299451410695944e-03 +-1.5295151324124961e-03 +-1.4365367984703447e-03 +-1.3516615460577440e-03 +-1.2749784262283297e-03 +-1.2062187170955594e-03 +-1.1449053201700464e-03 +-1.0904557648769408e-03 +-1.0422498064073071e-03 +-9.9967159414791375e-04 +-9.6213435993781915e-04 +-9.2909351649875553e-04 +-9.0005233366499216e-04 +-8.7456304429490419e-04 +-8.5222528090140616e-04 +-8.3268307961535779e-04 +-8.1562123644268356e-04 +-8.0076149882632301e-04 +-7.8785887797809073e-04 +-7.7669823952939982e-04 +-7.6709124950828428e-04 +-7.5887370236376109e-04 +-7.5190322802929830e-04 +-7.4605735767211486e-04 +-7.4123191911983012e-04 +-7.3733972900494197e-04 +-7.3430954841049328e-04 +-7.3208527014834927e-04 +-7.3062530888188409e-04 +-7.2990216890587295e-04 +-2.0572136693428108e-03 +-2.0612789425319519e-03 +-2.0694358049136935e-03 +-2.0817350881948927e-03 +-2.0982424367283260e-03 +-2.1190084978429118e-03 +-2.1439992104459338e-03 +-2.1729478012699932e-03 +-2.2050356981207259e-03 +-2.2382514830234170e-03 +-2.2684906905737498e-03 +-2.2891600073044241e-03 +-2.2923784837426582e-03 +-2.2716719725581632e-03 +-2.2244438140414393e-03 +-2.1526322234679432e-03 +-2.0615380960631890e-03 +-1.9579110623063134e-03 +-1.8483119040033592e-03 +-1.7381651080090163e-03 +-1.6314414171362918e-03 +-1.5307359520757406e-03 +-1.4375240891539417e-03 +-1.3524549241631309e-03 +-1.2756129775475056e-03 +-1.2067243353849743e-03 +-1.1453068699378620e-03 +-1.0907736189618123e-03 +-1.0425005055802830e-03 +-9.9986849875173295e-04 +-9.6228823493658305e-04 +-9.2921303010258603e-04 +-9.0014446927695049e-04 +-8.7463343427959545e-04 +-8.5227847371547726e-04 +-8.3272275200248940e-04 +-8.1565036131448778e-04 +-8.0078247790728980e-04 +-7.8787364673645749e-04 +-7.7670835048586958e-04 +-7.6709793880823981e-04 +-7.5887794348624999e-04 +-7.5190577569787971e-04 +-7.4605878437073098e-04 +-7.4123264609882080e-04 +-7.3734005323791067e-04 +-7.3430966663356675e-04 +-7.3208530084265552e-04 +-7.3062531285448238e-04 +-7.2990216895944674e-04 +-2.0571951315760694e-03 +-2.0612605313588251e-03 +-2.0694184069603942e-03 +-2.0817211110286554e-03 +-2.0982365761477557e-03 +-2.1190185651614787e-03 +-2.1440373732962131e-03 +-2.1730335293224292e-03 +-2.2052020954658894e-03 +-2.2385515266833147e-03 +-2.2689899218806607e-03 +-2.2899070102008288e-03 +-2.2933711544890932e-03 +-2.2728495081665409e-03 +-2.2257101591207423e-03 +-2.1538901895138238e-03 +-2.0627131881123316e-03 +-1.9589590829473522e-03 +-1.8492152610901725e-03 +-1.7389247705510158e-03 +-1.6320690531168975e-03 +-1.5312480488510760e-03 +-1.4379382238813084e-03 +-1.3527877134885827e-03 +-1.2758791404927192e-03 +-1.2069364134484003e-03 +-1.1454752945732514e-03 +-1.0909069369399254e-03 +-1.0426056557633881e-03 +-9.9995108557444251e-04 +-9.6235277393775728e-04 +-9.2926315717316169e-04 +-9.0018311352055801e-04 +-8.7466295805816330e-04 +-8.5230078472740183e-04 +-8.3273939230719333e-04 +-8.1566257776218649e-04 +-8.0079127778400643e-04 +-7.8787984178082095e-04 +-7.7671259183377506e-04 +-7.6710074491532902e-04 +-7.5887972265329144e-04 +-7.5190684448523054e-04 +-7.4605938291031292e-04 +-7.4123295109489434e-04 +-7.3734018926977353e-04 +-7.3430971623533476e-04 +-7.3208531372145999e-04 +-7.3062531452242790e-04 +-7.2990216898557417e-04 +-2.0571887353417018e-03 +-2.0612541707396774e-03 +-2.0694123472815695e-03 +-2.0817160745338916e-03 +-2.0982339652012116e-03 +-2.1190206927490097e-03 +-2.1440478010963607e-03 +-2.1730579110635331e-03 +-2.2052500895192906e-03 +-2.2386388041608363e-03 +-2.2691361657149831e-03 +-2.2901271038931210e-03 +-2.2936649022637433e-03 +-2.2731990311794631e-03 +-2.2260868400776645e-03 +-2.1542649270959975e-03 +-2.0630636013707544e-03 +-1.9592718406568070e-03 +-1.8494850032623276e-03 +-1.7391517098203210e-03 +-1.6322566221648588e-03 +-1.5314011381386960e-03 +-1.4380620622207790e-03 +-1.3528872514630458e-03 +-1.2759587675673703e-03 +-1.2069998723132414e-03 +-1.1455256999158908e-03 +-1.0909468418451172e-03 +-1.0426371337893044e-03 +-9.9997581206093841e-04 +-9.6237209911037471e-04 +-9.2927816850410093e-04 +-9.0019468728265927e-04 +-8.7467180111654630e-04 +-8.5230746800184101e-04 +-8.3274437736304940e-04 +-8.1566623785525659e-04 +-8.0079391449310706e-04 +-7.8788169816832734e-04 +-7.7671386289600720e-04 +-7.6710158593427404e-04 +-7.5888025593471209e-04 +-7.5190716486738093e-04 +-7.4605956234470290e-04 +-7.4123304253588844e-04 +-7.3734023005657997e-04 +-7.3430973110885157e-04 +-7.3208531758419055e-04 +-7.3062531502445709e-04 +-7.2990216899924075e-04 +-2.0571877673065527e-03 +-2.0612532075480676e-03 +-2.0694114268884883e-03 +-2.0817152989740899e-03 +-2.0982335273699655e-03 +-2.1190208987439318e-03 +-2.1440491012432008e-03 +-2.1730609998269596e-03 +-2.2052561714942173e-03 +-2.2386499165348555e-03 +-2.2691549798002568e-03 +-2.2901557564814507e-03 +-2.2937035470706304e-03 +-2.2732454004517079e-03 +-2.2261371366118585e-03 +-2.1543152156373630e-03 +-2.0631108124948773e-03 +-1.9593141144142773e-03 +-1.8495215609858622e-03 +-1.7391825372090452e-03 +-1.6322821523674540e-03 +-1.5314220118294464e-03 +-1.4380789737840976e-03 +-1.3529008632976181e-03 +-1.2759696699641630e-03 +-1.2070085704930609e-03 +-1.1455326156051789e-03 +-1.0909523216106724e-03 +-1.0426414597219105e-03 +-9.9997921251308896e-04 +-9.6237475843022346e-04 +-9.2928023538544886e-04 +-9.0019628169713179e-04 +-8.7467301995234183e-04 +-8.5230838959177179e-04 +-8.3274506509183846e-04 +-8.1566674302079620e-04 +-8.0079427857219099e-04 +-7.8788195461237389e-04 +-7.7671403855889931e-04 +-7.6710170221464175e-04 +-7.5888032969817748e-04 +-7.5190720920092092e-04 +-7.4605958718415653e-04 +-7.4123305519906211e-04 +-7.3734023570710321e-04 +-7.3430973317054873e-04 +-7.3208531812077565e-04 +-7.3062531509668458e-04 +-7.2990216900938596e-04 +-2.0571877673051272e-03 +-2.0612532075466386e-03 +-2.0694114268870537e-03 +-2.0817152989726466e-03 +-2.0982335273685092e-03 +-2.1190208987424621e-03 +-2.1440491012417137e-03 +-2.1730609998254534e-03 +-2.2052561714926908e-03 +-2.2386499165333125e-03 +-2.2691549797987081e-03 +-2.2901557564799150e-03 +-2.2937035470691376e-03 +-2.2732454004502898e-03 +-2.2261371366105432e-03 +-2.1543152156361664e-03 +-2.0631108124938079e-03 +-1.9593141144133332e-03 +-1.8495215609850358e-03 +-1.7391825372083261e-03 +-1.6322821523668300e-03 +-1.5314220118289048e-03 +-1.4380789737836277e-03 +-1.3529008632972104e-03 +-1.2759696699638093e-03 +-1.2070085704927536e-03 +-1.1455326156049118e-03 +-1.0909523216104397e-03 +-1.0426414597217086e-03 +-9.9997921251291332e-04 +-9.6237475843007135e-04 +-9.2928023538531703e-04 +-9.0019628169701828e-04 +-8.7467301995224414e-04 +-8.5230838959168885e-04 +-8.3274506509176767e-04 +-8.1566674302073667e-04 +-8.0079427857214134e-04 +-7.8788195461233323e-04 +-7.7671403855886635e-04 +-7.6710170221461552e-04 +-7.5888032969815774e-04 +-7.5190720920090585e-04 +-7.4605958718414601e-04 +-7.4123305519905539e-04 +-7.3734023570709920e-04 +-7.3430973317054656e-04 +-7.3208531812077435e-04 +-7.3062531509668176e-04 +-7.2990216900937219e-04 +-2.0571887353402723e-03 +-2.0612541707382454e-03 +-2.0694123472801318e-03 +-2.0817160745324448e-03 +-2.0982339651997536e-03 +-2.1190206927475374e-03 +-2.1440478010948706e-03 +-2.1730579110620239e-03 +-2.2052500895177614e-03 +-2.2386388041592902e-03 +-2.2691361657134310e-03 +-2.2901271038915823e-03 +-2.2936649022622479e-03 +-2.2731990311780424e-03 +-2.2260868400763457e-03 +-2.1542649270947980e-03 +-2.0630636013696823e-03 +-1.9592718406558599e-03 +-1.8494850032614982e-03 +-1.7391517098195987e-03 +-1.6322566221642315e-03 +-1.5314011381381519e-03 +-1.4380620622203070e-03 +-1.3528872514626358e-03 +-1.2759587675670143e-03 +-1.2069998723129316e-03 +-1.1455256999156214e-03 +-1.0909468418448826e-03 +-1.0426371337890999e-03 +-9.9997581206076060e-04 +-9.6237209911022021e-04 +-9.2927816850396703e-04 +-9.0019468728254359e-04 +-8.7467180111644644e-04 +-8.5230746800175569e-04 +-8.3274437736297632e-04 +-8.1566623785519501e-04 +-8.0079391449305545e-04 +-7.8788169816828473e-04 +-7.7671386289597218e-04 +-7.6710158593424607e-04 +-7.5888025593469008e-04 +-7.5190716486736402e-04 +-7.4605956234469011e-04 +-7.4123304253587944e-04 +-7.3734023005657379e-04 +-7.3430973110884734e-04 +-7.3208531758418751e-04 +-7.3062531502445264e-04 +-7.2990216899922666e-04 +-2.0571951315746409e-03 +-2.0612605313573939e-03 +-2.0694184069589574e-03 +-2.0817211110272099e-03 +-2.0982365761462985e-03 +-2.1190185651600068e-03 +-2.1440373732947247e-03 +-2.1730335293209209e-03 +-2.2052020954643611e-03 +-2.2385515266817699e-03 +-2.2689899218791094e-03 +-2.2899070101992914e-03 +-2.2933711544875991e-03 +-2.2728495081651211e-03 +-2.2257101591194248e-03 +-2.1538901895126251e-03 +-2.0627131881112608e-03 +-1.9589590829464064e-03 +-1.8492152610893446e-03 +-1.7389247705502950e-03 +-1.6320690531162715e-03 +-1.5312480488505330e-03 +-1.4379382238808374e-03 +-1.3527877134881738e-03 +-1.2758791404923640e-03 +-1.2069364134480918e-03 +-1.1454752945729829e-03 +-1.0909069369396916e-03 +-1.0426056557631849e-03 +-9.9995108557426600e-04 +-9.6235277393760409e-04 +-9.2926315717302887e-04 +-9.0018311352044341e-04 +-8.7466295805806453e-04 +-8.5230078472731759e-04 +-8.3273939230712134e-04 +-8.1566257776212589e-04 +-8.0079127778395602e-04 +-7.8787984178077921e-04 +-7.7671259183374123e-04 +-7.6710074491530202e-04 +-7.5887972265327051e-04 +-7.5190684448521461e-04 +-7.4605938291030143e-04 +-7.4123295109488642e-04 +-7.3734018926976854e-04 +-7.3430971623533183e-04 +-7.3208531372145815e-04 +-7.3062531452242508e-04 +-7.2990216898556224e-04 +-2.0572136693413740e-03 +-2.0612789425305130e-03 +-2.0694358049122489e-03 +-2.0817350881934390e-03 +-2.0982424367268606e-03 +-2.1190084978414325e-03 +-2.1439992104444372e-03 +-2.1729478012684775e-03 +-2.2050356981191893e-03 +-2.2382514830218640e-03 +-2.2684906905721903e-03 +-2.2891600073028789e-03 +-2.2923784837411572e-03 +-2.2716719725567368e-03 +-2.2244438140401148e-03 +-2.1526322234667384e-03 +-2.0615380960621113e-03 +-1.9579110623053615e-03 +-1.8483119040025252e-03 +-1.7381651080082897e-03 +-1.6314414171356597e-03 +-1.5307359520751922e-03 +-1.4375240891534656e-03 +-1.3524549241627174e-03 +-1.2756129775471461e-03 +-1.2067243353846614e-03 +-1.1453068699375892e-03 +-1.0907736189615751e-03 +-1.0425005055800763e-03 +-9.9986849875155297e-04 +-9.6228823493642649e-04 +-9.2921303010245007e-04 +-9.0014446927683275e-04 +-8.7463343427949386e-04 +-8.5227847371539009e-04 +-8.3272275200241470e-04 +-8.1565036131442468e-04 +-8.0078247790723645e-04 +-7.8787364673641304e-04 +-7.7670835048583293e-04 +-7.6709793880821021e-04 +-7.5887794348622624e-04 +-7.5190577569786139e-04 +-7.4605878437071678e-04 +-7.4123264609881028e-04 +-7.3734005323790298e-04 +-7.3430966663356112e-04 +-7.3208530084265108e-04 +-7.3062531285447718e-04 +-7.2990216895943286e-04 +-2.0572420058184299e-03 +-2.0613069363902932e-03 +-2.0694613056574233e-03 +-2.0817523178510559e-03 +-2.0982401265187442e-03 +-2.1189678015600625e-03 +-2.1438904655062992e-03 +-2.1727231670078547e-03 +-2.2046143830639934e-03 +-2.2375065507071802e-03 +-2.2672682290098773e-03 +-2.2873488269065847e-03 +-2.2899876897652604e-03 +-2.2688480147044668e-03 +-2.2214147821554195e-03 +-2.1496278642986573e-03 +-2.0587341341689490e-03 +-1.9554115290004205e-03 +-1.8461579426834766e-03 +-1.7363539933326429e-03 +-1.6299451410689675e-03 +-1.5295151324119520e-03 +-1.4365367984698724e-03 +-1.3516615460573336e-03 +-1.2749784262279728e-03 +-1.2062187170952489e-03 +-1.1449053201697760e-03 +-1.0904557648767055e-03 +-1.0422498064071020e-03 +-9.9967159414773550e-04 +-9.6213435993766411e-04 +-9.2909351649862076e-04 +-9.0005233366487582e-04 +-8.7456304429480380e-04 +-8.5222528090132007e-04 +-8.3268307961528428e-04 +-8.1562123644262144e-04 +-8.0076149882627064e-04 +-7.8785887797804715e-04 +-7.7669823952936426e-04 +-7.6709124950825565e-04 +-7.5887370236373843e-04 +-7.5190322802928073e-04 +-7.4605735767210174e-04 +-7.4123191911982058e-04 +-7.3733972900493546e-04 +-7.3430954841048883e-04 +-7.3208527014834602e-04 +-7.3062530888188030e-04 +-7.2990216890586081e-04 +-2.0572330548976722e-03 +-2.0612971512452977e-03 +-2.0694462630575622e-03 +-2.0817203732092283e-03 +-2.0981686101743204e-03 +-2.1188185102721090e-03 +-2.1436023739031919e-03 +-2.1721969979386149e-03 +-2.2036850101033647e-03 +-2.2359229060541132e-03 +-2.2647365285951931e-03 +-2.2836666448726455e-03 +-2.2851866087811546e-03 +-2.2632205738112843e-03 +-2.2154061403212651e-03 +-2.1436833633219311e-03 +-2.0531935031437415e-03 +-1.9504754298636463e-03 +-1.8419050946089320e-03 +-1.7327779500896140e-03 +-1.6269903064569000e-03 +-1.5271037859003629e-03 +-1.4345862974690802e-03 +-1.3500938124708531e-03 +-1.2737242941258211e-03 +-1.2052192340188648e-03 +-1.1441114321152442e-03 +-1.0898272636425809e-03 +-1.0417540350512932e-03 +-9.9928216630160941e-04 +-9.6183000880694606e-04 +-9.2885711308421056e-04 +-8.9987007509881637e-04 +-8.7442379583507995e-04 +-8.5212004904292743e-04 +-8.3260459337894919e-04 +-8.1556361598298613e-04 +-8.0071999350726417e-04 +-7.8782965911026028e-04 +-7.7667823576875840e-04 +-7.6707801528703295e-04 +-7.5886531171513499e-04 +-7.5189818776039781e-04 +-7.4605453514259789e-04 +-7.4123048090640330e-04 +-7.3733908756810072e-04 +-7.3430931452993340e-04 +-7.3208520942696649e-04 +-7.3062530102463376e-04 +-7.2990216880508693e-04 +-2.0570060736553176e-03 +-2.0610682037127321e-03 +-2.0692069322671381e-03 +-2.0814492035822092e-03 +-2.0978239514917530e-03 +-2.1183294131872418e-03 +-2.1428536334159001e-03 +-2.1710009724855636e-03 +-2.2017395075705835e-03 +-2.2327926749139836e-03 +-2.2599412407499444e-03 +-2.2769027676338076e-03 +-2.2765469640160432e-03 +-2.2532238354027270e-03 +-2.2048134215995178e-03 +-2.1332479651840269e-03 +-2.0434878575995960e-03 +-1.9418365316915768e-03 +-1.8344634399703875e-03 +-1.7265194120360987e-03 +-1.6218170276548229e-03 +-1.5228801275614366e-03 +-1.4311682463963749e-03 +-1.3473452854658159e-03 +-1.2715246557253154e-03 +-1.2034655734192844e-03 +-1.1427180424116938e-03 +-1.0887238345789394e-03 +-1.0408834171005807e-03 +-9.9859815144067170e-04 +-9.6129533142257778e-04 +-9.2844174173146814e-04 +-8.9954979819491471e-04 +-8.7417907370281663e-04 +-8.5193509374780982e-04 +-8.3246663683138452e-04 +-8.1546233021738597e-04 +-8.0064703216026472e-04 +-7.8777829435838700e-04 +-7.7664306982496280e-04 +-7.6705474966732787e-04 +-7.5885056094131742e-04 +-7.5188932693817895e-04 +-7.4604957312378220e-04 +-7.4122795252915810e-04 +-7.3733795992803812e-04 +-7.3430890337224011e-04 +-7.3208510268078146e-04 +-7.3062528721292211e-04 +-7.2990216863135339e-04 +-2.0560407435191407e-03 +-2.0600982467083415e-03 +-2.0682164627148455e-03 +-2.0803994673775921e-03 +-2.0966402773827629e-03 +-2.1168839203217428e-03 +-2.1409380527256062e-03 +-2.1682833651973181e-03 +-2.1977151819812615e-03 +-2.2267897929333356e-03 +-2.2512804080690868e-03 +-2.2652172042933786e-03 +-2.2620677064924704e-03 +-2.2367915792997168e-03 +-2.1876015948652980e-03 +-2.1164002813486857e-03 +-2.0278686402444420e-03 +-1.9279520742059963e-03 +-1.8225056174685902e-03 +-1.7164587792027994e-03 +-1.6134952685972407e-03 +-1.5160804911246381e-03 +-1.4256610463345271e-03 +-1.3429133623477523e-03 +-1.2679752438537796e-03 +-1.2006339741382074e-03 +-1.1404668774669200e-03 +-1.0869402402469616e-03 +-1.0394755330762335e-03 +-9.9749161510802277e-04 +-9.6043010685286615e-04 +-9.2776940145455715e-04 +-8.9903126693911416e-04 +-8.7378279313883003e-04 +-8.5163554874796384e-04 +-8.3224318141730163e-04 +-8.1529825634206097e-04 +-8.0052883226962356e-04 +-7.8769507683335493e-04 +-7.7658609399226342e-04 +-7.6701705356809369e-04 +-7.5882666051768405e-04 +-7.5187496971738726e-04 +-7.4604153309283032e-04 +-7.4122385575272427e-04 +-7.3733613279259680e-04 +-7.3430823716748035e-04 +-7.3208492971908571e-04 +-7.3062526483448186e-04 +-7.2990216835232919e-04 +-2.0529837166895389e-03 +-2.0570303541287854e-03 +-2.0651069687153386e-03 +-2.0771772767589304e-03 +-2.0931710455246713e-03 +-2.1129409594296544e-03 +-2.1361620100457173e-03 +-2.1621316327902099e-03 +-2.1894289813854952e-03 +-2.2154571375482828e-03 +-2.2360855788893861e-03 +-2.2458404596668378e-03 +-2.2389941671517215e-03 +-2.2112755863904873e-03 +-2.1612919435919481e-03 +-2.0908731245151478e-03 +-2.0043065806203721e-03 +-1.9070426750286396e-03 +-1.8045003387210966e-03 +-1.7012995612958502e-03 +-1.6009421446146171e-03 +-1.5058103017916216e-03 +-1.4173321485956244e-03 +-1.3362023744772210e-03 +-1.2625944687585445e-03 +-1.1963369860214005e-03 +-1.1370476177967506e-03 +-1.0842290272322856e-03 +-1.0373339689970457e-03 +-9.9580745068818407e-04 +-9.5911256460329459e-04 +-9.2674514619375988e-04 +-8.9824104734923438e-04 +-8.7317870063565632e-04 +-8.5117880992786269e-04 +-8.3190239500643037e-04 +-8.1504799173922628e-04 +-8.0034851754667033e-04 +-7.8756811571063367e-04 +-7.7649916228692472e-04 +-7.6695953514233138e-04 +-7.5879019080398705e-04 +-7.5185306145898246e-04 +-7.4602926430245573e-04 +-7.4121760417307275e-04 +-7.3733334462008926e-04 +-7.3430722055213072e-04 +-7.3208466578344826e-04 +-7.3062523068611143e-04 +-7.2990216792841189e-04 +-2.0445779271268429e-03 +-2.0485999299405143e-03 +-2.0565937188081495e-03 +-2.0684552597492207e-03 +-2.0840103305815884e-03 +-2.1029672271538724e-03 +-2.1248122923192884e-03 +-2.1486189867064827e-03 +-2.1727587406390803e-03 +-2.1945714313502695e-03 +-2.2101904807130522e-03 +-2.2148312888767108e-03 +-2.2037272320785282e-03 +-2.1734611074719166e-03 +-2.1230411483493888e-03 +-2.0541611009581512e-03 +-1.9706027761739850e-03 +-1.8771920949451053e-03 +-1.7787943540273695e-03 +-1.6796315936954942e-03 +-1.5829684003664500e-03 +-1.4910769623729763e-03 +-1.4053605701514513e-03 +-1.3265385345407226e-03 +-1.2548330287759180e-03 +-1.1901294240502852e-03 +-1.1321014122710484e-03 +-1.0803024562188468e-03 +-1.0342292498801715e-03 +-9.9336371110159767e-04 +-9.5719937383511244e-04 +-9.2525689756290221e-04 +-8.9709224653426224e-04 +-8.7230010000006379e-04 +-8.5051428160860549e-04 +-8.3140642413851351e-04 +-8.1468367719150271e-04 +-8.0008598088949752e-04 +-7.8738323442347532e-04 +-7.7637255795769090e-04 +-7.6687576044468832e-04 +-7.5873707013954022e-04 +-7.5182114930454720e-04 +-7.4601139280744953e-04 +-7.4120849759662778e-04 +-7.3732928310535622e-04 +-7.3430573965129137e-04 +-7.3208428130935074e-04 +-7.3062518094282782e-04 +-7.2990216731237591e-04 +-2.0242452370542530e-03 +-2.0282158687246199e-03 +-2.0360589552399166e-03 +-2.0475743598196436e-03 +-2.0624440675078796e-03 +-2.0801883328778283e-03 +-2.1000738638106225e-03 +-2.1209586690835143e-03 +-2.1410828489123201e-03 +-2.1578720641313499e-03 +-2.1679023160646352e-03 +-2.1672140348159763e-03 +-2.1520516989455099e-03 +-2.1198316409043001e-03 +-2.0699089469485457e-03 +-2.0037712351772203e-03 +-1.9246103788134992e-03 +-1.8365339628492921e-03 +-1.7437631157921855e-03 +-1.6500482101160837e-03 +-1.5583667817226064e-03 +-1.4708548479768040e-03 +-1.3888837245775746e-03 +-1.3132031156214779e-03 +-1.2440970869251125e-03 +-1.1815243606537709e-03 +-1.1252317918932025e-03 +-1.0748398730411931e-03 +-1.0299037678188625e-03 +-9.8995487007177562e-04 +-9.5452777902217093e-04 +-9.2317682822692069e-04 +-8.9548539870400699e-04 +-8.7107041326087099e-04 +-8.4958372750416021e-04 +-8.3071161109253089e-04 +-8.1417312966111026e-04 +-7.9971796475909881e-04 +-7.8712401883350663e-04 +-7.7619502205493777e-04 +-7.6675827015771215e-04 +-7.5866256445333445e-04 +-7.5177638753569278e-04 +-7.4598632431434005e-04 +-7.4119572344535337e-04 +-7.3732358579508910e-04 +-7.3430366230116070e-04 +-7.3208374198380406e-04 +-7.3062511116529251e-04 +-7.2990216644940476e-04 +-1.9822013073325356e-03 +-1.9860770469895626e-03 +-1.9936782627911968e-03 +-2.0047010887280330e-03 +-2.0186755771121703e-03 +-2.0349334795670580e-03 +-2.0525443377858270e-03 +-2.0702148342406569e-03 +-2.0861678460918935e-03 +-2.0980562798288685e-03 +-2.1030089939763665e-03 +-2.0979113801941631e-03 +-2.0799430405355301e-03 +-2.0472376528138103e-03 +-1.9994027638600858e-03 +-1.9376656296262028e-03 +-1.8645944943219777e-03 +-1.7835426774812850e-03 +-1.6980428135242619e-03 +-1.6113280715936951e-03 +-1.5260518699426351e-03 +-1.4441909734899377e-03 +-1.3670760660265907e-03 +-1.2954902519842488e-03 +-1.2297903276605494e-03 +-1.1700234871030162e-03 +-1.1160264560097922e-03 +-1.0675032701953015e-03 +-1.0240828591699322e-03 +-9.8535968691364586e-04 +-9.5092117278807418e-04 +-9.2036530396236453e-04 +-8.9331124878376945e-04 +-8.6940514194956805e-04 +-8.4832264826192796e-04 +-8.2976945688618508e-04 +-8.1348051079663958e-04 +-7.9921852054720330e-04 +-7.8677212836615064e-04 +-7.7595396000452294e-04 +-7.6659871307852760e-04 +-7.5856137043925364e-04 +-7.5171558693083978e-04 +-7.4595227159797060e-04 +-7.4117837065756909e-04 +-7.3731584627069349e-04 +-7.3430084030065242e-04 +-7.3208300932973177e-04 +-7.3062501637545692e-04 +-7.2990216527808478e-04 +-1.9091978447274525e-03 +-1.9129209529406919e-03 +-1.9201782434468346e-03 +-1.9305892890010880e-03 +-1.9435742597258435e-03 +-1.9583358544995790e-03 +-1.9738264054778402e-03 +-1.9887008786444371e-03 +-2.0012701422684027e-03 +-2.0094902275521998e-03 +-2.0110424334522856e-03 +-2.0035547375341534e-03 +-1.9849666992579652e-03 +-1.9539560839937093e-03 +-1.9102775621026586e-03 +-1.8548733389854952e-03 +-1.7897100050550307e-03 +-1.7174128446983505e-03 +-1.6408336315643843e-03 +-1.5626766555264971e-03 +-1.4852504456003780e-03 +-1.4103531457295407e-03 +-1.3392629145453773e-03 +-1.2727933876882543e-03 +-1.2113789828922536e-03 +-1.1551656508134675e-03 +-1.1040932879554332e-03 +-1.0579638922720283e-03 +-1.0164943929010062e-03 +-9.7935559113112420e-04 +-9.4619963557920417e-04 +-9.1667858855891339e-04 +-8.9045636948730553e-04 +-8.6721594694236877e-04 +-8.4666322947161792e-04 +-8.2852873611769082e-04 +-8.1256782910838746e-04 +-7.9856006141644910e-04 +-7.8630802098320215e-04 +-7.7563592939605555e-04 +-7.6638816460107215e-04 +-7.5842781553387990e-04 +-7.5163533408088628e-04 +-7.4590732101874379e-04 +-7.4115546348847011e-04 +-7.3730562920030010e-04 +-7.3429711489578448e-04 +-7.3208204212947764e-04 +-7.3062489124067656e-04 +-7.2990216373259231e-04 +-1.8021172372841455e-03 +-1.8056264388126434e-03 +-1.8124426952608316e-03 +-1.8221598393448036e-03 +-1.8341634519606540e-03 +-1.8476235926419865e-03 +-1.8614846314559039e-03 +-1.8744554733617692e-03 +-1.8850101549646614e-03 +-1.8914182570627055e-03 +-1.8918316724696391e-03 +-1.8844492969450569e-03 +-1.8677557963067116e-03 +-1.8407889874116209e-03 +-1.8033553694087932e-03 +-1.7561136446944553e-03 +-1.7004901188944867e-03 +-1.6384537041878992e-03 +-1.5722241877373609e-03 +-1.5039944127710903e-03 +-1.4357218027554221e-03 +-1.3690088182211583e-03 +-1.3050636375320388e-03 +-1.2447183530234541e-03 +-1.1884800660332403e-03 +-1.1365950147128011e-03 +-1.0891125782554730e-03 +-1.0459419874983714e-03 +-1.0068988685250843e-03 +-9.7174136893566482e-04 +-9.4019696555186266e-04 +-9.1198157404410887e-04 +-8.8681263255511707e-04 +-8.6441765463838335e-04 +-8.4453948680646563e-04 +-8.2693924028872030e-04 +-8.1139763089545008e-04 +-7.9771526719182525e-04 +-7.8571227550102481e-04 +-7.7522753536204091e-04 +-7.6611771415773802e-04 +-7.5825622808898131e-04 +-7.5153221280056153e-04 +-7.4584955616006118e-04 +-7.4112602439913749e-04 +-7.3729249835981778e-04 +-7.3429232699211535e-04 +-7.3208079907585493e-04 +-7.3062473041678058e-04 +-7.2990216174702511e-04 +-1.6665433304521025e-03 +-1.6697880691349011e-03 +-1.6760869973521269e-03 +-1.6850576388656514e-03 +-1.6961234661248040e-03 +-1.7085123579182854e-03 +-1.7212579431750642e-03 +-1.7332077851873069e-03 +-1.7430449886091997e-03 +-1.7493329310608455e-03 +-1.7505942940913900e-03 +-1.7454316219128480e-03 +-1.7326841103116888e-03 +-1.7115959197176542e-03 +-1.6819541596729485e-03 +-1.6441524230320964e-03 +-1.5991544722000878e-03 +-1.5483649254954589e-03 +-1.4934427331006000e-03 +-1.4361050696690934e-03 +-1.3779619703670999e-03 +-1.3204037292491729e-03 +-1.2645442592761618e-03 +-1.2112108986745279e-03 +-1.1609659244779422e-03 +-1.1141453979415840e-03 +-1.0709041615956500e-03 +-1.0312596685303208e-03 +-9.9513065838968229e-04 +-9.6236908860711885e-04 +-9.3278521555921858e-04 +-9.0616650804291939e-04 +-8.8229139785062018e-04 +-8.6093892014270314e-04 +-8.4189520344141438e-04 +-8.2495761901201750e-04 +-8.0993723930907402e-04 +-7.9666010846796934e-04 +-7.8496770381459365e-04 +-7.7471686769088393e-04 +-7.6577941149399054e-04 +-7.5804153522944235e-04 +-7.5140316238021755e-04 +-7.4577725811919907e-04 +-7.4108917601042098e-04 +-7.3727606207785851e-04 +-7.3428633372021196e-04 +-7.3207924307243009e-04 +-7.3062452910434056e-04 +-7.2990215926215483e-04 +-1.5143523068029358e-03 +-1.5173032518334994e-03 +-1.5230417465659676e-03 +-1.5312399534982740e-03 +-1.5414044113083443e-03 +-1.5528765234326066e-03 +-1.5648374020072956e-03 +-1.5763206454009026e-03 +-1.5862374942722506e-03 +-1.5934193467024977e-03 +-1.5966820144095205e-03 +-1.5949131126800856e-03 +-1.5871776289883130e-03 +-1.5728277515210151e-03 +-1.5515949405864021e-03 +-1.5236401790222134e-03 +-1.4895457973676247e-03 +-1.4502475879027428e-03 +-1.4069224876745432e-03 +-1.3608574999561479e-03 +-1.3133261778801853e-03 +-1.2654916316491617e-03 +-1.2183444031056759e-03 +-1.1726741853744478e-03 +-1.1290685858991590e-03 +-1.0879300726923521e-03 +-1.0495028139263136e-03 +-1.0139029899163738e-03 +-9.8114830740402784e-04 +-9.5118431105518616e-04 +-9.2390645887834694e-04 +-8.9917781325535274e-04 +-8.7684269660319718e-04 +-8.5673688820318578e-04 +-8.3869499815061703e-04 +-8.2255562068590327e-04 +-8.0816479200163127e-04 +-7.9537818690843059e-04 +-7.8406240077341259e-04 +-7.7409558555958165e-04 +-7.6536764415569025e-04 +-7.5778013534734769e-04 +-7.5124600132147332e-04 +-7.4568919865301050e-04 +-7.4104429042700271e-04 +-7.3725603982086703e-04 +-7.3427903271138515e-04 +-7.3207734753582296e-04 +-7.3062428386410716e-04 +-7.2990215623556728e-04 +-1.3589574535016642e-03 +-1.3616093564199506e-03 +-1.3667821278638933e-03 +-1.3742128909634273e-03 +-1.3835061096152455e-03 +-1.3941343267050289e-03 +-1.4054427047572018e-03 +-1.4166601513094202e-03 +-1.4269200819607157e-03 +-1.4352936802570324e-03 +-1.4408375398208056e-03 +-1.4426554440729528e-03 +-1.4399705599974165e-03 +-1.4321999194497907e-03 +-1.4190191178754114e-03 +-1.4004037617104735e-03 +-1.3766370336389757e-03 +-1.3482797469777409e-03 +-1.3161081194395180e-03 +-1.2810317600873021e-03 +-1.2440073928817526e-03 +-1.2059621534330823e-03 +-1.1677354261919333e-03 +-1.1300424719469845e-03 +-1.0934584170359648e-03 +-1.0584183958738526e-03 +-1.0252286983889972e-03 +-9.9408412567478319e-04 +-9.6508776670910603e-04 +-9.3827058374186642e-04 +-9.1360924388264695e-04 +-8.9104143948681019e-04 +-8.7047848811865373e-04 +-8.5181533495373664e-04 +-8.3493825325618688e-04 +-8.1973060529726073e-04 +-8.0607702883540215e-04 +-7.9386638284559090e-04 +-7.8299373990981880e-04 +-7.7336166311855309e-04 +-7.6488095871548743e-04 +-7.5747105490439495e-04 +-7.5106012308773370e-04 +-7.4558503010081995e-04 +-7.4099118801243524e-04 +-7.3723235086633782e-04 +-7.3427039443242843e-04 +-7.3207510479060057e-04 +-7.3062399370306245e-04 +-7.2990215265499904e-04 +-1.2115503797086784e-03 +-1.2139184753660695e-03 +-1.2185541047914940e-03 +-1.2252555243207576e-03 +-1.2337191511526452e-03 +-1.2435400044243940e-03 +-1.2542148629678170e-03 +-1.2651501025479324e-03 +-1.2756762846664090e-03 +-1.2850713148461143e-03 +-1.2925932262637886e-03 +-1.2975222584884082e-03 +-1.2992098960917849e-03 +-1.2971301676462134e-03 +-1.2909263927444064e-03 +-1.2804455843281794e-03 +-1.2657536644668037e-03 +-1.2471277381003380e-03 +-1.2250261766732688e-03 +-1.2000417493901220e-03 +-1.1728460085493391e-03 +-1.1441337674842050e-03 +-1.1145749663347877e-03 +-1.0847783957171570e-03 +-1.0552687256378604e-03 +-1.0264758774409279e-03 +-9.9873433115108814e-04 +-9.7228943691922149e-04 +-9.4730794146659467e-04 +-9.2389044751721547e-04 +-9.0208415087071202e-04 +-8.8189478981621757e-04 +-8.6329721964664729e-04 +-8.4624437192069911e-04 +-8.3067458594400902e-04 +-8.1651743366387673e-04 +-8.0369822550250148e-04 +-7.9214140666592370e-04 +-7.8177304882893171e-04 +-7.7252262323371798e-04 +-7.6432421625949472e-04 +-7.5711732233896408e-04 +-7.5084732442571439e-04 +-7.4546575033828928e-04 +-7.4093037464131677e-04 +-7.3720522019614387e-04 +-7.3426050080895369e-04 +-7.3207253609766686e-04 +-7.3062366137190723e-04 +-7.2990214855440927e-04 +-1.0795747024842379e-03 +-1.0816881919590952e-03 +-1.0858398902444044e-03 +-1.0918787683432667e-03 +-1.0995775004212223e-03 +-1.1086325887675664e-03 +-1.1186662360110845e-03 +-1.1292312649760596e-03 +-1.1398204567979534e-03 +-1.1498815146791853e-03 +-1.1588383883876796e-03 +-1.1661188675096302e-03 +-1.1711871953528463e-03 +-1.1735791145287327e-03 +-1.1729355194411829e-03 +-1.1690301626153538e-03 +-1.1617870325981155e-03 +-1.1512842803361595e-03 +-1.1377437429552040e-03 +-1.1215076492787593e-03 +-1.1030062610717796e-03 +-1.0827214067767766e-03 +-1.0611508708270572e-03 +-1.0387775993574333e-03 +-1.0160461297851434e-03 +-9.9334704793748699e-04 +-9.7100898816858145e-04 +-9.4929688282570054e-04 +-9.2841482669840929e-04 +-9.0851193770375164e-04 +-8.8968982560826278e-04 +-8.7201060228193157e-04 +-8.5550469340125827e-04 +-8.4017799422188581e-04 +-8.2601813187193783e-04 +-8.1299975299250116e-04 +-8.0108885740857517e-04 +-7.9024625811507378e-04 +-7.8043027722246800e-04 +-7.7159879674825794e-04 +-7.6371078000844880e-04 +-7.5672736938303979e-04 +-7.5061265309648846e-04 +-7.4533417968681995e-04 +-7.4086328538151857e-04 +-7.3717528734011759e-04 +-7.3424958493808698e-04 +-7.3206970196646945e-04 +-7.3062329469913664e-04 +-7.2990214403034596e-04 +-9.6691701964424692e-04 +-9.6881264321834978e-04 +-9.7254800219998233e-04 +-9.7801097288849922e-04 +-9.8503274649410790e-04 +-9.9338775578253322e-04 +-1.0027946602570374e-03 +-1.0129192203608525e-03 +-1.0233799466435869e-03 +-1.0337573287428354e-03 +-1.0436071896808478e-03 +-1.0524782492169144e-03 +-1.0599333294005159e-03 +-1.0655728672097648e-03 +-1.0690586518473041e-03 +-1.0701351705870604e-03 +-1.0686458272917291e-03 +-1.0645417249939635e-03 +-1.0578816690569252e-03 +-1.0488233663553575e-03 +-1.0376071518997079e-03 +-1.0245346270720574e-03 +-1.0099451046107352e-03 +-9.9419266593135224e-04 +-9.7762606391097839e-04 +-9.6057287158253014e-04 +-9.4332841844364779e-04 +-9.2614934544899062e-04 +-9.0925113269199999e-04 +-8.9280871619272040e-04 +-8.7695926724222592e-04 +-8.6180629465596554e-04 +-8.4742438489985076e-04 +-8.3386406947660169e-04 +-8.2115647245276904e-04 +-8.0931752776892941e-04 +-7.9835166094258591e-04 +-7.8825490441414346e-04 +-7.7901746478902380e-04 +-7.7062578930169262e-04 +-7.6306419341828620e-04 +-7.5631611621286272e-04 +-7.5036506858610816e-04 +-7.4519533417018299e-04 +-7.4079247569851063e-04 +-7.3714369189819011e-04 +-7.3423806231198534e-04 +-7.3206671026455005e-04 +-7.3062290764029506e-04 +-7.2990213925497413e-04 +-8.7486204787974619e-04 +-8.7657923772025803e-04 +-8.7997182611467245e-04 +-8.8495597429580949e-04 +-8.9140543641621605e-04 +-8.9915139489319610e-04 +-9.0798291736163164e-04 +-9.1764855805170919e-04 +-9.2785967004381281e-04 +-9.3829596187470306e-04 +-9.4861369922390952e-04 +-9.5845670537814836e-04 +-9.6746995677408909e-04 +-9.7531513394499044e-04 +-9.8168703826241100e-04 +-9.8632941391206042e-04 +-9.8904852611147467e-04 +-9.8972292475679020e-04 +-9.8830819799438068e-04 +-9.8483614617096357e-04 +-9.7940856164143147e-04 +-9.7218651949597900e-04 +-9.6337661275521359e-04 +-9.5321580539887735e-04 +-9.4195651345401941e-04 +-9.2985322009309166e-04 +-9.1715149143163817e-04 +-9.0407979692050942e-04 +-8.9084413838363648e-04 +-8.7762520271487802e-04 +-8.6457758592697052e-04 +-8.5183057544330372e-04 +-8.3948999501423920e-04 +-8.2764068196933228e-04 +-8.1634925364996395e-04 +-8.0566690997212328e-04 +-7.9563210058809591e-04 +-7.8627295242643576e-04 +-7.7760940501775053e-04 +-7.6965503799667444e-04 +-7.6241859977438191e-04 +-7.5590526125714533e-04 +-7.5011762617878885e-04 +-7.4505653228828313e-04 +-7.4072167701413297e-04 +-7.3711209860136259e-04 +-7.3422654000264464e-04 +-7.3206371860592696e-04 +-7.3062252058692914e-04 +-7.2990213447982110e-04 +-8.0313937532049693e-04 +-8.0471727353372316e-04 +-8.0784108437106591e-04 +-8.1244664629329013e-04 +-8.1843733715692508e-04 +-8.2568388299000231e-04 +-8.3402452932729483e-04 +-8.4326590706438752e-04 +-8.5318495791603815e-04 +-8.6353227487120487e-04 +-8.7403714767480276e-04 +-8.8441447345053857e-04 +-8.9437349792348983e-04 +-9.0362810647279322e-04 +-9.1190811581143402e-04 +-9.1897077098472113e-04 +-9.2461148173550521e-04 +-9.2867278670344920e-04 +-9.3105064420490231e-04 +-9.3169741314744073e-04 +-9.3062126813421174e-04 +-9.2788221933748176e-04 +-9.2358529770334308e-04 +-9.1787174718206493e-04 +-9.1090919537277157e-04 +-9.0288174797657620e-04 +-8.9398080053622515e-04 +-8.8439713320418421e-04 +-8.7431460457826923e-04 +-8.6390553322818653e-04 +-8.5332767805874617e-04 +-8.4272261158280671e-04 +-8.3221522047953098e-04 +-8.2191405438082382e-04 +-8.1191226251267937e-04 +-8.0228889507478899e-04 +-7.9311039112674696e-04 +-7.8443211958031543e-04 +-7.7629988004034186e-04 +-7.6875130348593129e-04 +-7.6181711861107260e-04 +-7.5552226855446405e-04 +-7.4988687575902276e-04 +-7.4492706099902749e-04 +-7.4065562734399078e-04 +-7.3708262198433254e-04 +-7.3421578923185834e-04 +-7.3206092723282848e-04 +-7.3062215944572377e-04 +-7.2990213002447572e-04 +-7.5076468116664589e-04 +-7.5224071774497797e-04 +-7.5516728688652533e-04 +-7.5949323495056841e-04 +-7.6514153030619370e-04 +-7.7200907510215587e-04 +-7.7996673371721057e-04 +-7.8885979688985840e-04 +-7.9850912550578576e-04 +-8.0871321819867979e-04 +-8.1925141500141009e-04 +-8.2988837980103435e-04 +-8.4037989598172483e-04 +-8.5047986757154825e-04 +-8.5994825578683228e-04 +-8.6855951964094288e-04 +-8.7611099667036986e-04 +-8.8243058420670137e-04 +-8.8738308551137852e-04 +-8.9087467822185080e-04 +-8.9285513716983822e-04 +-8.9331767419726065e-04 +-8.9229650579335533e-04 +-8.8986248319676878e-04 +-8.8611728364646619e-04 +-8.8118674500586511e-04 +-8.7521392628837577e-04 +-8.6835240697500141e-04 +-8.6076022192516750e-04 +-8.5259469266955228e-04 +-8.4400828332690614e-04 +-8.3514549683916044e-04 +-8.2614074326627714e-04 +-8.1711705818203592e-04 +-8.0818552254194006e-04 +-7.9944522992596583e-04 +-7.9098365624018273e-04 +-7.8287730478974148e-04 +-7.7519252130662012e-04 +-7.6798639561586506e-04 +-7.6130768700711539e-04 +-7.5519772792162314e-04 +-7.4969127487128874e-04 +-7.4481728664554762e-04 +-7.4059961816726281e-04 +-7.3705762427208601e-04 +-7.3420667167568713e-04 +-7.3205855988300796e-04 +-7.3062185316313355e-04 +-7.2990212624595417e-04 +-7.1661638290057550e-04 +-7.1802595372779158e-04 +-7.2082350173971693e-04 +-7.2496572150709186e-04 +-7.3038740428097771e-04 +-7.3700126059994813e-04 +-7.4469788297781402e-04 +-7.5334600557939947e-04 +-7.6279323744263077e-04 +-7.7286744967269068e-04 +-7.8337898063496293e-04 +-7.9412378294692646e-04 +-8.0488757060879850e-04 +-8.1545093595426223e-04 +-8.2559530072116969e-04 +-8.3510945463767874e-04 +-8.4379633358559411e-04 +-8.5147961453349813e-04 +-8.5800967151829937e-04 +-8.6326845643675616e-04 +-8.6717294254072715e-04 +-8.6967688982918798e-04 +-8.7077084352597974e-04 +-8.7048043718421881e-04 +-8.6886321715454911e-04 +-8.6600431549099159e-04 +-8.6201136172982154e-04 +-8.5700903749733309e-04 +-8.5113364722294799e-04 +-8.4452801499226317e-04 +-8.3733693603510971e-04 +-8.2970332527004809e-04 +-8.2176512572302120e-04 +-8.1365297369250130e-04 +-8.0548856858752530e-04 +-7.9738366360606748e-04 +-7.8943957688471010e-04 +-7.8174711833455934e-04 +-7.7438683165809727e-04 +-7.6742946083866879e-04 +-7.6093656306893710e-04 +-7.5496120365646459e-04 +-7.4954868155785871e-04 +-7.4473724602536955e-04 +-7.4055877499221937e-04 +-7.3703939415246532e-04 +-7.3420002228111560e-04 +-7.3205683336235756e-04 +-7.3062162978896337e-04 +-7.2990212349029735e-04 +-6.9978947726928066e-04 +-7.0116631261587863e-04 +-7.0390022401465419e-04 +-7.0795158764115141e-04 +-7.1326074149439308e-04 +-7.1974781537106197e-04 +-7.2731266819535574e-04 +-7.3583506227752440e-04 +-7.4517522115314825e-04 +-7.5517492267565772e-04 +-7.6565926867497378e-04 +-7.7643924402864242e-04 +-7.8731513010479870e-04 +-7.9808077119796590e-04 +-8.0852861175590774e-04 +-8.1845533416091318e-04 +-8.2766784179848425e-04 +-8.3598926214116921e-04 +-8.4326460152150604e-04 +-8.4936567667374811e-04 +-8.5419498281044323e-04 +-8.5768823253439203e-04 +-8.5981540621376509e-04 +-8.6058027900269530e-04 +-8.6001851579719623e-04 +-8.5819453646660329e-04 +-8.5519743624544865e-04 +-8.5113629222160505e-04 +-8.4613519479610961e-04 +-8.4032831707794950e-04 +-8.3385528388645188e-04 +-8.2685703586909227e-04 +-8.1947231357455891e-04 +-8.1183481977225474e-04 +-8.0407106185045483e-04 +-7.9629883290514337e-04 +-7.8862626083342231e-04 +-7.8115133824601302e-04 +-7.7396184010262580e-04 +-7.6713553800782769e-04 +-7.6074062747102900e-04 +-7.5483629486249287e-04 +-7.4947336249087722e-04 +-7.4469496189176324e-04 +-7.4053719621198111e-04 +-7.3702976202868911e-04 +-7.3419650886843968e-04 +-7.3205592108589225e-04 +-7.3062151175928771e-04 +-7.2990212203421514e-04 +-6.9978948768733033e-04 +-7.0116640649699744e-04 +-7.0390048539865945e-04 +-7.0795210144336909e-04 +-7.1326159325160526e-04 +-7.1974909017212269e-04 +-7.2731444856655799e-04 +-7.3583742486015209e-04 +-7.4517823212704956e-04 +-7.5517863205707932e-04 +-7.6566370384628570e-04 +-7.7644440312038922e-04 +-7.8732097610281077e-04 +-7.9808722782580299e-04 +-8.0853556221244748e-04 +-8.1846262361268075e-04 +-8.2767528411170426e-04 +-8.3599665072397555e-04 +-8.4327172343328434e-04 +-8.4937232849842186e-04 +-8.5420098634863553e-04 +-8.5769344827291226e-04 +-8.5981974282483230e-04 +-8.6058369775333357e-04 +-8.6002102956843644e-04 +-8.5819620390684202e-04 +-8.5519835223971639e-04 +-8.5113657623488354e-04 +-8.4613497871173775e-04 +-8.4032773394462695e-04 +-8.3385445860180982e-04 +-8.2685607837238155e-04 +-8.1947131469047518e-04 +-8.1183384950631726e-04 +-8.0407016971259277e-04 +-7.9629804973123516e-04 +-7.8862560156391407e-04 +-7.8115080517696296e-04 +-7.7396142621789842e-04 +-7.6713523010699580e-04 +-7.6074040890839985e-04 +-7.5483614779831899e-04 +-7.4947326962195189e-04 +-7.4469490767512729e-04 +-7.4053716762480725e-04 +-7.3702974892316030e-04 +-7.3419650398645966e-04 +-7.3205591979830893e-04 +-7.3062151159097551e-04 +-7.2990212203213856e-04 +-7.1661641578295516e-04 +-7.1802625004378665e-04 +-7.2082432672916240e-04 +-7.2496734309640651e-04 +-7.3039009212296055e-04 +-7.3700528240188117e-04 +-7.4470349736242001e-04 +-7.5335345096198998e-04 +-7.6280271681923660e-04 +-7.7287911182674011e-04 +-7.8339289906730568e-04 +-7.9413993472972789e-04 +-8.0490581819091299e-04 +-8.1547101546898342e-04 +-8.2561682031129712e-04 +-8.3513190552275891e-04 +-8.4381911501176052e-04 +-8.5150207155211500e-04 +-8.5803114214965369e-04 +-8.6328832274842893e-04 +-8.6719067905098807e-04 +-8.6969210278100108e-04 +-8.7078329598811192e-04 +-8.7049005729887953e-04 +-8.6887008960041204e-04 +-8.6600865874028859e-04 +-8.6201349544771694e-04 +-8.5700934520752765e-04 +-8.5113253916466853e-04 +-8.4452589515181980e-04 +-8.3733417598677313e-04 +-8.2970024604079023e-04 +-8.2176198766051442e-04 +-8.1364997341223130e-04 +-8.0548584154403941e-04 +-7.9738129063840646e-04 +-7.8943759314679853e-04 +-7.8174552324485741e-04 +-7.7438559880471387e-04 +-7.6742854709146210e-04 +-7.6093591643630219e-04 +-7.5496076965905854e-04 +-7.4954840806729540e-04 +-7.4473708663596650e-04 +-7.4055869106684578e-04 +-7.3703935572033783e-04 +-7.3420000797691910e-04 +-7.3205682959208559e-04 +-7.3062162929628596e-04 +-7.2990212348418213e-04 +-7.5076474166975286e-04 +-7.5224126295886807e-04 +-7.5516880479190853e-04 +-7.5949621818162090e-04 +-7.6514647378654967e-04 +-7.7201646817166923e-04 +-7.7997704525247598e-04 +-7.8887345246688074e-04 +-7.9852647658728573e-04 +-8.0873450470271644e-04 +-8.1927672435664082e-04 +-8.2991760748011157e-04 +-8.4041271410245015e-04 +-8.5051570890505893e-04 +-8.5998631986319602e-04 +-8.6859880527239862e-04 +-8.7615036124250988e-04 +-8.8246882519170595e-04 +-8.8741903496516398e-04 +-8.9090729781044604e-04 +-8.9288360050727099e-04 +-8.9334142527863086e-04 +-8.9231528658221301e-04 +-8.8987632885544955e-04 +-8.8612648912982171e-04 +-8.8119181063160310e-04 +-8.7521549182720064e-04 +-8.6835118374384399e-04 +-8.6075693075972706e-04 +-8.5259001317473211e-04 +-8.4400281713116227e-04 +-8.3513974522591477e-04 +-8.2613509781259264e-04 +-8.1711180198304533e-04 +-8.0818083917071635e-04 +-7.9944121732427838e-04 +-7.9098034308613333e-04 +-7.8287466739098972e-04 +-7.7519049960615932e-04 +-7.6798490739452051e-04 +-7.6130663978181217e-04 +-7.5519702835638190e-04 +-7.4969083574187199e-04 +-7.4481703154156195e-04 +-7.4059948419441144e-04 +-7.3705756304964331e-04 +-7.3420664892597247e-04 +-7.3205855389382442e-04 +-7.3062185238113419e-04 +-7.2990212623627441e-04 +-8.0313947294337090e-04 +-8.0471815323969432e-04 +-8.0784353338430237e-04 +-8.1245145861505073e-04 +-8.1844530824558715e-04 +-8.2569579424933968e-04 +-8.3404111974082825e-04 +-8.4328783049144478e-04 +-8.5321272656317378e-04 +-8.6356619233744476e-04 +-8.7407723851571088e-04 +-8.8446041978497924e-04 +-8.9442459618636265e-04 +-9.0368325776354560e-04 +-9.1196586038864253e-04 +-9.1902937105640232e-04 +-9.2466904770849225e-04 +-9.2872743257039331e-04 +-9.3110065046455226e-04 +-9.3174137291221319e-04 +-9.3065819489636576e-04 +-9.2791160248096628e-04 +-9.2360710202174111e-04 +-9.1788636256869179e-04 +-9.1091735011215023e-04 +-9.0288440246405976e-04 +-8.9397903785094247e-04 +-8.8439205977182151e-04 +-8.7430726958419422e-04 +-8.6389687076492410e-04 +-8.5331847209770060e-04 +-8.4271348116041450e-04 +-8.3220662101025499e-04 +-8.2190629054486753e-04 +-8.1190550841100852e-04 +-8.0228321799865015e-04 +-7.9310577611187941e-04 +-7.8442849274063713e-04 +-7.7629712940428168e-04 +-7.6874929664651963e-04 +-7.6181571694028470e-04 +-7.5552133803617326e-04 +-7.4988629468635448e-04 +-7.4492672488678583e-04 +-7.4065545144957608e-04 +-7.3708254183216791e-04 +-7.3421575951363458e-04 +-7.3206091942176396e-04 +-7.3062215842691655e-04 +-7.2990213001184921e-04 +-8.7486219778923260e-04 +-8.7658058857904440e-04 +-8.7997558647375407e-04 +-8.8496336152696679e-04 +-8.9141766528273594e-04 +-8.9916964767445835e-04 +-9.0800829098156509e-04 +-9.1768198620888371e-04 +-9.2790182260483859e-04 +-9.3834712978991121e-04 +-9.4867368024072088e-04 +-9.5852471220663003e-04 +-9.6754457264802652e-04 +-9.7539433816150756e-04 +-9.8176831478850196e-04 +-9.8640994032441983e-04 +-9.8912542159425841e-04 +-9.8979352020454989e-04 +-9.8837028391429195e-04 +-9.8488815794396580e-04 +-9.7944967568762593e-04 +-9.7221665335993801e-04 +-9.6339634099209853e-04 +-9.5322621637323037e-04 +-9.4195903743952416e-04 +-9.2984945695954264e-04 +-9.1714305921508296e-04 +-9.0406821371833822e-04 +-8.9083074176996349e-04 +-8.7761110466033458e-04 +-8.6456365744884032e-04 +-8.5181745363297368e-04 +-8.3947810509130811e-04 +-8.2763026795451544e-04 +-8.1634041260476517e-04 +-8.0565962616068333e-04 +-7.9562627716941461e-04 +-7.8626843929406273e-04 +-7.7760602215494684e-04 +-7.6965259423453691e-04 +-7.6241690717190598e-04 +-7.5590414551161031e-04 +-7.5011693356337309e-04 +-7.4505613363505183e-04 +-7.4072146924030488e-04 +-7.3711200423387947e-04 +-7.3422650510386058e-04 +-7.3206370945068573e-04 +-7.3062251939431748e-04 +-7.2990213446506619e-04 +-9.6691724431680938e-04 +-9.6881466774827250e-04 +-9.7255363724748744e-04 +-9.7802203914071025e-04 +-9.8505105098736453e-04 +-9.9341503502990702e-04 +-1.0028324826293392e-03 +-1.0129688457208147e-03 +-1.0234421503565506e-03 +-1.0338322095753121e-03 +-1.0436939946105166e-03 +-1.0525752585374326e-03 +-1.0600378470853032e-03 +-1.0656813495346635e-03 +-1.0691669809336569e-03 +-1.0702390441972038e-03 +-1.0687412029329727e-03 +-1.0646252377205067e-03 +-1.0579509463244732e-03 +-1.0488771890035235e-03 +-1.0376454482789767e-03 +-1.0245583240879289e-03 +-1.0099558840063285e-03 +-9.9419268191494430e-04 +-9.7761767138096868e-04 +-9.6055839879147188e-04 +-9.4331000057302930e-04 +-9.2612882098004406e-04 +-9.0922999480479486e-04 +-8.9278810673588211e-04 +-8.7693999994079160e-04 +-8.6178889568959340e-04 +-8.4740914150691852e-04 +-8.3385107993787233e-04 +-8.2114569318942157e-04 +-8.0930881515632483e-04 +-7.9834480677713673e-04 +-7.8824966485042795e-04 +-7.7901358309241317e-04 +-7.7062301303992733e-04 +-7.6306228682799799e-04 +-7.5631486848750404e-04 +-7.5036429878471930e-04 +-7.4519489337148055e-04 +-7.4079224694050124e-04 +-7.3714358836096867e-04 +-7.3423802412666119e-04 +-7.3206670026743613e-04 +-7.3062290633976235e-04 +-7.2990213923888609e-04 +-1.0795750330586133e-03 +-1.0816911707122610e-03 +-1.0858481801160474e-03 +-1.0918950408926314e-03 +-1.0996043884449792e-03 +-1.1086725796120725e-03 +-1.1187214935452260e-03 +-1.1293033802683180e-03 +-1.1399101469269687e-03 +-1.1499883142230100e-03 +-1.1589604029070347e-03 +-1.1662526721353446e-03 +-1.1713279523606920e-03 +-1.1737209445838355e-03 +-1.1730720972611751e-03 +-1.1691554389161500e-03 +-1.1618959380197598e-03 +-1.1513732652100078e-03 +-1.1378110520013163e-03 +-1.1215533041163761e-03 +-1.1030317962978857e-03 +-1.0827294524350310e-03 +-1.0611446856793520e-03 +-1.0387606414544025e-03 +-1.0160217178255895e-03 +-9.9331813312037668e-04 +-9.7097803069185720e-04 +-9.4926581273835039e-04 +-9.2838506402926832e-04 +-9.0848444841122871e-04 +-8.8966519466502671e-04 +-8.7198911075049904e-04 +-8.5548639131562013e-04 +-8.4016276491634780e-04 +-8.2600574603815475e-04 +-8.1298991238631230e-04 +-8.0108122902917674e-04 +-7.9024050008364008e-04 +-7.8042605768799682e-04 +-7.7159580708159516e-04 +-7.6370874340001948e-04 +-7.5672604578911284e-04 +-7.5061184131205115e-04 +-7.4533371717428300e-04 +-7.4086304635853477e-04 +-7.3717517952696671e-04 +-7.3424954528328703e-04 +-7.3206969160557035e-04 +-7.3062329335309031e-04 +-7.2990214401370801e-04 +-1.2115508556249726e-03 +-1.2139227636604672e-03 +-1.2185660369992259e-03 +-1.2252789330712258e-03 +-1.2337577788967377e-03 +-1.2435973079275098e-03 +-1.2542936956415011e-03 +-1.2652522825469627e-03 +-1.2758020969452835e-03 +-1.2852190443966279e-03 +-1.2927588613281969e-03 +-1.2976995118239157e-03 +-1.2993906465081767e-03 +-1.2973053194182838e-03 +-1.2910870157844202e-03 +-1.2805840888458972e-03 +-1.2658647350236034e-03 +-1.2472088227588921e-03 +-1.2250774663583152e-03 +-1.2000657277357863e-03 +-1.1728467462794332e-03 +-1.1441161548982318e-03 +-1.1145440367303437e-03 +-1.0847388244792527e-03 +-1.0552245250489915e-03 +-1.0264302631063798e-03 +-9.9868971531473808e-04 +-9.7224750142057474e-04 +-9.4726975077341353e-04 +-9.2385657354507854e-04 +-9.0205479207456426e-04 +-8.8186987547699317e-04 +-8.6327649602699211e-04 +-8.4622747041392804e-04 +-8.3066107511107145e-04 +-8.1650685773546701e-04 +-8.0369013197667527e-04 +-7.9213536536988931e-04 +-7.8176866443136644e-04 +-7.7251954279923540e-04 +-7.6432213308232294e-04 +-7.5711597699796489e-04 +-7.5084650376927879e-04 +-7.4546528492873030e-04 +-7.4093013505452539e-04 +-7.3720511247371058e-04 +-7.3426046128801986e-04 +-7.3207252579134965e-04 +-7.3062366003464750e-04 +-7.2990214853788679e-04 +-1.3589581178032328e-03 +-1.3616153419820770e-03 +-1.3667987789953262e-03 +-1.3742455335652023e-03 +-1.3835598833285328e-03 +-1.3942138392974317e-03 +-1.4055514849479404e-03 +-1.4167999296910050e-03 +-1.4270900098671316e-03 +-1.4354896863635349e-03 +-1.4410520838935084e-03 +-1.4428779036343229e-03 +-1.4401883440079827e-03 +-1.4324001662868611e-03 +-1.4191905970357150e-03 +-1.4005384841801814e-03 +-1.3767311587242342e-03 +-1.3483336190268419e-03 +-1.3161255524210215e-03 +-1.2810188812699312e-03 +-1.2439713993591507e-03 +-1.2059102532560755e-03 +-1.1676741010637128e-03 +-1.1299770765893888e-03 +-1.0933930544825014e-03 +-1.0583559797656015e-03 +-1.0251711180321327e-03 +-9.9403244980662462e-04 +-9.6504244494195182e-04 +-9.3823162390327289e-04 +-9.1357635690034091e-04 +-8.9101415152268294e-04 +-8.7045622371329065e-04 +-8.5179747642776557e-04 +-8.3492418165279872e-04 +-8.1971972750201566e-04 +-8.0606879463058004e-04 +-7.9386029478840535e-04 +-7.8298935817435486e-04 +-7.7335860684223773e-04 +-7.6487890493624343e-04 +-7.5746973584246810e-04 +-7.5105932229073424e-04 +-7.4558457780766856e-04 +-7.4099095598147732e-04 +-7.3723224683895812e-04 +-7.3427035635408803e-04 +-7.3207509487749432e-04 +-7.3062399241830727e-04 +-7.2990215263914529e-04 +-1.5143531935751181e-03 +-1.5173112415961742e-03 +-1.5230639669429457e-03 +-1.5312834744588152e-03 +-1.5414759543041581e-03 +-1.5529818814827426e-03 +-1.5649805452186984e-03 +-1.5765025908098058e-03 +-1.5864551685910208e-03 +-1.5936648212423361e-03 +-1.5969425535320816e-03 +-1.5951723508606588e-03 +-1.5874178460924542e-03 +-1.5730327626858435e-03 +-1.5517527909455252e-03 +-1.5237448475992792e-03 +-1.4895974891827495e-03 +-1.4502517230302826e-03 +-1.4068878993909459e-03 +-1.3607944698125047e-03 +-1.3132447938318088e-03 +-1.2654007015844048e-03 +-1.2182509297882132e-03 +-1.1725832771697614e-03 +-1.1289836392104260e-03 +-1.0878530824333975e-03 +-1.0494347117315558e-03 +-1.0138439527376131e-03 +-9.8109801150962172e-04 +-9.5114212670448348e-04 +-9.2387159148515756e-04 +-8.9914940096255311e-04 +-8.7681987465509047e-04 +-8.5671882924441664e-04 +-8.3868093574500510e-04 +-8.2254486152868642e-04 +-8.0815672074769458e-04 +-7.9537226632492926e-04 +-7.8405816902699576e-04 +-7.7409265181176427e-04 +-7.6536568320453814e-04 +-7.5777888176564614e-04 +-7.5124524335736811e-04 +-7.4568877204556159e-04 +-7.4104407222185139e-04 +-7.3725594223299413e-04 +-7.3427899706065983e-04 +-7.3207733826850916e-04 +-7.3062428266423656e-04 +-7.2990215622075535e-04 +-1.6665444424006316e-03 +-1.6697980872176354e-03 +-1.6761148491844027e-03 +-1.6851121290855618e-03 +-1.6962128098574700e-03 +-1.7086432753109855e-03 +-1.7214342991485538e-03 +-1.7334289461305758e-03 +-1.7433043234220647e-03 +-1.7496171079826586e-03 +-1.7508840395682563e-03 +-1.7457042529076758e-03 +-1.7329174545006874e-03 +-1.7117725178135263e-03 +-1.6820643657137879e-03 +-1.6441954294579015e-03 +-1.5991371659761294e-03 +-1.5482992965824749e-03 +-1.4933428885871279e-03 +-1.4359847209766249e-03 +-1.3778328164624413e-03 +-1.3202747453432574e-03 +-1.2644216650567399e-03 +-1.2110985216189081e-03 +-1.1608657214528056e-03 +-1.1140579811359235e-03 +-1.0708292501527292e-03 +-1.0311964394901876e-03 +-9.9507800005618286e-04 +-9.6232577248540972e-04 +-9.3275000622279570e-04 +-9.0613822864439662e-04 +-8.8226896554292270e-04 +-8.6092136203236194e-04 +-8.4188166054835576e-04 +-8.2494734326003425e-04 +-8.0992958678505591e-04 +-7.9665453094712561e-04 +-7.8496373972062260e-04 +-7.7471413312773239e-04 +-7.6577759165759091e-04 +-7.5804037631561775e-04 +-7.5140246400048883e-04 +-7.4577686618616660e-04 +-7.4108897603618936e-04 +-7.3727597282768572e-04 +-7.3428630116943586e-04 +-7.3207923462154979e-04 +-7.3062452801111067e-04 +-7.2990215924867831e-04 +-1.8021185188146916e-03 +-1.8056379840439717e-03 +-1.8124747796467097e-03 +-1.8222225266089004e-03 +-1.8342659163801864e-03 +-1.8477728330074362e-03 +-1.8616835881047650e-03 +-1.8747008609623329e-03 +-1.8852907147238330e-03 +-1.8917144227970600e-03 +-1.8921175279326219e-03 +-1.8846969579710865e-03 +-1.8679411685611704e-03 +-1.8408969180867959e-03 +-1.8033822744222675e-03 +-1.7560668403464252e-03 +-1.7003845669190233e-03 +-1.6383077532410250e-03 +-1.5720558145764923e-03 +-1.5038187796540983e-03 +-1.4355502168309532e-03 +-1.3688487416264336e-03 +-1.3049192843095161e-03 +-1.2445914926395639e-03 +-1.1883707978156716e-03 +-1.1365024038682324e-03 +-1.0890351267346745e-03 +-1.0458779556092213e-03 +-1.0068464789452333e-03 +-9.7169892590236618e-04 +-9.4016291685441533e-04 +-9.1195453668338651e-04 +-8.8679139672438094e-04 +-8.6440117575678716e-04 +-8.4452687175166994e-04 +-8.2692973151157376e-04 +-8.1139059048253314e-04 +-7.9771016192327837e-04 +-7.8570866333765995e-04 +-7.7522505344656037e-04 +-7.6611606823259314e-04 +-7.5825518315284684e-04 +-7.5153158480403912e-04 +-7.4584920455184934e-04 +-7.4112584535935492e-04 +-7.3729241858688723e-04 +-7.3429229793716192e-04 +-7.3208079154028890e-04 +-7.3062472944262200e-04 +-7.2990216173500900e-04 +-1.9091991693591086e-03 +-1.9129328856151546e-03 +-1.9202113884986998e-03 +-1.9306539465783440e-03 +-1.9436795547173478e-03 +-1.9584881127102352e-03 +-1.9740268279941999e-03 +-1.9889429860363837e-03 +-2.0015379903077805e-03 +-2.0097587355813054e-03 +-2.0112808443811920e-03 +-2.0037329700900038e-03 +-1.9850626224314437e-03 +-1.9539607713715532e-03 +-1.9101963661694098e-03 +-1.8547227587156364e-03 +-1.7895122387634411e-03 +-1.7171904189401969e-03 +-1.6406056862289878e-03 +-1.5624572706160822e-03 +-1.4850485729702336e-03 +-1.4101734445460415e-03 +-1.3391068949406778e-03 +-1.2726604972290773e-03 +-1.2112674749141386e-03 +-1.1550732039216601e-03 +-1.1040174092716972e-03 +-1.0579021570779122e-03 +-1.0164445714402667e-03 +-9.7931570315436733e-04 +-9.4616796183236151e-04 +-9.1665365874707199e-04 +-8.9043693901708098e-04 +-8.6720096975034236e-04 +-8.4665183098400038e-04 +-8.2852018835518238e-04 +-8.1256152874417578e-04 +-7.9855551091895932e-04 +-7.8630481262663508e-04 +-7.7563373176875623e-04 +-7.6638671120051100e-04 +-7.5842689505576885e-04 +-7.5163478205739740e-04 +-7.4590701251854943e-04 +-7.4115530664871756e-04 +-7.3730555941182746e-04 +-7.3429708950472369e-04 +-7.3208203554954812e-04 +-7.3062489039053434e-04 +-7.2990216372211762e-04 +-1.9822025053612656e-03 +-1.9860878382746390e-03 +-1.9937082202559149e-03 +-2.0047594186751918e-03 +-2.0187701473662299e-03 +-2.0350690282450730e-03 +-2.0527199412175381e-03 +-2.0704212138465956e-03 +-2.0863857388696639e-03 +-2.0982574953736415e-03 +-2.1031612647213985e-03 +-2.0979863018472491e-03 +-2.0799241219854703e-03 +-2.0471246956356892e-03 +-1.9992106157625976e-03 +-1.9374184963271888e-03 +-1.8643189385018515e-03 +-1.7832621085317106e-03 +-1.6977746424072812e-03 +-1.6110832352271860e-03 +-1.5258357874644733e-03 +-1.4440050378341297e-03 +-1.3669190963294159e-03 +-1.2953596492553357e-03 +-1.2296828825811884e-03 +-1.1699358880076169e-03 +-1.1159555749742230e-03 +-1.0674463007951469e-03 +-1.0240373630856156e-03 +-9.8532358918768841e-04 +-9.5089273136431107e-04 +-9.2034306894121462e-04 +-8.9329402005377547e-04 +-8.6939192961505178e-04 +-8.4831263776908173e-04 +-8.2976197933836272e-04 +-8.1347501821648466e-04 +-7.9921456550955566e-04 +-7.8676934731673124e-04 +-7.7595205958980781e-04 +-7.6659745888011158e-04 +-7.5856057759645138e-04 +-7.5171511222903403e-04 +-7.4595200668748545e-04 +-7.4117823614369802e-04 +-7.3731578647815430e-04 +-7.3430081856453886e-04 +-7.3208300370052482e-04 +-7.3062501564845458e-04 +-7.2990216526912103e-04 +-2.0242461661141497e-03 +-2.0282242363728982e-03 +-2.0360821677383582e-03 +-2.0476194495593217e-03 +-2.0625167563658149e-03 +-2.0802913102777746e-03 +-2.1002043466062412e-03 +-2.1211058207241140e-03 +-2.1412263621994779e-03 +-2.1579837284447624e-03 +-2.1679517808271794e-03 +-2.1671776510152059e-03 +-2.1519205228534067e-03 +-2.1196142497855262e-03 +-2.0696277466775276e-03 +-2.0034548395834358e-03 +-1.9242861018092254e-03 +-1.8362230884658439e-03 +-1.7434793772171256e-03 +-1.6497985100129991e-03 +-1.5581529135016486e-03 +-1.4706753244604807e-03 +-1.3887352748394330e-03 +-1.3130817350214133e-03 +-1.2439986894026121e-03 +-1.1814451358923216e-03 +-1.1251683676213738e-03 +-1.0747893603845480e-03 +-1.0298637431782923e-03 +-9.8992332717613794e-04 +-9.5450307079265710e-04 +-9.2315760900772237e-04 +-8.9547057189693724e-04 +-8.7105908624528282e-04 +-8.4957517403631084e-04 +-8.3070524056164672e-04 +-8.1416846225362751e-04 +-7.9971461151919366e-04 +-7.8712166567373662e-04 +-7.7619341689153247e-04 +-7.6675721248075171e-04 +-7.5866189677311594e-04 +-7.5177598826364853e-04 +-7.4598610173690289e-04 +-7.4119561053137637e-04 +-7.3732353564290103e-04 +-7.3430364408105233e-04 +-7.3208373726743809e-04 +-7.3062511055638430e-04 +-7.2990216644190349e-04 +-2.0445785385843308e-03 +-2.0486054362232175e-03 +-2.0566089775697471e-03 +-2.0684847962350924e-03 +-2.0840575414779561e-03 +-2.1030329065275452e-03 +-2.1248924996264064e-03 +-2.1487027329293155e-03 +-2.1728267434277340e-03 +-2.1945978763668488e-03 +-2.2101491325086614e-03 +-2.2147045235409225e-03 +-2.2035133473202384e-03 +-2.1731753555204892e-03 +-2.1227100921988348e-03 +-2.0538140857190050e-03 +-1.9702649033948682e-03 +-1.8768807782354006e-03 +-1.7785190960216410e-03 +-1.6793955685228627e-03 +-1.5827705462074136e-03 +-1.4909138360188225e-03 +-1.4052276970656925e-03 +-1.3264312625879374e-03 +-1.2547469995811699e-03 +-1.1900607885011938e-03 +-1.1320468923490476e-03 +-1.0802593240458853e-03 +-1.0341952684616194e-03 +-9.9333706243868091e-04 +-9.5717858795355112e-04 +-9.2524078873757842e-04 +-8.9707985891335348e-04 +-8.7229066271227076e-04 +-8.5050717245164489e-04 +-8.3140114058563727e-04 +-8.1467981341235983e-04 +-8.0008320959163348e-04 +-7.8738129248785520e-04 +-7.7637123501917294e-04 +-7.6687488973356207e-04 +-7.5873652104486435e-04 +-7.5182082124137552e-04 +-7.4601121006962151e-04 +-7.4120840495614721e-04 +-7.3732924198137754e-04 +-7.3430572471801421e-04 +-7.3208427744515976e-04 +-7.3062518044405699e-04 +-7.2990216730622990e-04 +-2.0529840591917321e-03 +-2.0570334375766166e-03 +-2.0651154975566445e-03 +-2.0771936839223564e-03 +-2.0931968673719172e-03 +-2.1129756638031722e-03 +-2.1362012482419668e-03 +-2.1621652586467943e-03 +-2.1894399531887159e-03 +-2.2154232472043280e-03 +-2.2359854309776934e-03 +-2.2456620772000027e-03 +-2.2387412022520665e-03 +-2.2109667931593849e-03 +-2.1609544670906297e-03 +-2.0905341069083288e-03 +-2.0039872415533741e-03 +-1.9067561804997949e-03 +-1.8042525144391318e-03 +-1.7010908838768753e-03 +-1.6007698465326928e-03 +-1.5056700392669681e-03 +-1.4172191139619329e-03 +-1.3361119386868189e-03 +-1.2625224942081502e-03 +-1.1962799354659130e-03 +-1.1370025506554965e-03 +-1.0841935419018168e-03 +-1.0373061254407472e-03 +-9.9578569157857859e-04 +-9.5909564363862144e-04 +-9.2673206678799721e-04 +-8.9823101207525409e-04 +-8.7317107048812256e-04 +-8.5117307198076552e-04 +-8.3189813696824455e-04 +-8.1504488202977746e-04 +-8.0034628971420506e-04 +-7.8756655621395018e-04 +-7.7649810085895880e-04 +-7.6695883711716778e-04 +-7.5878975092770137e-04 +-7.5185279881713864e-04 +-7.4602911808725682e-04 +-7.4121753008373696e-04 +-7.3733331174449020e-04 +-7.3430720861800949e-04 +-7.3208466269610788e-04 +-7.3062523028768198e-04 +-7.2990216792350458e-04 +-2.0560409086217953e-03 +-2.0600997322609950e-03 +-2.0682205564153825e-03 +-2.0804072435751282e-03 +-2.0966521229938660e-03 +-2.1168986363688537e-03 +-2.1409514764408823e-03 +-2.1682867432229408e-03 +-2.1976942333827455e-03 +-2.2267262770235656e-03 +-2.2511575796467843e-03 +-2.2650274805683756e-03 +-2.2618176119198041e-03 +-2.2365001920144601e-03 +-2.1872937546109600e-03 +-2.1160991264260456e-03 +-2.0275910033088259e-03 +-1.9277073772058185e-03 +-1.8222970546095101e-03 +-1.7162853174569480e-03 +-1.6133535220430597e-03 +-1.5159660989781632e-03 +-1.4255695330299824e-03 +-1.3428405968400328e-03 +-1.2679176352054611e-03 +-1.2005885136096199e-03 +-1.1404311019071797e-03 +-1.0869121622209372e-03 +-1.0394535628351195e-03 +-9.9747448685796967e-04 +-9.6041681450424526e-04 +-9.2775914516394142e-04 +-8.9902340988409258e-04 +-8.7377682719934411e-04 +-8.5163106757318689e-04 +-8.3223985943379098e-04 +-8.1529583244448569e-04 +-8.0052709714855199e-04 +-7.8769386309680291e-04 +-7.7658526841457257e-04 +-7.6701651094716991e-04 +-7.5882631874178198e-04 +-7.5187476573845857e-04 +-7.4604141957922295e-04 +-7.4122379825273166e-04 +-7.3733610728527518e-04 +-7.3430822791020051e-04 +-7.3208492732465395e-04 +-7.3062526452551048e-04 +-7.2990216834852408e-04 +-2.0570061424630016e-03 +-2.0610688220912554e-03 +-2.0692086225452791e-03 +-2.0814523253037485e-03 +-2.0978283496603215e-03 +-2.1183337480352444e-03 +-2.1428543332569173e-03 +-2.1709909589040580e-03 +-2.2017074375135087e-03 +-2.2327242609502238e-03 +-2.2598238687495877e-03 +-2.2767318530356882e-03 +-2.2763296634431174e-03 +-2.2529771002070568e-03 +-2.2045579479758456e-03 +-2.1330021128874209e-03 +-2.0432642822178545e-03 +-1.9416417253936633e-03 +-1.8342989877355807e-03 +-1.7263837354439824e-03 +-1.6217069060811137e-03 +-1.5227917621618214e-03 +-1.4310978929069644e-03 +-1.3472895712314228e-03 +-1.2714806978180043e-03 +-1.2034309860798459e-03 +-1.1426908911465160e-03 +-1.0887025704182389e-03 +-1.0408668087535675e-03 +-9.9858522361452118e-04 +-9.6128531231988055e-04 +-9.2843402006133314e-04 +-8.9954388881819660e-04 +-8.7417459060030404e-04 +-8.5193172895670305e-04 +-8.3246414412356897e-04 +-8.1546051248016763e-04 +-8.0064573163206245e-04 +-7.8777738504489942e-04 +-7.7664245156799005e-04 +-7.6705434345842878e-04 +-7.5885030516871174e-04 +-7.5188917433136157e-04 +-7.4604948821982301e-04 +-7.4122790953059039e-04 +-7.3733794085710633e-04 +-7.3430889645192054e-04 +-7.3208510089101423e-04 +-7.3062528698199095e-04 +-7.2990216862850725e-04 +-2.0572330791694955e-03 +-2.0612973687677018e-03 +-2.0694468462478118e-03 +-2.0817213760975545e-03 +-2.0981697173381914e-03 +-2.1188185575134271e-03 +-2.1435985908731863e-03 +-2.1721840661962036e-03 +-2.2036544890457984e-03 +-2.2358642540565559e-03 +-2.2646406904352017e-03 +-2.2835309126897885e-03 +-2.2850172513635835e-03 +-2.2630310159176144e-03 +-2.2152121542511911e-03 +-2.1434985072189688e-03 +-2.0530267858295645e-03 +-1.9503311795001511e-03 +-1.8417840378253958e-03 +-1.7326785707116512e-03 +-1.6269099818125672e-03 +-1.5270395568776419e-03 +-1.4345353118756872e-03 +-1.3500535369851665e-03 +-1.2736925845101990e-03 +-1.2051943288599435e-03 +-1.1440919113708404e-03 +-1.0898119955158969e-03 +-1.0417421232732991e-03 +-9.9927290318971036e-04 +-9.6182283583229095e-04 +-9.2885158888066457e-04 +-8.9986585007183326e-04 +-8.7442059228870451e-04 +-8.5211764576017873e-04 +-8.3260281371500900e-04 +-8.1556231868628118e-04 +-8.0071906563498451e-04 +-7.8782901053808016e-04 +-7.7667779490548934e-04 +-7.6707772569486175e-04 +-7.5886512940748251e-04 +-7.5189807900561897e-04 +-7.4605447464538811e-04 +-7.4123045027242010e-04 +-7.3733907398269947e-04 +-7.3430930960061613e-04 +-7.3208520815221351e-04 +-7.3062530086016474e-04 +-7.2990216880306294e-04 +-2.0572420125645457e-03 +-2.0613069963748326e-03 +-2.0694614576571681e-03 +-2.0817525206451525e-03 +-2.0982400910680645e-03 +-2.1189666703506273e-03 +-2.1438863024012067e-03 +-2.1727123138960205e-03 +-2.2045910608109115e-03 +-2.2374635742121473e-03 +-2.2671995286107139e-03 +-2.2872528303320041e-03 +-2.2898690615529411e-03 +-2.2687162533987669e-03 +-2.2212808088964984e-03 +-2.1495008953638932e-03 +-2.0586201583523991e-03 +-1.9553133033982234e-03 +-1.8460757865692646e-03 +-1.7362867391449589e-03 +-1.6298909111876030e-03 +-1.5294718559807543e-03 +-1.4365025031730515e-03 +-1.3516344934720443e-03 +-1.2749571529323323e-03 +-1.2062020258768202e-03 +-1.1448922489508513e-03 +-1.0904455488562352e-03 +-1.0422418412328969e-03 +-9.9966540348238363e-04 +-9.6212956840588523e-04 +-9.2908982785035838e-04 +-9.0004951350888492e-04 +-8.7456090662444157e-04 +-8.5222367766454236e-04 +-8.3268189267641471e-04 +-8.1562037139587562e-04 +-8.0076088022763110e-04 +-7.8785844565469197e-04 +-7.7669794570226218e-04 +-7.6709105652515328e-04 +-7.5887358088839150e-04 +-7.5190315557098833e-04 +-7.4605731736914036e-04 +-7.4123189871315171e-04 +-7.3733971995567065e-04 +-7.3430954512723138e-04 +-7.3208526929930805e-04 +-7.3062530877233967e-04 +-7.2990216890451228e-04 +-2.0572136705343858e-03 +-2.0612789527889278e-03 +-2.0694358244091400e-03 +-2.0817350685511421e-03 +-2.0982421797210620e-03 +-2.1190074617685965e-03 +-2.1439962008875674e-03 +-2.1729405780571190e-03 +-2.2050207290133881e-03 +-2.2382243857777808e-03 +-2.2684477954704866e-03 +-2.2891004414348280e-03 +-2.2923052136781500e-03 +-2.2715908966696873e-03 +-2.2243616407733469e-03 +-2.1525545604337355e-03 +-2.0614685446752848e-03 +-1.9578512422689788e-03 +-1.8482619552397761e-03 +-1.7381242777029359e-03 +-1.6314085335861542e-03 +-1.5307097370090617e-03 +-1.4375033322393165e-03 +-1.3524385626510315e-03 +-1.2756001192355620e-03 +-1.2067142518727546e-03 +-1.1452989768314780e-03 +-1.0907674523059087e-03 +-1.0424956991478748e-03 +-9.9986476415026698e-04 +-9.6228534507287881e-04 +-9.2921080586906807e-04 +-9.0014276904428554e-04 +-8.7463214570911748e-04 +-8.5227750742893342e-04 +-8.3272203670818048e-04 +-8.1564984005928602e-04 +-8.0078210518998768e-04 +-7.8787338627487344e-04 +-7.7670817347691662e-04 +-7.6709782255780107e-04 +-7.5887787031532093e-04 +-7.5190573205468649e-04 +-7.4605876009646436e-04 +-7.4123263380845936e-04 +-7.3734004778796863e-04 +-7.3430966465626757e-04 +-7.3208530033134209e-04 +-7.3062531278851161e-04 +-7.2990216895862210e-04 +-2.0571951315676452e-03 +-2.0612605310381684e-03 +-2.0694184014553563e-03 +-2.0817210707046179e-03 +-2.0982363950611863e-03 +-2.1190179625051333e-03 +-2.1440357357361472e-03 +-2.1730297099043952e-03 +-2.2051942869989898e-03 +-2.2385374890012601e-03 +-2.2689677860400076e-03 +-2.2898763486427463e-03 +-2.2933335099102653e-03 +-2.2728079180852688e-03 +-2.2256680624754273e-03 +-2.1538504493293599e-03 +-2.0626776339061981e-03 +-1.9589285291456105e-03 +-1.8491897673886689e-03 +-1.7389039434437049e-03 +-1.6320522880784627e-03 +-1.5312346893201617e-03 +-1.4379276497038414e-03 +-1.3527793809926163e-03 +-1.2758725937725775e-03 +-1.2069312806207047e-03 +-1.1454712774795961e-03 +-1.0909037989997074e-03 +-1.0426032103142038e-03 +-9.9994918568096082e-04 +-9.6235130393360177e-04 +-9.2926202585766847e-04 +-9.0018224879381467e-04 +-8.7466230274308614e-04 +-8.5230029334116522e-04 +-8.3273902857646962e-04 +-8.1566231271303785e-04 +-8.0079108827117642e-04 +-7.8787970935040698e-04 +-7.7671250183720074e-04 +-7.6710068581178545e-04 +-7.5887968545294436e-04 +-7.5190682229735780e-04 +-7.4605937056968863e-04 +-7.4123294484678478e-04 +-7.3734018649919831e-04 +-7.3430971523015043e-04 +-7.3208531346152913e-04 +-7.3062531448888962e-04 +-7.2990216898514830e-04 +-2.0571887352718280e-03 +-2.0612541700220882e-03 +-2.0694123436268324e-03 +-2.0817160567517382e-03 +-2.0982338946850102e-03 +-2.1190204680723583e-03 +-2.1440472013463411e-03 +-2.1730565234858476e-03 +-2.2052472638944315e-03 +-2.2386337346911311e-03 +-2.2691281808978805e-03 +-2.2901160519760819e-03 +-2.2936513410212207e-03 +-2.2731840556407907e-03 +-2.2260716882691539e-03 +-2.1542506284463765e-03 +-2.0630508126914023e-03 +-1.9592608534120298e-03 +-1.8494758376330789e-03 +-1.7391442233188031e-03 +-1.6322505967405611e-03 +-1.5313963372904249e-03 +-1.4380582627255421e-03 +-1.3528842577212560e-03 +-1.2759564156120324e-03 +-1.2069980284310400e-03 +-1.1455242569239177e-03 +-1.0909457147107891e-03 +-1.0426362554309986e-03 +-9.9997512967996659e-04 +-9.6237157114804656e-04 +-9.2927776219492854e-04 +-9.0019437672529863e-04 +-8.7467156577183903e-04 +-8.5230729153232179e-04 +-8.3274424673992228e-04 +-8.1566614267197422e-04 +-8.0079384643690044e-04 +-7.8788165061156217e-04 +-7.7671383057785611e-04 +-7.6710156471011663e-04 +-7.5888024257611845e-04 +-7.5190715689979796e-04 +-7.4605955791325561e-04 +-7.4123304029223905e-04 +-7.3734022906169123e-04 +-7.3430973074789974e-04 +-7.3208531749085137e-04 +-7.3062531501241138e-04 +-7.2990216899907845e-04 +-2.0571877672976953e-03 +-2.0612532074584691e-03 +-2.0694114264551682e-03 +-2.0817152969462567e-03 +-2.0982335194543811e-03 +-2.1190208736762009e-03 +-2.1440490344988876e-03 +-2.1730608455901544e-03 +-2.2052558575918384e-03 +-2.2386493535275728e-03 +-2.2691540931668278e-03 +-2.2901545294109990e-03 +-2.2937020415194722e-03 +-2.2732437380013969e-03 +-2.2261354546930460e-03 +-2.1543136285041087e-03 +-2.0631093930288513e-03 +-1.9593128949422171e-03 +-1.8495205437267775e-03 +-1.7391817063323138e-03 +-1.6322814836609658e-03 +-1.5314214790375005e-03 +-1.4380785521277560e-03 +-1.3529005310658081e-03 +-1.2759694089578681e-03 +-1.2070083658717457e-03 +-1.1455324554732157e-03 +-1.0909521965310023e-03 +-1.0426413622498518e-03 +-9.9997913678917007e-04 +-9.6237469984242685e-04 +-9.2928019029763528e-04 +-9.0019624723493817e-04 +-8.7467299383648604e-04 +-8.5230837000925921e-04 +-8.3274505059685198e-04 +-8.1566673245851912e-04 +-8.0079427102015810e-04 +-7.8788194933512314e-04 +-7.7671403497264291e-04 +-7.6710169985945821e-04 +-7.5888032821581474e-04 +-7.5190720831678321e-04 +-7.4605958669241327e-04 +-7.4123305495009189e-04 +-7.3734023559670367e-04 +-7.3430973313049462e-04 +-7.3208531811041653e-04 +-7.3062531509534407e-04 +-7.2990216900935376e-04 +-2.0571877673145290e-03 +-2.0612532076983614e-03 +-2.0694114278078960e-03 +-2.0817153028669807e-03 +-2.0982335403316784e-03 +-2.1190209349019979e-03 +-2.1440491891538140e-03 +-2.1730611902715789e-03 +-2.2052565414131574e-03 +-2.2386505575185027e-03 +-2.2691559632631634e-03 +-2.2901570904740867e-03 +-2.2937051581696788e-03 +-2.2732471571654611e-03 +-2.2261388958450569e-03 +-2.1543168618816410e-03 +-2.0631122746309384e-03 +-1.9593153632499914e-03 +-1.8495225976226427e-03 +-1.7391833803686234e-03 +-1.6322828285223780e-03 +-1.5314225488867682e-03 +-1.4380793976746106e-03 +-1.3529011965092905e-03 +-1.2759699312063664e-03 +-1.2070087749339539e-03 +-1.1455327753458952e-03 +-1.0909524462137227e-03 +-1.0426415567057837e-03 +-9.9997928777824591e-04 +-9.6237481660916809e-04 +-9.2928028012226826e-04 +-9.0019631586670847e-04 +-8.7467304583029222e-04 +-8.5230840898528485e-04 +-8.3274507944004577e-04 +-8.1566675347172310e-04 +-8.0079428604185239e-04 +-7.8788195983037516e-04 +-7.7671404210388317e-04 +-7.6710170454213889e-04 +-7.5888033116279377e-04 +-7.5190721007430638e-04 +-7.4605958766983866e-04 +-7.4123305544492848e-04 +-7.3734023581611334e-04 +-7.3430973321009522e-04 +-7.3208531813100271e-04 +-7.3062531509800644e-04 +-7.2990216900940526e-04 +-2.0571887354729713e-03 +-2.0612541766914260e-03 +-2.0694123914439971e-03 +-2.0817162481699273e-03 +-2.0982344623008977e-03 +-2.1190218709546400e-03 +-2.1440502602767674e-03 +-2.1730625632899762e-03 +-2.2052581231916044e-03 +-2.2386513868444596e-03 +-2.2691538727247313e-03 +-2.2901494111292374e-03 +-2.2936901912893907e-03 +-2.2732251475170544e-03 +-2.2261117975464688e-03 +-2.1542873547229797e-03 +-2.0630828324922257e-03 +-1.9592877704490003e-03 +-1.8494978764461096e-03 +-1.7391619368093149e-03 +-1.6322646553253300e-03 +-1.5314074031287164e-03 +-1.4380669277705596e-03 +-1.3528910218007252e-03 +-1.2759616862796689e-03 +-1.2070021308507111e-03 +-1.1455274471050038e-03 +-1.0909481927039288e-03 +-1.0426381770114272e-03 +-9.9997661606665133e-04 +-9.6237271679787244e-04 +-9.2927864091293239e-04 +-9.0019504638674309e-04 +-8.7467207193943157e-04 +-8.5230767021314189e-04 +-8.3274452648216435e-04 +-8.1566634616001693e-04 +-8.0079399170792699e-04 +-7.8788175198822575e-04 +-7.7671389938889870e-04 +-7.6710160985319893e-04 +-7.5888027096360406e-04 +-7.5190717381779860e-04 +-7.4605956731635392e-04 +-7.4123304505026777e-04 +-7.3734023117049080e-04 +-7.3430973151268500e-04 +-7.3208531768855889e-04 +-7.3062531503791767e-04 +-7.2990216899940751e-04 +-2.0571951320858448e-03 +-2.0612605724394596e-03 +-2.0694187273299627e-03 +-2.0817223630487146e-03 +-2.0982400765299858e-03 +-2.1190265962388009e-03 +-2.1440535174160101e-03 +-2.1730628590560463e-03 +-2.2052506727951514e-03 +-2.2386244989313891e-03 +-2.2690885035103001e-03 +-2.2900264203839335e-03 +-2.2935015665383669e-03 +-2.2729795312254803e-03 +-2.2258303851594640e-03 +-2.1539949602698239e-03 +-2.0628004991252251e-03 +-1.9590295194331715e-03 +-1.8492708093834182e-03 +-1.7389679182927614e-03 +-1.6321022504690219e-03 +-1.5312734514700045e-03 +-1.4379576113110041e-03 +-1.3528024992840743e-03 +-1.2758904212151038e-03 +-1.2069450277575160e-03 +-1.1454818788814241e-03 +-1.0909119725439943e-03 +-1.0426095065550044e-03 +-9.9995402722488137e-04 +-9.6235501603335154e-04 +-9.2926485980087846e-04 +-9.0018439960793501e-04 +-8.7466392252213542e-04 +-8.5230150124990126e-04 +-8.3273991835758191e-04 +-8.1566295832939575e-04 +-8.0079154816164305e-04 +-7.8788002965810998e-04 +-7.7671271887860881e-04 +-7.6710082798591447e-04 +-7.5887977473860938e-04 +-7.5190687544724605e-04 +-7.4605940008112218e-04 +-7.4123295976702874e-04 +-7.3734019310727481e-04 +-7.3430971762528715e-04 +-7.3208531408043467e-04 +-7.3062531456870316e-04 +-7.2990216898614598e-04 +-2.0572136701317652e-03 +-2.0612790904072143e-03 +-2.0694370055388961e-03 +-2.0817398025606729e-03 +-2.0982555555846679e-03 +-2.1190383209207749e-03 +-2.1440584309961536e-03 +-2.1730538317596320e-03 +-2.2052084711996424e-03 +-2.2385065665387954e-03 +-2.2688292565837837e-03 +-2.2895629408340892e-03 +-2.2928109619195520e-03 +-2.2720958747664281e-03 +-2.2248292955157575e-03 +-2.1529627306368392e-03 +-2.0618092028351570e-03 +-1.9581264470780058e-03 +-1.8484792711367718e-03 +-1.7382932804995753e-03 +-1.6315387028193369e-03 +-1.5308094402457450e-03 +-1.4375794939843960e-03 +-1.3524966940206111e-03 +-1.2756445024183969e-03 +-1.2067481664971218e-03 +-1.1453249146665719e-03 +-1.0907872998396060e-03 +-1.0425108840834355e-03 +-9.9987636902731112e-04 +-9.6229419359221554e-04 +-9.2921752766599898e-04 +-9.0014784793935080e-04 +-8.7463595551871256e-04 +-8.5228033851113120e-04 +-8.3272411565619249e-04 +-8.1565134434662242e-04 +-8.0078317410706243e-04 +-7.8787412914524792e-04 +-7.7670867588181599e-04 +-7.6709815110335869e-04 +-7.5887807633519516e-04 +-7.5190585453407195e-04 +-7.4605882802611335e-04 +-7.4123266811876125e-04 +-7.3734006297147836e-04 +-7.3430967015602805e-04 +-7.3208530175177889e-04 +-7.3062531297161970e-04 +-7.2990216896088830e-04 +-2.0572420046444948e-03 +-2.0613073137878218e-03 +-2.0694645240791299e-03 +-2.0817650792283602e-03 +-2.0982756708109187e-03 +-2.1190483683591172e-03 +-2.1440495630415269e-03 +-2.1730058173585450e-03 +-2.2050706474711895e-03 +-2.2381734149603634e-03 +-2.2681445832352771e-03 +-2.2883820903883806e-03 +-2.2910870954111397e-03 +-2.2699167611368912e-03 +-2.2223789172610324e-03 +-2.1504479984733042e-03 +-2.0594015903528970e-03 +-1.9559376356847653e-03 +-1.8465635533130996e-03 +-1.7366621938958672e-03 +-1.6301772681588283e-03 +-1.5296891497666185e-03 +-1.4366670256655992e-03 +-1.3517590216924847e-03 +-1.2750514867893308e-03 +-1.2062735831118211e-03 +-1.1449466044257828e-03 +-1.0904868805091145e-03 +-1.0422732807100598e-03 +-9.9968930372696394e-04 +-9.6214770422144624e-04 +-9.2910354462753017e-04 +-9.0005983685699845e-04 +-8.7456862296758067e-04 +-8.5222939346622057e-04 +-8.3268607801992571e-04 +-8.1562339214376626e-04 +-8.0076302185915415e-04 +-7.8785993104265890e-04 +-7.7669894848118762e-04 +-7.6709171125218195e-04 +-7.5887399087340088e-04 +-7.5190339901012393e-04 +-7.4605745224207403e-04 +-7.4123196677349933e-04 +-7.3733975005178549e-04 +-7.3430955602191324e-04 +-7.3208527211179246e-04 +-7.3062530913478000e-04 +-7.2990216890898667e-04 +-2.0572330434653350e-03 +-2.0612979234412862e-03 +-2.0694532946442675e-03 +-2.0817486426684814e-03 +-2.0982476231464525e-03 +-2.1189974495073312e-03 +-2.1439543375352211e-03 +-2.1728181680419471e-03 +-2.2046792926145357e-03 +-2.2373633396429449e-03 +-2.2666146172010413e-03 +-2.2858671642393101e-03 +-2.2875169197677484e-03 +-2.2654776333807130e-03 +-2.2174360368241068e-03 +-2.1454051324349506e-03 +-2.0545906615806945e-03 +-1.9515733044691938e-03 +-1.8427487159991540e-03 +-1.7334167084782819e-03 +-1.6274696137745460e-03 +-1.5274617227101106e-03 +-1.4348531087144433e-03 +-1.3502927298729875e-03 +-1.2738727990906171e-03 +-1.2053303225476376e-03 +-1.1441947046858044e-03 +-1.0898897962721128e-03 +-1.0418010463744997e-03 +-9.9931751557982493e-04 +-9.6185656207251513e-04 +-9.2887700997289582e-04 +-8.9988492242123422e-04 +-8.7443480777439815e-04 +-8.5212814873581626e-04 +-8.3261048666361556e-04 +-8.1556784511343855e-04 +-8.0072297645663486e-04 +-7.8783171850163375e-04 +-7.7667962034089373e-04 +-7.6707891598185973e-04 +-7.5886587389148972e-04 +-7.5189852061138135e-04 +-7.4605471909163239e-04 +-7.4123057353231382e-04 +-7.3733912845311430e-04 +-7.3430932930853372e-04 +-7.3208521323786004e-04 +-7.3062530151536676e-04 +-7.2990216881113927e-04 +-2.0570060307481216e-03 +-2.0610695404114148e-03 +-2.0692202548568848e-03 +-2.0815037338606508e-03 +-2.0979771073381961e-03 +-2.1186760504049097e-03 +-2.1435323595058254e-03 +-2.1721894711853465e-03 +-2.2036231762564687e-03 +-2.2354947774359804e-03 +-2.2634364588789168e-03 +-2.2809771107701023e-03 +-2.2808509818679286e-03 +-2.2573902670081740e-03 +-2.2085625283994269e-03 +-2.1364309945293095e-03 +-2.0460731359685834e-03 +-1.9438692829347130e-03 +-1.8360257713886938e-03 +-1.7277020969733486e-03 +-1.6227039313886286e-03 +-1.5235418003916011e-03 +-1.4316608370813749e-03 +-1.3477119742467357e-03 +-1.2717979511083757e-03 +-1.2036696413517251e-03 +-1.1428707255511359e-03 +-1.0888382718798227e-03 +-1.0409692867346461e-03 +-9.9866259978620897e-04 +-9.6134365642691394e-04 +-9.2847789093913283e-04 +-8.9957672992269989e-04 +-8.7419901846868793e-04 +-8.5194974353354567e-04 +-8.3247728234586422e-04 +-8.1546996075181142e-04 +-8.0065240855098851e-04 +-7.8778200260897174e-04 +-7.7664556081873484e-04 +-7.6705636886795691e-04 +-7.5885157088736955e-04 +-7.5188992454109412e-04 +-7.4604990321250624e-04 +-7.4122811866681490e-04 +-7.3733803323305404e-04 +-7.3430892986142801e-04 +-7.3208510950982389e-04 +-7.3062528809216519e-04 +-7.2990216864218587e-04 +-2.0560406254744213e-03 +-2.0601002293357431e-03 +-2.0682389370964690e-03 +-2.0804935548257176e-03 +-2.0969060859736982e-03 +-2.1174848718975262e-03 +-2.1421077822971232e-03 +-2.1703118725549856e-03 +-2.2008927660336990e-03 +-2.2312974219723938e-03 +-2.2570630535733455e-03 +-2.2719292323414883e-03 +-2.2691546801074541e-03 +-2.2436679183221340e-03 +-2.1938136680298187e-03 +-2.1216987442591287e-03 +-2.0321918687364392e-03 +-1.9313655314987686e-03 +-1.8251384674924315e-03 +-1.7184575891013032e-03 +-1.6149975191541010e-03 +-1.5172030564200157e-03 +-1.4264976670561407e-03 +-1.3435365525681702e-03 +-1.2684398405280667e-03 +-1.2009808792852025e-03 +-1.1407263662446257e-03 +-1.0871346466312436e-03 +-1.0396213282134316e-03 +-9.9760097014115813e-04 +-9.6051204771163137e-04 +-9.2783065330298868e-04 +-8.9907686814037963e-04 +-8.7381654050460182e-04 +-8.5166032032769911e-04 +-8.3226117082750161e-04 +-8.1531114334001378e-04 +-8.0053790742550229e-04 +-7.8770133315656259e-04 +-7.7659029477060448e-04 +-7.6701978307683024e-04 +-7.5882836239258319e-04 +-7.5187597643116004e-04 +-7.4604208900387744e-04 +-7.4122413548401113e-04 +-7.3733625619441161e-04 +-7.3430828175241570e-04 +-7.3208494121191844e-04 +-7.3062526631407435e-04 +-7.2990216837054769e-04 +-2.0529834513432761e-03 +-2.0570328065344823e-03 +-2.0651407280758397e-03 +-2.0773226813181091e-03 +-2.0935848266463294e-03 +-2.1138755081846535e-03 +-2.1379694549995870e-03 +-2.1652341048685655e-03 +-2.1942311468760808e-03 +-2.2221955580273524e-03 +-2.2446668472980505e-03 +-2.2557758750190102e-03 +-2.2495068883230571e-03 +-2.2215335380400647e-03 +-2.1706310322307147e-03 +-2.0989076178834442e-03 +-2.0109187476808283e-03 +-1.9123053118497643e-03 +-1.8085885312962538e-03 +-1.7044224161501954e-03 +-1.6033014289936289e-03 +-1.5075808975967774e-03 +-1.4186563693041213e-03 +-1.3371915554757331e-03 +-1.2633335607770972e-03 +-1.1968898083347587e-03 +-1.1374616822403681e-03 +-1.0845395468828557e-03 +-1.0375670107112304e-03 +-9.9598233402498223e-04 +-9.5924365067680002e-04 +-9.2684315521177985e-04 +-8.9831402206076401e-04 +-8.7323270826906399e-04 +-8.5121845298916196e-04 +-8.3193118322803783e-04 +-8.1506861350454291e-04 +-8.0036303866937186e-04 +-7.8757812575838714e-04 +-7.7650588304893761e-04 +-7.6696390178134291e-04 +-7.5879291330166302e-04 +-7.5185467183171237e-04 +-7.4603015352330525e-04 +-7.4121805161085532e-04 +-7.3733354200016942e-04 +-7.3430729186417347e-04 +-7.3208468416560723e-04 +-7.3062523305262802e-04 +-7.2990216795754223e-04 +-2.0445774280922788e-03 +-2.0486022542072421e-03 +-2.0566380905557256e-03 +-2.0686534378906479e-03 +-2.0845798527313751e-03 +-2.1042543484161105e-03 +-2.1272900082339413e-03 +-2.1528378610849285e-03 +-2.1792287591850782e-03 +-2.2035791968483031e-03 +-2.2216148887267240e-03 +-2.2280710287733707e-03 +-2.2178192977835910e-03 +-2.1873468927834433e-03 +-2.1358379801796113e-03 +-2.0653162028095983e-03 +-1.9799039901976928e-03 +-1.8846865820720472e-03 +-1.7846815771127567e-03 +-1.6841731457501441e-03 +-1.5864288823403876e-03 +-1.4936929975737942e-03 +-1.4073292161704463e-03 +-1.3280167537864920e-03 +-1.2559423246294951e-03 +-1.1909621532332131e-03 +-1.1327269989162168e-03 +-1.0807727667038346e-03 +-1.0345829353632567e-03 +-9.9362957783938810e-04 +-9.5739893476973453e-04 +-9.2540627431698561e-04 +-8.9720357379700986e-04 +-8.7238255689077253e-04 +-8.5057484716479002e-04 +-8.3145043048118354e-04 +-8.1471521506831519e-04 +-8.0010819784329644e-04 +-7.8739855501196599e-04 +-7.7638284746287391e-04 +-7.6688244765423896e-04 +-7.5874124050506330e-04 +-7.5182361665455076e-04 +-7.4601275551055331e-04 +-7.4120918340253746e-04 +-7.3732958568389461e-04 +-7.3430584898463724e-04 +-7.3208430949503705e-04 +-7.3062518457169879e-04 +-7.2990216735703843e-04 +-2.0242444509852597e-03 +-2.0282171436878773e-03 +-2.0361089273572669e-03 +-2.0478082862517514e-03 +-2.0631254795714254e-03 +-2.0817341186685949e-03 +-2.1030466985865579e-03 +-2.1260033215056299e-03 +-2.1487891123234981e-03 +-2.1685770527884872e-03 +-2.1814981578635855e-03 +-2.1830673301855446e-03 +-2.1691107268505170e-03 +-2.1368908511600134e-03 +-2.0859029562839406e-03 +-2.0179693474576348e-03 +-1.9366642626323651e-03 +-1.8464135095614049e-03 +-1.7516460285950408e-03 +-1.6562147901967642e-03 +-1.5631235242972660e-03 +-1.4744894089740001e-03 +-1.3916441229220998e-03 +-1.3152922561530983e-03 +-1.2456754246600121e-03 +-1.1827160032741163e-03 +-1.1261313858814453e-03 +-1.0755189864407315e-03 +-1.0304162786879856e-03 +-9.9034128091199641e-04 +-9.5481856091755195e-04 +-9.2339496013633363e-04 +-8.9564827057264261e-04 +-8.7119124085887733e-04 +-8.4967259943763505e-04 +-8.3077626203111802e-04 +-8.1421951137090887e-04 +-7.9975066858465249e-04 +-7.8714658943358686e-04 +-7.7621019174437423e-04 +-7.6676813540672080e-04 +-7.5866872031037232e-04 +-7.5178003146127647e-04 +-7.4598833775512308e-04 +-7.4119673715305546e-04 +-7.3732403319731364e-04 +-7.3430382401035318e-04 +-7.3208378368078023e-04 +-7.3062511653452058e-04 +-7.2990216651548537e-04 +-1.9822002668714749e-03 +-1.9860765165246792e-03 +-1.9937259065502858e-03 +-2.0049382622175662e-03 +-2.0193789874050935e-03 +-2.0365410195509626e-03 +-2.0556464946867702e-03 +-2.0754894179676165e-03 +-2.0942443882580181e-03 +-2.1093250406386986e-03 +-2.1174338208142418e-03 +-2.1149374315365989e-03 +-2.0985691587475362e-03 +-2.0662420048783697e-03 +-2.0176244407471228e-03 +-1.9542240135076395e-03 +-1.8789815561646771e-03 +-1.7955973930768602e-03 +-1.7078593019088928e-03 +-1.6191500367924098e-03 +-1.5321852841401681e-03 +-1.4489455231636770e-03 +-1.3707328221073882e-03 +-1.2982881743881670e-03 +-1.2319242025234127e-03 +-1.1716477339549954e-03 +-1.1172612632569605e-03 +-1.0684410867804386e-03 +-1.0247942977117022e-03 +-9.8589849008465474e-04 +-9.5132820422937157e-04 +-9.2067166397220748e-04 +-8.9354066158944042e-04 +-8.6957576275141859e-04 +-8.4844842062549507e-04 +-8.2986112787904241e-04 +-8.1354638875020429e-04 +-7.9926504089604226e-04 +-7.8680427724594419e-04 +-7.7597559292321078e-04 +-7.6661279647569503e-04 +-7.5857016673861279e-04 +-7.5172079825726388e-04 +-7.4595515325638379e-04 +-7.4117982243369625e-04 +-7.3731648737139098e-04 +-7.3430107212576091e-04 +-7.3208306912710922e-04 +-7.3062502407726865e-04 +-7.2990216537287961e-04 +-1.9091966715634073e-03 +-1.9129185219344134e-03 +-1.9202166856721326e-03 +-1.9307970013547062e-03 +-1.9442045665836352e-03 +-1.9597919306590132e-03 +-1.9766564101575904e-03 +-1.9935443335972088e-03 +-2.0087438199857602e-03 +-2.0200243831636267e-03 +-2.0247121893545252e-03 +-2.0199773548032333e-03 +-2.0033260489995021e-03 +-1.9731620797406356e-03 +-1.9292006069540457e-03 +-1.8725608352951506e-03 +-1.8055146551072528e-03 +-1.7310162232455001e-03 +-1.6521930501407149e-03 +-1.5719385219734045e-03 +-1.4926648361142979e-03 +-1.4162075772603505e-03 +-1.3438394093199830e-03 +-1.2763453337524878e-03 +-1.2141218786412464e-03 +-1.1572762423287136e-03 +-1.1057130397106446e-03 +-1.0592041928461358e-03 +-1.0174420229778071e-03 +-9.8007772742692771e-04 +-9.4674810818138016e-04 +-9.1709334750800838e-04 +-8.9076822903276021e-04 +-8.6744871786848400e-04 +-8.4683535559171178e-04 +-8.2865454029691979e-04 +-8.1265845764570037e-04 +-7.9862419854806379e-04 +-7.8635242994317257e-04 +-7.7566586362347312e-04 +-7.6640768232749624e-04 +-7.5844002282829978e-04 +-7.5164257510000870e-04 +-7.4591132935051976e-04 +-7.4115748478313268e-04 +-7.3730652251331199e-04 +-7.3429743813350470e-04 +-7.3208212554783537e-04 +-7.3062490198850356e-04 +-7.2990216386489642e-04 +-1.8021160850451210e-03 +-1.8056226886294807e-03 +-1.8124690977394220e-03 +-1.8223195200916472e-03 +-1.8346619546941092e-03 +-1.8487909914590697e-03 +-1.8637758622326466e-03 +-1.8784144799132386e-03 +-1.8911877069072019e-03 +-1.9002480483642985e-03 +-1.9034926970020278e-03 +-1.8987631656927637e-03 +-1.8841682529645305e-03 +-1.8584559487123905e-03 +-1.8213075607206124e-03 +-1.7734394441009376e-03 +-1.7164754923743269e-03 +-1.6526471348561863e-03 +-1.5844302660793458e-03 +-1.5142219205576941e-03 +-1.4441156759553433e-03 +-1.3757871183364819e-03 +-1.3104696228442023e-03 +-1.2489893438709300e-03 +-1.1918303663311005e-03 +-1.1392087898132609e-03 +-1.0911429072271942e-03 +-1.0475132430449686e-03 +-1.0081105448815633e-03 +-9.7267224538612326e-04 +-9.4090902139155734e-04 +-9.1252339940937118e-04 +-8.8722226630600070e-04 +-8.6472487614910041e-04 +-8.4476763014563496e-04 +-8.2710661118972392e-04 +-8.1151860395286472e-04 +-7.9780113134267946e-04 +-7.8577188458464620e-04 +-7.7526780961660862e-04 +-7.6614402884519659e-04 +-7.5827271731923000e-04 +-7.5154201001265966e-04 +-7.4585498744743752e-04 +-7.4112876674024874e-04 +-7.3729371164901346e-04 +-7.3429276639756563e-04 +-7.3208091255031534e-04 +-7.3062474504381595e-04 +-7.2990216192711976e-04 +-1.6665423187577359e-03 +-1.6697838481219715e-03 +-1.6761024443419303e-03 +-1.6851676499238285e-03 +-1.6964790848562059e-03 +-1.7093586881758575e-03 +-1.7229381586250936e-03 +-1.7361434689424191e-03 +-1.7476847990611694e-03 +-1.7560696539347682e-03 +-1.7596644676963716e-03 +-1.7568267022947004e-03 +-1.7461077851053254e-03 +-1.7264907754296487e-03 +-1.6975946774810289e-03 +-1.6597741187457404e-03 +-1.6140769638086690e-03 +-1.5620753536017028e-03 +-1.5056270853122792e-03 +-1.4466350219204903e-03 +-1.3868552001634080e-03 +-1.3277758272843207e-03 +-1.2705648027953045e-03 +-1.2160696687036076e-03 +-1.1648503106992667e-03 +-1.1172273523854745e-03 +-1.0733341483684185e-03 +-1.0331651610050556e-03 +-9.9661725859317594e-04 +-9.6352293251320573e-04 +-9.3367582456811205e-04 +-9.0684960891184883e-04 +-8.8281147256200261e-04 +-8.6133139295990410e-04 +-8.4218825416021122e-04 +-8.2517365256783105e-04 +-8.1009405893883604e-04 +-7.9677184330070362e-04 +-7.8504553867150535e-04 +-7.7476961684544389e-04 +-7.6581397127561859e-04 +-7.5806324372029417e-04 +-7.5141608853758414e-04 +-7.4578443762616002e-04 +-7.4109280702762371e-04 +-7.3727767078240363e-04 +-7.3428691699120780e-04 +-7.3207939383026978e-04 +-7.3062454854870779e-04 +-7.2990215950163102e-04 +-1.5143514922988169e-03 +-1.5172992626108291e-03 +-1.5230492579061279e-03 +-1.5313092907216217e-03 +-1.5416383872564302e-03 +-1.5534437883173505e-03 +-1.5659777979311099e-03 +-1.5783365666929073e-03 +-1.5894656462494506e-03 +-1.5981810338211056e-03 +-1.6032175666731256e-03 +-1.6033152315188498e-03 +-1.5973445810351450e-03 +-1.5844553015267324e-03 +-1.5642141842844418e-03 +-1.5366917420896024e-03 +-1.5024679334258899e-03 +-1.4625531930773812e-03 +-1.4182479476677343e-03 +-1.3709788299417101e-03 +-1.3221484180203709e-03 +-1.2730224074582962e-03 +-1.2246622779697321e-03 +-1.1778992762879921e-03 +-1.1333392283630519e-03 +-1.0913864589993539e-03 +-1.0522768573618152e-03 +-1.0161129873108715e-03 +-9.8289691402208266e-04 +-9.5255858058114614e-04 +-9.2497902581312251e-04 +-9.0000859629048779e-04 +-8.7748073850216961e-04 +-8.5722211597979330e-04 +-8.3905979791426533e-04 +-8.2282618929076397e-04 +-8.0836226608828451e-04 +-7.9551956951699678e-04 +-7.8416131382599125e-04 +-7.7416287806199692e-04 +-7.6541188405317162e-04 +-7.5780800946071032e-04 +-7.5126264377544728e-04 +-7.4569846428466674e-04 +-7.4104898613709886e-04 +-7.3725812384468296e-04 +-7.3427978938580738e-04 +-7.3207754332362093e-04 +-7.3062430913473054e-04 +-7.2990215654691122e-04 +-1.3589568386465612e-03 +-1.3616059876369062e-03 +-1.3667848188843516e-03 +-1.3742535906291003e-03 +-1.3836510048894309e-03 +-1.3944931410972492e-03 +-1.4061737381409417e-03 +-1.4179676533558584e-03 +-1.4290404239881626e-03 +-1.4384682680730629e-03 +-1.4452739237442299e-03 +-1.4484830627766287e-03 +-1.4472020719643861e-03 +-1.4407104109576830e-03 +-1.4285517607852602e-03 +-1.4106024345590397e-03 +-1.3870974963170084e-03 +-1.3586054582707527e-03 +-1.3259570339474139e-03 +-1.2901455064628200e-03 +-1.2522210023839830e-03 +-1.2131979030541756e-03 +-1.1739869060169194e-03 +-1.1353549094546909e-03 +-1.0979097068039400e-03 +-1.0621033247291717e-03 +-1.0282472297927169e-03 +-9.9653356114594630e-04 +-9.6705809074885323e-04 +-9.3984215999879848e-04 +-9.1485209891355569e-04 +-8.9201552463465778e-04 +-8.7123447718074449e-04 +-8.5239566064552888e-04 +-8.3537819764947102e-04 +-8.2005933922460190e-04 +-8.0631854842502044e-04 +-7.9404032461725493e-04 +-7.8311607521891827e-04 +-7.7344528287954617e-04 +-7.6493616367583701e-04 +-7.5750596762179595e-04 +-7.5108103673750552e-04 +-7.4559670729756216e-04 +-7.4099712058365598e-04 +-7.3723498933261303e-04 +-7.3427135403856462e-04 +-7.3207535340650133e-04 +-7.3062402582024560e-04 +-7.2990215305086727e-04 +-1.2115499364707882e-03 +-1.2139158392786324e-03 +-1.2185543138110687e-03 +-1.2252780947903232e-03 +-1.2338051204917810e-03 +-1.2437580933449667e-03 +-1.2546654877765785e-03 +-1.2659654079140441e-03 +-1.2770141398260244e-03 +-1.2871017009935416e-03 +-1.2954769314115168e-03 +-1.3013842169989531e-03 +-1.3041121947366156e-03 +-1.3030514842167331e-03 +-1.2977542245046032e-03 +-1.2879846499904181e-03 +-1.2737492324334972e-03 +-1.2552982640709951e-03 +-1.2330973894872732e-03 +-1.2077749418635500e-03 +-1.1800560868485258e-03 +-1.1506960905888406e-03 +-1.1204227852277412e-03 +-1.0898941107843835e-03 +-1.0596722924322390e-03 +-1.0302129892418130e-03 +-1.0018660232184659e-03 +-9.7488386185237686e-04 +-9.4943442439009693e-04 +-9.2561556105630208e-04 +-9.0346939508023183e-04 +-8.8299544473955380e-04 +-8.6416199236556115e-04 +-8.4691554065079156e-04 +-8.3118842485154258e-04 +-8.1690477137924046e-04 +-8.0398504401704685e-04 +-7.9234942608906911e-04 +-7.8192026986719681e-04 +-7.7262381616323168e-04 +-7.6439135526489596e-04 +-7.5715996954367959e-04 +-7.5087297037136093e-04 +-7.4548011825696474e-04 +-7.4093769541700523e-04 +-7.3720848397748119e-04 +-7.3426169017291388e-04 +-7.3207284469859921e-04 +-7.3062370127825911e-04 +-7.2990214904653222e-04 +-1.0795743930650981e-03 +-1.0816862357708216e-03 +-1.0858390690335160e-03 +-1.0918907395465781e-03 +-1.0996271622198395e-03 +-1.1087620332614139e-03 +-1.1189376541904858e-03 +-1.1297278563594268e-03 +-1.1406442106397852e-03 +-1.1511468426326648e-03 +-1.1606611625499140e-03 +-1.1686014966396329e-03 +-1.1744017651787817e-03 +-1.1775518629315567e-03 +-1.1776364101736487e-03 +-1.1743706169056230e-03 +-1.1676270072934470e-03 +-1.1574474488040630e-03 +-1.1440374664763136e-03 +-1.1277434918612185e-03 +-1.1090172266083093e-03 +-1.0883735004825236e-03 +-1.0663483286609658e-03 +-1.0434625696968442e-03 +-1.0201944065315214e-03 +-9.9696163733486846e-04 +-9.7411303391634302e-04 +-9.5192701524915511e-04 +-9.3061553118275390e-04 +-9.1033116088826409e-04 +-8.9117578792671499e-04 +-8.7320965057048345e-04 +-8.5645997708982654e-04 +-8.4092875102607055e-04 +-8.2659939819874234e-04 +-8.1344235307980850e-04 +-8.0141956343187358e-04 +-7.9048804625694109e-04 +-7.8060263043669973e-04 +-7.7171802387882439e-04 +-7.6379033406940070e-04 +-7.5677815642746489e-04 +-7.5064332839632050e-04 +-7.4535143091969012e-04 +-7.4087210396883620e-04 +-7.3717922959551190e-04 +-7.3425102469484665e-04 +-7.3207007615497992e-04 +-7.3062334314080062e-04 +-7.2990214462805990e-04 +-9.6691680853170075e-04 +-9.6881124738030133e-04 +-9.7254693178000593e-04 +-9.7801714313467823e-04 +-9.8506115939972732e-04 +-9.9346399478554104e-04 +-1.0029568836593522e-03 +-1.0132191721929544e-03 +-1.0238823805424940e-03 +-1.0345372382441465e-03 +-1.0447444385358667e-03 +-1.0540496446808504e-03 +-1.0620028419990129e-03 +-1.0681814158684231e-03 +-1.0722153874796938e-03 +-1.0738122401453712e-03 +-1.0727780484250076e-03 +-1.0690315479781626e-03 +-1.0626085753235991e-03 +-1.0536558713023323e-03 +-1.0424151596176324e-03 +-1.0292001016079040e-03 +-1.0143697085499440e-03 +-9.9830187520425417e-04 +-9.8137001818805790e-04 +-9.6392469855784005e-04 +-9.4628094849959308e-04 +-9.2871107615657999e-04 +-9.1144211230729849e-04 +-8.9465678467367594e-04 +-8.7849688442566800e-04 +-8.6306802745199417e-04 +-8.4844502374305209e-04 +-8.3467729035266870e-04 +-8.2179394123612910e-04 +-8.0980834537837008e-04 +-7.9872206071043394e-04 +-7.8852813008099582e-04 +-7.7921377450328178e-04 +-7.7076254580940627e-04 +-7.6315601250285755e-04 +-7.5637505438609816e-04 +-7.5040083742079972e-04 +-7.4521553301411692e-04 +-7.4080283733542814e-04 +-7.3714833747436331e-04 +-7.3423976289424932e-04 +-7.3206715301883554e-04 +-7.3062296502604323e-04 +-7.2990213996346729e-04 +-8.7486190664002434e-04 +-8.7657827571580537e-04 +-8.7997087511531430e-04 +-8.8495918242554466e-04 +-8.9142192485447674e-04 +-8.9919683155481546e-04 +-9.0808085208393024e-04 +-9.1783127510748500e-04 +-9.2816823917964033e-04 +-9.3877914239939495e-04 +-9.4932541177263606e-04 +-9.5945196295531634e-04 +-9.6879944188716142e-04 +-9.7701897624779600e-04 +-9.8378869028085958e-04 +-9.8883071560979733e-04 +-9.9192698624723879e-04 +-9.9293189679024239e-04 +-9.9178006477524424e-04 +-9.8848801266470006e-04 +-9.8314947469643906e-04 +-9.7592502142969254e-04 +-9.6702752216877455e-04 +-9.5670543387731003e-04 +-9.4522594351523941e-04 +-9.3285966135643150e-04 +-9.1986801429297100e-04 +-9.0649388737916534e-04 +-8.9295554012295956e-04 +-8.7944345241910277e-04 +-8.6611954777247608e-04 +-8.5311817443178286e-04 +-8.4054825688342565e-04 +-8.2849611854076408e-04 +-8.1702858718190837e-04 +-8.0619610453057692e-04 +-7.9603565728915610e-04 +-7.8657342354040104e-04 +-7.7782708529043490e-04 +-7.6980779727449681e-04 +-7.6252182731928464e-04 +-7.5597189801433686e-04 +-7.5015826626952575e-04 +-7.4507957902870199e-04 +-7.4073354187572207e-04 +-7.3711743387421967e-04 +-7.3422849766464850e-04 +-7.3206422919420402e-04 +-7.3062258684307403e-04 +-7.2990213529831535e-04 +-8.0313928324693353e-04 +-8.0471663923334803e-04 +-8.0784040456141789e-04 +-8.1244850348763040e-04 +-8.1844744708872783e-04 +-8.2571210565368354e-04 +-8.3408576520943459e-04 +-8.4338075243066738e-04 +-8.5337994914596671e-04 +-8.6383952680562314e-04 +-8.7449320303045991e-04 +-8.8505824631213170e-04 +-8.9524332162861631e-04 +-9.0475807450702184e-04 +-9.1332410035933475e-04 +-9.2068666472534507e-04 +-9.2662627633376831e-04 +-9.3096903528306729e-04 +-9.3359465177584320e-04 +-9.3444120110338248e-04 +-9.3350604329338978e-04 +-9.3084282810584321e-04 +-9.2655502162679424e-04 +-9.2078681445800998e-04 +-9.1371251792454072e-04 +-9.0552559272581777e-04 +-8.9642830924137372e-04 +-8.8662277387553353e-04 +-8.7630374698122236e-04 +-8.6565338972684810e-04 +-8.5483785092728339e-04 +-8.4400545628550677e-04 +-8.3328618793080496e-04 +-8.2279212643248333e-04 +-8.1261855157578752e-04 +-8.0284544435817173e-04 +-7.9353918703327971e-04 +-7.8475431126626691e-04 +-7.7653519125597565e-04 +-7.6891761675487551e-04 +-7.6193020999458733e-04 +-7.5559567146076011e-04 +-7.4993185361909914e-04 +-7.4495267054800385e-04 +-7.4066885634487543e-04 +-7.3708858728415534e-04 +-7.3421798292172481e-04 +-7.3206150032948379e-04 +-7.3062223389551732e-04 +-7.2990213094469957e-04 +-7.5076462421466911e-04 +-7.5224033368928036e-04 +-7.5516693554655812e-04 +-7.5949465549144594e-04 +-7.6514853640518557e-04 +-7.7202823401640881e-04 +-7.8000798768472349e-04 +-7.8893695850711034e-04 +-7.9864015247000297e-04 +-8.0892015401963578e-04 +-8.1955987978967761e-04 +-8.3032651803088343e-04 +-8.4097674240245712e-04 +-8.5126317781152928e-04 +-8.6094195449683264e-04 +-8.6978102562884835e-04 +-8.7756876370441938e-04 +-8.8412222092207988e-04 +-8.8929437143002563e-04 +-8.9297967687164209e-04 +-8.9511744358292762e-04 +-8.9569265928509496e-04 +-8.9473427406316344e-04 +-8.9231117348407575e-04 +-8.8852632769182273e-04 +-8.8350974926804148e-04 +-8.7741093765579222e-04 +-8.7039143658714435e-04 +-8.6261800909817252e-04 +-8.5425677642576294e-04 +-8.4546850480419350e-04 +-8.3640508217604670e-04 +-8.2720711868306766e-04 +-8.1800253429954544e-04 +-8.0890596084330028e-04 +-8.0001877670310168e-04 +-7.9142960262116647e-04 +-7.8321510804736996e-04 +-7.7544100375692520e-04 +-7.6816312322091794e-04 +-7.6142851990795965e-04 +-7.5527652886030780e-04 +-7.4973975803878704e-04 +-7.4484498816651057e-04 +-7.4061396954667330e-04 +-7.3706411114277451e-04 +-7.3420906167620634e-04 +-7.3205918514483649e-04 +-7.3062193446576549e-04 +-7.2990212725135306e-04 +-7.1661635226914029e-04 +-7.1802577101587382e-04 +-7.2082351175825827e-04 +-7.2496726677274211e-04 +-7.3039332869955171e-04 +-7.3701640524978702e-04 +-7.4472954941033089e-04 +-7.5340434547722772e-04 +-7.6289151048326831e-04 +-7.7302207759845105e-04 +-7.8360931948673297e-04 +-7.9445154230845633e-04 +-8.0533583289245261e-04 +-8.1604277210608664e-04 +-8.2635203881372397e-04 +-8.3604872680787467e-04 +-8.4493009170460173e-04 +-8.5281235007415412e-04 +-8.5953708572703805e-04 +-8.6497679447194965e-04 +-8.6903913069828916e-04 +-8.7166951000461823e-04 +-8.7285186359659084e-04 +-8.7260751301537645e-04 +-8.7099231121297999e-04 +-8.6809235009941386e-04 +-8.6401864284525991e-04 +-8.5890123909620564e-04 +-8.5288322247251450e-04 +-8.4611498230358485e-04 +-8.3874906197581637e-04 +-8.3093578290133023e-04 +-8.2281974219419491e-04 +-8.1453719540053131e-04 +-8.0621426950161620e-04 +-7.9796590756915176e-04 +-7.8989542307844954e-04 +-7.8209453512943805e-04 +-7.7464376108582825e-04 +-7.6761305599773238e-04 +-7.6106260490143749e-04 +-7.5504369189673961e-04 +-7.4959958689851068e-04 +-7.4476640603326919e-04 +-7.4057391428831727e-04 +-7.3704624911301374e-04 +-7.3420255137661558e-04 +-7.3205749569101985e-04 +-7.3062171596997990e-04 +-7.2990212455638554e-04 +-6.9978946823179788e-04 +-7.0116630881935022e-04 +-7.0390064503701461e-04 +-7.0795368469615653e-04 +-7.1326701698164814e-04 +-7.1976243679496531e-04 +-7.2734185834745653e-04 +-7.3588743519949391e-04 +-7.4526202041313256e-04 +-7.5531010723508575e-04 +-7.6585938519371018e-04 +-7.7672302640816656e-04 +-7.8770278075497005e-04 +-7.9859290608976050e-04 +-8.0918489258175732e-04 +-8.1927286227978220e-04 +-8.2865944272793703e-04 +-8.3716183567057441e-04 +-8.4461773932407406e-04 +-8.5089074656717980e-04 +-8.5587484149242756e-04 +-8.5949765903884907e-04 +-8.6172225680106185e-04 +-8.6254726711930993e-04 +-8.6200543668566549e-04 +-8.6016070089496620e-04 +-8.5710406086921508e-04 +-8.5294861582628739e-04 +-8.4782414258222408e-04 +-8.4187160643839853e-04 +-8.3523794042777587e-04 +-8.2807135526836778e-04 +-8.2051735488831447e-04 +-8.1271554550340155e-04 +-8.0479725017201505e-04 +-7.9688388159128258e-04 +-7.8908598569835304e-04 +-7.8150284635561612e-04 +-7.7422253402346995e-04 +-7.6732228500805012e-04 +-7.6086910874793130e-04 +-7.5492053533200579e-04 +-7.4952543143630781e-04 +-7.4472482834061018e-04 +-7.4055271954953086e-04 +-7.3703679725783760e-04 +-7.3419910632642493e-04 +-7.3205660167823786e-04 +-7.3062160034791102e-04 +-7.2990212313027881e-04 +-6.9978949888040468e-04 +-7.0116658500659365e-04 +-7.0390141399825370e-04 +-7.0795519624236981e-04 +-7.1326952275199316e-04 +-7.1976618711068344e-04 +-7.2734709599072669e-04 +-7.3589438563899086e-04 +-7.4527087834049823e-04 +-7.5532101978963129e-04 +-7.6587243292751243e-04 +-7.7673820381690998e-04 +-7.8771997894208699e-04 +-7.9861190065369969e-04 +-8.0920533990303629e-04 +-8.1929430685418803e-04 +-8.2868133697240815e-04 +-8.3718357182031270e-04 +-8.4463869094055649e-04 +-8.5091031523475027e-04 +-8.5589250298138953e-04 +-8.5951300292935447e-04 +-8.6173501442699950e-04 +-8.6255732453897264e-04 +-8.6201283179581745e-04 +-8.6016560623094053e-04 +-8.5710675556746022e-04 +-8.5294945133293899e-04 +-8.4782350687630248e-04 +-8.4186989092776535e-04 +-8.3523551254188961e-04 +-8.2806853843220697e-04 +-8.2051441629534276e-04 +-8.1271269110054251e-04 +-8.0479462561130111e-04 +-7.9688157758832118e-04 +-7.8908404620646455e-04 +-7.8150127812986905e-04 +-7.7422131642351593e-04 +-7.6732137920000718e-04 +-7.6086846576227331e-04 +-7.5492010268637542e-04 +-7.4952515822674347e-04 +-7.4472466884156362e-04 +-7.4055263544937271e-04 +-7.3703675870287618e-04 +-7.3419909196418697e-04 +-7.3205659789029730e-04 +-7.3062159985273593e-04 +-7.2990212312414949e-04 +-7.1661644900520010e-04 +-7.1802664274297470e-04 +-7.2082593878111277e-04 +-7.2497203729959055e-04 +-7.3040123601717422e-04 +-7.3702823692087043e-04 +-7.4474606627071864e-04 +-7.5342624891310168e-04 +-7.6291939767884486e-04 +-7.7305638624755959e-04 +-7.8365026580712554e-04 +-7.9449905883285075e-04 +-8.0538951494348076e-04 +-8.1610184340158258e-04 +-8.2641534654269205e-04 +-8.3611477419275244e-04 +-8.4499711140388243e-04 +-8.5287841532419209e-04 +-8.5960024909115522e-04 +-8.6503523810349580e-04 +-8.6909130873227011e-04 +-8.7171426409102769e-04 +-8.7288849673953237e-04 +-8.7263581383329727e-04 +-8.7101252882317124e-04 +-8.6810512721280820e-04 +-8.6402491986265189e-04 +-8.5890214427889627e-04 +-8.5287996267563015e-04 +-8.4610874598947997e-04 +-8.3874094225846606e-04 +-8.3092672419486299e-04 +-8.2281051040527359e-04 +-8.1452836894623003e-04 +-8.0620624687273630e-04 +-7.9795892658523094e-04 +-7.8988958715925817e-04 +-7.8208984256525826e-04 +-7.7464013417691052e-04 +-7.6761036786094435e-04 +-7.6106070258402073e-04 +-7.5504241512711122e-04 +-7.4959878232119445e-04 +-7.4476593712823156e-04 +-7.4057366738965430e-04 +-7.3704613605018185e-04 +-7.3420250929534905e-04 +-7.3205748459933293e-04 +-7.3062171452059556e-04 +-7.2990212453841034e-04 +-7.5076480220752915e-04 +-7.5224193764485852e-04 +-7.5517140104727613e-04 +-7.5950343180946353e-04 +-7.6516307954731808e-04 +-7.7204998356114900e-04 +-7.8003832300729218e-04 +-7.8897713159307352e-04 +-7.9869119726619245e-04 +-8.0898277631407268e-04 +-8.1963433675670734e-04 +-8.3041250212672962e-04 +-8.4107328899768875e-04 +-8.5136861815172319e-04 +-8.6105393367282663e-04 +-8.6989659826432544e-04 +-8.7768456838888858e-04 +-8.8423472001356333e-04 +-8.8940012904889249e-04 +-8.9307563844616910e-04 +-8.9520117806415000e-04 +-8.9576253103731734e-04 +-8.9478952401402206e-04 +-8.9235190508971942e-04 +-8.8855340866225848e-04 +-8.8352465144824648e-04 +-8.7741554313519241e-04 +-8.7038783793396324e-04 +-8.6260832688804881e-04 +-8.5424300994601848e-04 +-8.4545242395355185e-04 +-8.3638816165820579e-04 +-8.2719051046510291e-04 +-8.1798707121203524e-04 +-8.0889218293736520e-04 +-8.0000697211393375e-04 +-7.9141985571871390e-04 +-7.8320734913366399e-04 +-7.7543505615295012e-04 +-7.6815874504865766e-04 +-7.6142543909377320e-04 +-7.5527447082108774e-04 +-7.4973846617124073e-04 +-7.4484423768028305e-04 +-7.4061357541411869e-04 +-7.3706393103344992e-04 +-7.3420899474917081e-04 +-7.3205916752533363e-04 +-7.3062193216519333e-04 +-7.2990212722285567e-04 +-8.0313957044182325e-04 +-8.0471922722569742e-04 +-8.0784760927302287e-04 +-8.1246266077718917e-04 +-8.1847089710005273e-04 +-8.2574714718010073e-04 +-8.3413457224246407e-04 +-8.4344524852640905e-04 +-8.5346164112103280e-04 +-8.6393930776184247e-04 +-8.7461114514153558e-04 +-8.8519341433404412e-04 +-8.9539364568295640e-04 +-9.0492032170401795e-04 +-9.1349397629487852e-04 +-9.2085905705444168e-04 +-9.2679562618587692e-04 +-9.3112979438387188e-04 +-9.3374176171868431e-04 +-9.3457052315244987e-04 +-9.3361467539162461e-04 +-9.3092926816478610e-04 +-9.2661916610130084e-04 +-9.2082981034565176e-04 +-9.1373650769330434e-04 +-9.0553340166725504e-04 +-8.9642312356533909e-04 +-8.8660784848369192e-04 +-8.7628216839648668e-04 +-8.6562790589981339e-04 +-8.5481076818554546e-04 +-8.4397859574968353e-04 +-8.3326088937337253e-04 +-8.2276928618846333e-04 +-8.1259868183380056e-04 +-8.0282874308579082e-04 +-7.9352561021162060e-04 +-7.8474364153450365e-04 +-7.7652709920929784e-04 +-7.6891171286909454e-04 +-7.6192608644325751e-04 +-7.5559293398465332e-04 +-7.4993014417108587e-04 +-7.4495168174495714e-04 +-7.4066833888399779e-04 +-7.3708835148582786e-04 +-7.3421789549418283e-04 +-7.3206147735025600e-04 +-7.3062223089832108e-04 +-7.2990213090757096e-04 +-8.7486234765586104e-04 +-8.7658224978472089e-04 +-8.7998193765346860e-04 +-8.8498091479762031e-04 +-8.9145790074762017e-04 +-8.9925052908418942e-04 +-9.0815549824423396e-04 +-9.1792961668091646e-04 +-9.2829224675600088e-04 +-9.3892967180886073e-04 +-9.4950186787407128e-04 +-9.5965202948867915e-04 +-9.6901895077054344e-04 +-9.7725198275034437e-04 +-9.8402779256489886e-04 +-9.8906761058650144e-04 +-9.9215319914592063e-04 +-9.9313957572953727e-04 +-9.9196271000374123e-04 +-9.8864102151803796e-04 +-9.8327042446222672e-04 +-9.7601366958350764e-04 +-9.6708555893324530e-04 +-9.5673606097165635e-04 +-9.4523336848186435e-04 +-9.3284859066883731e-04 +-9.1984320788924222e-04 +-9.0645981122201120e-04 +-8.9291612913059467e-04 +-8.7940197783992397e-04 +-8.6607857202024600e-04 +-8.5307957175204834e-04 +-8.4051327822778790e-04 +-8.2846548179836121e-04 +-8.1700257790558335e-04 +-8.0617467643545246e-04 +-7.9601852548680544e-04 +-7.8656014643990258e-04 +-7.7781713330676502e-04 +-7.6980060801308786e-04 +-7.6251684788083171e-04 +-7.5596861562122705e-04 +-7.5015622867570476e-04 +-7.4507840623731206e-04 +-7.4073293062928969e-04 +-7.3711715625604968e-04 +-7.3422839499647083e-04 +-7.3206420226053595e-04 +-7.3062258333453681e-04 +-7.2990213525489555e-04 +-9.6691746949171859e-04 +-9.6881720331120291e-04 +-9.7256350943291520e-04 +-9.7804969875587905e-04 +-9.8511500906794426e-04 +-9.9354424708940608e-04 +-1.0030681524989392e-03 +-1.0133651638232584e-03 +-1.0240653758209135e-03 +-1.0347575274915028e-03 +-1.0449998061725771e-03 +-1.0543350312725748e-03 +-1.0623103159852468e-03 +-1.0685005520351073e-03 +-1.0725340717418828e-03 +-1.0741178162733470e-03 +-1.0730586244726535e-03 +-1.0692772252856712e-03 +-1.0628123746539075e-03 +-1.0538142063394706e-03 +-1.0425278196576225e-03 +-1.0292698133776534e-03 +-1.0144014192878163e-03 +-9.9830192203197144e-04 +-9.8134532864573541e-04 +-9.6388212184896169e-04 +-9.4622676590347279e-04 +-9.2865069616096280e-04 +-9.1137992761754921e-04 +-8.9459615445652526e-04 +-8.7844020256934723e-04 +-8.6301684193120930e-04 +-8.4840017959887789e-04 +-8.3463907673415438e-04 +-8.2176222995505117e-04 +-8.0978271391980510e-04 +-7.9870189657235268e-04 +-7.8851271590446353e-04 +-7.7920235500871134e-04 +-7.7075437837279448e-04 +-7.6315040353715506e-04 +-7.5637138372370357e-04 +-7.5039857275483498e-04 +-7.4521423623566635e-04 +-7.4080216435599001e-04 +-7.3714803287990493e-04 +-7.3423965055746925e-04 +-7.3206712360849148e-04 +-7.3062296120003016e-04 +-7.2990213991614198e-04 +-1.0795753655757389e-03 +-1.0816949989152409e-03 +-1.0858634568691248e-03 +-1.0919386114820002e-03 +-1.0997062636090326e-03 +-1.1088796815173737e-03 +-1.1191002150177114e-03 +-1.1299400102413619e-03 +-1.1409080667564562e-03 +-1.1514610312786608e-03 +-1.1610201099911492e-03 +-1.1689951269115530e-03 +-1.1748158461501038e-03 +-1.1779690985988700e-03 +-1.1780381930601802e-03 +-1.1747391518193511e-03 +-1.1679473819506108e-03 +-1.1577092214837444e-03 +-1.1442354739421082e-03 +-1.1278777978403402e-03 +-1.1090923454335573e-03 +-1.0883971689162261e-03 +-1.0663301330007186e-03 +-1.0434126825736422e-03 +-1.0201225907407816e-03 +-9.9687657467114363e-04 +-9.7402196183192351e-04 +-9.5183561165418373e-04 +-9.3052797362856677e-04 +-9.1025029113725182e-04 +-8.9110332693928291e-04 +-8.7314642524034694e-04 +-8.5640613464698007e-04 +-8.4088394828233596e-04 +-8.2656296057711707e-04 +-8.1341340319584371e-04 +-8.0139712164615498e-04 +-7.9047110680830217e-04 +-7.8059021706213449e-04 +-7.7170922862963636e-04 +-7.6378434260534816e-04 +-7.5677426256851791e-04 +-7.5064094022108784e-04 +-7.4535007026165368e-04 +-7.4087140079103051e-04 +-7.3717891242176207e-04 +-7.3425090803503495e-04 +-7.3207004567441805e-04 +-7.3062333918088825e-04 +-7.2990214457911316e-04 +-1.2115513365602703e-03 +-1.2139284549407177e-03 +-1.2185894169736932e-03 +-1.2253469605857659e-03 +-1.2339187587137911e-03 +-1.2439266732389700e-03 +-1.2548974034287362e-03 +-1.2662660075813054e-03 +-1.2773842610310187e-03 +-1.2875362974528709e-03 +-1.2959642001489425e-03 +-1.3019056612370238e-03 +-1.3046439231761664e-03 +-1.3035667394780031e-03 +-1.2982267372235411e-03 +-1.2883920940764734e-03 +-1.2740759723707297e-03 +-1.2555367934845602e-03 +-1.2332482702629775e-03 +-1.2078454799926627e-03 +-1.1800582569000385e-03 +-1.1506442781172898e-03 +-1.1203317966130047e-03 +-1.0897776997336468e-03 +-1.0595422621614010e-03 +-1.0300787994655209e-03 +-1.0017347704152444e-03 +-9.7476049382956326e-04 +-9.4932207276269772e-04 +-9.2551590841944212e-04 +-9.0338302534503933e-04 +-8.8292214992470347e-04 +-8.6410102605580458e-04 +-8.4686581848472469e-04 +-8.3114867761094693e-04 +-8.1687365826060572e-04 +-8.0396123382299402e-04 +-7.9233165330786892e-04 +-7.8190737148398125e-04 +-7.7261475388536302e-04 +-7.6438522680087476e-04 +-7.5715601170731723e-04 +-7.5087055609572291e-04 +-7.4547874907622438e-04 +-7.4093699058054780e-04 +-7.3720816707061791e-04 +-7.3426157390692800e-04 +-7.3207281437861799e-04 +-7.3062369734420301e-04 +-7.2990214899793242e-04 +-1.3589587929433010e-03 +-1.3616235964626852e-03 +-1.3668338045675849e-03 +-1.3743496213141076e-03 +-1.3838092006737560e-03 +-1.3947270571719771e-03 +-1.4064937549355745e-03 +-1.4183788609950533e-03 +-1.4295403243277968e-03 +-1.4390448821684587e-03 +-1.4459050679577160e-03 +-1.4491374869758395e-03 +-1.4478427363171379e-03 +-1.4412994811113331e-03 +-1.4290562017186476e-03 +-1.4109987469848166e-03 +-1.3873743834943481e-03 +-1.3587639336333209e-03 +-1.3260083166635260e-03 +-1.2901076203246837e-03 +-1.2521151183381297e-03 +-1.2130452246169284e-03 +-1.1738065004131652e-03 +-1.1351625289882893e-03 +-1.0977174218613850e-03 +-1.0619197068992264e-03 +-1.0280778373221149e-03 +-9.9638153831012105e-04 +-9.6692476042708076e-04 +-9.3972754536575246e-04 +-9.1475534966710653e-04 +-8.9193524688272363e-04 +-8.7116897804801223e-04 +-8.5234312303122776e-04 +-8.3533680068084292e-04 +-8.2002733804451087e-04 +-8.0629432436708326e-04 +-7.9402241426868329e-04 +-7.8310318466648929e-04 +-7.7343629167178683e-04 +-7.6493012169690107e-04 +-7.5750208709531161e-04 +-7.5107868088596758e-04 +-7.4559537670373563e-04 +-7.4099643797555660e-04 +-7.3723468329614473e-04 +-7.3427124201649809e-04 +-7.3207532424327914e-04 +-7.3062402204063042e-04 +-7.2990215300421319e-04 +-1.5143541010779998e-03 +-1.5173227675608976e-03 +-1.5231146276552853e-03 +-1.5314373242258617e-03 +-1.5418488579977492e-03 +-1.5537537380671267e-03 +-1.5663989050710187e-03 +-1.5788718212987082e-03 +-1.5901060046189638e-03 +-1.5989031683954795e-03 +-1.6039840097006686e-03 +-1.6040778389386019e-03 +-1.5980512264263014e-03 +-1.5850583769063632e-03 +-1.5646785257716852e-03 +-1.5369996406056458e-03 +-1.5026199930335549e-03 +-1.4625653572089424e-03 +-1.4181461994673529e-03 +-1.3707934129900293e-03 +-1.3219090070401560e-03 +-1.2727549123813194e-03 +-1.2243872992017560e-03 +-1.1776318418100019e-03 +-1.1330893301513341e-03 +-1.0911599661808404e-03 +-1.0520765110510698e-03 +-1.0159393083962547e-03 +-9.8274895037633826e-04 +-9.5243447976969201e-04 +-9.2487645038996831e-04 +-8.9992501086372614e-04 +-8.7741359912156243e-04 +-8.5716898870092739e-04 +-8.3901842799532275e-04 +-8.2279453712457698e-04 +-8.0833852140989012e-04 +-7.9550215185493251e-04 +-7.8414886452310374e-04 +-7.7415424731846626e-04 +-7.6540611516353967e-04 +-7.5780432156938814e-04 +-7.5126041393330258e-04 +-7.4569720925520672e-04 +-7.4104834420293808e-04 +-7.3725783675252041e-04 +-7.3427968450552887e-04 +-7.3207751606027191e-04 +-7.3062430560486263e-04 +-7.2990215650334885e-04 +-1.6665455899791508e-03 +-1.6698133201528324e-03 +-1.6761843811679332e-03 +-1.6853279536456433e-03 +-1.6967419230002714e-03 +-1.7097438296077481e-03 +-1.7234569715260911e-03 +-1.7367940863165200e-03 +-1.7484477095215251e-03 +-1.7569056344449085e-03 +-1.7605168179595325e-03 +-1.7576286958398664e-03 +-1.7467942015743337e-03 +-1.7270102607554270e-03 +-1.6979188611599332e-03 +-1.6599006272095451e-03 +-1.6140260552728609e-03 +-1.5618822959296008e-03 +-1.5053333742503377e-03 +-1.4462809903754944e-03 +-1.3864752623922536e-03 +-1.3273963861489472e-03 +-1.2702041557992633e-03 +-1.2157390763067480e-03 +-1.1645555304367057e-03 +-1.1169701858916707e-03 +-1.0731137699342324e-03 +-1.0329791499883053e-03 +-9.9646234480717092e-04 +-9.6339550207081789e-04 +-9.3357224312220588e-04 +-9.0676641440082663e-04 +-8.8274547943033581e-04 +-8.6127973910191569e-04 +-8.4214841257686311e-04 +-8.2514342251803908e-04 +-8.1007154611214259e-04 +-7.9675543488750720e-04 +-7.8503387677019668e-04 +-7.7476157207965167e-04 +-7.6580861752899223e-04 +-7.5805983433076349e-04 +-7.5141403398569235e-04 +-7.4578328460476356e-04 +-7.4109221872667756e-04 +-7.3727740821875670e-04 +-7.3428682123059168e-04 +-7.3207936896874614e-04 +-7.3062454533253719e-04 +-7.2990215946197004e-04 +-1.8021198551568490e-03 +-1.8056566533531152e-03 +-1.8125634862360539e-03 +-1.8225039384943726e-03 +-1.8349633920708153e-03 +-1.8492300360055658e-03 +-1.8643611614112868e-03 +-1.8791363648243313e-03 +-1.8920130515605979e-03 +-1.9011192895264475e-03 +-1.9043335949312926e-03 +-1.8994916968089780e-03 +-1.8847135462705207e-03 +-1.8587734367806750e-03 +-1.8213867042606775e-03 +-1.7733017645334187e-03 +-1.7161649983159436e-03 +-1.6522177976643964e-03 +-1.5839349646480246e-03 +-1.5137052565761422e-03 +-1.4436109122977221e-03 +-1.3753162079228692e-03 +-1.3100449638613824e-03 +-1.2486161430512160e-03 +-1.1915089169497223e-03 +-1.1389363426640344e-03 +-1.0909150558442286e-03 +-1.0473248698868495e-03 +-1.0079564215596747e-03 +-9.7254738334950485e-04 +-9.4080885433439631e-04 +-9.1244385878201802e-04 +-8.8715979304222010e-04 +-8.6467639724022865e-04 +-8.4473051814538329e-04 +-8.2707863748573518e-04 +-8.1149789188325074e-04 +-7.9778611223952343e-04 +-7.8576125802163927e-04 +-7.7526050811061278e-04 +-7.6613918672515215e-04 +-7.5826964323877941e-04 +-7.5154016251997890e-04 +-7.4585395305699020e-04 +-7.4112824002603862e-04 +-7.3729347696633392e-04 +-7.3429268092127704e-04 +-7.3208089038156337e-04 +-7.3062474217796343e-04 +-7.2990216189177965e-04 +-1.9092005684732682e-03 +-1.9129536264701381e-03 +-1.9203141945199655e-03 +-1.9309872161568863e-03 +-1.9445143310358372e-03 +-1.9602398529461268e-03 +-1.9772460208471098e-03 +-1.9942565670683786e-03 +-2.0095317668423537e-03 +-2.0208142590506925e-03 +-2.0254135164136516e-03 +-2.0205016490176561e-03 +-2.0036082164775278e-03 +-1.9731758681611361e-03 +-1.9289617623078838e-03 +-1.8721178878836702e-03 +-1.8049328991736550e-03 +-1.7303619202129977e-03 +-1.6515225019082555e-03 +-1.5712931483875270e-03 +-1.4920709729672162e-03 +-1.4156789328508173e-03 +-1.3433804280820320e-03 +-1.2759543920775661e-03 +-1.2137938392706171e-03 +-1.1570042768624157e-03 +-1.1054898149812078e-03 +-1.0590225759982308e-03 +-1.0172954545713739e-03 +-9.7996038194963575e-04 +-9.4665492787993316e-04 +-9.1702000700128578e-04 +-8.9071106690477261e-04 +-8.6740465674168090e-04 +-8.4680182258293753e-04 +-8.2862939378214090e-04 +-8.1263992271119411e-04 +-7.9861081151577553e-04 +-7.8634299133228307e-04 +-7.7565939845999454e-04 +-7.6640340659226596e-04 +-7.5843731488881776e-04 +-7.5164095111112056e-04 +-7.4591042177882076e-04 +-7.4115702337880745e-04 +-7.3730631720372712e-04 +-7.3429736343594320e-04 +-7.3208210619043655e-04 +-7.3062489948747455e-04 +-7.2990216383407244e-04 +-1.9822037913300888e-03 +-1.9861082632256907e-03 +-1.9938140378920515e-03 +-2.0051098619024662e-03 +-2.0196572010818437e-03 +-2.0369397848471740e-03 +-2.0561630918870602e-03 +-2.0760965476123664e-03 +-2.0948853790092297e-03 +-2.1099169616561643e-03 +-2.1178817525512482e-03 +-2.1151578240293477e-03 +-2.0985135078565240e-03 +-2.0659097301477208e-03 +-2.0170592164831533e-03 +-1.9534970387178820e-03 +-1.8781709639593195e-03 +-1.7947720438545513e-03 +-1.7070704139150019e-03 +-1.6184297856367286e-03 +-1.5315496143443171e-03 +-1.4483985349749492e-03 +-1.3702710436711866e-03 +-1.2979039613897720e-03 +-1.2316081146534958e-03 +-1.1713900294315148e-03 +-1.1170527405724871e-03 +-1.0682734900605093e-03 +-1.0246604538866793e-03 +-9.8579229498100608e-04 +-9.5124453298588694e-04 +-9.2060625119144972e-04 +-8.9348997670552703e-04 +-8.6953689361935177e-04 +-8.4841897093010832e-04 +-8.2983912980836964e-04 +-8.1353023022091094e-04 +-7.9925340563660871e-04 +-7.8679609572264008e-04 +-7.7597000212443969e-04 +-7.6660910676995238e-04 +-7.5856783428735115e-04 +-7.5171940173977955e-04 +-7.4595437392055192e-04 +-7.4117942670953382e-04 +-7.3731631146869644e-04 +-7.3430100818064662e-04 +-7.3208305256664333e-04 +-7.3062502193852082e-04 +-7.2990216534651799e-04 +-2.0242471841686949e-03 +-2.0282417603317998e-03 +-2.0361772158039564e-03 +-2.0479409348686723e-03 +-2.0633393210872388e-03 +-2.0820370641979314e-03 +-2.1034305589945667e-03 +-2.1264362153515064e-03 +-2.1492112979397547e-03 +-2.1689055410413789e-03 +-2.1816436687228094e-03 +-2.1829603011183051e-03 +-2.1687248531501785e-03 +-2.1362513646769484e-03 +-2.0850757633811027e-03 +-2.0170386150128268e-03 +-1.9357103359285478e-03 +-1.8454989994298300e-03 +-1.7508113362187517e-03 +-1.6554802244001373e-03 +-1.5624943637530455e-03 +-1.4739612810293825e-03 +-1.3912074067928750e-03 +-1.3149351719910927e-03 +-1.2453859526338012e-03 +-1.1824829344350728e-03 +-1.1259447997433206e-03 +-1.0753703844783183e-03 +-1.0302985310778050e-03 +-9.9024848551012819e-04 +-9.5474587225194256e-04 +-9.2333841946855267e-04 +-8.9560465185241898e-04 +-8.7115791810810225e-04 +-8.4964743613621496e-04 +-8.3075752067338180e-04 +-8.1420578040255435e-04 +-7.9974080374364159e-04 +-7.8713966671159908e-04 +-7.7620546954048741e-04 +-7.6676502384417846e-04 +-7.5866675607283993e-04 +-7.5177885684935507e-04 +-7.4598768295817811e-04 +-7.4119640497325465e-04 +-7.3732388565539832e-04 +-7.3430377040890513e-04 +-7.3208376980577470e-04 +-7.3062511474318006e-04 +-7.2990216649341480e-04 +-2.0445792269263340e-03 +-2.0486184530470459e-03 +-2.0566829800445744e-03 +-2.0687403307224281e-03 +-2.0847187413892674e-03 +-2.1044475685600183e-03 +-2.1275259666294717e-03 +-2.1530842288454530e-03 +-2.1794288105469049e-03 +-2.2036569922755807e-03 +-2.2214932528753090e-03 +-2.2276981211341120e-03 +-2.2171901134149280e-03 +-2.1865062980093906e-03 +-2.1348641111582651e-03 +-2.0642953800871127e-03 +-1.9789100536887253e-03 +-1.8837707588253178e-03 +-1.7838718238797522e-03 +-1.6834788027703829e-03 +-1.5858468282606197e-03 +-1.4932131048301168e-03 +-1.4069383226050253e-03 +-1.3277011742964080e-03 +-1.2556892379771162e-03 +-1.1907602361416500e-03 +-1.1325666080539557e-03 +-1.0806458770992514e-03 +-1.0344829661131198e-03 +-9.9355118064600864e-04 +-9.5733778516462358e-04 +-9.2535888404898694e-04 +-8.9716713086933353e-04 +-8.7235479349429576e-04 +-8.5055393285533561e-04 +-8.3143488688493608e-04 +-8.1470384828036951e-04 +-8.0010004500774437e-04 +-7.8739284206343681e-04 +-7.7637895553170691e-04 +-7.6687988612340419e-04 +-7.5873962513239293e-04 +-7.5182265153084834e-04 +-7.4601221791710656e-04 +-7.4120891086500932e-04 +-7.3732946470192614e-04 +-7.3430580505266937e-04 +-7.3208429812703644e-04 +-7.3062518310437459e-04 +-7.2990216733896001e-04 +-2.0529844589420969e-03 +-2.0570418776762528e-03 +-2.0651658189283135e-03 +-2.0773709492558769e-03 +-2.0936607914063834e-03 +-2.1139776040918919e-03 +-2.1380848885097547e-03 +-2.1653330271896856e-03 +-2.1942634241137191e-03 +-2.2220958590439552e-03 +-2.2443722335200650e-03 +-2.2552511157218269e-03 +-2.2487627284681526e-03 +-2.2206251459685670e-03 +-2.1696382586462526e-03 +-2.0979103057137665e-03 +-2.0099793194149175e-03 +-1.9114624999597659e-03 +-1.8078594756622541e-03 +-1.7038085207655566e-03 +-1.6027945538053675e-03 +-1.5071682649951336e-03 +-1.4183238365763962e-03 +-1.3369255050694015e-03 +-1.2631218206938925e-03 +-1.1967219726200429e-03 +-1.1373291001705369e-03 +-1.0844351532910423e-03 +-1.0374850982762711e-03 +-9.9591832129396793e-04 +-9.5919387118823473e-04 +-9.2680467713306396e-04 +-8.9828449945831190e-04 +-8.7321026126590737e-04 +-8.5120157261798471e-04 +-8.3191865657587208e-04 +-8.1505946510149229e-04 +-8.0035648464559157e-04 +-7.8757353790061767e-04 +-7.7650276045134272e-04 +-7.6696184827249568e-04 +-7.5879161923677794e-04 +-7.5185389916993743e-04 +-7.4602972337517893e-04 +-7.4121783364863186e-04 +-7.3733344528396992e-04 +-7.3430725675536904e-04 +-7.3208467508300667e-04 +-7.3062523188049261e-04 +-7.2990216794310381e-04 +-2.0560411111844412e-03 +-2.0601045996559565e-03 +-2.0682509802833265e-03 +-2.0805164314841727e-03 +-2.0969409343512668e-03 +-2.1175281647126906e-03 +-2.1421472731610490e-03 +-2.1703218102505869e-03 +-2.2008311383336326e-03 +-2.2311105684359313e-03 +-2.2567017142302997e-03 +-2.2713711017094272e-03 +-2.2684189523950872e-03 +-2.2428107163328104e-03 +-2.1929080631721072e-03 +-2.1208128033055663e-03 +-2.0313751098755416e-03 +-1.9306456731200453e-03 +-1.8245249075360263e-03 +-1.7179472896568012e-03 +-1.6145805202064400e-03 +-1.5168665297603243e-03 +-1.4262284465635234e-03 +-1.3433224854854512e-03 +-1.2682703629144873e-03 +-1.2008471398843462e-03 +-1.1406211188143727e-03 +-1.0870520444037574e-03 +-1.0395566943526698e-03 +-9.9755058084021776e-04 +-9.6047294317828447e-04 +-9.2780048049454172e-04 +-8.9905375360141860e-04 +-8.7379898940616644e-04 +-8.5164713723356281e-04 +-8.3225139793882176e-04 +-8.1530401251547248e-04 +-8.0053280290120403e-04 +-7.8769776248481852e-04 +-7.7658786601705367e-04 +-7.6701818674916481e-04 +-7.5882735692760792e-04 +-7.5187537634885360e-04 +-7.4604175506002754e-04 +-7.4122396632570451e-04 +-7.3733618115482595e-04 +-7.3430825451856728e-04 +-7.3208493416777399e-04 +-7.3062526540511406e-04 +-7.2990216835935201e-04 +-2.0570062331695485e-03 +-2.0610713596062834e-03 +-2.0692252274554790e-03 +-2.0815129175978130e-03 +-2.0979900462296014e-03 +-2.1186888030075963e-03 +-2.1435344183503425e-03 +-2.1721600124967452e-03 +-2.2035288304265346e-03 +-2.2352935132776476e-03 +-2.2630911682889766e-03 +-2.2804743075160788e-03 +-2.2802117197734078e-03 +-2.2566644134420599e-03 +-2.2078109670482723e-03 +-2.1357077360591959e-03 +-2.0454154110212046e-03 +-1.9432961908682756e-03 +-1.8355419755450918e-03 +-1.7273029543891268e-03 +-1.6223799678267983e-03 +-1.5232818404250904e-03 +-1.4314538657375828e-03 +-1.3475480697001468e-03 +-1.2716686322001736e-03 +-1.2035678895023954e-03 +-1.1427908497322640e-03 +-1.0887757152177329e-03 +-1.0409204269237026e-03 +-9.9862456763325359e-04 +-9.6131418139649852e-04 +-9.2845517468611368e-04 +-8.9955934522501565e-04 +-8.7418582970321052e-04 +-8.5193984470981394e-04 +-8.3246994908955907e-04 +-8.1546461318039850e-04 +-8.0064858254829318e-04 +-7.8777932751444033e-04 +-7.7664374197860674e-04 +-7.6705517384859491e-04 +-7.5885081843408736e-04 +-7.5188947558956539e-04 +-7.4604965343491667e-04 +-7.4122799217001825e-04 +-7.3733797712858347e-04 +-7.3430890950264944e-04 +-7.3208510424453710e-04 +-7.3062528741279500e-04 +-7.2990216863381616e-04 +-2.0572331148674249e-03 +-2.0612985633640894e-03 +-2.0694550103192754e-03 +-2.0817515930461662e-03 +-2.0982508802901492e-03 +-2.1189975884829413e-03 +-2.1439432083097151e-03 +-2.1727801244261161e-03 +-2.2045895034763191e-03 +-2.2371907930615912e-03 +-2.2663326742451439e-03 +-2.2854678590908161e-03 +-2.2870186943893529e-03 +-2.2649199812029472e-03 +-2.2168653572652592e-03 +-2.1448613113567204e-03 +-2.0541002016678305e-03 +-1.9511489387537345e-03 +-1.8423925823567943e-03 +-1.7331243467275108e-03 +-1.6272333085020998e-03 +-1.5272727686805817e-03 +-1.4347031151925196e-03 +-1.3501742441717772e-03 +-1.2737795131424086e-03 +-1.2052570544966112e-03 +-1.1441372769429982e-03 +-1.0898448792286562e-03 +-1.0417660033143581e-03 +-9.9929026458492527e-04 +-9.6183546001696308e-04 +-9.2886075840943583e-04 +-8.9987249288369915e-04 +-8.7442538331377045e-04 +-8.5212107855757360e-04 +-8.3260525109930654e-04 +-8.1556402861739650e-04 +-8.0072024676426873e-04 +-7.8782981047766912e-04 +-7.7667832337238718e-04 +-7.6707806403533241e-04 +-7.5886533756354348e-04 +-7.5189820066743978e-04 +-7.4605454111585222e-04 +-7.4123048341067917e-04 +-7.3733908848642950e-04 +-7.3430931480704571e-04 +-7.3208520948767812e-04 +-7.3062530103151356e-04 +-7.2990216880518125e-04 +-2.0572420244879988e-03 +-2.0613074902525695e-03 +-2.0694649712418908e-03 +-2.0817656758221575e-03 +-2.0982755665163253e-03 +-2.1190450404705154e-03 +-2.1440373156734064e-03 +-2.1729738887888549e-03 +-2.2050020362030060e-03 +-2.2380469833620971e-03 +-2.2679424752174511e-03 +-2.2880996806329298e-03 +-2.2907381064140920e-03 +-2.2695291363020579e-03 +-2.2219847850436202e-03 +-2.1500744718986001e-03 +-2.0590662876923062e-03 +-1.9556486680242353e-03 +-1.8463218599880742e-03 +-1.7364643401475784e-03 +-1.6300177303035632e-03 +-1.5295618356257605e-03 +-1.4365661329407383e-03 +-1.3516794361612132e-03 +-1.2749889032437841e-03 +-1.2062244794975290e-03 +-1.1449081504250418e-03 +-1.0904568261679048e-03 +-1.0422498480955012e-03 +-9.9967109151034481e-04 +-9.6213360809266238e-04 +-9.2909269305354951e-04 +-9.0005154028614137e-04 +-8.7456233418999529e-04 +-8.5222467693004712e-04 +-8.3268258618376251e-04 +-8.1562084727678744e-04 +-8.0076120201384097e-04 +-7.8785865919757099e-04 +-7.7669808407597495e-04 +-7.6709114351829503e-04 +-7.5887363350702068e-04 +-7.5190318584622377e-04 +-7.4605733367542513e-04 +-7.4123190673943502e-04 +-7.3733972342988842e-04 +-7.3430954636294354e-04 +-7.3208526961401714e-04 +-7.3062530881252237e-04 +-7.2990216890501795e-04 +-2.0572136736386718e-03 +-2.0612791205834777e-03 +-2.0694370628936702e-03 +-2.0817397447724945e-03 +-2.0982547995006939e-03 +-2.1190352729124366e-03 +-2.1440495772285812e-03 +-2.1730325819154989e-03 +-2.2051644338500673e-03 +-2.2384268496545897e-03 +-2.2687030643115669e-03 +-2.2893877052050740e-03 +-2.2925954102340626e-03 +-2.2718573592978414e-03 +-2.2245875516661512e-03 +-2.1527342553101566e-03 +-2.0616045909538669e-03 +-1.9579504636307423e-03 +-1.8483323277770959e-03 +-1.7381731625457160e-03 +-1.6314419632742897e-03 +-1.5307323185893553e-03 +-1.4375184295681023e-03 +-1.3524485603623728e-03 +-1.2756066747646672e-03 +-1.2067185019797497e-03 +-1.1453016940674017e-03 +-1.0907691582563443e-03 +-1.0424967441191218e-03 +-9.9986538226473219e-04 +-9.6228569194972929e-04 +-9.2921098422999902e-04 +-9.0014284605284230e-04 +-8.7463216469442549e-04 +-8.5227749580865403e-04 +-8.3272201134364709e-04 +-8.1564981087453808e-04 +-8.0078207761618376e-04 +-7.8787336289761996e-04 +-7.7670815514210942e-04 +-7.6709780910812360e-04 +-7.5887786107485913e-04 +-7.5190572614089338e-04 +-7.4605875661405913e-04 +-7.4123263196195811e-04 +-7.3734004693839096e-04 +-7.3430966433905018e-04 +-7.3208530024756037e-04 +-7.3062531277755260e-04 +-7.2990216895849947e-04 +-2.0571951320624846e-03 +-2.0612605714975516e-03 +-2.0694187111362124e-03 +-2.0817222444215288e-03 +-2.0982395437958274e-03 +-2.1190248232954650e-03 +-2.1440486999065342e-03 +-2.1730516227749692e-03 +-2.2052277011984870e-03 +-2.2385832017135501e-03 +-2.2690233824616537e-03 +-2.2899362176797252e-03 +-2.2933908206116591e-03 +-2.2728571780952591e-03 +-2.2257065417742418e-03 +-2.1538780493100440e-03 +-2.0626959028166082e-03 +-1.9589396337234013e-03 +-1.8491958098928499e-03 +-1.7389066473745408e-03 +-1.6320529296817014e-03 +-1.5312341492876463e-03 +-1.4379265033132363e-03 +-1.3527779860517540e-03 +-1.2758711615270561e-03 +-1.2069299275762732e-03 +-1.1454700610597458e-03 +-1.0909027410893283e-03 +-1.0426023123283131e-03 +-9.9994843795953741e-04 +-9.6235069145234693e-04 +-9.2926153160248026e-04 +-9.0018185568259673e-04 +-8.7466199466153325e-04 +-8.5230005564885625e-04 +-8.3273884830418923e-04 +-8.1566217858570209e-04 +-8.0079099063699887e-04 +-7.8787964006328255e-04 +-7.7671245411919194e-04 +-7.6710065411019271e-04 +-7.5887966529953666e-04 +-7.5190681017312129e-04 +-7.4605936377645230e-04 +-7.4123294138582485e-04 +-7.3734018495656998e-04 +-7.3430971466815554e-04 +-7.3208531331575230e-04 +-7.3062531447004662e-04 +-7.2990216898492983e-04 +-2.0571887352688360e-03 +-2.0612541745817911e-03 +-2.0694123806936182e-03 +-2.0817161958583429e-03 +-2.0982342548518927e-03 +-2.1190212099835458e-03 +-2.1440484958834957e-03 +-2.1730584811994373e-03 +-2.2052498105337302e-03 +-2.2386364730563996e-03 +-2.2691303823243174e-03 +-2.2901168976783054e-03 +-2.2936502956953969e-03 +-2.2731810912285490e-03 +-2.2260672226923975e-03 +-2.1542452897625880e-03 +-2.0630452096880728e-03 +-1.9592554472552047e-03 +-1.8494709122327951e-03 +-1.7391399123940698e-03 +-1.6322469292290177e-03 +-1.5313932795924096e-03 +-1.4380557500982358e-03 +-1.3528822145611903e-03 +-1.2759547671011241e-03 +-1.2069967063641567e-03 +-1.1455232019908054e-03 +-1.0909448768061305e-03 +-1.0426355929837065e-03 +-9.9997460858141382e-04 +-9.6237116359429236e-04 +-9.2927744559875933e-04 +-9.0019413276323985e-04 +-8.7467137958278690e-04 +-8.5230715106043473e-04 +-8.3274414220419607e-04 +-8.1566606614193648e-04 +-8.0079379149453631e-04 +-7.8788161208179783e-04 +-7.7671380431269235e-04 +-7.6710154741422404e-04 +-7.5888023166419648e-04 +-7.5190715037811242e-04 +-7.4605955427956363e-04 +-7.4123303844972138e-04 +-7.3734022824365007e-04 +-7.3430973045081186e-04 +-7.3208531741397146e-04 +-7.3062531500249213e-04 +-7.2990216899897133e-04 +-2.0571877672898916e-03 +-2.0612532074361970e-03 +-2.0694114265345487e-03 +-2.0817152969027706e-03 +-2.0982335170464028e-03 +-2.1190208611571140e-03 +-2.1440489928012921e-03 +-2.1730607365263461e-03 +-2.2052556179504063e-03 +-2.2386489012181294e-03 +-2.2691533548923320e-03 +-2.2901534805771372e-03 +-2.2937007290148559e-03 +-2.2732422664315135e-03 +-2.2261339478369395e-03 +-2.1543121927214900e-03 +-2.0631080987281330e-03 +-1.9593117757060355e-03 +-1.8495196049656119e-03 +-1.7391809360266792e-03 +-1.6322808612663246e-03 +-1.5314209814754000e-03 +-1.4380781572111857e-03 +-1.3529002191223702e-03 +-1.2759691633565692e-03 +-1.2070081729621597e-03 +-1.1455323042565573e-03 +-1.0909520782441178e-03 +-1.0426412699545288e-03 +-9.9997906500746167e-04 +-9.6237464425083801e-04 +-9.2928014747929700e-04 +-9.0019621448305656e-04 +-8.7467296900057960e-04 +-8.5230835137589255e-04 +-8.3274503679755152e-04 +-8.1566672239879079e-04 +-8.0079426382469903e-04 +-7.8788194430535639e-04 +-7.7671403155356560e-04 +-7.6710169761348820e-04 +-7.5888032680187384e-04 +-7.5190720747329018e-04 +-7.4605958622319703e-04 +-7.4123305471249343e-04 +-7.3734023549133505e-04 +-7.3430973309226392e-04 +-7.3208531810053218e-04 +-7.3062531509407382e-04 +-7.2990216900935495e-04 +-2.0571877673237877e-03 +-2.0612532078923200e-03 +-2.0694114290772353e-03 +-2.0817153080722938e-03 +-2.0982335566867376e-03 +-2.1190209780309489e-03 +-2.1440492891738809e-03 +-2.1730613989019501e-03 +-2.2052569347162636e-03 +-2.2386512231007626e-03 +-2.2691569654429903e-03 +-2.2901584294879149e-03 +-2.2937067556625750e-03 +-2.2732488816757132e-03 +-2.2261406085801808e-03 +-2.1543184535739437e-03 +-2.0631136801174438e-03 +-1.9593165577943958e-03 +-1.8495235850261120e-03 +-1.7391841805830307e-03 +-1.6322834682354862e-03 +-1.5314230556223672e-03 +-1.4380797966883269e-03 +-1.3529015095183950e-03 +-1.2759701761656088e-03 +-1.2070089663278674e-03 +-1.1455329246836221e-03 +-1.0909525625591634e-03 +-1.0426416471646886e-03 +-9.9997935791304123e-04 +-9.6237487077720967e-04 +-9.2928032174439165e-04 +-9.0019634763687190e-04 +-8.7467306987750425e-04 +-8.5230842699788765e-04 +-8.3274509276081397e-04 +-8.1566676317059610e-04 +-8.0079429297168225e-04 +-7.8788196466985727e-04 +-7.7671404539086833e-04 +-7.6710170669976095e-04 +-7.5888033252024807e-04 +-7.5190721088365148e-04 +-7.4605958811984284e-04 +-7.4123305567270505e-04 +-7.3734023591709170e-04 +-7.3430973324672261e-04 +-7.3208531814047040e-04 +-7.3062531509922237e-04 +-7.2990216900940320e-04 +-2.0571887356496911e-03 +-2.0612541866355150e-03 +-2.0694124666062745e-03 +-2.0817165408363774e-03 +-2.0982352838130294e-03 +-2.1190237700762313e-03 +-2.1440541150821424e-03 +-2.1730696447414197e-03 +-2.2052699935597646e-03 +-2.2386694417523322e-03 +-2.2691785709731262e-03 +-2.2901796980222813e-03 +-2.2937236658998892e-03 +-2.2732589077058183e-03 +-2.2261433584722539e-03 +-2.1543151470533825e-03 +-2.0631062234029332e-03 +-1.9593068173864498e-03 +-1.8495130296201354e-03 +-1.7391738041918950e-03 +-1.6322738561638851e-03 +-1.5314144939850309e-03 +-1.4380723754661832e-03 +-1.3528952019675484e-03 +-1.2759648935404442e-03 +-1.2070045927310923e-03 +-1.1455293377734142e-03 +-1.0909496449303573e-03 +-1.0426392919186266e-03 +-9.9997747078699878e-04 +-9.6237337034962205e-04 +-9.2927913864721521e-04 +-9.0019542332493078e-04 +-8.7467235526644588e-04 +-8.5230788113675184e-04 +-8.3274468161989351e-04 +-8.1566645857580108e-04 +-8.0079407169003029e-04 +-7.8788180763642815e-04 +-7.7671393706143350e-04 +-7.6710163451068473e-04 +-7.5888028643746551e-04 +-7.5190718302329184e-04 +-7.4605957242491886e-04 +-7.4123304763183001e-04 +-7.3734023231340241e-04 +-7.3430973192680892e-04 +-7.3208531779554102e-04 +-7.3062531505170612e-04 +-7.2990216899956211e-04 +-2.0571951329841119e-03 +-2.0612606449247534e-03 +-2.0694192900876482e-03 +-2.0817245466385635e-03 +-2.0982461243759824e-03 +-2.1190403159592891e-03 +-2.1440807415138699e-03 +-2.1731116140506924e-03 +-2.2053301867267206e-03 +-2.2387420189557126e-03 +-2.2692446216303445e-03 +-2.2902123135868343e-03 +-2.2937011192393380e-03 +-2.2731751045203343e-03 +-2.2260081863369301e-03 +-2.1541473568070478e-03 +-2.0629254671102222e-03 +-1.9591287744552760e-03 +-1.8493479188461616e-03 +-1.7390269594018005e-03 +-1.6321470580698851e-03 +-1.5313072954684307e-03 +-1.4379831259151224e-03 +-1.3528217343542195e-03 +-1.2759049384403500e-03 +-1.2069560021809934e-03 +-1.1454901888701874e-03 +-1.0909182731249471e-03 +-1.0426142864724272e-03 +-9.9995765212478353e-04 +-9.6235776060933230e-04 +-9.2926693149183775e-04 +-9.0018595597665446e-04 +-8.7466508397267002e-04 +-8.5230236033395472e-04 +-8.3274054659651404e-04 +-8.1566341123048467e-04 +-8.0079186892370049e-04 +-7.8788025192582983e-04 +-7.7671286880706214e-04 +-7.6710092580451025e-04 +-7.5887983595220065e-04 +-7.5190691177366925e-04 +-7.4605942019709520e-04 +-7.4123296991372538e-04 +-7.3734019759250753e-04 +-7.3430971924845153e-04 +-7.3208531449936345e-04 +-7.3062531462267681e-04 +-7.2990216898679639e-04 +-2.0572136725252421e-03 +-2.0612793608381255e-03 +-2.0694391480022135e-03 +-2.0817481349074381e-03 +-2.0982785735836808e-03 +-2.1190902708829178e-03 +-2.1441607954001637e-03 +-2.1732355782252957e-03 +-2.2055019527462247e-03 +-2.2389356975502216e-03 +-2.2693930519981391e-03 +-2.2902268216697191e-03 +-2.2935157341917355e-03 +-2.2727789497124823e-03 +-2.2254434157409622e-03 +-2.1534832580603429e-03 +-2.0622313027907511e-03 +-1.9584579844379056e-03 +-1.8487340062632671e-03 +-1.7384862102306936e-03 +-1.6316835623614765e-03 +-1.5309177180135528e-03 +-1.4376602998482175e-03 +-1.3525570193078777e-03 +-1.2756896063981335e-03 +-1.2067819596832926e-03 +-1.1453502874691367e-03 +-1.0908063845005967e-03 +-1.0425252549515181e-03 +-9.9988719194847803e-04 +-9.6230233571106057e-04 +-9.2922363745233979e-04 +-9.0015241326531280e-04 +-8.7463934574828306e-04 +-8.5228283502073387e-04 +-8.3272593401411440e-04 +-8.1565265048514865e-04 +-8.0078409617078035e-04 +-7.8787476622480500e-04 +-7.7670910450462728e-04 +-7.6709843010692926e-04 +-7.5887825057473115e-04 +-7.5190595774779284e-04 +-7.4605888509132452e-04 +-7.4123269686403597e-04 +-7.3734007566354852e-04 +-7.3430967474494247e-04 +-7.3208530293532520e-04 +-7.3062531312404041e-04 +-7.2990216896275128e-04 +-2.0572420081905974e-03 +-2.0613080321513514e-03 +-2.0694703503868961e-03 +-2.0817878476323973e-03 +-2.0983385870503375e-03 +-2.1191901016032731e-03 +-2.1443278385937245e-03 +-2.1734973142645405e-03 +-2.2058591994723212e-03 +-2.2393185273912853e-03 +-2.2696392275798213e-03 +-2.2901318393428139e-03 +-2.2929350997351419e-03 +-2.2716995177663778e-03 +-2.2239745733312970e-03 +-2.1517944855058133e-03 +-2.0604885365491888e-03 +-1.9567874016988593e-03 +-1.8472133344758386e-03 +-1.7371518992772114e-03 +-1.6305431167600493e-03 +-1.5299612265164244e-03 +-1.4368690442620787e-03 +-1.3519090806235904e-03 +-1.2751631287181498e-03 +-1.2063568255592466e-03 +-1.1450088138479076e-03 +-1.0905334634247598e-03 +-1.0423082087044984e-03 +-9.9971550283865372e-04 +-9.6216733965231831e-04 +-9.2911822724131901e-04 +-9.0007077234962999e-04 +-8.7457671949651408e-04 +-8.5223533936289229e-04 +-8.3269039802783018e-04 +-8.1562648825483843e-04 +-8.0076520310726337e-04 +-7.8786143537124616e-04 +-7.7669995892169579e-04 +-7.6709236801279963e-04 +-7.5887440048859865e-04 +-7.5190364137217732e-04 +-7.4605758610463385e-04 +-7.4123203414487137e-04 +-7.3733977977684189e-04 +-7.3430956676284352e-04 +-7.3208527488078106e-04 +-7.3062530949127467e-04 +-7.2990216891336197e-04 +-2.0572330434610875e-03 +-2.0612994723441932e-03 +-2.0694662333429602e-03 +-2.0817995417928025e-03 +-2.0983884714954821e-03 +-2.1193143743260005e-03 +-2.1445744782672810e-03 +-2.1739074179118558e-03 +-2.2064146178748891e-03 +-2.2398652894587397e-03 +-2.2698605894636965e-03 +-2.2896508478223716e-03 +-2.2915024010659209e-03 +-2.2693165461125588e-03 +-2.2208689785412250e-03 +-2.1483000330790583e-03 +-2.0569258434142354e-03 +-1.9533972263559730e-03 +-1.8441417265944926e-03 +-1.7344650069583958e-03 +-1.6282514319797248e-03 +-1.5280420292200906e-03 +-1.4352830854467990e-03 +-1.3506114051021660e-03 +-1.2741093424096959e-03 +-1.2055062796370861e-03 +-1.1443258927931923e-03 +-1.0899878024634372e-03 +-1.0418743648950349e-03 +-9.9937239063043739e-04 +-9.6189760332970268e-04 +-9.2890763844366109e-04 +-8.9990769206418539e-04 +-8.7445163720311898e-04 +-8.5214048824966827e-04 +-8.3261943891866101e-04 +-8.1557425259042872e-04 +-8.0072748515527142e-04 +-7.8783482459562643e-04 +-7.7668170461789407e-04 +-7.6708026951428443e-04 +-7.5886671741239693e-04 +-7.5189901936007170e-04 +-7.4605499439471610e-04 +-7.4123071201600784e-04 +-7.3733918952669040e-04 +-7.3430935136909348e-04 +-7.3208521892346935e-04 +-7.3062530224723304e-04 +-7.2990216882013446e-04 +-2.0570060121474268e-03 +-2.0610724233115561e-03 +-2.0692452576750947e-03 +-2.0816029056689648e-03 +-2.0982520007548750e-03 +-2.1192935288034528e-03 +-2.1447349040469433e-03 +-2.1742858362323461e-03 +-2.2069322147506222e-03 +-2.2402228483297381e-03 +-2.2695281912104609e-03 +-2.2880497206938916e-03 +-2.2882916107562776e-03 +-2.2645626960495048e-03 +-2.2149886516832202e-03 +-2.1418627073481033e-03 +-2.0504649000364214e-03 +-1.9473065917913898e-03 +-1.8386553425739187e-03 +-1.7296833584146362e-03 +-1.6241827101715145e-03 +-1.5246398636023434e-03 +-1.4324744947424831e-03 +-1.3483148809822520e-03 +-1.2722452717228931e-03 +-1.2040021816012523e-03 +-1.1431184696934333e-03 +-1.0890231959275144e-03 +-1.0411075029412586e-03 +-9.9876595034420674e-04 +-9.6142087984578569e-04 +-9.2853546815165674e-04 +-8.9961949523965966e-04 +-8.7423060000056056e-04 +-8.5197288079028651e-04 +-8.3249405570542793e-04 +-8.1548195777031082e-04 +-8.0066084502992485e-04 +-7.8778781123022825e-04 +-7.7664945652539694e-04 +-7.6705889755301448e-04 +-7.5885314609951409e-04 +-7.5189085556972451e-04 +-7.4605041696098576e-04 +-7.4122837702132835e-04 +-7.3733814714469252e-04 +-7.3430897099992221e-04 +-7.3208512011079245e-04 +-7.3062528945662278e-04 +-7.2990216865896510e-04 +-2.0560405541214504e-03 +-2.0601049793390305e-03 +-2.0682821513761922e-03 +-2.0806666606711264e-03 +-2.0973866882616540e-03 +-2.1185613746680476e-03 +-2.1441904554283225e-03 +-2.1739069662323604e-03 +-2.2065024364887479e-03 +-2.2392268945318062e-03 +-2.2672008743406507e-03 +-2.2836569874414001e-03 +-2.2814960028886291e-03 +-2.2556017919863080e-03 +-2.2045575386660178e-03 +-2.1308303739825084e-03 +-2.0396161608680912e-03 +-1.9372062511664174e-03 +-1.8296269913900308e-03 +-1.7218525926876122e-03 +-1.6175396307809111e-03 +-1.5190956040432356e-03 +-1.4279029193545341e-03 +-1.3445794773532258e-03 +-1.2692145527658260e-03 +-1.2015573026914047e-03 +-1.1411560607268007e-03 +-1.0874555059278525e-03 +-1.0398611952948942e-03 +-9.9778034329080375e-04 +-9.6064607194284188e-04 +-9.2793057120223741e-04 +-8.9915107108681780e-04 +-8.7387132854140634e-04 +-8.5170045132895505e-04 +-8.3229025796629108e-04 +-8.1533194355693167e-04 +-8.0055253164302328e-04 +-7.8771140030243819e-04 +-7.7659704545055398e-04 +-7.6702416425271900e-04 +-7.5883109122340108e-04 +-7.5187758911497129e-04 +-7.4604297880348025e-04 +-7.4122458290871215e-04 +-7.3733645345514583e-04 +-7.3430835298786846e-04 +-7.3208495956775938e-04 +-7.3062526867661128e-04 +-7.2990216839960637e-04 +-2.0529832670828294e-03 +-2.0570397211128093e-03 +-2.0652076259459556e-03 +-2.0775938633357475e-03 +-2.0943391305194205e-03 +-2.1155594479926299e-03 +-2.1412029787895828e-03 +-2.1707562739022098e-03 +-2.2027443126724109e-03 +-2.2341000379165082e-03 +-2.2597793027871274e-03 +-2.2732208696245172e-03 +-2.2679118626422324e-03 +-2.2394407811842216e-03 +-2.1868872898335376e-03 +-2.1128525046474169e-03 +-2.0223614661532348e-03 +-1.9213857111122226e-03 +-1.8156214756832188e-03 +-1.7097785650624332e-03 +-1.6073357527732935e-03 +-1.5105994525158727e-03 +-1.4209071575621950e-03 +-1.3388678742561652e-03 +-1.2645823954860601e-03 +-1.1978212249881448e-03 +-1.1381573664624312e-03 +-1.0850598543467615e-03 +-1.0379564851889002e-03 +-9.9627388975978407e-04 +-9.5946168042481978e-04 +-9.2700581231375408e-04 +-8.9843488443669449e-04 +-8.7332198750264686e-04 +-8.5128387192675615e-04 +-8.3197861344287336e-04 +-8.1510253934810801e-04 +-8.0038689629494477e-04 +-7.8759455205726684e-04 +-7.7651689969991016e-04 +-7.6697105256432016e-04 +-7.5879736775025870e-04 +-7.5185730461777207e-04 +-7.4603160631223802e-04 +-7.4121878219355556e-04 +-7.3733386412478785e-04 +-7.3430740819850626e-04 +-7.3208471414395614e-04 +-7.3062523691122224e-04 +-7.2990216800500633e-04 +-2.0445770542982132e-03 +-2.0486109624986049e-03 +-2.0567293947487005e-03 +-2.0690290268851968e-03 +-2.0856277970477798e-03 +-2.1065884881640183e-03 +-2.1317446619392479e-03 +-2.1603787972648142e-03 +-2.1907429146247434e-03 +-2.2195524266869055e-03 +-2.2418107110539257e-03 +-2.2514098776979592e-03 +-2.2425945490408797e-03 +-2.2116968857041537e-03 +-2.1582220220334306e-03 +-2.0847800037813559e-03 +-1.9960927839164943e-03 +-1.8976983341574051e-03 +-1.7948773428102993e-03 +-1.6920187402649401e-03 +-1.5923919384595159e-03 +-1.4981896386795581e-03 +-1.4107046550804103e-03 +-1.3305450613670799e-03 +-1.2578350287852651e-03 +-1.1923795944245566e-03 +-1.1337893845601004e-03 +-1.0815696710474165e-03 +-1.0351809397455014e-03 +-9.9407817895971295e-04 +-9.5773500396337100e-04 +-9.2565737253938061e-04 +-8.9739039326833703e-04 +-8.7252071008228919e-04 +-8.5067617440337398e-04 +-8.3152395536787924e-04 +-8.1476784349069557e-04 +-8.0014523085922436e-04 +-7.8742406685805815e-04 +-7.7639996594497493e-04 +-7.6689356394395094e-04 +-7.5874816791248096e-04 +-7.5182771251081982e-04 +-7.4601501633516786e-04 +-7.4121032064263708e-04 +-7.3733008722661234e-04 +-7.3430603015007027e-04 +-7.3208435618668175e-04 +-7.3062519058212933e-04 +-7.2990216743097842e-04 +-2.0242438337577978e-03 +-2.0282263801241376e-03 +-2.0362167826890008e-03 +-2.0482601534390116e-03 +-2.0643928176421874e-03 +-2.0845574271773836e-03 +-2.1084200586722053e-03 +-2.1350594192670528e-03 +-2.1625552989513325e-03 +-2.1876265583627616e-03 +-2.2056144387727246e-03 +-2.2111089592088446e-03 +-2.1992080016207346e-03 +-2.1669164527607357e-03 +-2.1139893128010569e-03 +-2.0428465929282660e-03 +-1.9577383719411824e-03 +-1.8636488275703788e-03 +-1.7653685610787223e-03 +-1.6669265416987917e-03 +-1.5713686559023809e-03 +-1.4807760170851419e-03 +-1.3964086503346438e-03 +-1.3188906599999732e-03 +-1.2483884316096959e-03 +-1.1847602094812617e-03 +-1.1276715839660105e-03 +-1.0766795047459784e-03 +-1.0312905075605349e-03 +-9.9099927257368932e-04 +-9.5531290281541709e-04 +-9.2376522343767960e-04 +-8.9592433663187644e-04 +-8.7139576911877059e-04 +-8.4982285020372293e-04 +-8.3088544013234307e-04 +-8.1429775668638647e-04 +-7.9980578758754781e-04 +-7.8718459745174109e-04 +-7.7623571722844418e-04 +-7.6678472379572557e-04 +-7.5867906494862531e-04 +-7.5178615154143625e-04 +-7.4599171775282971e-04 +-7.4119843817036066e-04 +-7.3732478368054410e-04 +-7.3430409518759627e-04 +-7.3208385358901763e-04 +-7.3062512553511436e-04 +-7.2990216662622307e-04 +-1.9821994234571856e-03 +-1.9860845770114546e-03 +-1.9938352638379461e-03 +-2.0054069218077074e-03 +-2.0207035302262626e-03 +-2.0395008476066763e-03 +-2.0612864816016434e-03 +-2.0850020390590046e-03 +-2.1087281999088111e-03 +-2.1294473558541361e-03 +-2.1431034536432475e-03 +-2.1451480710268983e-03 +-2.1315343530840087e-03 +-2.0997983411084288e-03 +-2.0497289872265030e-03 +-1.9833378522644417e-03 +-1.9042273132660701e-03 +-1.8167093796150771e-03 +-1.7250185585469292e-03 +-1.6327970859295929e-03 +-1.5428663430229895e-03 +-1.4572100685217089e-03 +-1.3770775452655001e-03 +-1.3031340369158190e-03 +-1.2356134479992549e-03 +-1.1744510468527684e-03 +-1.1193888682094067e-03 +-1.0700543566374706e-03 +-1.0260162445447007e-03 +-9.8682255519471664e-04 +-9.5202529969724153e-04 +-9.2119565594630008e-04 +-8.9393256240744739e-04 +-8.6986689794622536e-04 +-8.4866280360301576e-04 +-8.3001723284632063e-04 +-8.1365847199532746e-04 +-7.9934412584359695e-04 +-7.8685889069404302e-04 +-7.7601231797820342e-04 +-7.6663669093546673e-04 +-7.5858508298267573e-04 +-7.5172963115825242e-04 +-7.4596003548552852e-04 +-7.4118228121741964e-04 +-7.3731757283756647e-04 +-7.3430146453979338e-04 +-7.3208317032826464e-04 +-7.3062503711017837e-04 +-7.2990216553325349e-04 +-1.9091956987302787e-03 +-1.9129241686446281e-03 +-1.9203124062962460e-03 +-1.9312187651583997e-03 +-1.9454085944946989e-03 +-1.9624974672603937e-03 +-1.9818351450364940e-03 +-2.0023232779108539e-03 +-2.0222017111589225e-03 +-2.0389019576969422e-03 +-2.0491165586513792e-03 +-2.0492055301493763e-03 +-2.0359144630803200e-03 +-2.0071732931928256e-03 +-1.9626392283796528e-03 +-1.9037541256526455e-03 +-1.8333350710273606e-03 +-1.7549186796402029e-03 +-1.6721177976706289e-03 +-1.5881564060084299e-03 +-1.5056260158476363e-03 +-1.4264249681924684e-03 +-1.3518136080901320e-03 +-1.2825245410162344e-03 +-1.2188862241052651e-03 +-1.1609367658486538e-03 +-1.1085181679614047e-03 +-1.0613491539888541e-03 +-1.0190786331692179e-03 +-9.8132329623912859e-04 +-9.4769298661116113e-04 +-9.1780705639938297e-04 +-8.9130429919785745e-04 +-8.6784844340668870e-04 +-8.4713066932220191e-04 +-8.2887019953473877e-04 +-8.1281369828677780e-04 +-7.9873398464678396e-04 +-7.8642839853768466e-04 +-7.7571704168988157e-04 +-7.6644103437173547e-04 +-7.5846087319691275e-04 +-7.5165493792213323e-04 +-7.4591817046539672e-04 +-7.4116093351437088e-04 +-7.3730804628873174e-04 +-7.3429798938301212e-04 +-7.3208226778676260e-04 +-7.3062492031293288e-04 +-7.2990216409042922e-04 +-1.8021151133223231e-03 +-1.8056256760674648e-03 +-1.8125426124522659e-03 +-1.8226545811242741e-03 +-1.8356302100451243e-03 +-1.8509827969665148e-03 +-1.8679992816580267e-03 +-1.8856299582281140e-03 +-1.9023610524204772e-03 +-1.9161307405337561e-03 +-1.9243798572905542e-03 +-1.9243154809954954e-03 +-1.9133841523115856e-03 +-1.8898282984127731e-03 +-1.8531173238639463e-03 +-1.8040787689655984e-03 +-1.7446926784990642e-03 +-1.6776580158982225e-03 +-1.6059037530191359e-03 +-1.5321860913413354e-03 +-1.4588364817961245e-03 +-1.3876568134680480e-03 +-1.3199224018107538e-03 +-1.2564468770687612e-03 +-1.1976721966837950e-03 +-1.1437602439527499e-03 +-1.0946738039102084e-03 +-1.0502423714618314e-03 +-1.0102126105202922e-03 +-9.7428534060319254e-04 +-9.4214160887679899e-04 +-9.1346037307877745e-04 +-8.8792997979155776e-04 +-8.6525519443641456e-04 +-8.4516113068357668e-04 +-8.2739507987817523e-04 +-8.1172696483540149e-04 +-7.9794893138704543e-04 +-7.8587443447994680e-04 +-7.7533706186295385e-04 +-7.6618925714343818e-04 +-7.5830104682153630e-04 +-7.5155883626631622e-04 +-7.4586431253955408e-04 +-7.4113347386657949e-04 +-7.3729579374711535e-04 +-7.3429352031423995e-04 +-7.3208110721896720e-04 +-7.3062477013456119e-04 +-7.2990216223600864e-04 +-1.6665414544964571e-03 +-1.6697847281252648e-03 +-1.6761530279237513e-03 +-1.6854079142166109e-03 +-1.6971833643454959e-03 +-1.7109666369226561e-03 +-1.7260607063289426e-03 +-1.7415266172962933e-03 +-1.7561174461234025e-03 +-1.7682361103414591e-03 +-1.7759673622676736e-03 +-1.7772318401426276e-03 +-1.7700719032331261e-03 +-1.7530123205881064e-03 +-1.7253810573625190e-03 +-1.6874711664804681e-03 +-1.6404858228088960e-03 +-1.5862979779278539e-03 +-1.5271192090382628e-03 +-1.4651807897252821e-03 +-1.4024955815348035e-03 +-1.3407229013520326e-03 +-1.2811239654169895e-03 +-1.2245801193197928e-03 +-1.1716454746228135e-03 +-1.1226122125067046e-03 +-1.0775749030095482e-03 +-1.0364868512598136e-03 +-9.9920595882336746e-04 +-9.6553015105514802e-04 +-9.3522364356286793e-04 +-9.0803573180843261e-04 +-8.8371376863398095e-04 +-8.6201178331440063e-04 +-8.4269592591960994e-04 +-8.2554765876782028e-04 +-8.1036539039209046e-04 +-7.9696506416294759e-04 +-7.8518007128677717e-04 +-7.7486075032971594e-04 +-7.6587365586684155e-04 +-7.5810072101624112e-04 +-7.5143839717847262e-04 +-7.4579682503054883e-04 +-7.4109907046186415e-04 +-7.3728044522231159e-04 +-7.3428792276559573e-04 +-7.3207965376112852e-04 +-7.3062458207120875e-04 +-7.2990215991445130e-04 +-1.5143507894479912e-03 +-1.5172988614824180e-03 +-1.5230810915425460e-03 +-1.5314683770508055e-03 +-1.5421124035418839e-03 +-1.5545362266583072e-03 +-1.5681166963934690e-03 +-1.5820582576831154e-03 +-1.5953637845362424e-03 +-1.6068179171061592e-03 +-1.6150080594800054e-03 +-1.6184097382232960e-03 +-1.6155480996272989e-03 +-1.6052155887238862e-03 +-1.5866910124644428e-03 +-1.5598896899602082e-03 +-1.5253925858242604e-03 +-1.4843466274068412e-03 +-1.4382737031918100e-03 +-1.3888488498749749e-03 +-1.3377029198987887e-03 +-1.2862821805729133e-03 +-1.2357722224574093e-03 +-1.1870763055710440e-03 +-1.1408311031714004e-03 +-1.0974430722983737e-03 +-1.0571325652898771e-03 +-1.0199774119450493e-03 +-9.8595156649064616e-04 +-9.5495709222772620e-04 +-9.2684935834908618e-04 +-9.0145613864693966e-04 +-8.7859161807922882e-04 +-8.5806634891858998e-04 +-8.3969409733331566e-04 +-8.2329636894179178e-04 +-8.0870524370566833e-04 +-7.9576500782868858e-04 +-7.8433295083171469e-04 +-7.7427960040853594e-04 +-7.6548859358554133e-04 +-7.5785632657787109e-04 +-7.5129148395717551e-04 +-7.4571451711394994e-04 +-7.4105711984426845e-04 +-7.3726173307960777e-04 +-7.3428109965707701e-04 +-7.3207788231768455e-04 +-7.3062435288609277e-04 +-7.2990215708590184e-04 +-1.3589563038169537e-03 +-1.3616050137561643e-03 +-1.3668034714296748e-03 +-1.3743528899234972e-03 +-1.3839524482750784e-03 +-1.3951948803720656e-03 +-1.4075590458661000e-03 +-1.4203996673829615e-03 +-1.4329370017933654e-03 +-1.4442534764657297e-03 +-1.4533089635646874e-03 +-1.4589882284092605e-03 +-1.4601892228342621e-03 +-1.4559475919096495e-03 +-1.4455748243006779e-03 +-1.4287741508433533e-03 +-1.4056989135874910e-03 +-1.3769347493889918e-03 +-1.3434117449533994e-03 +-1.3062732498795647e-03 +-1.2667356491197531e-03 +-1.2259678065111603e-03 +-1.1850060855241047e-03 +-1.1447078840338041e-03 +-1.1057378043089763e-03 +-1.0685768018879125e-03 +-1.0335446636535301e-03 +-1.0008281370715373e-03 +-9.7050952547484304e-04 +-9.4259276830629989e-04 +-9.1702564488061226e-04 +-8.9371777798272841e-04 +-8.7255469452912919e-04 +-8.5340847005656989e-04 +-8.3614556351954586e-04 +-8.2063242538258968e-04 +-8.0673939073991536e-04 +-7.9434328261409660e-04 +-7.8332906586377009e-04 +-7.7359081716467772e-04 +-7.6503221394682089e-04 +-7.5756669487543182e-04 +-7.5111740510817025e-04 +-7.4561700937451382e-04 +-7.4100743313235823e-04 +-7.3723957506582286e-04 +-7.3427302165941658e-04 +-7.3207578541588847e-04 +-7.3062408162545838e-04 +-7.2990215373866291e-04 +-1.2115495484476323e-03 +-1.2139147474220123e-03 +-1.2185646353859733e-03 +-1.2253375879051202e-03 +-1.2339895798430473e-03 +-1.2441920994892381e-03 +-1.2555292466078396e-03 +-1.2674944465763966e-03 +-1.2794882564901243e-03 +-1.2908204660565378e-03 +-1.3007217093623923e-03 +-1.3083709736442606e-03 +-1.3129440696211783e-03 +-1.3136831070227264e-03 +-1.3099789149380533e-03 +-1.3014502823089967e-03 +-1.2880003228078309e-03 +-1.2698341643480966e-03 +-1.2474326169999378e-03 +-1.2214888912625891e-03 +-1.1928243987541904e-03 +-1.1623021238456621e-03 +-1.1307525226856119e-03 +-1.0989202659074967e-03 +-1.0674335285319058e-03 +-1.0367928848032180e-03 +-1.0073746588420485e-03 +-9.7944331693767400e-04 +-9.5316834364923147e-04 +-9.2864230723443898e-04 +-9.0589803896350563e-04 +-8.8492381945824445e-04 +-8.6567613965093351e-04 +-8.4809002242170741e-04 +-8.3208711861102174e-04 +-8.1758189118168753e-04 +-8.0448622392770188e-04 +-7.9271277153569373e-04 +-7.8217732869436491e-04 +-7.7280045082035969e-04 +-7.6450851515545367e-04 +-7.5723437197477289e-04 +-7.5091770265817961e-04 +-7.4550517442649358e-04 +-7.4095046005212518e-04 +-7.3721417400700328e-04 +-7.3426376347155516e-04 +-7.3207338260827446e-04 +-7.3062377083362568e-04 +-7.2990214990423870e-04 +-1.0795741208085956e-03 +-1.0816852558030001e-03 +-1.0858445284653772e-03 +-1.0919255107382593e-03 +-1.0997375333453687e-03 +-1.1090246198927399e-03 +-1.1194643948645800e-03 +-1.1306674147441265e-03 +-1.1421777938511765e-03 +-1.1534766665370825e-03 +-1.1639908325071391e-03 +-1.1731094945406735e-03 +-1.1802116929703289e-03 +-1.1847052639579359e-03 +-1.1860748079353097e-03 +-1.1839321050131043e-03 +-1.1780593729530545e-03 +-1.1684355042262497e-03 +-1.1552386391624457e-03 +-1.1388241323245410e-03 +-1.1196829074924498e-03 +-1.0983891393566080e-03 +-1.0755470595154592e-03 +-1.0517448232516598e-03 +-1.0275200746866411e-03 +-1.0033384933799689e-03 +-9.7958410290762223e-04 +-9.5655876482584148e-04 +-9.3448791607201394e-04 +-9.1352988869732336e-04 +-8.9378673523227386e-04 +-8.7531512405411094e-04 +-8.5813642963356268e-04 +-8.4224557007369803e-04 +-8.2761843773472620e-04 +-8.1421795064801051e-04 +-8.0199885202945985e-04 +-7.9091142929076639e-04 +-7.8090433358972552e-04 +-7.7192667119995264e-04 +-7.6392951876088787e-04 +-7.5686699193229067e-04 +-7.5069697462504270e-04 +-7.4538159560078986e-04 +-7.4088752156673183e-04 +-7.3718612106723753e-04 +-7.3425354130546457e-04 +-7.3207073016896341e-04 +-7.3062342780412330e-04 +-7.2990214567265964e-04 +-9.6691662204586486e-04 +-9.6881046392462351e-04 +-9.7254973577038425e-04 +-9.7803729931192330e-04 +-9.8512674201537949e-04 +-9.9362175800176127e-04 +-1.0032757101472527e-03 +-1.0137917459063864e-03 +-1.0248240191778092e-03 +-1.0359808274719203e-03 +-1.0468307760559768e-03 +-1.0569133066792248e-03 +-1.0657548557612511e-03 +-1.0728912790483678e-03 +-1.0778958627764416e-03 +-1.0804104107736523e-03 +-1.0801751143760985e-03 +-1.0770519619849198e-03 +-1.0710369478275105e-03 +-1.0622583575456426e-03 +-1.0509613303109008e-03 +-1.0374817136057693e-03 +-1.0222140271843000e-03 +-1.0055787255120487e-03 +-9.8799306509382632e-04 +-9.6984829116836052e-04 +-9.5149416478417133e-04 +-9.3323049127752740e-04 +-9.1530446900881305e-04 +-8.9791233192937695e-04 +-8.8120377997518199e-04 +-8.6528792168170281e-04 +-8.5023976450453805e-04 +-8.3610659505044586e-04 +-8.2291384979811478e-04 +-8.1067027239652102e-04 +-7.9937228896404130e-04 +-7.8900761851518936e-04 +-7.7955818421896470e-04 +-7.7100241407172397e-04 +-7.6331702589687981e-04 +-7.5647838809310105e-04 +-7.5046353886398407e-04 +-7.4525093576395746e-04 +-7.4082099609928671e-04 +-7.3715647803141923e-04 +-7.3424274262943274e-04 +-7.3206792876017346e-04 +-7.3062306556651209e-04 +-7.2990214120470780e-04 +-8.7486178154070661e-04 +-8.7657769870190245e-04 +-8.7997232710543358e-04 +-8.8497102466562785e-04 +-8.9146132325177254e-04 +-8.9929251858718816e-04 +-9.0827544714310537e-04 +-9.1818272915743769e-04 +-9.2874984102861414e-04 +-9.3967748167280319e-04 +-9.5063580600805015e-04 +-9.6127117503647704e-04 +-9.7121603961465781e-04 +-9.8010233486283869e-04 +-9.8757823843078946e-04 +-9.9332735397250388e-04 +-9.9708848114641257e-04 +-9.9867341779881036e-04 +-9.9798003131259974e-04 +-9.9499832899550876e-04 +-9.8980839423415141e-04 +-9.8257052186146213e-04 +-9.7350924209547844e-04 +-9.6289379082579877e-04 +-9.5101779530652741e-04 +-9.3818056436599127e-04 +-9.2467162616092276e-04 +-9.1075930997964853e-04 +-8.9668343154759487e-04 +-8.8265162516015165e-04 +-8.6883859005456785e-04 +-8.5538744217330675e-04 +-8.4241242098837010e-04 +-8.3000233103787467e-04 +-8.1822425064522809e-04 +-8.0712718512290641e-04 +-7.9674546304189472e-04 +-7.8710176701734570e-04 +-7.7820975636297321e-04 +-7.7007628231459452e-04 +-7.6270322254715257e-04 +-7.5608897530251684e-04 +-7.5022965864985627e-04 +-7.4512006030137180e-04 +-7.4075438021885221e-04 +-7.3712680347094023e-04 +-7.3423193540639330e-04 +-7.3206512576568710e-04 +-7.3062270318223477e-04 +-7.2990213673546306e-04 +-8.0313920160978325e-04 +-8.0471624961480216e-04 +-8.0784124314681118e-04 +-8.1245580587489038e-04 +-8.1847199874578982e-04 +-8.2577201943682076e-04 +-8.3420804482900132e-04 +-8.4360241724186198e-04 +-8.5374841961386187e-04 +-8.6441192808649528e-04 +-8.7533426849526711e-04 +-8.8623662265010063e-04 +-8.9682630479107777e-04 +-9.0680512180753476e-04 +-9.1587980875662740e-04 +-9.2377418493409845e-04 +-9.3024224500954495e-04 +-9.3508098236950922e-04 +-9.3814147395578735e-04 +-9.3933676257972238e-04 +-9.3864540861181181e-04 +-9.3611019566818812e-04 +-9.3183221496949983e-04 +-9.2596122905986157e-04 +-9.1868366644353220e-04 +-9.1020974677482648e-04 +-9.0076109972488994e-04 +-8.9055990784483638e-04 +-8.7982018904878641e-04 +-8.6874143851022978e-04 +-8.5750453755460731e-04 +-8.4626963376775472e-04 +-8.3517559667002032e-04 +-8.2434063440640622e-04 +-8.1386369119839709e-04 +-8.0382630759724325e-04 +-7.9429469688036404e-04 +-7.8532185905364057e-04 +-7.7694961240864634e-04 +-7.6921046909022195e-04 +-7.6212931583823518e-04 +-7.5572488547816165e-04 +-7.5001102083195137e-04 +-7.4499774248764803e-04 +-7.4069213704590668e-04 +-7.3709908445873077e-04 +-7.3422184296863453e-04 +-7.3206250871885807e-04 +-7.3062236488987396e-04 +-7.2990213256378985e-04 +-7.5076457381700477e-04 +-7.5224010826681223e-04 +-7.5516757928212352e-04 +-7.5949965914861163e-04 +-7.6516506643439645e-04 +-7.7206832855412780e-04 +-7.8008964458035261e-04 +-7.8908499352572025e-04 +-7.9888666010174633e-04 +-8.0930437121188616e-04 +-8.2012724995855399e-04 +-8.3112679465298335e-04 +-8.4206106894929719e-04 +-8.5268023260657796e-04 +-8.6273343678508973e-04 +-8.7197694594536501e-04 +-8.8018313858732433e-04 +-8.8714981173864695e-04 +-8.9270902092756230e-04 +-8.9673458890962858e-04 +-8.9914746098294039e-04 +-8.9991828693055330e-04 +-8.9906693939159719e-04 +-8.9665906738503631e-04 +-8.9280014690541819e-04 +-8.8762775414987427e-04 +-8.8130290945821776e-04 +-8.7400131940163005e-04 +-8.6590521110482095e-04 +-8.5719625443805641e-04 +-8.4804985264390895e-04 +-8.3863088807396315e-04 +-8.2909085922528770e-04 +-8.1956624558248358e-04 +-8.1017788441059026e-04 +-8.0103112906844257e-04 +-7.9221657011144329e-04 +-7.8381112768650821e-04 +-7.7587935790185132e-04 +-7.6847485093581823e-04 +-7.6164163089472965e-04 +-7.5541549492819885e-04 +-7.4982525122137115e-04 +-7.4489383236462660e-04 +-7.4063927284364641e-04 +-7.3707554776076092e-04 +-7.3421327518370997e-04 +-7.3206028743357128e-04 +-7.3062207779337710e-04 +-7.2990212902372220e-04 +-7.1661632544732024e-04 +-7.1802569457561877e-04 +-7.2082421753852789e-04 +-7.2497135570209856e-04 +-7.3040606197396151e-04 +-7.3704657925713812e-04 +-7.4479031023611051e-04 +-7.5351386966807652e-04 +-7.6307344899575731e-04 +-7.7330563585024372e-04 +-7.8402883639234219e-04 +-7.9504544413323581e-04 +-8.0614488128193150e-04 +-8.1710760285314118e-04 +-8.2771009431375738e-04 +-8.3773080666301966e-04 +-8.4695685959067972e-04 +-8.5519121296677002e-04 +-8.6225987841652722e-04 +-8.6801864313627776e-04 +-8.7235873636363386e-04 +-8.7521090695565301e-04 +-8.7654750452296267e-04 +-8.7638235231300948e-04 +-8.7476843493379476e-04 +-8.7179365541946734e-04 +-8.6757510299532189e-04 +-8.6225238630963552e-04 +-8.5598061607529571e-04 +-8.4892357333082088e-04 +-8.4124749540367407e-04 +-8.3311577760646354e-04 +-8.2468475018666659e-04 +-8.1610056676466086e-04 +-8.0749714425207915e-04 +-7.9899502928618051e-04 +-7.9070103094505705e-04 +-7.8270844874182626e-04 +-7.7509773195624776e-04 +-7.6793742464245434e-04 +-7.6128527453402702e-04 +-7.5518940933103594e-04 +-7.4968950767776972e-04 +-7.4481791290872870e-04 +-7.4060065465578098e-04 +-7.3705835659280776e-04 +-7.3420701825264295e-04 +-7.3205866547243709e-04 +-7.3062186817809071e-04 +-7.2990212643921819e-04 +-6.9978946091579146e-04 +-7.0116638039252372e-04 +-7.0390160862390295e-04 +-7.0795782690529874e-04 +-7.1327884067954662e-04 +-7.1978939322700519e-04 +-7.2739503634971136e-04 +-7.3598215338195638e-04 +-7.4541824529745409e-04 +-7.5555260054285995e-04 +-7.6621747228835320e-04 +-7.7722988157148925e-04 +-7.8839414942986766e-04 +-7.9950523320837855e-04 +-8.1035289919228993e-04 +-8.2072670348051844e-04 +-8.3042167534657188e-04 +-8.3924450561887094e-04 +-8.4701994541690033e-04 +-8.5359703220148951e-04 +-8.5885469911036317e-04 +-8.6270630900157647e-04 +-8.6510270046279202e-04 +-8.6603344251947397e-04 +-8.6552615712807881e-04 +-8.6364395978675049e-04 +-8.6048125671482785e-04 +-8.5615829006710877e-04 +-8.5081491671310883e-04 +-8.4460413088553699e-04 +-8.3768580068861352e-04 +-8.3022099879569047e-04 +-8.2236719043118759e-04 +-8.1427441891643000e-04 +-8.0608251839953896e-04 +-7.9791929609517075e-04 +-7.8989956693240732e-04 +-7.8212489103090730e-04 +-7.7468385448541458e-04 +-7.6765274055317224e-04 +-7.6109645542737209e-04 +-7.5506959510988837e-04 +-7.4961756349447184e-04 +-7.4477767397435719e-04 +-7.4058018617242547e-04 +-7.3704924509973688e-04 +-7.3420370212448020e-04 +-7.3205780587357082e-04 +-7.3062175709018632e-04 +-7.2990212506954884e-04 +-6.9978951001377235e-04 +-7.0116682283489530e-04 +-7.0390284047313343e-04 +-7.0796024834984188e-04 +-7.1328285483632931e-04 +-7.1979540110123010e-04 +-7.2740342686839887e-04 +-7.3599328773509454e-04 +-7.4543243536929007e-04 +-7.5557008203790620e-04 +-7.6623837423783823e-04 +-7.7725419514465229e-04 +-7.8842170016345974e-04 +-7.9953566160430756e-04 +-8.1038565477220808e-04 +-8.2076105653636124e-04 +-8.3045674867164045e-04 +-8.3927932560758230e-04 +-8.4705350855909301e-04 +-8.5362837988656149e-04 +-8.5888299157492248e-04 +-8.6273088880050143e-04 +-8.6512313722949120e-04 +-8.6604955374086840e-04 +-8.6553800351991299e-04 +-8.6365181774060993e-04 +-8.6048557338552095e-04 +-8.5615962844232433e-04 +-8.5081389830359803e-04 +-8.4460138269631350e-04 +-8.3768191131521747e-04 +-8.3021648634379309e-04 +-8.2236248292916138e-04 +-8.1426984628079810e-04 +-8.0607831395862700e-04 +-7.9791560517235792e-04 +-7.8989645994014803e-04 +-7.8212237879153081e-04 +-7.7468190393466436e-04 +-7.6765128948119189e-04 +-7.6109542538714710e-04 +-7.5506890202679431e-04 +-7.4961712582229112e-04 +-7.4477741846242971e-04 +-7.4058005144688561e-04 +-7.3704918333601926e-04 +-7.3420367911666601e-04 +-7.3205779980541486e-04 +-7.3062175629692654e-04 +-7.2990212505972347e-04 +-7.1661648041511459e-04 +-7.1802709105221491e-04 +-7.2082810554499968e-04 +-7.2497899792044553e-04 +-7.3041872922106075e-04 +-7.3706553317834042e-04 +-7.4481676965809142e-04 +-7.5354895817608333e-04 +-7.6311812323982115e-04 +-7.7336059697319295e-04 +-7.8409443073009161e-04 +-7.9512156355940832e-04 +-8.0623087746660785e-04 +-8.1720223217089378e-04 +-8.2781150996524399e-04 +-8.3783661084917583e-04 +-8.4706422110995545e-04 +-8.5529704526452171e-04 +-8.6236106185347684e-04 +-8.6811226569461376e-04 +-8.7244232173779685e-04 +-8.7528259961507505e-04 +-8.7660618798441334e-04 +-8.7642768799511513e-04 +-8.7480082192088250e-04 +-8.7181412328679478e-04 +-8.6758515818438782e-04 +-8.6225383619696519e-04 +-8.5597539394159194e-04 +-8.4891358299952872e-04 +-8.4123448796497632e-04 +-8.3310126595109301e-04 +-8.2466996125385038e-04 +-8.1608642715055857e-04 +-8.0748429232312406e-04 +-7.9898384602241637e-04 +-7.9069168202425331e-04 +-7.8270093142821006e-04 +-7.7509192178023569e-04 +-7.6793311834372517e-04 +-7.6128222708896011e-04 +-7.5518736399096936e-04 +-7.4968821877302442e-04 +-7.4481716173918177e-04 +-7.4060025913269935e-04 +-7.3705817547007550e-04 +-7.3420695083991640e-04 +-7.3205864770394349e-04 +-7.3062186585623197e-04 +-7.2990212641042742e-04 +-7.5076485895532712e-04 +-7.5224267774801198e-04 +-7.5517473285939638e-04 +-7.5951371850502085e-04 +-7.6518836403980522e-04 +-7.7210317055656811e-04 +-7.8013824067651397e-04 +-7.8914934932611247e-04 +-7.9896843190914273e-04 +-8.0940468960902820e-04 +-8.2024652684304852e-04 +-8.3126453724685439e-04 +-8.4221573184135737e-04 +-8.5284914241610184e-04 +-8.6291282097308657e-04 +-8.7216208612545464e-04 +-8.8036864997614861e-04 +-8.8733002731213148e-04 +-8.9287843674101797e-04 +-8.9688831188889848e-04 +-8.9928159690554554e-04 +-9.0003021575204797e-04 +-8.9915544522021183e-04 +-8.9672431598981938e-04 +-8.9284352829131373e-04 +-8.8765162607219511e-04 +-8.8131028684119669e-04 +-8.7399555434392430e-04 +-8.6588970058421022e-04 +-8.5717420115501196e-04 +-8.4802409185194755e-04 +-8.3860378215818950e-04 +-8.2906425357697801e-04 +-8.1954147436068476e-04 +-8.1015581275991754e-04 +-8.0101221857689425e-04 +-7.9220095594330808e-04 +-7.8379869819412463e-04 +-7.7586983005640902e-04 +-7.6846783726059820e-04 +-7.6163669553946554e-04 +-7.5541219802163306e-04 +-7.4982318169466717e-04 +-7.4489263011179362e-04 +-7.4063864145696822e-04 +-7.3707525923185984e-04 +-7.3421316796891086e-04 +-7.3206025920773143e-04 +-7.3062207410793366e-04 +-7.2990212897806395e-04 +-8.0313966168597296e-04 +-8.0472039548881605e-04 +-8.0785278484486701e-04 +-8.1247848535998240e-04 +-8.1850956484109635e-04 +-8.2582815471360230e-04 +-8.3428623191231265e-04 +-8.4370573753966469e-04 +-8.5387928689355664e-04 +-8.6457177292109124e-04 +-8.7552320631756320e-04 +-8.8645315501963259e-04 +-8.9706711563077382e-04 +-9.0706503199182670e-04 +-9.1615193875717402e-04 +-9.2405034505570129e-04 +-9.3051353039704215e-04 +-9.3533850527631490e-04 +-9.3837713146034641e-04 +-9.3954392503512666e-04 +-9.3881942740306197e-04 +-9.3624866474142682e-04 +-9.3193496852852456e-04 +-9.2603010448926305e-04 +-9.1872209573166507e-04 +-9.1022225571446775e-04 +-9.0075279227866964e-04 +-8.9053599804268650e-04 +-8.7978562122797879e-04 +-8.6870061467636344e-04 +-8.5746115229354681e-04 +-8.4622660441606966e-04 +-8.3513506948580706e-04 +-8.2430404529106266e-04 +-8.1383186067124390e-04 +-8.0379955280840073e-04 +-7.9427294732510654e-04 +-7.8530476653718530e-04 +-7.7693664924305276e-04 +-7.6920101127607942e-04 +-7.6212271005474564e-04 +-7.5572050013746430e-04 +-7.5000828235589044e-04 +-7.4499615845955997e-04 +-7.4069130809154384e-04 +-7.3709870671798843e-04 +-7.3422170291274577e-04 +-7.3206247190693585e-04 +-7.3062236008847455e-04 +-7.2990213250431605e-04 +-8.7486248803266920e-04 +-8.7658406502248958e-04 +-8.7999004890752157e-04 +-8.8500583916731855e-04 +-8.9151895536166402e-04 +-8.9937854008786402e-04 +-9.0839502748927962e-04 +-9.1834026845622786e-04 +-9.2894849587019362e-04 +-9.3991862275019016e-04 +-9.5091847953545597e-04 +-9.6159167003513786e-04 +-9.7156767861971088e-04 +-9.8047559445647967e-04 +-9.8796126123510070e-04 +-9.9370683915828975e-04 +-9.9745085314596423e-04 +-9.9900609906732789e-04 +-9.9827261037940254e-04 +-9.9524343329732102e-04 +-9.9000214313437287e-04 +-9.8271252698577311e-04 +-9.7360221097505281e-04 +-9.6294285215610864e-04 +-9.5102968898127258e-04 +-9.3816282954659145e-04 +-9.2463188771841633e-04 +-9.1070472193897196e-04 +-8.9662029731517865e-04 +-8.8258518504969678e-04 +-8.6877294891387507e-04 +-8.5532560246980775e-04 +-8.4235638671745282e-04 +-8.2995325225744066e-04 +-8.1818258482712475e-04 +-8.0709285814359896e-04 +-7.9671801853850881e-04 +-7.8708049759010639e-04 +-7.7819381364431029e-04 +-7.7006476537384784e-04 +-7.6269524566236727e-04 +-7.5608371702372702e-04 +-7.5022639449559287e-04 +-7.4511818153032779e-04 +-7.4075340102327093e-04 +-7.3712635873624953e-04 +-7.3423177093552485e-04 +-7.3206508261887935e-04 +-7.3062269756167563e-04 +-7.2990213666590249e-04 +-9.6691768088075962e-04 +-9.6882000511939385e-04 +-9.7257629259426810e-04 +-9.7808945227638834e-04 +-9.8521300726062328e-04 +-9.9375031922257812e-04 +-1.0034539584691993e-03 +-1.0140256182966021e-03 +-1.0251171689881226e-03 +-1.0363337191088998e-03 +-1.0472398594562247e-03 +-1.0573704760711946e-03 +-1.0662474045944820e-03 +-1.0734025065196034e-03 +-1.0784063632075633e-03 +-1.0808999106076793e-03 +-1.0806245648206745e-03 +-1.0774455074862533e-03 +-1.0713634093423719e-03 +-1.0625119908051252e-03 +-1.0511417980030315e-03 +-1.0375933835087708e-03 +-1.0222648238816185e-03 +-1.0055787999784962e-03 +-9.8795351416637719e-04 +-9.6978008633990035e-04 +-9.5140736794686138e-04 +-9.3313376632905756e-04 +-9.1520485275033516e-04 +-8.9781520557558872e-04 +-8.8111297846306825e-04 +-8.6520592485675874e-04 +-8.5016792614774311e-04 +-8.3604537842099495e-04 +-8.2286304958716127e-04 +-8.1062921178398498e-04 +-7.9933998676756581e-04 +-7.8898292556740541e-04 +-7.7953989059896219e-04 +-7.7098933012818577e-04 +-7.6330804053119654e-04 +-7.5647250782033071e-04 +-7.5045991094799648e-04 +-7.4524885836993395e-04 +-7.4081991800957112e-04 +-7.3715599008165346e-04 +-7.3424256266980265e-04 +-7.3206788164582165e-04 +-7.3062305943737279e-04 +-7.2990214112889540e-04 +-1.0795756787367395e-03 +-1.0816992940564294e-03 +-1.0858835969291037e-03 +-1.0920021998905621e-03 +-1.0998642508970528e-03 +-1.1092130878858416e-03 +-1.1197248105231340e-03 +-1.1310072753174152e-03 +-1.1426004770891895e-03 +-1.1539799768342854e-03 +-1.1645658394760533e-03 +-1.1737400557062104e-03 +-1.1808750086405452e-03 +-1.1853736274299901e-03 +-1.1867184128543202e-03 +-1.1845224472119677e-03 +-1.1785725668262575e-03 +-1.1688548253099807e-03 +-1.1555558178126086e-03 +-1.1390392709870892e-03 +-1.1198032371979203e-03 +-1.0984270526550866e-03 +-1.0755179116197836e-03 +-1.0516649087997398e-03 +-1.0274050321180221e-03 +-1.0032022298078927e-03 +-9.7943821201537163e-04 +-9.5641234223195026e-04 +-9.3434765404560162e-04 +-9.1340033971466761e-04 +-8.9367065632264353e-04 +-8.7521383998748485e-04 +-8.5805017636890035e-04 +-8.4217379791689953e-04 +-8.2756006609769879e-04 +-8.1417157403428574e-04 +-8.0196290111957168e-04 +-7.9088429290876251e-04 +-7.8088444780751169e-04 +-7.7191258152186737e-04 +-7.6391992064580889e-04 +-7.5686075410624223e-04 +-7.5069314885143257e-04 +-7.4537941587386356e-04 +-7.4088639510027092e-04 +-7.3718561296588010e-04 +-7.3425335442048626e-04 +-7.3207068134015848e-04 +-7.3062342146048057e-04 +-7.2990214559424883e-04 +-1.2115517913422157e-03 +-1.2139349572750197e-03 +-1.2186208694274377e-03 +-1.2254479084569546e-03 +-1.2341716240396735e-03 +-1.2444621576666683e-03 +-1.2559007648976247e-03 +-1.2679759911609768e-03 +-1.2800811668380876e-03 +-1.2915166555619126e-03 +-1.3015022676500258e-03 +-1.3092062682674183e-03 +-1.3137958283902307e-03 +-1.3145084689048234e-03 +-1.3107358027537161e-03 +-1.3021029366438498e-03 +-1.2885237014561136e-03 +-1.2702162455560898e-03 +-1.2476743014775812e-03 +-1.2216018813343539e-03 +-1.1928278743525132e-03 +-1.1622191269040586e-03 +-1.1306067696867574e-03 +-1.0987337877390276e-03 +-1.0672252322537761e-03 +-1.0365779239210826e-03 +-1.0071644014920528e-03 +-9.7924568942433740e-04 +-9.5298836292326988e-04 +-9.2848266899904887e-04 +-9.0575967885039345e-04 +-8.8480640447558857e-04 +-8.6557847421068687e-04 +-8.4801036951820917e-04 +-8.3202344507232403e-04 +-8.1753204913453232e-04 +-8.0444808087031926e-04 +-7.9268430018075719e-04 +-7.8215666594335037e-04 +-7.7278593337066972e-04 +-7.6449869757074201e-04 +-7.5722803165893999e-04 +-7.5091383507255752e-04 +-7.4550298104647051e-04 +-7.4094933092855796e-04 +-7.3721366633318981e-04 +-7.3426357721747431e-04 +-7.3207333403671622e-04 +-7.3062376453140597e-04 +-7.2990214982638583e-04 +-1.3589594345322761e-03 +-1.3616332224839060e-03 +-1.3668819447782831e-03 +-1.3745067276131455e-03 +-1.3842058718132040e-03 +-1.3955696037832297e-03 +-1.4080716963896925e-03 +-1.4210583961667919e-03 +-1.4337378027343744e-03 +-1.4451771552248765e-03 +-1.4543199794698565e-03 +-1.4600365197195487e-03 +-1.4612154573927785e-03 +-1.4568911690304351e-03 +-1.4463828338380344e-03 +-1.4294089575709813e-03 +-1.4061424265688857e-03 +-1.3771885932471323e-03 +-1.3434938893346071e-03 +-1.3062125628308255e-03 +-1.2665660399057289e-03 +-1.2257232375222670e-03 +-1.1847170984139487e-03 +-1.1443997115620013e-03 +-1.1054297820771713e-03 +-1.0682826612722690e-03 +-1.0332733091353273e-03 +-1.0005846061663861e-03 +-9.7029593787804447e-04 +-9.4240916155964550e-04 +-9.1687065715538238e-04 +-8.9358917655179865e-04 +-8.7244976763317683e-04 +-8.5332430687676405e-04 +-8.3607924715498538e-04 +-8.2058116067947431e-04 +-8.0670058467948932e-04 +-7.9431459087679602e-04 +-7.8330841565519009e-04 +-7.7357641356575401e-04 +-7.6502253490772615e-04 +-7.5756047840713878e-04 +-7.5111363111585248e-04 +-7.4561487780935994e-04 +-7.4100633961783787e-04 +-7.3723908480599729e-04 +-7.3427284220394049e-04 +-7.3207573869741140e-04 +-7.3062407557064114e-04 +-7.2990215366392007e-04 +-1.5143549686214509e-03 +-1.5173365155961619e-03 +-1.5231858115796523e-03 +-1.5316734820173239e-03 +-1.5424495691709610e-03 +-1.5550327515283125e-03 +-1.5687912854320319e-03 +-1.5829156954231256e-03 +-1.5963895763373877e-03 +-1.6079746865633694e-03 +-1.6162357817585619e-03 +-1.6196312922016939e-03 +-1.6166799923648784e-03 +-1.6061815708998252e-03 +-1.5874347696200075e-03 +-1.5603828639182478e-03 +-1.5256361468742004e-03 +-1.4843661112819227e-03 +-1.4381107245525072e-03 +-1.3885518478320008e-03 +-1.3373194241958265e-03 +-1.2858536927732314e-03 +-1.2353317411157186e-03 +-1.1866479043231338e-03 +-1.1404307892520207e-03 +-1.0970802487605558e-03 +-1.0568116243098048e-03 +-1.0196991888663609e-03 +-9.8571453675775863e-04 +-9.5475828884114230e-04 +-9.2668503718176928e-04 +-9.0132223834834321e-04 +-8.7848406350052202e-04 +-8.5798124107511089e-04 +-8.3962782427553456e-04 +-8.2324566333156904e-04 +-8.0866720558609177e-04 +-7.9573710535355317e-04 +-7.8431300748733391e-04 +-7.7426577425975061e-04 +-7.6547935202558892e-04 +-7.5785041870425499e-04 +-7.5128791182748201e-04 +-7.4571250660028087e-04 +-7.4105609148799158e-04 +-7.3726127316791105e-04 +-7.3428093164250611e-04 +-7.3207783864274653e-04 +-7.3062434723137031e-04 +-7.2990215701612010e-04 +-1.6665466948793083e-03 +-1.6698319412944511e-03 +-1.6762842878186126e-03 +-1.6856647147646940e-03 +-1.6976044199077391e-03 +-1.7115836136271387e-03 +-1.7268918100316734e-03 +-1.7425688486637622e-03 +-1.7573395387709360e-03 +-1.7695752230977139e-03 +-1.7773326639502686e-03 +-1.7785164496951003e-03 +-1.7711713627005003e-03 +-1.7538443884113090e-03 +-1.7259003042435779e-03 +-1.6876737962249165e-03 +-1.6404042814706901e-03 +-1.5859887486384743e-03 +-1.5266487504756641e-03 +-1.4646137010466786e-03 +-1.4018869854096456e-03 +-1.3401150909476919e-03 +-1.2805462524329836e-03 +-1.2240505439470061e-03 +-1.1711732621079954e-03 +-1.1222002508373147e-03 +-1.0772218709562311e-03 +-1.0361888722013569e-03 +-9.9895779486807107e-04 +-9.6532601345333650e-04 +-9.3505771059611709e-04 +-9.0790245761928603e-04 +-8.8360805022760737e-04 +-8.6192903579224427e-04 +-8.4263210117457095e-04 +-8.2549923132315165e-04 +-8.1032932564786668e-04 +-7.9693877846522920e-04 +-7.8516138933034882e-04 +-7.7484786289600080e-04 +-7.6586507935118449e-04 +-7.5809525929267769e-04 +-7.5143510585762643e-04 +-7.4579497793023813e-04 +-7.4109812802412595e-04 +-7.3728002460443783e-04 +-7.3428776936039942e-04 +-7.3207961393382344e-04 +-7.3062457691901032e-04 +-7.2990215985091109e-04 +-1.8021211529100987e-03 +-1.8056800863735501e-03 +-1.8126938194657364e-03 +-1.8229500123601405e-03 +-1.8361130993869118e-03 +-1.8516861219302128e-03 +-1.8689368876092587e-03 +-1.8867863450431975e-03 +-1.9036831422615972e-03 +-1.9175263139956493e-03 +-1.9257267890069594e-03 +-1.9254823958314772e-03 +-1.9142575506565392e-03 +-1.8903368141978687e-03 +-1.8532440867327629e-03 +-1.8038582490132278e-03 +-1.7441953559728409e-03 +-1.6769703276368257e-03 +-1.6051103903619915e-03 +-1.5313584935618069e-03 +-1.4580279307768226e-03 +-1.3869024775379660e-03 +-1.3192421451700027e-03 +-1.2558490440347926e-03 +-1.1971572600934096e-03 +-1.1433238020754314e-03 +-1.0943087995007492e-03 +-1.0499406076170050e-03 +-1.0099657123565674e-03 +-9.7408531716157182e-04 +-9.4198114542672073e-04 +-9.1333295215129280e-04 +-8.8782990001183212e-04 +-8.6517753302657108e-04 +-8.4510167861022694e-04 +-8.2735026700732231e-04 +-8.1169378483434849e-04 +-7.9792487131224706e-04 +-7.8585741109788538e-04 +-7.7532536510491266e-04 +-7.6618150023552174e-04 +-7.5829612225138468e-04 +-7.5155587664711698e-04 +-7.4586265548190857e-04 +-7.4113263008866346e-04 +-7.3729541779359237e-04 +-7.3429338338418758e-04 +-7.3208107170539660e-04 +-7.3062476554356726e-04 +-7.2990216217939800e-04 +-1.9092019414441721e-03 +-1.9129804048895194e-03 +-1.9204686119917069e-03 +-1.9315234819338018e-03 +-1.9459048231327081e-03 +-1.9632150128981677e-03 +-1.9827796553245312e-03 +-2.0034641993473749e-03 +-2.0234638870655379e-03 +-2.0401671881571503e-03 +-2.0502399180677014e-03 +-2.0500453030579120e-03 +-2.0363664080822307e-03 +-2.0071953780839563e-03 +-1.9622566765684023e-03 +-1.9030446589898820e-03 +-1.8324032585228789e-03 +-1.7538706440446683e-03 +-1.6710437172789247e-03 +-1.5871226286411958e-03 +-1.5046747318790729e-03 +-1.4255781423041642e-03 +-1.3510783652193026e-03 +-1.2818982846963800e-03 +-1.2183607281002129e-03 +-1.1605010937753913e-03 +-1.1081605740139500e-03 +-1.0610582126699512e-03 +-1.0188438371734174e-03 +-9.8113531372571007e-04 +-9.4754371549584987e-04 +-9.1768956772867989e-04 +-8.9121272760356578e-04 +-8.6777785909133097e-04 +-8.4707695064775376e-04 +-8.2882991571171230e-04 +-8.1278400597495186e-04 +-7.9871253909013216e-04 +-7.8641327821242697e-04 +-7.7570668472298559e-04 +-7.6643418479242038e-04 +-7.5845653517180988e-04 +-7.5165233634822922e-04 +-7.4591671656697753e-04 +-7.4116019436062009e-04 +-7.3730771738988283e-04 +-7.3429786972010135e-04 +-7.3208223677687654e-04 +-7.3062491630636816e-04 +-7.2990216404104761e-04 +-1.9822050695170288e-03 +-1.9861354341219901e-03 +-1.9939764471063976e-03 +-2.0056818179073057e-03 +-2.0211492160524874e-03 +-2.0401396468941071e-03 +-2.0621140306949733e-03 +-2.0859745967777058e-03 +-2.1097549755529519e-03 +-2.1303955029087218e-03 +-2.1438209366342457e-03 +-2.1455010802905860e-03 +-2.1314452172702079e-03 +-2.0992661396674996e-03 +-2.0488236680816347e-03 +-1.9821734414368687e-03 +-1.9029289455149887e-03 +-1.8153873461868551e-03 +-1.7237549014122728e-03 +-1.6316433506318416e-03 +-1.5418480779425766e-03 +-1.4563338489125197e-03 +-1.3763378153188394e-03 +-1.3025185552782905e-03 +-1.2351070948358547e-03 +-1.1740382183015000e-03 +-1.1190548251396838e-03 +-1.0697858742742892e-03 +-1.0258018323976075e-03 +-9.8665243490098239e-04 +-9.5189126159201092e-04 +-9.2109086711960394e-04 +-8.9385136707851123e-04 +-8.6980463099623070e-04 +-8.4861562623892470e-04 +-8.2998199271324638e-04 +-8.1363258659808934e-04 +-7.9932548656432489e-04 +-7.8684578417860475e-04 +-7.7600336171286825e-04 +-7.6663078015492474e-04 +-7.5858134647663550e-04 +-7.5172739398564120e-04 +-7.4595878701652532e-04 +-7.4118164728101833e-04 +-7.3731729104754243e-04 +-7.3430136210193603e-04 +-7.3208314379897361e-04 +-7.3062503368398100e-04 +-7.2990216549102609e-04 +-2.0242482122221610e-03 +-2.0282658151315859e-03 +-2.0363261783579905e-03 +-2.0484726515091478e-03 +-2.0647353825186130e-03 +-2.0850427297602571e-03 +-2.1090349761600327e-03 +-2.1357528742435602e-03 +-2.1632315866182842e-03 +-2.1881527421612119e-03 +-2.2058475174128499e-03 +-2.2109375245962918e-03 +-2.1985899335285452e-03 +-2.1658921675858744e-03 +-2.1126643644113143e-03 +-2.0413557806244396e-03 +-1.9562103803626137e-03 +-1.8621839448674895e-03 +-1.7640315078169249e-03 +-1.6657498575578294e-03 +-1.5703608047021303e-03 +-1.4799300009373409e-03 +-1.3957090624679290e-03 +-1.3183186332982595e-03 +-1.2479247132246032e-03 +-1.1843868446515980e-03 +-1.1273726813919812e-03 +-1.0764414506724495e-03 +-1.0311018806064185e-03 +-9.9085061791403780e-04 +-9.5519645829138873e-04 +-9.2367464735657609e-04 +-8.9585446101260241e-04 +-8.7134238725795335e-04 +-8.4978253948291601e-04 +-8.3085541713473726e-04 +-8.1427576015477153e-04 +-7.9978998445586434e-04 +-7.8717350749176352e-04 +-7.7622815242174375e-04 +-7.6677973918044644e-04 +-7.5867591830817808e-04 +-7.5178426985383190e-04 +-7.4599066879080147e-04 +-7.4119790602982102e-04 +-7.3732454732350209e-04 +-7.3430400931993010e-04 +-7.3208383136173772e-04 +-7.3062512266544772e-04 +-7.2990216659086615e-04 +-2.0445799359672186e-03 +-2.0486369124767955e-03 +-2.0568013061273691e-03 +-2.0691682259929211e-03 +-2.0858502910073621e-03 +-2.1068980175089663e-03 +-2.1321226529709522e-03 +-2.1607734588787297e-03 +-2.1910633760014765e-03 +-2.2196770445179464e-03 +-2.2416158709628780e-03 +-2.2508125527947727e-03 +-2.2415867300925210e-03 +-2.2103504357758519e-03 +-2.1566620867933123e-03 +-2.0831448392230755e-03 +-1.9945006622323373e-03 +-1.8962313143007423e-03 +-1.7935802136654245e-03 +-1.6909064711547357e-03 +-1.5914595358807035e-03 +-1.4974208841723616e-03 +-1.4100784673174661e-03 +-1.3300395199488284e-03 +-1.2574295962189553e-03 +-1.1920561322449771e-03 +-1.1335324451016765e-03 +-1.0813663989472026e-03 +-1.0350207928362873e-03 +-9.9395258957628405e-04 +-9.5763704452733311e-04 +-9.2558145503339483e-04 +-8.9733201299377666e-04 +-8.7247623410037186e-04 +-8.5064267041313243e-04 +-8.3149905506965085e-04 +-8.1474963429234654e-04 +-8.0013217030010079e-04 +-7.8741491491285452e-04 +-7.7639373120623923e-04 +-7.6688946046034562e-04 +-7.5874558014143371e-04 +-7.5182616641607865e-04 +-7.4601415512908300e-04 +-7.4120988404695310e-04 +-7.3732989341768673e-04 +-7.3430595977257813e-04 +-7.3208433797553843e-04 +-7.3062518823152731e-04 +-7.2990216740201808e-04 +-2.0529848812203787e-03 +-2.0570542527664163e-03 +-2.0652478206120567e-03 +-2.0776711868284161e-03 +-2.0944608231295747e-03 +-2.1157230011955618e-03 +-2.1413878973039276e-03 +-2.1709147411024601e-03 +-2.2027960181910276e-03 +-2.2339403305979399e-03 +-2.2593073693118358e-03 +-2.2723802834441935e-03 +-2.2667198392022792e-03 +-2.2379856867889053e-03 +-2.1852970229509455e-03 +-2.1112549534026176e-03 +-2.0208566200252825e-03 +-1.9200356171497485e-03 +-1.8144535951324045e-03 +-1.7087951523030883e-03 +-1.6065237725058339e-03 +-1.5099384390969174e-03 +-1.4203744573583099e-03 +-1.3384416740285787e-03 +-1.2642431971055690e-03 +-1.1975523590683252e-03 +-1.1379449751914069e-03 +-1.0848926197734132e-03 +-1.0378252644981855e-03 +-9.9617134368897757e-04 +-9.5938193546722477e-04 +-9.2694417179640986e-04 +-8.9838759026727240e-04 +-8.7328602819009460e-04 +-8.5125683016144501e-04 +-8.3195854618230256e-04 +-8.1508788392440897e-04 +-8.0037639697637213e-04 +-7.8758720246824895e-04 +-7.7651189740680449e-04 +-7.6696776291429914e-04 +-7.5879529470313704e-04 +-7.5185606684036567e-04 +-7.4603091722983219e-04 +-7.4121843302561762e-04 +-7.3733370918878231e-04 +-7.3430735195541524e-04 +-7.3208469959394336e-04 +-7.3062523503350117e-04 +-7.2990216798187596e-04 +-2.0560413322112188e-03 +-2.0601119804396473e-03 +-2.0683014441408038e-03 +-2.0807033082648504e-03 +-2.0974425140721981e-03 +-2.1186307280301759e-03 +-2.1442537180222446e-03 +-2.1739228859060187e-03 +-2.2064037128682397e-03 +-2.2389275698131736e-03 +-2.2666220427457473e-03 +-2.2827629226112849e-03 +-2.2803174533406146e-03 +-2.2542286564229148e-03 +-2.2031068629642827e-03 +-2.1294111890647594e-03 +-2.0383077888317977e-03 +-1.9360530962336091e-03 +-1.8286441114549138e-03 +-1.7210351243492710e-03 +-1.6168716211979945e-03 +-1.5185565048839379e-03 +-1.4274716402905645e-03 +-1.3442365509305832e-03 +-1.2689430564259577e-03 +-1.2013430573276627e-03 +-1.1409874582838204e-03 +-1.0873231801855330e-03 +-1.0397576541805100e-03 +-9.9769962142677235e-04 +-9.6058342786266401e-04 +-9.2788223542323255e-04 +-8.9911404240403169e-04 +-8.7384321229381850e-04 +-8.5167933247090784e-04 +-8.3227460213818440e-04 +-8.1532052022350514e-04 +-8.0054435437212305e-04 +-7.8770568021006870e-04 +-7.7659315467151703e-04 +-7.6702160699109270e-04 +-7.5882948050333009e-04 +-7.5187662780389281e-04 +-7.4604244383699204e-04 +-7.4122431192295835e-04 +-7.3733633324432472e-04 +-7.3430830936018399e-04 +-7.3208494828328244e-04 +-7.3062526722048765e-04 +-7.2990216838167074e-04 +-2.0570063364186825e-03 +-2.0610753375978333e-03 +-2.0692532236043265e-03 +-2.0816176176925607e-03 +-2.0982727283931201e-03 +-2.1193139579938850e-03 +-2.1447382022339134e-03 +-2.1742386447330094e-03 +-2.2067810775556985e-03 +-2.2399004351254157e-03 +-2.2689750595023743e-03 +-2.2872442688781939e-03 +-2.2872675659647416e-03 +-2.2633999397215880e-03 +-2.2137847113901676e-03 +-2.1407041017761363e-03 +-2.0494112696110693e-03 +-1.9463885334557133e-03 +-1.8378803283075399e-03 +-1.7290439519558284e-03 +-1.6236637354396302e-03 +-1.5242234188888996e-03 +-1.4321429350558851e-03 +-1.3480523122806932e-03 +-1.2720381077098491e-03 +-1.2038391788872771e-03 +-1.1429905115238517e-03 +-1.0889229823916294e-03 +-1.0410292312552935e-03 +-9.9870502417385271e-04 +-9.6137366187963309e-04 +-9.2849907750741374e-04 +-8.9959164555944318e-04 +-8.7420947205680438e-04 +-8.5195702321839745e-04 +-8.3248230808324419e-04 +-8.1547339114631774e-04 +-8.0065471590620219e-04 +-7.8778352582146798e-04 +-7.7664654280651033e-04 +-7.6705698317338018e-04 +-7.5885194069540900e-04 +-7.5189013636491736e-04 +-7.4605001682593241e-04 +-7.4122817437783707e-04 +-7.3733805726727147e-04 +-7.3430893838586286e-04 +-7.3208511167598557e-04 +-7.3062528836829608e-04 +-7.2990216864555796e-04 +-2.0572331578438963e-03 +-2.0613004974774857e-03 +-2.0694689817939214e-03 +-2.0818042681940894e-03 +-2.0983936893239161e-03 +-2.1193145969592873e-03 +-2.1445566496651239e-03 +-2.1738464735503618e-03 +-2.2062707795349962e-03 +-2.2395888780050248e-03 +-2.2694089316103996e-03 +-2.2890111837174871e-03 +-2.2907042738604978e-03 +-2.2684232210784024e-03 +-2.2199547835220191e-03 +-2.1474288620881182e-03 +-2.0561401522095615e-03 +-1.9527174130503971e-03 +-1.8435712166062182e-03 +-1.7339966558754334e-03 +-1.6278728804947891e-03 +-1.5277393322102163e-03 +-1.4350428014787179e-03 +-1.3504215953730060e-03 +-1.2739599016983866e-03 +-1.2053889068392835e-03 +-1.1442338955841875e-03 +-1.0899158469410732e-03 +-1.0418182271405303e-03 +-9.9932873548819667e-04 +-9.6186379857178582e-04 +-9.2888160400412222e-04 +-8.9988778037673040e-04 +-8.7443653954420871e-04 +-8.5212916206928938e-04 +-8.3261105172610129e-04 +-8.1556813869600230e-04 +-8.0072311228265370e-04 +-7.8783176800731249e-04 +-7.7667962691925377e-04 +-7.6707890472544086e-04 +-7.5886585823358983e-04 +-7.5189850682094792e-04 +-7.4605470928367217e-04 +-7.4123056764426401e-04 +-7.3733912550144089e-04 +-7.3430932813820871e-04 +-7.3208521291580580e-04 +-7.3062530147211566e-04 +-7.2990216881058882e-04 +-2.0572420399783417e-03 +-2.0613083148408999e-03 +-2.0694710667252710e-03 +-2.0817888033540645e-03 +-2.0983384199731855e-03 +-2.1191847704423476e-03 +-2.1443082187489653e-03 +-2.1734461658727646e-03 +-2.2057492868500215e-03 +-2.2391159890644452e-03 +-2.2693154591380757e-03 +-2.2896794315302839e-03 +-2.2923760354269847e-03 +-2.2710785607362900e-03 +-2.2233431914904255e-03 +-2.1511961124416044e-03 +-2.0599513959411028e-03 +-1.9563244873105684e-03 +-1.8468261512875920e-03 +-1.7368349451263988e-03 +-1.6302875430568916e-03 +-1.5297572739130778e-03 +-1.4367074177488236e-03 +-1.3517815874367536e-03 +-1.2750628720894911e-03 +-1.2062781632942983e-03 +-1.1449472118841731e-03 +-1.0904853174185959e-03 +-1.0422706704716924e-03 +-9.9968632750064928e-04 +-9.6214475814342007e-04 +-9.2910084339626556e-04 +-9.0005748153077522e-04 +-8.7456664509277414e-04 +-8.5222778363535311e-04 +-8.3268480422724642e-04 +-8.1562241146606999e-04 +-8.0076228777808435e-04 +-7.8785939791944622e-04 +-7.7669857417446528e-04 +-7.6709145852276004e-04 +-7.5887382800002181e-04 +-7.5190329989098189e-04 +-7.4605739616496070e-04 +-7.4123193797237367e-04 +-7.3733973712948077e-04 +-7.3430955128950585e-04 +-7.3208527087943005e-04 +-7.3062530897502844e-04 +-7.2990216890700388e-04 +-2.0572136781423192e-03 +-2.0612794091785856e-03 +-2.0694392398817041e-03 +-2.0817480423319045e-03 +-2.0982773623625453e-03 +-2.1190853880789767e-03 +-2.1441466119743705e-03 +-2.1732015367274130e-03 +-2.2054314064955879e-03 +-2.2388079940256944e-03 +-2.2691908967126203e-03 +-2.2899461009029710e-03 +-2.2931704287551583e-03 +-2.2723968572121315e-03 +-2.2250561514356535e-03 +-2.1531172492984369e-03 +-2.0619035222319785e-03 +-1.9581760654493285e-03 +-1.8484986083445465e-03 +-1.7382937855837798e-03 +-1.6315285890523802e-03 +-1.5307941718440089e-03 +-1.4375624767983895e-03 +-1.3524799108714472e-03 +-1.2756290078164893e-03 +-1.2067344381591378e-03 +-1.1453130888763874e-03 +-1.0907773223140990e-03 +-1.0425026032192452e-03 +-9.9986959153576917e-04 +-9.6228871637444756e-04 +-9.2921315509457707e-04 +-9.0014440041638285e-04 +-8.7463327297905634e-04 +-8.5227828110979553e-04 +-8.3272256297826821e-04 +-8.1565019391595037e-04 +-8.0078233963034142e-04 +-7.8787353872261895e-04 +-7.7670827029763202e-04 +-7.6709788224239026e-04 +-7.5887790573511411e-04 +-7.5190575206635633e-04 +-7.4605877069167830e-04 +-7.4123263894208336e-04 +-7.3734004997909320e-04 +-7.3430966542634233e-04 +-7.3208530052561724e-04 +-7.3062531281315021e-04 +-7.2990216895892361e-04 +-2.0571951329458279e-03 +-2.0612606434149863e-03 +-2.0694192641449553e-03 +-2.0817243566010491e-03 +-2.0982452709534479e-03 +-2.1190374757646944e-03 +-2.1440730240302221e-03 +-2.1730936139190350e-03 +-2.2052933870315363e-03 +-2.2386758622641237e-03 +-2.2691403000137575e-03 +-2.2900678120637654e-03 +-2.2935237082194284e-03 +-2.2729790991784554e-03 +-2.2258097936513213e-03 +-2.1539600696041067e-03 +-2.0627579075240278e-03 +-1.9589847807137987e-03 +-1.8492277722931252e-03 +-1.7389288055330800e-03 +-1.6320680478886284e-03 +-1.5312443347402604e-03 +-1.4379332919838826e-03 +-1.3527824650071073e-03 +-1.2758740850882402e-03 +-1.2069318122141827e-03 +-1.1454712571294207e-03 +-1.0909034846543972e-03 +-1.0426027615704496e-03 +-9.9994869831525508e-04 +-9.6235083278029519e-04 +-9.2926159983322087e-04 +-9.0018188069631644e-04 +-8.7466199560670547e-04 +-8.5230004453110315e-04 +-8.3273883240799970e-04 +-8.1566216210805906e-04 +-8.0079097578850068e-04 +-7.8787962780838504e-04 +-7.7671244467162584e-04 +-7.6710064726160970e-04 +-7.5887966063458367e-04 +-7.5190680720677234e-04 +-7.4605936203826447e-04 +-7.4123294046766857e-04 +-7.3734018453535776e-04 +-7.3430971451122757e-04 +-7.3208531327436830e-04 +-7.3062531446463266e-04 +-7.2990216898484873e-04 +-2.0571887353218118e-03 +-2.0612541832550888e-03 +-2.0694124493836736e-03 +-2.0817164570341596e-03 +-2.0982349514860315e-03 +-2.1190227112225530e-03 +-2.1440512885843696e-03 +-2.1730631053729758e-03 +-2.2052566769692325e-03 +-2.2386455503805212e-03 +-2.2691409401666253e-03 +-2.2901276126031001e-03 +-2.2936597545448220e-03 +-2.2731883310630435e-03 +-2.2260719511051422e-03 +-2.1542477604480203e-03 +-2.0630459529767803e-03 +-1.9592550367514344e-03 +-1.8494698338854137e-03 +-1.7391385218420376e-03 +-1.6322454595717475e-03 +-1.5313918685690546e-03 +-1.4380544692221765e-03 +-1.3528810930747228e-03 +-1.2759538092559160e-03 +-1.2069959028913634e-03 +-1.1455225372473603e-03 +-1.0909443329768043e-03 +-1.0426351523956019e-03 +-9.9997425486507679e-04 +-9.6237088217119280e-04 +-9.2927722379523164e-04 +-9.0019395973165383e-04 +-8.7467124613502169e-04 +-8.5230704947204491e-04 +-8.3274406601985425e-04 +-8.1566600999649760e-04 +-8.0079375095508181e-04 +-7.8788158351115046e-04 +-7.7671378475262242e-04 +-7.6710153448559257e-04 +-7.5888022348116193e-04 +-7.5190714547371577e-04 +-7.4605955154042442e-04 +-7.4123303705797767e-04 +-7.3734022762470127e-04 +-7.3430973022572271e-04 +-7.3208531735566046e-04 +-7.3062531499495508e-04 +-7.2990216899886324e-04 +-2.0571877672834588e-03 +-2.0612532074714804e-03 +-2.0694114270365114e-03 +-2.0817152985169651e-03 +-2.0982335193836538e-03 +-2.1190208598933125e-03 +-2.1440489746230428e-03 +-2.1730606720168914e-03 +-2.2052554553599973e-03 +-2.2386485697640005e-03 +-2.2691527869223311e-03 +-2.2901526465571162e-03 +-2.2936996603090684e-03 +-2.2732410468884814e-03 +-2.2261326820417738e-03 +-2.1543109737403908e-03 +-2.0631069904651490e-03 +-1.9593108106726715e-03 +-1.8495187908927073e-03 +-1.7391802648314676e-03 +-1.6322803167590518e-03 +-1.5314205446833183e-03 +-1.4380778095086021e-03 +-1.3528999437781562e-03 +-1.2759689460966159e-03 +-1.2070080019897175e-03 +-1.1455321700146576e-03 +-1.0909519730844610e-03 +-1.0426411877989881e-03 +-9.9997900104185499e-04 +-9.6237459466504268e-04 +-9.2928010925486611e-04 +-9.0019618522370391e-04 +-8.7467294679890648e-04 +-8.5230833470958608e-04 +-8.3274502444897168e-04 +-8.1566671339279844e-04 +-8.0079425738054197e-04 +-7.8788193979928986e-04 +-7.7671402848960495e-04 +-7.6710169560028653e-04 +-7.5888032553419289e-04 +-7.5190720671690424e-04 +-7.4605958580236634e-04 +-7.4123305449936530e-04 +-7.3734023539680541e-04 +-7.3430973305796008e-04 +-7.3208531809165788e-04 +-7.3062531509292337e-04 +-7.2990216900932373e-04 +-2.0571877673321243e-03 +-2.0612532080976462e-03 +-2.0694114304698817e-03 +-2.0817153137031030e-03 +-2.0982335738852641e-03 +-2.1190210220439452e-03 +-2.1440493884928016e-03 +-2.1730616012714385e-03 +-2.2052573088220001e-03 +-2.2386518460356525e-03 +-2.2691578909763590e-03 +-2.2901596525329812e-03 +-2.2937082015035597e-03 +-2.2732504305912576e-03 +-2.2261421370709622e-03 +-2.1543198663481916e-03 +-2.0631149218631700e-03 +-1.9593176090040346e-03 +-1.8495244509938434e-03 +-1.7391848803166895e-03 +-1.6322840261896085e-03 +-1.5314234966068954e-03 +-1.4380801432491786e-03 +-1.3529017809137615e-03 +-1.2759703882375018e-03 +-1.2070091318056315e-03 +-1.1455330536486485e-03 +-1.0909526629289631e-03 +-1.0426417251314622e-03 +-9.9997941831394383e-04 +-9.6237491739443049e-04 +-9.2928035754230739e-04 +-9.0019637494650486e-04 +-8.7467309053857725e-04 +-8.5230844246758251e-04 +-8.3274510419681033e-04 +-8.1566677149446222e-04 +-8.0079429891737790e-04 +-7.8788196882102572e-04 +-7.7671404820973055e-04 +-7.6710170854974444e-04 +-7.5888033368395728e-04 +-7.5190721157737997e-04 +-7.4605958850551459e-04 +-7.4123305586789852e-04 +-7.3734023600361851e-04 +-7.3430973327810809e-04 +-7.3208531814858652e-04 +-7.3062531510027404e-04 +-7.2990216900943226e-04 +-2.0571887358405271e-03 +-2.0612541984010770e-03 +-2.0694125561014774e-03 +-2.0817168881774426e-03 +-2.0982362522129140e-03 +-2.1190259890597443e-03 +-2.1440585732163571e-03 +-2.1730777432034292e-03 +-2.2052834090288648e-03 +-2.2386896001764262e-03 +-2.2692058111903595e-03 +-2.2902126993321779e-03 +-2.2937597104683545e-03 +-2.2732948448035352e-03 +-2.2261765864229730e-03 +-2.1543441018377265e-03 +-2.0631303515751547e-03 +-1.9593262813786547e-03 +-1.8495283789381907e-03 +-1.7391857266578822e-03 +-1.6322830290543605e-03 +-1.5314215130672346e-03 +-1.4380777325030138e-03 +-1.3528992875532788e-03 +-1.2759680106619246e-03 +-1.2070069731082475e-03 +-1.1455311572429105e-03 +-1.0909510364710017e-03 +-1.0426403560716427e-03 +-9.9997828371984048e-04 +-9.6237398997170518e-04 +-9.2927960919215102e-04 +-9.0019577875971330e-04 +-8.7467262181900813e-04 +-8.5230807916786559e-04 +-8.3274482701073112e-04 +-8.1566656375903700e-04 +-8.0079414641931186e-04 +-7.8788185956407610e-04 +-7.7671397217582904e-04 +-7.6710165747105119e-04 +-7.5888030083372953e-04 +-7.5190719158117335e-04 +-7.4605957717094405e-04 +-7.4123305002882537e-04 +-7.3734023337409973e-04 +-7.3430973231099791e-04 +-7.3208531789476471e-04 +-7.3062531506450047e-04 +-7.2990216899973374e-04 +-2.0571951340649366e-03 +-2.0612607322563143e-03 +-2.0694199671444078e-03 +-2.0817271676671942e-03 +-2.0982533616098671e-03 +-2.1190566725332242e-03 +-2.1441130567804549e-03 +-2.1731692033309124e-03 +-2.2054236036673095e-03 +-2.2388792894333710e-03 +-2.2694258624922740e-03 +-2.2904267456057476e-03 +-2.2939297962851681e-03 +-2.2733977206790073e-03 +-2.2262092033642766e-03 +-2.1543184830196773e-03 +-2.0630648458305955e-03 +-1.9592387353254857e-03 +-1.8494327840463340e-03 +-1.7390915212306883e-03 +-1.6321957490542563e-03 +-1.5313438500606908e-03 +-1.4380105234048075e-03 +-1.3528422736133056e-03 +-1.2759203575399324e-03 +-1.2069675996576811e-03 +-1.1454989289598958e-03 +-1.0909248703412332e-03 +-1.0426192707051534e-03 +-9.9996141747379854e-04 +-9.6236060145697721e-04 +-9.2926906891385469e-04 +-9.0018755699037753e-04 +-8.7466627554206775e-04 +-8.5230323956356560e-04 +-8.3274118816635166e-04 +-8.1566387283642521e-04 +-8.0079219527734219e-04 +-7.8788047771343568e-04 +-7.7671302089668624e-04 +-7.6710102490958596e-04 +-7.5887989790242934e-04 +-7.5190694850151420e-04 +-7.4605944051811611e-04 +-7.4123298015638128e-04 +-7.3734020211738919e-04 +-7.3430972088515544e-04 +-7.3208531492163125e-04 +-7.3062531467707470e-04 +-7.2990216898747922e-04 +-2.0572136757931016e-03 +-2.0612796903180029e-03 +-2.0694417385382917e-03 +-2.0817581793671526e-03 +-2.0983062564841433e-03 +-2.1191526034598724e-03 +-2.1442833087897545e-03 +-2.1734524981656600e-03 +-2.2058511755978197e-03 +-2.2394446690212552e-03 +-2.2700594109814681e-03 +-2.2910085789227576e-03 +-2.2943424363089642e-03 +-2.2735769854606192e-03 +-2.2261579258597594e-03 +-2.1540863154228627e-03 +-2.0627182264878747e-03 +-1.9588387787879166e-03 +-1.8490253140296864e-03 +-1.7387058804014350e-03 +-1.6318477882814712e-03 +-1.5310399488484871e-03 +-1.4377511374178108e-03 +-1.3526245571503100e-03 +-1.2757399032938138e-03 +-1.2068194998491170e-03 +-1.1453783706604026e-03 +-1.0908274344343636e-03 +-1.0425410536264565e-03 +-9.9989905348715226e-04 +-9.6231123352168168e-04 +-9.2923029650484115e-04 +-9.0015737678803681e-04 +-8.7464302338132306e-04 +-8.5228553760793803e-04 +-8.3272789879913561e-04 +-8.1565405942109475e-04 +-8.0078508928956471e-04 +-7.8787545145854714e-04 +-7.7670956495894681e-04 +-7.6709872950146848e-04 +-7.5887843736584563e-04 +-7.5190606830105437e-04 +-7.4605894616822880e-04 +-7.4123272761005238e-04 +-7.3734008923157131e-04 +-7.3430967964838341e-04 +-7.3208530419956804e-04 +-7.3062531328682329e-04 +-7.2990216896476735e-04 +-2.0572420146233086e-03 +-2.0613089178317437e-03 +-2.0694774268330452e-03 +-2.0818153763944988e-03 +-2.0984144672416016e-03 +-2.1193607031149459e-03 +-2.1446621726365998e-03 +-2.1740867041286447e-03 +-2.2068029204051921e-03 +-2.2406860590883882e-03 +-2.2714201509046066e-03 +-2.2922117504077903e-03 +-2.2951262944891837e-03 +-2.2738078121339873e-03 +-2.2258564771015011e-03 +-2.1533780759308788e-03 +-2.0617632163424863e-03 +-1.9577810231599002e-03 +-1.8479708648871437e-03 +-1.7377211043929203e-03 +-1.6309670845914030e-03 +-1.5302755844013886e-03 +-1.4371017659739710e-03 +-1.3520814415102077e-03 +-1.2752909966695231e-03 +-1.2064519014207168e-03 +-1.1450796758186634e-03 +-1.0905863886137960e-03 +-1.0423477946348309e-03 +-9.9974512677161861e-04 +-9.6218949336832949e-04 +-9.2913475914605805e-04 +-9.0008306189022350e-04 +-8.7458580268153928e-04 +-8.5224199916853144e-04 +-8.3269522966531524e-04 +-8.1562994645163918e-04 +-8.0076763652124454e-04 +-7.8786311178875347e-04 +-7.7670108385299494e-04 +-7.6709309854946237e-04 +-7.5887485576131911e-04 +-7.5190391056252268e-04 +-7.4605773469486371e-04 +-7.4123210888929242e-04 +-7.3733981274040530e-04 +-7.3430957866971256e-04 +-7.3208527794951144e-04 +-7.3062530988629365e-04 +-7.2990216891823546e-04 +-2.0572330512116628e-03 +-2.0613014101889980e-03 +-2.0694820267655603e-03 +-2.0818612583744854e-03 +-2.0985587208994794e-03 +-2.1196966736617582e-03 +-2.1453213010533558e-03 +-2.1752171681821814e-03 +-2.2084980562993559e-03 +-2.2428644505860964e-03 +-2.2737453092195889e-03 +-2.2941714008899473e-03 +-2.2962556100060852e-03 +-2.2738865053119422e-03 +-2.2249478410627885e-03 +-2.1517328295476480e-03 +-2.0596893031093340e-03 +-1.9555511808800347e-03 +-1.8457833228792448e-03 +-1.7356977332561511e-03 +-1.6291688136212102e-03 +-1.5287214863484754e-03 +-1.4357854430575826e-03 +-1.3509829303397028e-03 +-1.2743845351061577e-03 +-1.2057105658687171e-03 +-1.1444778979688883e-03 +-1.0901011415573800e-03 +-1.0419589975055013e-03 +-9.9943562255451826e-04 +-9.6194481641763755e-04 +-9.2894281817778440e-04 +-8.9993380739330825e-04 +-8.7447091367924112e-04 +-8.5215460457800857e-04 +-8.3262966870964548e-04 +-8.1558156693305487e-04 +-8.0073262718318924e-04 +-7.8783836400945822e-04 +-7.7668407785834632e-04 +-7.6708180964707136e-04 +-7.5886767663654474e-04 +-7.5189958621330771e-04 +-7.4605530714177558e-04 +-7.4123086927015581e-04 +-7.3733925885427758e-04 +-7.3430937640404817e-04 +-7.3208522537427940e-04 +-7.3062530307748319e-04 +-7.2990216883036326e-04 +-2.0570060116980021e-03 +-2.0610760983606935e-03 +-2.0692759569883711e-03 +-2.0817235273240162e-03 +-2.0985849909434737e-03 +-2.1200397342796468e-03 +-2.1461856688393690e-03 +-2.1768113199133465e-03 +-2.2109133871141586e-03 +-2.2459040356038627e-03 +-2.2768385483547004e-03 +-2.2965260543196626e-03 +-2.2971969899562186e-03 +-2.2731351620335601e-03 +-2.2226581546600224e-03 +-2.1483358607556229e-03 +-2.0556908146119684e-03 +-1.9513904529643571e-03 +-1.8417746168527458e-03 +-1.7320298362743347e-03 +-1.6259312554587316e-03 +-1.5259361366087095e-03 +-1.4334334682095124e-03 +-1.3490243200413850e-03 +-1.2727707957442133e-03 +-1.2043922489056670e-03 +-1.1434086297994754e-03 +-1.0892394618733784e-03 +-1.0412689162948244e-03 +-9.9888648383115834e-04 +-9.6151082747807689e-04 +-9.2860245208167597e-04 +-8.9966919173024677e-04 +-8.7426726203492845e-04 +-8.5199971443860819e-04 +-8.3251349170059528e-04 +-8.1549584808354389e-04 +-8.0067060578543534e-04 +-7.8779452719596708e-04 +-7.7665395808205941e-04 +-7.6706181792630381e-04 +-7.5885496443649019e-04 +-7.5189192983944749e-04 +-7.4605100952906435e-04 +-7.4122867491625572e-04 +-7.3733827845428072e-04 +-7.3430901841104628e-04 +-7.3208513232608883e-04 +-7.3062529102868687e-04 +-7.2990216867832060e-04 +-2.0560405208120214e-03 +-2.0601111836552580e-03 +-2.0683355859416083e-03 +-2.0808779511450426e-03 +-2.0979701901369338e-03 +-2.1198645838265361e-03 +-2.1467069127321901e-03 +-2.1782445061456659e-03 +-2.2132621658394365e-03 +-2.2487710879771725e-03 +-2.2793896787681269e-03 +-2.2977420263829893e-03 +-2.2963017241897673e-03 +-2.2699028494899396e-03 +-2.2174180473358124e-03 +-2.1417484635558293e-03 +-2.0484824939512600e-03 +-1.9441730900049100e-03 +-1.8349744081253636e-03 +-1.7258922453471893e-03 +-1.6205606672283627e-03 +-1.5213418765832815e-03 +-1.4295687227165892e-03 +-1.3458142266577862e-03 +-1.2701306222542895e-03 +-1.2022380736344644e-03 +-1.1416629384117004e-03 +-1.0878335634598260e-03 +-1.0401435095040495e-03 +-9.9799123524015390e-04 +-9.6080348845820973e-04 +-9.2804781781617122e-04 +-8.9923806622611065e-04 +-8.7393550913374607e-04 +-8.5174742661470648e-04 +-8.3232428222682292e-04 +-8.1535625886153967e-04 +-8.0056961736601714e-04 +-7.8772315575395319e-04 +-7.7660492451503242e-04 +-7.6702927556733861e-04 +-7.5883427360858653e-04 +-7.5187946920232077e-04 +-7.4604401583385361e-04 +-7.4122510423202262e-04 +-7.3733668324624474e-04 +-7.3430843595609905e-04 +-7.3208498094400119e-04 +-7.3062527142765058e-04 +-7.2990216843346557e-04 +-2.0529831542696044e-03 +-2.0570490470207797e-03 +-2.0652910456528781e-03 +-2.0779262142119059e-03 +-2.0952572444202402e-03 +-2.1176017464012912e-03 +-2.1451158491046403e-03 +-2.1774278955273376e-03 +-2.2130163295669483e-03 +-2.2484480753513628e-03 +-2.2779752429208386e-03 +-2.2942049064219442e-03 +-2.2900297300812991e-03 +-2.2609404405396173e-03 +-2.2063865887687393e-03 +-2.1295636653412523e-03 +-2.0360611163301621e-03 +-1.9322466686712116e-03 +-1.8240253066293571e-03 +-1.7161724431044706e-03 +-1.6121469136270879e-03 +-1.5141956468799434e-03 +-1.4235859757091485e-03 +-1.3408609858050018e-03 +-1.2660657698237577e-03 +-1.1989264931172446e-03 +-1.1389821184471613e-03 +-1.0856761245612309e-03 +-1.0384173831954632e-03 +-9.9661861978579919e-04 +-9.5971926734734819e-04 +-9.2719783470718428e-04 +-8.9857746554352009e-04 +-8.7342724063195747e-04 +-8.5136094869603612e-04 +-8.3203446457069457e-04 +-8.1514246803789483e-04 +-8.0041496219455412e-04 +-7.8761386762850772e-04 +-7.7652984914494813e-04 +-7.6697945500549551e-04 +-7.5880260028117095e-04 +-7.5186039643837456e-04 +-7.4603331198801930e-04 +-7.4121963976970758e-04 +-7.3733424217604568e-04 +-7.3430754471102088e-04 +-7.3208474931820864e-04 +-7.3062524143826548e-04 +-7.2990216806071383e-04 +-2.0445767988093600e-03 +-2.0486232262656836e-03 +-2.0568444046755044e-03 +-2.0694915118759784e-03 +-2.0869069413415723e-03 +-2.1094249623177424e-03 +-2.1371435389046746e-03 +-2.1695013918377648e-03 +-2.2046527094512288e-03 +-2.2388269490119118e-03 +-2.2661560969294814e-03 +-2.2795182940526875e-03 +-2.2724072007008636e-03 +-2.2409735910104136e-03 +-2.1851133261798512e-03 +-2.1081444485108324e-03 +-2.0155104773680135e-03 +-1.9132928814455576e-03 +-1.8070871253719927e-03 +-1.7014065010941112e-03 +-1.5995212994425832e-03 +-1.5035613666753039e-03 +-1.4147336813952925e-03 +-1.3335604657186810e-03 +-1.2600905549739027e-03 +-1.1940674117769431e-03 +-1.1350534389386899e-03 +-1.0825171355143125e-03 +-1.0358914106030558e-03 +-9.9461077899553902e-04 +-9.5813373840425691e-04 +-9.2595510715537128e-04 +-8.9761178210131978e-04 +-8.7268433898655148e-04 +-8.5079612669119683e-04 +-8.3161095498706457e-04 +-8.1483009084488489e-04 +-8.0018901565782343e-04 +-7.8745421948953889e-04 +-7.7642019204235185e-04 +-7.6690669452069164e-04 +-7.5875634850241873e-04 +-7.5183254822679222e-04 +-7.4601768501789806e-04 +-7.4121166281356724e-04 +-7.3733067906178967e-04 +-7.3430624390549357e-04 +-7.3208441127278930e-04 +-7.3062519767272069e-04 +-7.2990216751822590e-04 +-2.0242433861230986e-03 +-2.0282401953167469e-03 +-2.0363542987383537e-03 +-2.0488196172157949e-03 +-2.0659447395885186e-03 +-2.0879958534927058e-03 +-2.1149431125370628e-03 +-2.1460297400674889e-03 +-2.1792053061604555e-03 +-2.2106382753544836e-03 +-2.2347166305490152e-03 +-2.2449172334529583e-03 +-2.2354646561721756e-03 +-2.2030589559600021e-03 +-2.1477728470378934e-03 +-2.0727490006089803e-03 +-1.9830519459726886e-03 +-1.8843372122250082e-03 +-1.7818291376017344e-03 +-1.6797668107622155e-03 +-1.5812453879299655e-03 +-1.4883014895824753e-03 +-1.4021081867545552e-03 +-1.3231922975792932e-03 +-1.2516294569782447e-03 +-1.1872006536472240e-03 +-1.1295091381237890e-03 +-1.0780632093925898e-03 +-1.0323322357851349e-03 +-9.9178288091358196e-04 +-9.5590129672671210e-04 +-9.2420570443436131e-04 +-8.9625259786802467e-04 +-8.7163885774826911e-04 +-8.5000135400062674e-04 +-8.3101509840374517e-04 +-8.1439064712494761e-04 +-7.9987120230242108e-04 +-7.8722969194624322e-04 +-7.7626599392748117e-04 +-7.6680439524370392e-04 +-7.5869132961463542e-04 +-7.5179340618443792e-04 +-7.4599572368621973e-04 +-7.4120045390850477e-04 +-7.3732567291055035e-04 +-7.3430441646775836e-04 +-7.3208393640738839e-04 +-7.3062513619733807e-04 +-7.2990216675742270e-04 +-1.9821987889389568e-03 +-1.9860977482199288e-03 +-1.9939767469601419e-03 +-2.0059908717896249e-03 +-2.0223314444066556e-03 +-2.0431143454838533e-03 +-2.0681455290721164e-03 +-2.0965418526828839e-03 +-2.1262673562224654e-03 +-2.1537812835894302e-03 +-2.1741114263771418e-03 +-2.1816070961579934e-03 +-2.1712847411661600e-03 +-2.1402313234700297e-03 +-2.0883859977755678e-03 +-2.0183709941570204e-03 +-1.9345870038885325e-03 +-1.8420825241036961e-03 +-1.7456288299587432e-03 +-1.6491790498411672e-03 +-1.5556803379063995e-03 +-1.4671191455144538e-03 +-1.3846803239591003e-03 +-1.3089373832431807e-03 +-1.2400291126427867e-03 +-1.1778044510964134e-03 +-1.1219325756515815e-03 +-1.0719821141745446e-03 +-1.0274756488071110e-03 +-9.8792565204326331e-04 +-9.5285706721399575e-04 +-9.2182060495607846e-04 +-8.9439977928676537e-04 +-8.7021385194095311e-04 +-8.4891819999582941e-04 +-8.3020314197720555e-04 +-8.1379191509524569e-04 +-7.9943825671403043e-04 +-7.8692387843934180e-04 +-7.7605600959937740e-04 +-7.6666511239453718e-04 +-7.5860282206610219e-04 +-7.5174013398659979e-04 +-7.4596583992973548e-04 +-7.4118520409477580e-04 +-7.3731886305386399e-04 +-7.3430193093601049e-04 +-7.3208329060143128e-04 +-7.3062505259857181e-04 +-7.2990216572385970e-04 +-1.9091949485594997e-03 +-1.9129347930161797e-03 +-1.9204384590638416e-03 +-1.9317481701008083e-03 +-1.9468945676381279e-03 +-1.9658095735022901e-03 +-1.9881457573789371e-03 +-2.0129895527214096e-03 +-2.0385193928697757e-03 +-2.0617560376293897e-03 +-2.0786259493977112e-03 +-2.0845124815348439e-03 +-2.0752468194473201e-03 +-2.0481919757567818e-03 +-2.0029399982129685e-03 +-1.9413253355669647e-03 +-1.8668241569862211e-03 +-1.7836753892744085e-03 +-1.6960759783382110e-03 +-1.6076469645870347e-03 +-1.5211945209938269e-03 +-1.4386913705966334e-03 +-1.3613820576388385e-03 +-1.2899353824816406e-03 +-1.2245973524147023e-03 +-1.1653225816530561e-03 +-1.1118775087745007e-03 +-1.0639167201782704e-03 +-1.0210368289007474e-03 +-9.8281298623105928e-04 +-9.4882260286249071e-04 +-9.1865998571256555e-04 +-8.9194471351888719e-04 +-8.6832581820907740e-04 +-8.4748324323027436e-04 +-8.2912760282236270e-04 +-8.1299894102005766e-04 +-7.9886495790708150e-04 +-7.8651900897296284e-04 +-7.7577807200661581e-04 +-7.6648080020776674e-04 +-7.5848572942006562e-04 +-7.5166967394311459e-04 +-7.4592632384951085e-04 +-7.4116504336303561e-04 +-7.3730986201310002e-04 +-7.3429864620358932e-04 +-7.3208243725716255e-04 +-7.3062494214476967e-04 +-7.2990216435914581e-04 +-1.8021143507177795e-03 +-1.8056329689330377e-03 +-1.8126415408395691e-03 +-1.8230787732334977e-03 +-1.8368308852946898e-03 +-1.8536742740945136e-03 +-1.8731571427666154e-03 +-1.8944115141923104e-03 +-1.9159274084960644e-03 +-1.9353816995739805e-03 +-1.9496627042005033e-03 +-1.9552117706133788e-03 +-1.9486781720821379e-03 +-1.9276977715809219e-03 +-1.8914883204903155e-03 +-1.8410149476153455e-03 +-1.7786895083008725e-03 +-1.7077756869168894e-03 +-1.6317485879379851e-03 +-1.5537965993564461e-03 +-1.4765368228583315e-03 +-1.4019222887893138e-03 +-1.3312779122635629e-03 +-1.2654014867732510e-03 +-1.2046836638509180e-03 +-1.1492206309810320e-03 +-1.0989080597777338e-03 +-1.0535138286717825e-03 +-1.0127314232814294e-03 +-9.7621753067826070e-04 +-9.4361750688977820e-04 +-9.1458193622716126e-04 +-8.8877685784815414e-04 +-8.6588961394909447e-04 +-8.4563175158241047e-04 +-8.2774000098040964e-04 +-8.1197604631795192e-04 +-7.9812558094887365e-04 +-7.8599697906017989e-04 +-7.7541980296961448e-04 +-7.6624328696412792e-04 +-7.5833488483770944e-04 +-7.5157893194020928e-04 +-7.4587544839926630e-04 +-7.4113909453662834e-04 +-7.3729827974718706e-04 +-7.3429442042748246e-04 +-7.3208133962636597e-04 +-7.3062480008851273e-04 +-7.2990216260478179e-04 +-1.6665407673247866e-03 +-1.6697889909309679e-03 +-1.6762229435581110e-03 +-1.6857151405411676e-03 +-1.6980614340194925e-03 +-1.7129480079143211e-03 +-1.7298834943107206e-03 +-1.7480903726998223e-03 +-1.7663714610529776e-03 +-1.7830012885644605e-03 +-1.7957228928216537e-03 +-1.8019289805579445e-03 +-1.7990482238209088e-03 +-1.7850543768634874e-03 +-1.7589270854277508e-03 +-1.7208880505557537e-03 +-1.6723301679634464e-03 +-1.6154906734886206e-03 +-1.5530083465732068e-03 +-1.4875103090380747e-03 +-1.4213184806887930e-03 +-1.3562976821588537e-03 +-1.2938208272243999e-03 +-1.2348093055188328e-03 +-1.1798097014002102e-03 +-1.1290794883982813e-03 +-1.0826661908340713e-03 +-1.0404733114707759e-03 +-1.0023116673752274e-03 +-9.6793745879989325e-04 +-9.3707940861459523e-04 +-9.0945742727514931e-04 +-8.8479497463385686e-04 +-8.6282687885993017e-04 +-8.4330396684296485e-04 +-8.2599551260682216e-04 +-8.1069023324683914e-04 +-7.9719635077917840e-04 +-7.8534108194188584e-04 +-7.7496980452599013e-04 +-7.6594506774237006e-04 +-7.5814555696370519e-04 +-7.5146508338755586e-04 +-7.4581164186097591e-04 +-7.4110656170945266e-04 +-7.3728376331821802e-04 +-7.3428912556037899e-04 +-7.3207996459734553e-04 +-7.3062462215775395e-04 +-7.2990216040811837e-04 +-1.5143502250187161e-03 +-1.5173009307892968e-03 +-1.5231265908678588e-03 +-1.5316741789885022e-03 +-1.5427070364734932e-03 +-1.5558876163776409e-03 +-1.5707424029689921e-03 +-1.5866054957337037e-03 +-1.6025475576265922e-03 +-1.6173137954567319e-03 +-1.6293121959552619e-03 +-1.6366981343973208e-03 +-1.6375797711929343e-03 +-1.6303192826681405e-03 +-1.6138496254945592e-03 +-1.5879009368415086e-03 +-1.5530574073077479e-03 +-1.5106321993558275e-03 +-1.4624152999193529e-03 +-1.4103817127751634e-03 +-1.3564374850565306e-03 +-1.3022462353178017e-03 +-1.2491426698436202e-03 +-1.1981163175341081e-03 +-1.1498405336754617e-03 +-1.1047239213756146e-03 +-1.0629677714868691e-03 +-1.0246198527377294e-03 +-9.8962006200102896e-04 +-9.5783674286061189e-04 +-9.2909425331365802e-04 +-9.0319312087685263e-04 +-8.7992429774265814e-04 +-8.5907891547814933e-04 +-8.4045471395341660e-04 +-8.2386007545091303e-04 +-8.0911637445549940e-04 +-7.9605917106932136e-04 +-7.8453863240140163e-04 +-7.7441945702628047e-04 +-7.6558049637784884e-04 +-7.5791420760293164e-04 +-7.5132602967387639e-04 +-7.4573374421392882e-04 +-7.4106686124773130e-04 +-7.3726605546701551e-04 +-7.3428266875492248e-04 +-7.3207828826152104e-04 +-7.3062440527693682e-04 +-7.2990215773133683e-04 +-1.3589558709687873e-03 +-1.3616057517409734e-03 +-1.3668312916437682e-03 +-1.3744830987989210e-03 +-1.3843332413632919e-03 +-1.3960667438495551e-03 +-1.4092647898142770e-03 +-1.4233778492443729e-03 +-1.4376913354827152e-03 +-1.4512941042556461e-03 +-1.4630690582634618e-03 +-1.4717300007704181e-03 +-1.4759228588845290e-03 +-1.4743891621759482e-03 +-1.4661609386778106e-03 +-1.4507337695554027e-03 +-1.4281638009157232e-03 +-1.3990586627745446e-03 +-1.3644693696061546e-03 +-1.3257209529450567e-03 +-1.2842306147880706e-03 +-1.2413535112760603e-03 +-1.1982773264391463e-03 +-1.1559682521777091e-03 +-1.1151590192812720e-03 +-1.0763651086905782e-03 +-1.0399160285844253e-03 +-1.0059917720632422e-03 +-9.7465820771606504e-04 +-9.4589815011840114e-04 +-9.1963691234053975e-04 +-8.9576235624801799e-04 +-8.7414005997521037e-04 +-8.5462444164021171e-04 +-8.3706668542521412e-04 +-8.2132022265598865e-04 +-8.0724439205883812e-04 +-7.9470677428519288e-04 +-7.8358458151127016e-04 +-7.7376538846897437e-04 +-7.6514741647075544e-04 +-7.5763952446742874e-04 +-7.5116101787320690e-04 +-7.4564135384158506e-04 +-7.4101979830442689e-04 +-7.3724507327820575e-04 +-7.3427502102774178e-04 +-7.3207630335134666e-04 +-7.3062414852890416e-04 +-7.2990215456325341e-04 +-1.2115492324827793e-03 +-1.2139148007319482e-03 +-1.2185808985753180e-03 +-1.2254168306765809e-03 +-1.2342244237479468e-03 +-1.2447339208218442e-03 +-1.2565963231085269e-03 +-1.2693714493340366e-03 +-1.2825127570188527e-03 +-1.2953532312266474e-03 +-1.3071007944215273e-03 +-1.3168548086146033e-03 +-1.3236544056736133e-03 +-1.3265622690236544e-03 +-1.3247747457295386e-03 +-1.3177356638200538e-03 +-1.3052242346832364e-03 +-1.2873920138693614e-03 +-1.2647389768905596e-03 +-1.2380372972253060e-03 +-1.2082249505859701e-03 +-1.1762950790111032e-03 +-1.1432019439658017e-03 +-1.1097947017558478e-03 +-1.0767808595739618e-03 +-1.0447149158861098e-03 +-1.0140049106505569e-03 +-9.8492955654285309e-04 +-9.5766003538330700e-04 +-9.3228239229871575e-04 +-9.0881813535435450e-04 +-8.8724190721534699e-04 +-8.6749591950502337e-04 +-8.4950131268724752e-04 +-8.3316683071218186e-04 +-8.1839527310300741e-04 +-8.0508817568105025e-04 +-7.9314911925716040e-04 +-7.8248599985127510e-04 +-7.7301252861886592e-04 +-7.6464917135681063e-04 +-7.5732368859132433e-04 +-7.5097139789266371e-04 +-7.4553524923680478e-04 +-7.4096578059288927e-04 +-7.3722100307533971e-04 +-7.3426625172012968e-04 +-7.3207402815832299e-04 +-7.3062385430616218e-04 +-7.2990215093357059e-04 +-1.0795738980405366e-03 +-1.0816850256075675e-03 +-1.0858537628638421e-03 +-1.0919726527790971e-03 +-1.0998792584785070e-03 +-1.1093541385558603e-03 +-1.1201174206918437e-03 +-1.1318237748722010e-03 +-1.1440562865356510e-03 +-1.1563210466722666e-03 +-1.1680460658238243e-03 +-1.1785897450574678e-03 +-1.1872644717188165e-03 +-1.1933787721206616e-03 +-1.1962964720053477e-03 +-1.1955047025997191e-03 +-1.1906770903467537e-03 +-1.1817170719791883e-03 +-1.1687703390101225e-03 +-1.1522035741039186e-03 +-1.1325554819392402e-03 +-1.1104721519380099e-03 +-1.0866402822796069e-03 +-1.0617292520109902e-03 +-1.0363483747479825e-03 +-1.0110209639866098e-03 +-9.8617340756589479e-04 +-9.6213567672277951e-04 +-9.3914931709484953e-04 +-9.1737945835023717e-04 +-8.9692823823390565e-04 +-8.7784792451062351e-04 +-8.6015275883192881e-04 +-8.4382908498987304e-04 +-8.2884367332654687e-04 +-8.1515035401143827e-04 +-8.0269516928869274e-04 +-7.9142028660090862e-04 +-7.8126690873891980e-04 +-7.7217739264615472e-04 +-7.6409675683230855e-04 +-7.5697372511717548e-04 +-7.5076142496796649e-04 +-7.4541783338260181e-04 +-7.4090604237415220e-04 +-7.3719439932370576e-04 +-7.3425656424802458e-04 +-7.3207151575021591e-04 +-7.3062352949753969e-04 +-7.2990214692738979e-04 +-9.6691646889574922e-04 +-9.6881016584244694e-04 +-9.7255491873301494e-04 +-9.7806514858260647e-04 +-9.8521169903747173e-04 +-9.9382077382697913e-04 +-1.0036723737716217e-03 +-1.0144982566251226e-03 +-1.0259797211593193e-03 +-1.0377460367829315e-03 +-1.0493750763674297e-03 +-1.0603984638982843e-03 +-1.0703139151505060e-03 +-1.0786069202303669e-03 +-1.0847821503595578e-03 +-1.0884021344789319e-03 +-1.0891276886106679e-03 +-1.0867525800162708e-03 +-1.0812250709263643e-03 +-1.0726515589058949e-03 +-1.0612816681712775e-03 +-1.0474783204009227e-03 +-1.0316790986848298e-03 +-1.0143559356451341e-03 +-9.9597902480120723e-04 +-9.7698867171802542e-04 +-9.5777646368570900e-04 +-9.3867527826299612e-04 +-9.1995653079885104e-04 +-9.0183263602566072e-04 +-8.8446273057511335e-04 +-8.6796004577208499e-04 +-8.5239975243750325e-04 +-8.3782650823187213e-04 +-8.2426126937261077e-04 +-8.1170716901389625e-04 +-8.0015442297510782e-04 +-7.8958431743624327e-04 +-7.7997238123620805e-04 +-7.7129086334884976e-04 +-7.6351063596226930e-04 +-7.5660263369981809e-04 +-7.5053892530302108e-04 +-7.4529349880601142e-04 +-7.4084282666681239e-04 +-7.3716626434002159e-04 +-7.3424632467689770e-04 +-7.3206886128901656e-04 +-7.3062318642598350e-04 +-7.2990214269680819e-04 +-8.7486167854610374e-04 +-8.7657743436195224e-04 +-8.7997528017900615e-04 +-8.8498766976311774e-04 +-8.9151275459393292e-04 +-8.9941377191731821e-04 +-9.0851828159512946e-04 +-9.1861734474947153e-04 +-9.2946485372385286e-04 +-9.4077742899333723e-04 +-9.5223559401439145e-04 +-9.6348726417351299e-04 +-9.7415480202827840e-04 +-9.8384679788180969e-04 +-9.9217514903530415e-04 +-9.9877689021479776e-04 +-1.0033387771758843e-03 +-1.0056213000295881e-03 +-1.0054781500321184e-03 +-1.0028675619065115e-03 +-9.9785339198600544e-04 +-9.9059583870156906e-04 +-9.8133370490388790e-04 +-9.7036145031347053e-04 +-9.5800469963688926e-04 +-9.4459742862644676e-04 +-9.3046306460363990e-04 +-9.1590059455639379e-04 +-9.0117577746238466e-04 +-8.8651686773128619e-04 +-8.7211389868475345e-04 +-8.5812048825576533e-04 +-8.4465722026210886e-04 +-8.3181583503607953e-04 +-8.1966366691041544e-04 +-8.0824795310875197e-04 +-7.9759979041424303e-04 +-7.8773762840093681e-04 +-7.7867026474748822e-04 +-7.7039935625437133e-04 +-7.6292148617961150e-04 +-7.5622984101341069e-04 +-7.5031555303121467e-04 +-7.4516876268329113e-04 +-7.4077944968401908e-04 +-7.3713807521579348e-04 +-7.3423607096591271e-04 +-7.3206620431265042e-04 +-7.3062284313306618e-04 +-7.2990213846429606e-04 +-8.0313913433223926e-04 +-8.0471606075825219e-04 +-8.0784303726666570e-04 +-8.1246615203864607e-04 +-8.1850416090796930e-04 +-8.2584809556373196e-04 +-8.3436084369316928e-04 +-8.4387680144693672e-04 +-8.5420175234309848e-04 +-8.6511321145326791e-04 +-8.7636159194893419e-04 +-8.8767268559762364e-04 +-8.9875205302591434e-04 +-9.0929191870086192e-04 +-9.1898097700329414e-04 +-9.2751708978407589e-04 +-9.3462222272509517e-04 +-9.4005826352285297e-04 +-9.4364180715943342e-04 +-9.4525580449329825e-04 +-9.4485627587563646e-04 +-9.4247305106864116e-04 +-9.3820450833092259e-04 +-9.3220726562720144e-04 +-9.2468247343710877e-04 +-9.1586063819418283e-04 +-9.0598677816419910e-04 +-8.9530729793464942e-04 +-8.8405942493338522e-04 +-8.7246352572972210e-04 +-8.6071820436155340e-04 +-8.4899781586545591e-04 +-8.3745189816673002e-04 +-8.2620600304256111e-04 +-8.1536345366634694e-04 +-8.0500763810299389e-04 +-7.9520453989941173e-04 +-7.8600529298859789e-04 +-7.7744862068786496e-04 +-7.6956307520462358e-04 +-7.6236903551902624e-04 +-7.5588045007352815e-04 +-7.5010632910036236e-04 +-7.4505200225988505e-04 +-7.4072016274649060e-04 +-7.3711172086576783e-04 +-7.3422648958131628e-04 +-7.3206372257359961e-04 +-7.3062252257380541e-04 +-7.2990213451277239e-04 +-7.5076453235973671e-04 +-7.5224001058042265e-04 +-7.5516884082878753e-04 +-7.5950664801942649e-04 +-7.6518658517829672e-04 +-7.7211905430658542e-04 +-7.8019143670279292e-04 +-7.8926792146177078e-04 +-7.9918954930928660e-04 +-8.0977462673514043e-04 +-8.2081971420378561e-04 +-8.3210144714507479e-04 +-8.4337949393802135e-04 +-8.5440096377209453e-04 +-8.6490651450460464e-04 +-8.7463824711793913e-04 +-8.8334920289729268e-04 +-8.9081393452531917e-04 +-8.9683927735598407e-04 +-9.0127420201831731e-04 +-9.0401757555175395e-04 +-9.0502284055416274e-04 +-9.0429901602930062e-04 +-9.0190794057538415e-04 +-8.9795819508393427e-04 +-8.9259654361983248e-04 +-8.8599794651588370e-04 +-8.7835521547273171e-04 +-8.6986923276448065e-04 +-8.6074040951126390e-04 +-8.5116177919036633e-04 +-8.4131386620116353e-04 +-8.3136126794773667e-04 +-8.2145075423869325e-04 +-8.1171061605432484e-04 +-8.0225097444816345e-04 +-7.9316477418975751e-04 +-7.8452922133786260e-04 +-7.7640746777774775e-04 +-7.6885039081646801e-04 +-7.6189835726529699e-04 +-7.5558289654668138e-04 +-7.4992823542809669e-04 +-7.4495266823860909e-04 +-7.4066975165866284e-04 +-7.3708932340283133e-04 +-7.3421835037841532e-04 +-7.3206161513484041e-04 +-7.3062225042973316e-04 +-7.2990213115852961e-04 +-7.1661630360168600e-04 +-7.1802569705994217e-04 +-7.2082533250142030e-04 +-7.2497680608172687e-04 +-7.3042228015680302e-04 +-7.3708426126257672e-04 +-7.4486539590872382e-04 +-7.5364836026363001e-04 +-7.6329593779336823e-04 +-7.7365139865846365e-04 +-7.8453931697119853e-04 +-7.9576698547007343e-04 +-8.0712660643203797e-04 +-8.1839844235995739e-04 +-8.2935508554422106e-04 +-8.3976693670543428e-04 +-8.4940885992900827e-04 +-8.5806780747983854e-04 +-8.6555100576004554e-04 +-8.7169410253489248e-04 +-8.7636854512688220e-04 +-8.7948743402209797e-04 +-8.8100919963627147e-04 +-8.8093867367404607e-04 +-8.7932543081279714e-04 +-8.7625960099361219e-04 +-8.7186563412138408e-04 +-8.6629468868876735e-04 +-8.5971639048450026e-04 +-8.5231067127073366e-04 +-8.4426027551624165e-04 +-8.3574435220452490e-04 +-8.2693336495652222e-04 +-8.1798538645168849e-04 +-8.0904371068166343e-04 +-8.0023562624692481e-04 +-7.9167214436130123e-04 +-7.8344845967155306e-04 +-7.7564493125186168e-04 +-7.6832839595964201e-04 +-7.6155365884111783e-04 +-7.5536503951674234e-04 +-7.4979788551855439e-04 +-7.4487999117268705e-04 +-7.4063288290285528e-04 +-7.3707294873207388e-04 +-7.3421240176718488e-04 +-7.3206007529455811e-04 +-7.3062205161884255e-04 +-7.2990212870841517e-04 +-6.9978945542011181e-04 +-7.0116649672639746e-04 +-7.0390285445882266e-04 +-7.0796298755488880e-04 +-7.1329337497491271e-04 +-7.1982231627995411e-04 +-7.2745975022026749e-04 +-7.3609716031503383e-04 +-7.4560765061073675e-04 +-7.5584628843648239e-04 +-7.6665082442107927e-04 +-7.7784291277272865e-04 +-7.8922996449607222e-04 +-8.0060776788623122e-04 +-8.1176399663300200e-04 +-8.2248268691173781e-04 +-8.3254969267758361e-04 +-8.4175901978019265e-04 +-8.4991980050837560e-04 +-8.5686351878600442e-04 +-8.6245096165885710e-04 +-8.6657828974496880e-04 +-8.6918161881121561e-04 +-8.7023960273177028e-04 +-8.6977369850989902e-04 +-8.6784604710367559e-04 +-8.6455517316410125e-04 +-8.6002994205131673e-04 +-8.5442237272307438e-04 +-8.4789996875048396e-04 +-8.4063819775235832e-04 +-8.3281364173288651e-04 +-8.2459818770742638e-04 +-8.1615446188140436e-04 +-8.0763255828959128e-04 +-7.9916799161036613e-04 +-7.9088072127622439e-04 +-7.8287504924523391e-04 +-7.7524018077214385e-04 +-7.6805124766851738e-04 +-7.6137061811991315e-04 +-7.5524934862280613e-04 +-7.4972866636628340e-04 +-7.4484140069843330e-04 +-7.4061330813494973e-04 +-7.3706425588760793e-04 +-7.3420924415970189e-04 +-7.3205925800018032e-04 +-7.3062194610383512e-04 +-7.2990212740810679e-04 +-6.9978952011407272e-04 +-7.0116707971075659e-04 +-7.0390447760543306e-04 +-7.0796617817210368e-04 +-7.1329866422945867e-04 +-7.1983023255530235e-04 +-7.2747080598368986e-04 +-7.3611183148386821e-04 +-7.4562634813141171e-04 +-7.5586932287311848e-04 +-7.6667836577518599e-04 +-7.7787494938772687e-04 +-7.8926626646699664e-04 +-8.0064786149710004e-04 +-8.1180715652697780e-04 +-8.2252795157900524e-04 +-8.3259590627018866e-04 +-8.4180489944631943e-04 +-8.4996402400845130e-04 +-8.5690482305493120e-04 +-8.6248824023676669e-04 +-8.6661067640188413e-04 +-8.6920854651766858e-04 +-8.7026083102728191e-04 +-8.6978930740683105e-04 +-8.6785640078309082e-04 +-8.6456086080046498e-04 +-8.6003170543881395e-04 +-8.5442103076667584e-04 +-8.4789634759686611e-04 +-8.4063307294286369e-04 +-8.3280769593386530e-04 +-8.2459198490062498e-04 +-8.1614843677619664e-04 +-8.0762701832925803e-04 +-7.9916312828050588e-04 +-7.9087662735704113e-04 +-7.8287173899827271e-04 +-7.7523761063165160e-04 +-7.6804933566472792e-04 +-7.6136926088783306e-04 +-7.5524843538193908e-04 +-7.4972808966748585e-04 +-7.4484106402307698e-04 +-7.4061313061379429e-04 +-7.3706417450461882e-04 +-7.3420921384344294e-04 +-7.3205925000446870e-04 +-7.3062194505859278e-04 +-7.2990212739515708e-04 +-7.1661650779505188e-04 +-7.1802753712788968e-04 +-7.2083045553465589e-04 +-7.2498687585323125e-04 +-7.3043897115726119e-04 +-7.3710923589506423e-04 +-7.4490026015118895e-04 +-7.5369459459095965e-04 +-7.6335480270662756e-04 +-7.7372381797504071e-04 +-7.8462574698125729e-04 +-7.9586728362753402e-04 +-8.0723991838398958e-04 +-8.1852312936610044e-04 +-8.2948871411133633e-04 +-8.3990634735153422e-04 +-8.4955032214933674e-04 +-8.5820725436019138e-04 +-8.6568432684443729e-04 +-8.7181746097597483e-04 +-8.7647867820495257e-04 +-8.7958189696503474e-04 +-8.8108652143671358e-04 +-8.8099840827091233e-04 +-8.7936810407092739e-04 +-8.7628656949290974e-04 +-8.7187888274882280e-04 +-8.6629659884100328e-04 +-8.5970950945523197e-04 +-8.5229750755093424e-04 +-8.4424313636617687e-04 +-8.3572523104080763e-04 +-8.2691387842956095e-04 +-8.1796675547864551e-04 +-8.0902677640311098e-04 +-8.0022089066357060e-04 +-7.9165982578310325e-04 +-7.8343855449870240e-04 +-7.7563727548129134e-04 +-7.6832272176858218e-04 +-7.6154964337631992e-04 +-7.5536234447459716e-04 +-7.4979618719307425e-04 +-7.4487900139395033e-04 +-7.4063236174173842e-04 +-7.3707271007563964e-04 +-7.3421231294078118e-04 +-7.3206005188189752e-04 +-7.3062204855944704e-04 +-7.2990212867048154e-04 +-7.5076490807232546e-04 +-7.5224339625833776e-04 +-7.5517826674258539e-04 +-7.5952517333458111e-04 +-7.6521728327051599e-04 +-7.7216496386188699e-04 +-7.8025546930566864e-04 +-7.8935271976281933e-04 +-7.9929729566622916e-04 +-8.0990681075713211e-04 +-8.2097687848994275e-04 +-8.3228294222179901e-04 +-8.4358328332157959e-04 +-8.5462352473197401e-04 +-8.6514287606412723e-04 +-8.7488219210044287e-04 +-8.8359363616763215e-04 +-8.9105138917457095e-04 +-8.9706250145160703e-04 +-9.0147674858682557e-04 +-9.0419431374079667e-04 +-9.0517031835873950e-04 +-9.0441563151325824e-04 +-9.0199391222140260e-04 +-8.9801535437469924e-04 +-8.9262799711058768e-04 +-8.8600766663551119e-04 +-8.7834761891967910e-04 +-8.6984879539159807e-04 +-8.6071135121738472e-04 +-8.5112783574843359e-04 +-8.4127815034667781e-04 +-8.3132621122936350e-04 +-8.2141811460101409e-04 +-8.1168153345776513e-04 +-8.0222605711292394e-04 +-7.9314420022553490e-04 +-7.8451284364171878e-04 +-7.7639491342436720e-04 +-7.6884114925253083e-04 +-7.6189185419614817e-04 +-7.5557855237795405e-04 +-7.4992550851596179e-04 +-7.4495108408985052e-04 +-7.4066891971179055e-04 +-7.3708894322261167e-04 +-7.3421820910678866e-04 +-7.3206157794304758e-04 +-7.3062224557360366e-04 +-7.2990213109836474e-04 +-8.0313974055178040e-04 +-8.0472152357079565e-04 +-8.0785824518934003e-04 +-8.1249603566777983e-04 +-8.1855365987219049e-04 +-8.2592206217911156e-04 +-8.3446386678791458e-04 +-8.4401294114052640e-04 +-8.5437418897722100e-04 +-8.6532382979228641e-04 +-8.7661054379576026e-04 +-8.8795799619472468e-04 +-8.9906935261946537e-04 +-9.0963438277851286e-04 +-9.1933954068543070e-04 +-9.2788096208140138e-04 +-9.3497967056937819e-04 +-9.4039757660160288e-04 +-9.4395230940279599e-04 +-9.4552876108250133e-04 +-9.4508556216494027e-04 +-9.4265549710132411e-04 +-9.3833989577194333e-04 +-9.3229801540256759e-04 +-9.2473310743569268e-04 +-9.1587711946885186e-04 +-9.0597583157962965e-04 +-8.9527579342610906e-04 +-8.8401387714584891e-04 +-8.7240973478320562e-04 +-8.6066103831570757e-04 +-8.4894111869346226e-04 +-8.3739849786896409e-04 +-8.2615779164103549e-04 +-8.1532151233599257e-04 +-8.0497238475734094e-04 +-7.9517588165695541e-04 +-7.8598277106580643e-04 +-7.7743153978787974e-04 +-7.6955061312206899e-04 +-7.6236033141031782e-04 +-7.5587467172946851e-04 +-7.5010272074695875e-04 +-7.4504991506484704e-04 +-7.4071907047449270e-04 +-7.3711122313553634e-04 +-7.3422630503662035e-04 +-7.3206367406835780e-04 +-7.3062251624724222e-04 +-7.2990213443440929e-04 +-8.7486260945545985e-04 +-8.7658582294677890e-04 +-8.7999863131761179e-04 +-8.8503354309683044e-04 +-8.9158869352799677e-04 +-8.9952711805385479e-04 +-9.0867584634268144e-04 +-9.1882492568399891e-04 +-9.2972660976781683e-04 +-9.4109516573669463e-04 +-9.5260805408059436e-04 +-9.6390955713762303e-04 +-9.7461812878244089e-04 +-9.8433860962863443e-04 +-9.9267982207023654e-04 +-9.9927689938059767e-04 +-1.0038162357666599e-03 +-1.0060596366640742e-03 +-1.0058636474714075e-03 +-1.0031905068744636e-03 +-9.9810867189874166e-04 +-9.9078294204222174e-04 +-9.8145619901852271e-04 +-9.7042609247704093e-04 +-9.5802036996830834e-04 +-9.4457406039589477e-04 +-9.3041070411387723e-04 +-9.1582866784624916e-04 +-9.0109258990603020e-04 +-8.8642932405075790e-04 +-8.7202740755451427e-04 +-8.5803900586393326e-04 +-8.4458338719668345e-04 +-8.3175116671005823e-04 +-8.1960876615322278e-04 +-8.0820272228841067e-04 +-7.9756362823345608e-04 +-7.8770960277569236e-04 +-7.7864925784067911e-04 +-7.7038418096381136e-04 +-7.6291097543909180e-04 +-7.5622291244223936e-04 +-7.5031125201774601e-04 +-7.4516628712008141e-04 +-7.4077815944661508e-04 +-7.3713748921095388e-04 +-7.3423585425080396e-04 +-7.3206614746023919e-04 +-7.3062283572713203e-04 +-7.2990213837263750e-04 +-9.6691786406990089e-04 +-9.6882273780146461e-04 +-9.7258991134015291e-04 +-9.7813386793715483e-04 +-9.8532536638137641e-04 +-9.9399017227039341e-04 +-1.0039072419440460e-03 +-1.0148064168572324e-03 +-1.0263659864926660e-03 +-1.0382110180665383e-03 +-1.0499140946165664e-03 +-1.0610008373749058e-03 +-1.0709629003238779e-03 +-1.0792805113257601e-03 +-1.0854547785363615e-03 +-1.0890470883181064e-03 +-1.0897198711542848e-03 +-1.0872711019784406e-03 +-1.0816552045448268e-03 +-1.0729857366487889e-03 +-1.0615194459424469e-03 +-1.0476254528587474e-03 +-1.0317460265141111e-03 +-1.0143560328920082e-03 +-9.9592691187885590e-04 +-9.7689880411588122e-04 +-9.5766209866592002e-04 +-9.3854783131751718e-04 +-9.1982527371622588e-04 +-9.0170465927973890e-04 +-8.8434308728959873e-04 +-8.6785200358576202e-04 +-8.5230509524697126e-04 +-8.3774584653413368e-04 +-8.2419433271270438e-04 +-8.1165306563390919e-04 +-8.0011186005892658e-04 +-7.8955178080970768e-04 +-7.7994827666374100e-04 +-7.7127362329641464e-04 +-7.6349879639639657e-04 +-7.5659488555796200e-04 +-7.5053414497873829e-04 +-7.4529076152714171e-04 +-7.4084140612151056e-04 +-7.3716562139282209e-04 +-7.3424608755301836e-04 +-7.3206879920877175e-04 +-7.3062317834992100e-04 +-7.2990214259691457e-04 +-1.0795759508450836e-03 +-1.0817035231175855e-03 +-1.0859052414347551e-03 +-1.0920737022246650e-03 +-1.1000462277000835e-03 +-1.1096024727888915e-03 +-1.1204605556546562e-03 +-1.1322715881691911e-03 +-1.1446132271387063e-03 +-1.1569842193398904e-03 +-1.1688037011094406e-03 +-1.1794205710283620e-03 +-1.1881384458583110e-03 +-1.1942593881039240e-03 +-1.1971444589386883e-03 +-1.1962825069044595e-03 +-1.1913532444787528e-03 +-1.1822695434092285e-03 +-1.1691882339105869e-03 +-1.1524870280302682e-03 +-1.1327140216315413e-03 +-1.1105221041008528e-03 +-1.0866018770079265e-03 +-1.0616239574548034e-03 +-1.0361967949639153e-03 +-1.0108414223835203e-03 +-9.8598117982694427e-04 +-9.6194274738060188e-04 +-9.3896450418335894e-04 +-9.1720876055507105e-04 +-8.9677528853112037e-04 +-8.7771446866651850e-04 +-8.6003910791941152e-04 +-8.4373451483377583e-04 +-8.2876676018631601e-04 +-8.1508924600246023e-04 +-8.0264779864252904e-04 +-7.9138453038046308e-04 +-7.8124070625185560e-04 +-7.7215882738631517e-04 +-7.6408410987648784e-04 +-7.5696550584488753e-04 +-7.5075638393642334e-04 +-7.4541496126471248e-04 +-7.4090455808520383e-04 +-7.3719372982375105e-04 +-7.3425631799895635e-04 +-7.3207145141092062e-04 +-7.3062352113883631e-04 +-7.2990214682407172e-04 +-1.2115521878336092e-03 +-1.2139414302523041e-03 +-1.2186549953689409e-03 +-1.2255621944907778e-03 +-1.2344642938839061e-03 +-1.2450897615435576e-03 +-1.2570858502804351e-03 +-1.2700059477425154e-03 +-1.2832939880971898e-03 +-1.2962705354681125e-03 +-1.3081292507234369e-03 +-1.3179553697857962e-03 +-1.3247766436900530e-03 +-1.3276497133722703e-03 +-1.3257719620293148e-03 +-1.3185955435306080e-03 +-1.3059137894312913e-03 +-1.2878954082686184e-03 +-1.2650573986965636e-03 +-1.2381861634358649e-03 +-1.2082295290194078e-03 +-1.1761857257535642e-03 +-1.1430099045612761e-03 +-1.1095490019152172e-03 +-1.0765064101534410e-03 +-1.0444316829080862e-03 +-1.0137278730634842e-03 +-9.8466915858580017e-04 +-9.5742288798025398e-04 +-9.3207204783199221e-04 +-9.0863582701912113e-04 +-8.8708719654208247e-04 +-8.6736723135443839e-04 +-8.4939635845801022e-04 +-8.3308293150835555e-04 +-8.1832959885404114e-04 +-8.0503791654330152e-04 +-7.9311160400425730e-04 +-7.8245877358818037e-04 +-7.7299339970415121e-04 +-7.6463623521605580e-04 +-7.5731533427304018e-04 +-7.5096630176739779e-04 +-7.4553235912887283e-04 +-7.4096429280279556e-04 +-7.3722033413873775e-04 +-7.3426600630236447e-04 +-7.3207396415799007e-04 +-7.3062384600204079e-04 +-7.2990215083098891e-04 +-1.3589599961569313e-03 +-1.3616429209811396e-03 +-1.3669346920537936e-03 +-1.3746858028696313e-03 +-1.3846671639936550e-03 +-1.3965604950675319e-03 +-1.4099402755698490e-03 +-1.4242458050446735e-03 +-1.4387464760691406e-03 +-1.4525111310733664e-03 +-1.4644011359633443e-03 +-1.4731111653042276e-03 +-1.4772749381595316e-03 +-1.4756323193977981e-03 +-1.4672254739539438e-03 +-1.4515701084135176e-03 +-1.4287481154393327e-03 +-1.3993930954555136e-03 +-1.3645775932743056e-03 +-1.3256409969449458e-03 +-1.2840071503677840e-03 +-1.2410312811940070e-03 +-1.1978965685462246e-03 +-1.1555622114334024e-03 +-1.1147531720737069e-03 +-1.0759775481537059e-03 +-1.0395584882876730e-03 +-1.0056708904781577e-03 +-9.7437677863638388e-04 +-9.4565622367342203e-04 +-9.1943269463394040e-04 +-8.9559290570695666e-04 +-8.7400180371637048e-04 +-8.5451354440261402e-04 +-8.3697930387109437e-04 +-8.2125267382432312e-04 +-8.0719325930304724e-04 +-7.9466896863871113e-04 +-7.8355737177120913e-04 +-7.7374640956805023e-04 +-7.6513466288391301e-04 +-7.5763133333658591e-04 +-7.5115604507107762e-04 +-7.4563854518400077e-04 +-7.4101835743459502e-04 +-7.3724442728714660e-04 +-7.3427478456815722e-04 +-7.3207624179272334e-04 +-7.3062414055076940e-04 +-7.2990215446476644e-04 +-1.5143557317081212e-03 +-1.5173505457448900e-03 +-1.5232645752098852e-03 +-1.5319444351995050e-03 +-1.5431513009835772e-03 +-1.5565418563899323e-03 +-1.5716312595793740e-03 +-1.5877352645990261e-03 +-1.6038991288457036e-03 +-1.6188379097244068e-03 +-1.6309297570865854e-03 +-1.6383075300695346e-03 +-1.6390710056190232e-03 +-1.6315919129404675e-03 +-1.6148294756300685e-03 +-1.5885506583952808e-03 +-1.5533782829145752e-03 +-1.5106578680936416e-03 +-1.4622005803705612e-03 +-1.4099904147737369e-03 +-1.3559322232638618e-03 +-1.3016816859431207e-03 +-1.2485623093428488e-03 +-1.1975518654792434e-03 +-1.1493130826964939e-03 +-1.1042458628630022e-03 +-1.0625448943913096e-03 +-1.0242532591780078e-03 +-9.8930774428898161e-04 +-9.5757479238083238e-04 +-9.2887773722030590e-04 +-9.0301668814208778e-04 +-8.7978257901725511e-04 +-8.5896677343816319e-04 +-8.4036738942135276e-04 +-8.2379326328391384e-04 +-8.0906625356365043e-04 +-7.9602240538720987e-04 +-7.8451235405760811e-04 +-7.7440123900105926e-04 +-7.6556831923483366e-04 +-7.5790642309169691e-04 +-7.5132132285601395e-04 +-7.4573109505985421e-04 +-7.4106550623368166e-04 +-7.3726544946418351e-04 +-7.3428244737045551e-04 +-7.3207823071322255e-04 +-7.3062439782599147e-04 +-7.2990215763939095e-04 +-1.6665476723171202e-03 +-1.6698512013779605e-03 +-1.6763958981142271e-03 +-1.6860535131558924e-03 +-1.6986162348121123e-03 +-1.7137609571468751e-03 +-1.7309785720741478e-03 +-1.7494636134601337e-03 +-1.7679816510441689e-03 +-1.7847656136139097e-03 +-1.7975216703495975e-03 +-1.8036213984667878e-03 +-1.8004966792708964e-03 +-1.7861505453421335e-03 +-1.7596111376066699e-03 +-1.7211549941929039e-03 +-1.6722227446445083e-03 +-1.6150832847805520e-03 +-1.5523885362487249e-03 +-1.4867631759254152e-03 +-1.4205166448360289e-03 +-1.3554968659254673e-03 +-1.2930596527570290e-03 +-1.2341115455857879e-03 +-1.1791875146305976e-03 +-1.1285366830601860e-03 +-1.0822010284374072e-03 +-1.0400806858333856e-03 +-1.0019846781125614e-03 +-9.6766847927314903e-04 +-9.3686076843771946e-04 +-9.0928181933665479e-04 +-8.8465567521651143e-04 +-8.6271784682220962e-04 +-8.4321986828679617e-04 +-8.2593170224073921e-04 +-8.1064271256049182e-04 +-7.9716171543765606e-04 +-7.8531646566311569e-04 +-7.7495282339753654e-04 +-7.6593376689458679e-04 +-7.5813836032200975e-04 +-7.5146074657749169e-04 +-7.4580920802854789e-04 +-7.4110531990598911e-04 +-7.3728320909090207e-04 +-7.3428892342595575e-04 +-7.3207991211887756e-04 +-7.3062461536895493e-04 +-7.2990216032439259e-04 +-1.8021223087827686e-03 +-1.8057046626884328e-03 +-1.8128407786827947e-03 +-1.8234680472788438e-03 +-1.8374671600349180e-03 +-1.8546009959136312e-03 +-1.8743925429866091e-03 +-1.8959351517776465e-03 +-1.9176693276985936e-03 +-1.9372203793611184e-03 +-1.9514372388473485e-03 +-1.9567490914389283e-03 +-1.9498287791388251e-03 +-1.9283676760512606e-03 +-1.8916553141427347e-03 +-1.8407244396973737e-03 +-1.7780343353171186e-03 +-1.7068697052189440e-03 +-1.6307033612075396e-03 +-1.5527062419617499e-03 +-1.4754715351926991e-03 +-1.4009284112259559e-03 +-1.3303816232171522e-03 +-1.2646137864002276e-03 +-1.2040051799836889e-03 +-1.1486455674954896e-03 +-1.0984271204896100e-03 +-1.0531162148684019e-03 +-1.0124061010876270e-03 +-9.7595397164094880e-04 +-9.4340607328076019e-04 +-9.1441404062925626e-04 +-8.8864498804271759e-04 +-8.6578728355592291e-04 +-8.4555341463774599e-04 +-8.2768095333673433e-04 +-8.1193232670302717e-04 +-7.9809387819451184e-04 +-7.8597454819984906e-04 +-7.7540439073421337e-04 +-7.6623306607230210e-04 +-7.5832839597622930e-04 +-7.5157503219688989e-04 +-7.4587326497661669e-04 +-7.4113798273231881e-04 +-7.3729778437187446e-04 +-7.3429424000154319e-04 +-7.3208129283189598e-04 +-7.3062479403918903e-04 +-7.2990216253019042e-04 +-1.9092031742736484e-03 +-1.9130088927196147e-03 +-1.9206442834026069e-03 +-1.9321496790956402e-03 +-1.9475484182873127e-03 +-1.9667550313567450e-03 +-1.9893902510419699e-03 +-2.0144928058195627e-03 +-2.0401823601616680e-03 +-2.0634229730566332e-03 +-2.0801059183854888e-03 +-2.0856188048650982e-03 +-2.0758422017973007e-03 +-2.0482210700752722e-03 +-2.0024360383472635e-03 +-1.9403906967809506e-03 +-1.8655965768526693e-03 +-1.7822946595625316e-03 +-1.6946608980488202e-03 +-1.6062849484657319e-03 +-1.5199411633411576e-03 +-1.4375756202714366e-03 +-1.3604133109327507e-03 +-1.2891102253069157e-03 +-1.2239049509889402e-03 +-1.1647485295833756e-03 +-1.1114063318556609e-03 +-1.0635333653312819e-03 +-1.0207274522673953e-03 +-9.8256529238820536e-04 +-9.4862591651077887e-04 +-9.1850517716346686e-04 +-8.9182405441602165e-04 +-8.6823281288981127e-04 +-8.4741246086690678e-04 +-8.2907452286237445e-04 +-8.1295981695106185e-04 +-7.9883670016910654e-04 +-7.8649908567408986e-04 +-7.7576442514662447e-04 +-7.6647177485745165e-04 +-7.5848001341975745e-04 +-7.5166624597827107e-04 +-7.4592440811968076e-04 +-7.4116406941679338e-04 +-7.3730942863939396e-04 +-7.3429848852970322e-04 +-7.3208239639697135e-04 +-7.3062493686551640e-04 +-7.2990216429407676e-04 +-1.9822062284716238e-03 +-1.9861647601056914e-03 +-1.9941627770123219e-03 +-2.0063530877133923e-03 +-2.0229186979947010e-03 +-2.0439560454761927e-03 +-2.0692359149447688e-03 +-2.0978232755165587e-03 +-2.1276201773870705e-03 +-2.1550304670713994e-03 +-2.1750566780921153e-03 +-2.1820721565368722e-03 +-2.1711673151348821e-03 +-2.1395302128693347e-03 +-2.0871933428222170e-03 +-2.0168369899378510e-03 +-1.9328764837864356e-03 +-1.8403407804903880e-03 +-1.7439639529379164e-03 +-1.6476589605286121e-03 +-1.5543387093629819e-03 +-1.4659646524292484e-03 +-1.3837056552237447e-03 +-1.3081264163017558e-03 +-1.2393619299453243e-03 +-1.1772604956013630e-03 +-1.1214924285077592e-03 +-1.0716283511025037e-03 +-1.0271931301816764e-03 +-9.8770149389637248e-04 +-9.5268045237186351e-04 +-9.2168253020528273e-04 +-8.9429279238633112e-04 +-8.7013180595331549e-04 +-8.4885603676691031e-04 +-8.3015670782392325e-04 +-8.1375780720206378e-04 +-7.9941369666532711e-04 +-7.8690660863629173e-04 +-7.7604420837371069e-04 +-7.6665732405254024e-04 +-7.5859789865753311e-04 +-7.5173718617523673e-04 +-7.4596419488405215e-04 +-7.4118436878821794e-04 +-7.3731849175312286e-04 +-7.3430179595872583e-04 +-7.3208325564510092e-04 +-7.3062504808404287e-04 +-7.2990216566822018e-04 +-2.0242491554080329e-03 +-2.0282921568659526e-03 +-2.0364984438965544e-03 +-2.0490996147195495e-03 +-2.0663961174394677e-03 +-2.0886353036432986e-03 +-2.1157533372207437e-03 +-2.1469434300305963e-03 +-2.1800963547999653e-03 +-2.2113315333155228e-03 +-2.2350237074417532e-03 +-2.2446913779132511e-03 +-2.2346503986520640e-03 +-2.2017095445412958e-03 +-2.1460273237623325e-03 +-2.0707849312094732e-03 +-1.9810388509498606e-03 +-1.8824072168608700e-03 +-1.7800675198100262e-03 +-1.6782164554336400e-03 +-1.5799174594454204e-03 +-1.4871867782148913e-03 +-1.4011864003331085e-03 +-1.3224385818678610e-03 +-1.2510184474345968e-03 +-1.1867086946938774e-03 +-1.1291152921334782e-03 +-1.0777495391295900e-03 +-1.0320836924168949e-03 +-9.9158700661221570e-04 +-9.5574786387043890e-04 +-9.2408635699908423e-04 +-8.9616052632441668e-04 +-8.7156851916782036e-04 +-8.4994823858897985e-04 +-8.3097553860186836e-04 +-8.1436166339252721e-04 +-7.9985037930253389e-04 +-7.8721507925730468e-04 +-7.7625602615741100e-04 +-7.6679782726356315e-04 +-7.5868718344263713e-04 +-7.5179092677801545e-04 +-7.4599434152097528e-04 +-7.4119975273330212e-04 +-7.3732536147459444e-04 +-7.3430430332419114e-04 +-7.3208390711960276e-04 +-7.3062513241612000e-04 +-7.2990216671083409e-04 +-2.0445805958412672e-03 +-2.0486574192627206e-03 +-2.0569391586902686e-03 +-2.0696749273222039e-03 +-2.0872001092337952e-03 +-2.1098328096029345e-03 +-2.1376415891779786e-03 +-2.1700214003869552e-03 +-2.2050749433066975e-03 +-2.2389911394350872e-03 +-2.2658993917536847e-03 +-2.2787313243376548e-03 +-2.2710794265965203e-03 +-2.2391996850679402e-03 +-2.1830581457274512e-03 +-2.1059901244606556e-03 +-2.0134128244374051e-03 +-1.9113600166928758e-03 +-1.8053780698701330e-03 +-1.6999409896357636e-03 +-1.5982927631354880e-03 +-1.5025484440736126e-03 +-1.4139086010258111e-03 +-1.3328943483873279e-03 +-1.2595563421241628e-03 +-1.1936412048930737e-03 +-1.1347148843791782e-03 +-1.0822492949828166e-03 +-1.0356803935452671e-03 +-9.9444529641844670e-04 +-9.5800466229312793e-04 +-9.2585507452073307e-04 +-8.9753485736145827e-04 +-8.7262573521865584e-04 +-8.5075198015913871e-04 +-8.3157814510614794e-04 +-8.1480609749074557e-04 +-8.0017180640839093e-04 +-7.8744216042592294e-04 +-7.7641197683660527e-04 +-7.6690128756395155e-04 +-7.5875293872487400e-04 +-7.5183051101443041e-04 +-7.4601655024934626e-04 +-7.4121108753308297e-04 +-7.3733042368937754e-04 +-7.3430615117256134e-04 +-7.3208438727686849e-04 +-7.3062519457544901e-04 +-7.2990216748006654e-04 +-2.0529852811381577e-03 +-2.0570681946589825e-03 +-2.0653440081554986e-03 +-2.0780280994307683e-03 +-2.0954175922555701e-03 +-2.1178172509105065e-03 +-2.1453595039302260e-03 +-2.1776366952404912e-03 +-2.2130844569849505e-03 +-2.2482376480620764e-03 +-2.2773534434329295e-03 +-2.2930974031036776e-03 +-2.2884592106667506e-03 +-2.2590233227041852e-03 +-2.2042913668484177e-03 +-2.1274588234011507e-03 +-2.0340783909499303e-03 +-1.9304678145311486e-03 +-1.8224865140126251e-03 +-1.7148766908076896e-03 +-1.6110770332836732e-03 +-1.5133246777188675e-03 +-1.4228840721379878e-03 +-1.3402994081573860e-03 +-1.2656188279557908e-03 +-1.1985722235466738e-03 +-1.1387022619750754e-03 +-1.0854557684049034e-03 +-1.0382444805048987e-03 +-9.9648350008357204e-04 +-9.5961419146473785e-04 +-9.2711661410500488e-04 +-8.9851514838896812e-04 +-8.7337985884331437e-04 +-8.5132531711022827e-04 +-8.3200802294024581e-04 +-8.1512315731462124e-04 +-8.0040112776395128e-04 +-7.8760418343988190e-04 +-7.7652325787152914e-04 +-7.6697512039684596e-04 +-7.5879986872979329e-04 +-7.5185876548046677e-04 +-7.4603240401830101e-04 +-7.4121917968842754e-04 +-7.3733403802455223e-04 +-7.3430747060228751e-04 +-7.3208473014637753e-04 +-7.3062523896408511e-04 +-7.2990216803023571e-04 +-2.0560415460618721e-03 +-2.0601204086577165e-03 +-2.0683610070560679e-03 +-2.0809262398299930e-03 +-2.0980437489078042e-03 +-2.1199559669509579e-03 +-2.1467902700768172e-03 +-2.1782654824402314e-03 +-2.2131320855143131e-03 +-2.2483766956311883e-03 +-2.2786270152752408e-03 +-2.2965640268255414e-03 +-2.2947489044587220e-03 +-2.2680936518002814e-03 +-2.2155066781845592e-03 +-2.1398785721843971e-03 +-2.0467585922797813e-03 +-1.9426536877860552e-03 +-1.8336793507211643e-03 +-1.7248151296225772e-03 +-1.6196804772981037e-03 +-1.5206315401310457e-03 +-1.4290004521944175e-03 +-1.3453623721051968e-03 +-1.2697728864634300e-03 +-1.2019557739757077e-03 +-1.1414407798019009e-03 +-1.0876592046532819e-03 +-1.0400070786580418e-03 +-9.9788487212346230e-04 +-9.6072094550436488e-04 +-9.2798412818099574e-04 +-8.9918927537976511e-04 +-8.7389846175523085e-04 +-8.5171959934613622e-04 +-8.3230365332018121e-04 +-8.1534120690236831e-04 +-8.0055884258202514e-04 +-7.8771561867204852e-04 +-7.7659979782849435e-04 +-7.6702590599052301e-04 +-7.5883215124262419e-04 +-7.5187820253037971e-04 +-7.4604331093503634e-04 +-7.4122474716752942e-04 +-7.3733652485040457e-04 +-7.3430837847006120e-04 +-7.3208496607500464e-04 +-7.3062526950898809e-04 +-7.2990216840983235e-04 +-2.0570064389737021e-03 +-2.0610799383707088e-03 +-2.0692864532968745e-03 +-2.0817429126205704e-03 +-2.0986123026974831e-03 +-2.1200666527524097e-03 +-2.1461900146808378e-03 +-2.1767491384916552e-03 +-2.2107142436021358e-03 +-2.2454792156695593e-03 +-2.2761097329770451e-03 +-2.2954647847029360e-03 +-2.2958477060902498e-03 +-2.2716031128036346e-03 +-2.2210718377978431e-03 +-2.1468092704443366e-03 +-2.0543025332650997e-03 +-1.9501807973441260e-03 +-1.8407534347482163e-03 +-1.7311873318427964e-03 +-1.6252474340273039e-03 +-1.5253874114755735e-03 +-1.4329965904184639e-03 +-1.3486783474040622e-03 +-1.2724978266308124e-03 +-1.2041774686689828e-03 +-1.1432400258643081e-03 +-1.0891074155778831e-03 +-1.0411657816373245e-03 +-9.9880620447171265e-04 +-9.6144861072409917e-04 +-9.2855450194432253e-04 +-8.9963249559296698e-04 +-8.7423942279391432e-04 +-8.5197881970389068e-04 +-8.3249801244208218e-04 +-8.1548456026823914e-04 +-8.0066252974318297e-04 +-7.8778888052540702e-04 +-7.7665011881918706e-04 +-7.6705929544319254e-04 +-7.5885337613527178e-04 +-7.5189098217893298e-04 +-7.4605048229094291e-04 +-7.4122840790297358e-04 +-7.3733816002725841e-04 +-7.3430897543711696e-04 +-7.3208512121196196e-04 +-7.3062528959465310e-04 +-7.2990216866065504e-04 +-2.0572332019277622e-03 +-2.0613027609558388e-03 +-2.0694856482624769e-03 +-2.0818674861175215e-03 +-2.0985655961695149e-03 +-2.1196969670142338e-03 +-2.1452978092395799e-03 +-2.1751368651273841e-03 +-2.2083085288436594e-03 +-2.2425002404066943e-03 +-2.2731501900048272e-03 +-2.2933285613838048e-03 +-2.2952039773811161e-03 +-2.2727094381616935e-03 +-2.2237432736593489e-03 +-2.1505849490738092e-03 +-2.0586540504187890e-03 +-1.9546554339304727e-03 +-1.8450315961524122e-03 +-1.7350806139386559e-03 +-1.6286700172892367e-03 +-1.5283226387813585e-03 +-1.4354688335172618e-03 +-1.3507328278855532e-03 +-1.2741876247244275e-03 +-1.2055559096840343e-03 +-1.1443566778815198e-03 +-1.0900063293742639e-03 +-1.0418850275925849e-03 +-9.9937810035067741e-04 +-9.6190027357113961e-04 +-9.2890851389139601e-04 +-8.9990757075202705e-04 +-8.7445102024373556e-04 +-8.5213968063225370e-04 +-8.3261861732214580e-04 +-8.1557351095764739e-04 +-8.0072686526582175e-04 +-7.8783433649461706e-04 +-7.7668134017787479e-04 +-7.6708001133248297e-04 +-7.5886654453922856e-04 +-7.5189891086591414e-04 +-7.4605493146508617e-04 +-7.4123067903866466e-04 +-7.3733917449137875e-04 +-7.3430934579386158e-04 +-7.3208521745827789e-04 +-7.3062530205614869e-04 +-7.2990216881778478e-04 +-2.0572420565079883e-03 +-2.0613092903172866e-03 +-2.0694783707161241e-03 +-2.0818166357009942e-03 +-2.0984142470919444e-03 +-2.1193536785116341e-03 +-2.1446363205644653e-03 +-2.1740193085428589e-03 +-2.2066580943959028e-03 +-2.2404191855148426e-03 +-2.2709935398315308e-03 +-2.2916156395719743e-03 +-2.2943896494949829e-03 +-2.2729896150464300e-03 +-2.2250245434250202e-03 +-2.1525896350917078e-03 +-2.0610554569956913e-03 +-1.9571710666785279e-03 +-1.8474606946227835e-03 +-1.7373034707397446e-03 +-1.6306303284560693e-03 +-1.5300068465520661e-03 +-1.4368887989506887e-03 +-1.3519134501836494e-03 +-1.2751588935509259e-03 +-1.2063482520937405e-03 +-1.1449985059873921e-03 +-1.0905229490209168e-03 +-1.0422983323735016e-03 +-9.9970668387907376e-04 +-9.6215973883576349e-04 +-9.2911185331648587e-04 +-9.0006554923781150e-04 +-8.7457252813956138e-04 +-8.5223204336114689e-04 +-8.3268785899172023e-04 +-8.1562457466925265e-04 +-8.0076379513654842e-04 +-7.8786042713954187e-04 +-7.7669925924022656e-04 +-7.6709190015952799e-04 +-7.5887410142150237e-04 +-7.5190346060967893e-04 +-7.4605748442077059e-04 +-7.4123198216755808e-04 +-7.3733975654609004e-04 +-7.3430955828126144e-04 +-7.3208527267712876e-04 +-7.3062530920606108e-04 +-7.2990216890985750e-04 +-2.0572136831939884e-03 +-2.0612797540133731e-03 +-2.0694418596028811e-03 +-2.0817580573845060e-03 +-2.0983046605177842e-03 +-2.1191461696319406e-03 +-2.1442646199989314e-03 +-2.1734076433989440e-03 +-2.2057582203948213e-03 +-2.2392764006792369e-03 +-2.2697930415650600e-03 +-2.2906386881088626e-03 +-2.2938874458854146e-03 +-2.2730735227401325e-03 +-2.2256476484281890e-03 +-2.1536040450953844e-03 +-2.0622863272344557e-03 +-1.9584673087501021e-03 +-1.8487151422688689e-03 +-1.7384523322322770e-03 +-1.6316435877823073e-03 +-1.5308771582713647e-03 +-1.4376222408838027e-03 +-1.3525229552142927e-03 +-1.2756600555628651e-03 +-1.2067568831016469e-03 +-1.1453293559239878e-03 +-1.0907891406348967e-03 +-1.0425112065634713e-03 +-9.9987586229682499e-04 +-9.6229328799755779e-04 +-9.2921648442199955e-04 +-9.0014681865442333e-04 +-8.7463502159447677e-04 +-8.5227953714531537e-04 +-8.3272345695235373e-04 +-8.1565082252166407e-04 +-8.0078277478331616e-04 +-7.8787383403977195e-04 +-7.7670846576574366e-04 +-7.6709800760752292e-04 +-7.5887798298777422e-04 +-7.5190579728481866e-04 +-7.4605879542948310e-04 +-7.4123265128916429e-04 +-7.3734005538843587e-04 +-7.3430966736972453e-04 +-7.3208530102441443e-04 +-7.3062531287717810e-04 +-7.2990216895972332e-04 +-2.0571951340140372e-03 +-2.0612607302665136e-03 +-2.0694199329605507e-03 +-2.0817269172637275e-03 +-2.0982522370968709e-03 +-2.1190529301493440e-03 +-2.1441028878353657e-03 +-2.1731454854532544e-03 +-2.2053751145458748e-03 +-2.2387921180757287e-03 +-2.2692884031480101e-03 +-2.2902363432498849e-03 +-2.2936960307712992e-03 +-2.2731394543745375e-03 +-2.2259477913644265e-03 +-2.1540717041273784e-03 +-2.0628440609962596e-03 +-1.9590490019961845e-03 +-1.8492744729442798e-03 +-1.7389621887773600e-03 +-1.6320916412753265e-03 +-1.5312608898421657e-03 +-1.4379448597109216e-03 +-1.3527905303453186e-03 +-1.2758797036096824e-03 +-1.2069357257389500e-03 +-1.1454739835443971e-03 +-1.0909053843071788e-03 +-1.0426040849134299e-03 +-9.9994961948302453e-04 +-9.6235147300019366e-04 +-9.2926204365166478e-04 +-9.0018218719553709e-04 +-8.7466220615535571e-04 +-8.5230018814495909e-04 +-8.3273892946512690e-04 +-8.1566222692972684e-04 +-8.0079101843736147e-04 +-7.8787965534481358e-04 +-7.7671246203444243e-04 +-7.6710065788740932e-04 +-7.5887966689509206e-04 +-7.5190681071889403e-04 +-7.4605936388510465e-04 +-7.4123294135676975e-04 +-7.3734018491262857e-04 +-7.3430971464314950e-04 +-7.3208531330751583e-04 +-7.3062531446882798e-04 +-7.2990216898491335e-04 +-2.0571887354080419e-03 +-2.0612541939464017e-03 +-2.0694125334076536e-03 +-2.0817167777549563e-03 +-2.0982358143216474e-03 +-2.1190245938603022e-03 +-2.1440548488799783e-03 +-2.1730691266016087e-03 +-2.2052658624179692e-03 +-2.2386581197016359e-03 +-2.2691562269457439e-03 +-2.2901440689639244e-03 +-2.2936754976533211e-03 +-2.2732018494706022e-03 +-2.2260824964852937e-03 +-2.1542553098567751e-03 +-2.0630509362286531e-03 +-1.9592580526071319e-03 +-1.8494714620627079e-03 +-1.7391392368562991e-03 +-1.6322456122736934e-03 +-1.5313917006788704e-03 +-1.4380541383333461e-03 +-1.3528806969648551e-03 +-1.2759534054498176e-03 +-1.2069955229372924e-03 +-1.1455221965268893e-03 +-1.0909440371731493e-03 +-1.0426349016273630e-03 +-9.9997404625893943e-04 +-9.6237071142232366e-04 +-9.2927708608660242e-04 +-9.0019385025539114e-04 +-8.7467116037149727e-04 +-8.5230698332449371e-04 +-8.3274401586506193e-04 +-8.1566597268831263e-04 +-8.0079372380275791e-04 +-7.8788156424529745e-04 +-7.7671377148604980e-04 +-7.6710152567293808e-04 +-7.5888021787932306e-04 +-7.5190714210395340e-04 +-7.4605954965247716e-04 +-7.4123303609618149e-04 +-7.3734022719602898e-04 +-7.3430973006955987e-04 +-7.3208531731515532e-04 +-7.3062531498972250e-04 +-7.2990216899881304e-04 +-2.0571877672785318e-03 +-2.0612532075426726e-03 +-2.0694114277804649e-03 +-2.0817153011120598e-03 +-2.0982335247323762e-03 +-2.1190208663793703e-03 +-2.1440489740242826e-03 +-2.1730606434905548e-03 +-2.2052553595471119e-03 +-2.2386483498648769e-03 +-2.2691523851463961e-03 +-2.2901520326513462e-03 +-2.2936988523076193e-03 +-2.2732401070801886e-03 +-2.2261316926639498e-03 +-2.1543100105420512e-03 +-2.0631061072397283e-03 +-1.9593100363064259e-03 +-1.8495181340017230e-03 +-1.7391797207247980e-03 +-1.6322798736451852e-03 +-1.5314201880668487e-03 +-1.4380775248408445e-03 +-1.3528997178153591e-03 +-1.2759687674364724e-03 +-1.2070078611449721e-03 +-1.1455320592586907e-03 +-1.0909518862073039e-03 +-1.0426411198479926e-03 +-9.9997894808242171e-04 +-9.6237455357507109e-04 +-9.2928007755535395e-04 +-9.0019616094269073e-04 +-8.7467292836398080e-04 +-8.5230832086383710e-04 +-8.3274501418566021e-04 +-8.1566670590470724e-04 +-8.0079425202068098e-04 +-7.8788193605029905e-04 +-7.7671402593976310e-04 +-7.6710169392450874e-04 +-7.5888032447877227e-04 +-7.5190720608705889e-04 +-7.4605958545188725e-04 +-7.4123305432184454e-04 +-7.3734023531806187e-04 +-7.3430973302938453e-04 +-7.3208531808426883e-04 +-7.3062531509197459e-04 +-7.2990216900932828e-04 +-2.0571877673387648e-03 +-2.0612532082787713e-03 +-2.0694114317222532e-03 +-2.0817153187289686e-03 +-2.0982335890002749e-03 +-2.1190210600661608e-03 +-2.1440494728993506e-03 +-2.1730617707579449e-03 +-2.2052576181986155e-03 +-2.2386523556666279e-03 +-2.2691586413008131e-03 +-2.2901606364575965e-03 +-2.2937093571393937e-03 +-2.2732516618247395e-03 +-2.2261433464005756e-03 +-2.1543209796667322e-03 +-2.0631158970539801e-03 +-1.9593184321202517e-03 +-1.8495251273258513e-03 +-1.7391854255997276e-03 +-1.6322844601412700e-03 +-1.5314238389996656e-03 +-1.4380804119253294e-03 +-1.3529019910390389e-03 +-1.2759705522409684e-03 +-1.2070092596445068e-03 +-1.1455331531893811e-03 +-1.0909527403365653e-03 +-1.0426417852187526e-03 +-9.9997946483453308e-04 +-9.6237495327910626e-04 +-9.2928038508521566e-04 +-9.0019639594956700e-04 +-8.7467310642246098e-04 +-8.5230845435650270e-04 +-8.3274511298316847e-04 +-8.1566677788812169e-04 +-8.0079430348331624e-04 +-7.8788197200824889e-04 +-7.7671405037364998e-04 +-7.6710170996968240e-04 +-7.5888033457703337e-04 +-7.5190721210971262e-04 +-7.4605958880143001e-04 +-7.4123305601765167e-04 +-7.3734023606999673e-04 +-7.3430973330218204e-04 +-7.3208531815480832e-04 +-7.3062531510107169e-04 +-7.2990216900942575e-04 +-2.0571887360107048e-03 +-2.0612542093845980e-03 +-2.0694126398950476e-03 +-2.0817172128971260e-03 +-2.0982371546760551e-03 +-2.1190280483155822e-03 +-2.1440626901270345e-03 +-2.1730851809898997e-03 +-2.2052956578832690e-03 +-2.2387078928252768e-03 +-2.2692303748202869e-03 +-2.2902422692150592e-03 +-2.2937918031056092e-03 +-2.2733266425345325e-03 +-2.2262058083139138e-03 +-2.1543694157400758e-03 +-2.0631513261546459e-03 +-1.9593431095419303e-03 +-1.8495415810193261e-03 +-1.7391959309920430e-03 +-1.6322908436961479e-03 +-1.5314274667722649e-03 +-1.4380822578853349e-03 +-1.3529027257207778e-03 +-1.2759706245384376e-03 +-1.2070089626355636e-03 +-1.1455326733605105e-03 +-1.0909521927846353e-03 +-1.0426412380929305e-03 +-9.9997895595912815e-04 +-9.6237450128165789e-04 +-9.2927999674860301e-04 +-9.0019607100855431e-04 +-8.7467284065115833e-04 +-8.5230824152346374e-04 +-8.3274494606376201e-04 +-8.1566664979450493e-04 +-8.0079420748562337e-04 +-7.8788190196120347e-04 +-7.7671400082368548e-04 +-7.6710167619049657e-04 +-7.5888031256393868e-04 +-7.5190719855057898e-04 +-7.4605958103428132e-04 +-7.4123305197925835e-04 +-7.3734023423690663e-04 +-7.3430973262342660e-04 +-7.3208531797543585e-04 +-7.3062531507489385e-04 +-7.2990216899984726e-04 +-2.0571951350817955e-03 +-2.0612608144685712e-03 +-2.0694206040992010e-03 +-2.0817296308489647e-03 +-2.0982601534429387e-03 +-2.1190719959909093e-03 +-2.1441432697424370e-03 +-2.1732229226718038e-03 +-2.2055105221995166e-03 +-2.2390066598040638e-03 +-2.2695935387989628e-03 +-2.2906245165141225e-03 +-2.2941400280275257e-03 +-2.2736017034522358e-03 +-2.2263927729240852e-03 +-2.1544742216550077e-03 +-2.0631912553094114e-03 +-1.9593381214230462e-03 +-1.8495092259192690e-03 +-1.7391494787706515e-03 +-1.6322393143937968e-03 +-1.5313764507033428e-03 +-1.4380348805656479e-03 +-1.3528604781079009e-03 +-1.2759339839943128e-03 +-1.2069778202142493e-03 +-1.1455066109851298e-03 +-1.0909306544250744e-03 +-1.0426236303796089e-03 +-9.9996470381294097e-04 +-9.6236307589473791e-04 +-9.2927092718834980e-04 +-9.0018894653875418e-04 +-8.7466730811947588e-04 +-8.5230400040252200e-04 +-8.3274174263927702e-04 +-8.1566427131827711e-04 +-8.0079247671160946e-04 +-7.8788067224336690e-04 +-7.7671315182280829e-04 +-7.6710111016108388e-04 +-7.5887995115792408e-04 +-7.5190698005634575e-04 +-7.4605945796816261e-04 +-7.4123298894812151e-04 +-7.3734020599988280e-04 +-7.3430972228908297e-04 +-7.3208531528375911e-04 +-7.3062531472371111e-04 +-7.2990216898803986e-04 +-2.0572136790342264e-03 +-2.0612800020543532e-03 +-2.0694441811916226e-03 +-2.0817676373889914e-03 +-2.0983322953571000e-03 +-2.1192111715984054e-03 +-2.1443982899628689e-03 +-2.1736558222007220e-03 +-2.2061780526134570e-03 +-2.2399203493520667e-03 +-2.2706811679746026e-03 +-2.2917367440106911e-03 +-2.2951110570884666e-03 +-2.2743175369010324e-03 +-2.2268196559752894e-03 +-2.1546436881981182e-03 +-2.0631673262153497e-03 +-1.9591892500641639e-03 +-1.8492928514377263e-03 +-1.7389071924180410e-03 +-1.6319979666283174e-03 +-1.5311514859808943e-03 +-1.4378338532437724e-03 +-1.3526859292894537e-03 +-1.2757855162222644e-03 +-1.2068534774225719e-03 +-1.1454037408323531e-03 +-1.0908464165266623e-03 +-1.0425552759208523e-03 +-9.9990971423987492e-04 +-9.6231921847049105e-04 +-9.2923626395902755e-04 +-9.0016181900996956e-04 +-8.7464631082002713e-04 +-8.5228795080220375e-04 +-8.3272965144180863e-04 +-8.1565531509136347e-04 +-8.0078597365001937e-04 +-7.8787606120001030e-04 +-7.7670997441279459e-04 +-7.6709899557633667e-04 +-7.5887860328092635e-04 +-7.5190616645263281e-04 +-7.4605900037131884e-04 +-7.4123275488611464e-04 +-7.3734010126472540e-04 +-7.3430968399607098e-04 +-7.3208530532031292e-04 +-7.3062531343110501e-04 +-7.2990216896653070e-04 +-2.0572420216058273e-03 +-2.0613097602540133e-03 +-2.0694841128371818e-03 +-2.0818413330544747e-03 +-2.0984859326816973e-03 +-2.1195212348965303e-03 +-2.1449765059909265e-03 +-2.1746403536015268e-03 +-2.2076885994246754e-03 +-2.2419682240257480e-03 +-2.2730881554304488e-03 +-2.2941576237880943e-03 +-2.2971738819653662e-03 +-2.2757755187747934e-03 +-2.2276106499974865e-03 +-2.1548522354016809e-03 +-2.0629482008586242e-03 +-1.9587034430625029e-03 +-1.8486731169477871e-03 +-1.7382480178018314e-03 +-1.6313589856424401e-03 +-1.5305657460220978e-03 +-1.4373162659402257e-03 +-1.3522400805640539e-03 +-1.2754085200587595e-03 +-1.2065391660010195e-03 +-1.1451446294893771e-03 +-1.0906348389377869e-03 +-1.0423839891766386e-03 +-9.9977218128415534e-04 +-9.6220970341179041e-04 +-9.2914982513285776e-04 +-9.0009425099994028e-04 +-8.7459406524079467e-04 +-8.5224805237465822e-04 +-8.3269961795986080e-04 +-8.1563308520651390e-04 +-8.0076984379987037e-04 +-7.8786463157431649e-04 +-7.7670210316913523e-04 +-7.6709376020186028e-04 +-7.5887526793976554e-04 +-7.5190415418568003e-04 +-7.4605786913026705e-04 +-7.4123217649524082e-04 +-7.3733984254899026e-04 +-7.3430958943496909e-04 +-7.3208528072362343e-04 +-7.3062531024334766e-04 +-7.2990216892261802e-04 +-2.0572330618355192e-03 +-2.0613032652017677e-03 +-2.0694969821961162e-03 +-2.0819195255431205e-03 +-2.0987192275702922e-03 +-2.1200567612324290e-03 +-2.1460242016736924e-03 +-2.1764490250073482e-03 +-2.2104562211548266e-03 +-2.2456812529248523e-03 +-2.2773910909547161e-03 +-2.2984105780105607e-03 +-2.3007093035828799e-03 +-2.2781648337259976e-03 +-2.2287630203878485e-03 +-2.1549407583568085e-03 +-2.0622692955998907e-03 +-1.9575601801227419e-03 +-1.8473129252080881e-03 +-1.7368452015881319e-03 +-1.6300218765351860e-03 +-1.5293526580079804e-03 +-1.4362516221493188e-03 +-1.3513273477664734e-03 +-1.2746393918150341e-03 +-1.2058995689206752e-03 +-1.1446183957962300e-03 +-1.0902058028514844e-03 +-1.0420370802902209e-03 +-9.9949391111671523e-04 +-9.6198830334073024e-04 +-9.2897519687649814e-04 +-8.9995782639509542e-04 +-8.7448863116514801e-04 +-8.5216757139795686e-04 +-8.3263906026555257e-04 +-8.1558827853390049e-04 +-8.0073734330735145e-04 +-7.8784160890649831e-04 +-7.7668625280053296e-04 +-7.6708322061465101e-04 +-7.5886855514789488e-04 +-7.5190010522963751e-04 +-7.4605559342830327e-04 +-7.4123101319008310e-04 +-7.3733932229233913e-04 +-7.3430939930901342e-04 +-7.3208523127561741e-04 +-7.3062530383695261e-04 +-7.2990216883969813e-04 +-2.0570060206973884e-03 +-2.0610796445131195e-03 +-2.0693051036419358e-03 +-2.0818375663519922e-03 +-2.0988992309611152e-03 +-2.1207431651454503e-03 +-2.1475522106207327e-03 +-2.1791886428600775e-03 +-2.2146587512583676e-03 +-2.2512455866040078e-03 +-2.2837078072804216e-03 +-2.3044861167532157e-03 +-2.3055547641788595e-03 +-2.2811753439681303e-03 +-2.2298467004847711e-03 +-2.1543989665697514e-03 +-2.0605822779404988e-03 +-1.9552102211977964e-03 +-1.8446900446960511e-03 +-1.7342213399156566e-03 +-1.6275630871633070e-03 +-1.5271449662188751e-03 +-1.4343270710311135e-03 +-1.3496848971409499e-03 +-1.2732597572551218e-03 +-1.2047549097397160e-03 +-1.1436782082967056e-03 +-1.0894402470319612e-03 +-1.0414186743660401e-03 +-9.9899824189749712e-04 +-9.6159417558700682e-04 +-9.2866448568977881e-04 +-8.9971519077342282e-04 +-8.7430117946194342e-04 +-8.5202452781883969e-04 +-8.3253145678095514e-04 +-8.1550868221132503e-04 +-8.0067962117992835e-04 +-7.8780072832791411e-04 +-7.7665811335720020e-04 +-7.6706451294970509e-04 +-7.5885664207147262e-04 +-7.5189292077773215e-04 +-7.4605155603204188e-04 +-7.4122894961016050e-04 +-7.3733839952095769e-04 +-7.3430906211910136e-04 +-7.3208514358637396e-04 +-7.3062529247775777e-04 +-7.2990216869614055e-04 +-2.0560405120482487e-03 +-2.0601172308382884e-03 +-2.0683864756888331e-03 +-2.0810780269719972e-03 +-2.0985214022532484e-03 +-2.1210940657643449e-03 +-2.1490789432142923e-03 +-2.1823303726369978e-03 +-2.2196260392615399e-03 +-2.2577516224693952e-03 +-2.2908527933929836e-03 +-2.3109817964414850e-03 +-2.3102118967514278e-03 +-2.2833320428296035e-03 +-2.2294882857380395e-03 +-2.1519902639188944e-03 +-2.0567951702567906e-03 +-1.9507013079508944e-03 +-1.8399823583381788e-03 +-1.7296732979095492e-03 +-1.6233866787107140e-03 +-1.5234419157166819e-03 +-1.4311251710805990e-03 +-1.3469672453760833e-03 +-1.2709855603870042e-03 +-1.2028730531788122e-03 +-1.1421354579232122e-03 +-1.0881858039821174e-03 +-1.0404064076368787e-03 +-9.9818752513483860e-04 +-9.6094993609548596e-04 +-9.2815684589173737e-04 +-8.9931892951646334e-04 +-8.7399514276536542e-04 +-8.5179105818649747e-04 +-8.3235587418841925e-04 +-8.1537882910644470e-04 +-8.0058547251167804e-04 +-7.8773406180560719e-04 +-7.7661223261784554e-04 +-7.6703401552151234e-04 +-7.5883722424049829e-04 +-7.5188121209186873e-04 +-7.4604497705063535e-04 +-7.4122558738356267e-04 +-7.3733689618961146e-04 +-7.3430851283477500e-04 +-7.3208500075002498e-04 +-7.3062527397649171e-04 +-7.2990216846481549e-04 +-2.0529830949165360e-03 +-2.0570582532040121e-03 +-2.0653707852724516e-03 +-2.0782414966134927e-03 +-2.0961255345429944e-03 +-2.1195300940158460e-03 +-2.1488066450418954e-03 +-2.1837162548208485e-03 +-2.2226925406403533e-03 +-2.2619569278041160e-03 +-2.2950988150155761e-03 +-2.3139433450453588e-03 +-2.3108256004317519e-03 +-2.2811463981423693e-03 +-2.2247047876265951e-03 +-2.1452559522520498e-03 +-2.0489199986105894e-03 +-1.9424366439599579e-03 +-1.8319064689826586e-03 +-1.7221659642443217e-03 +-1.6166547650141494e-03 +-1.5175635764218458e-03 +-1.4260935991897558e-03 +-1.3427258629853129e-03 +-1.2674530700206195e-03 +-1.1999597093266517e-03 +-1.1397527644653291e-03 +-1.0862517184289813e-03 +-1.0388476816885169e-03 +-9.9694033514864666e-04 +-9.5995956679699869e-04 +-9.2737690618375156e-04 +-8.9871038601410278e-04 +-8.7352533189011944e-04 +-8.5143276024427330e-04 +-8.3208648670859942e-04 +-8.1517965035393268e-04 +-8.0044109191338634e-04 +-7.8763184708255363e-04 +-7.7654190065746685e-04 +-7.6698727353596223e-04 +-7.5880746847738082e-04 +-7.5186327260602485e-04 +-7.4603489851263703e-04 +-7.4122043736046339e-04 +-7.3733459375417904e-04 +-7.3430767165560084e-04 +-7.3208478202546243e-04 +-7.3062524564764528e-04 +-7.2990216811249186e-04 +-2.0445766419046143e-03 +-2.0486355313658424e-03 +-2.0569548202128236e-03 +-2.0699311630863236e-03 +-2.0881182063224647e-03 +-2.1121055588803391e-03 +-2.1422395401197972e-03 +-2.1781050023169032e-03 +-2.2177627591569524e-03 +-2.2569835896785921e-03 +-2.2890787231116118e-03 +-2.3059726720820344e-03 +-2.3004542849003624e-03 +-2.2685060163634609e-03 +-2.2103932456511962e-03 +-2.1301010164533453e-03 +-2.0337516579354872e-03 +-1.9279373520084953e-03 +-1.8185489205781956e-03 +-1.7102159424032383e-03 +-1.6062089961147619e-03 +-1.5085984378318525e-03 +-1.4185102862497212e-03 +-1.3363858956628592e-03 +-1.2622031953731759e-03 +-1.1956477283842880e-03 +-1.1362365585648273e-03 +-1.0834036266784393e-03 +-1.0365559360797087e-03 +-9.9510877588346487e-04 +-9.5850645281108564e-04 +-9.2623333222257003e-04 +-8.9781860805493332e-04 +-8.7283716591061164e-04 +-8.5090813418692182e-04 +-8.3169217492950662e-04 +-8.1488819147445884e-04 +-8.0022987632307645e-04 +-7.8748235381906036e-04 +-7.7643906150156499e-04 +-7.6691894275597529e-04 +-7.5876397847017454e-04 +-7.5183705798178993e-04 +-7.4602017358139374e-04 +-7.4121291429572148e-04 +-7.3733123086992130e-04 +-7.3430644319318528e-04 +-7.3208446262830766e-04 +-7.3062520428292385e-04 +-7.2990216759954215e-04 +-2.0242430917334800e-03 +-2.0282543535294446e-03 +-2.0364870016216521e-03 +-2.0493527406259190e-03 +-2.0674164148512184e-03 +-2.0912485092788166e-03 +-2.1211047808129720e-03 +-2.1563822051020322e-03 +-2.1949062683149418e-03 +-2.2323258489497888e-03 +-2.2621308546079237e-03 +-2.2767509251926969e-03 +-2.2695905486946619e-03 +-2.2370653826288751e-03 +-2.1795492630902005e-03 +-2.1008660773337486e-03 +-2.0068469405320260e-03 +-1.9037786469172158e-03 +-1.7972929344793193e-03 +-1.6918258718937949e-03 +-1.5905183740709229e-03 +-1.4953647627555897e-03 +-1.4074560107479336e-03 +-1.3272272358475156e-03 +-1.2546686059635645e-03 +-1.1894883941717103e-03 +-1.1312312013513173e-03 +-1.0793595734678921e-03 +-1.0333079374694534e-03 +-9.9251662704191094e-04 +-9.5645211053173936e-04 +-9.2461795370627549e-04 +-8.9655975098590270e-04 +-8.7186626761118278e-04 +-8.5016831236921881e-04 +-8.3113634895450310e-04 +-8.1447749991076380e-04 +-7.9993235613283280e-04 +-7.8727184345468541e-04 +-7.7629429123365250e-04 +-7.6682277861411709e-04 +-7.5870279006694415e-04 +-7.5180018453545512e-04 +-7.4599946632836775e-04 +-7.4120233703623155e-04 +-7.3732650359363289e-04 +-7.3430471658112557e-04 +-7.3208401376677009e-04 +-7.3062514615652053e-04 +-7.2990216687995153e-04 +-1.9821983553608247e-03 +-1.9861116317800736e-03 +-1.9941141100390364e-03 +-2.0065488712444658e-03 +-2.0238776897756401e-03 +-2.0465363476814161e-03 +-2.0746298041829639e-03 +-2.1074387169924698e-03 +-2.1428157361677021e-03 +-2.1767260238484787e-03 +-2.2033339759310617e-03 +-2.2159515790852770e-03 +-2.2087151795315454e-03 +-2.1782914049292058e-03 +-2.1247630079739180e-03 +-2.0513284004747578e-03 +-1.9631401018674684e-03 +-1.8659395260350645e-03 +-1.7650025261842170e-03 +-1.6645741356929591e-03 +-1.5677192604918100e-03 +-1.4764264231804779e-03 +-1.3918194978017227e-03 +-1.3143854258702058e-03 +-1.2441733573569725e-03 +-1.1809509249892296e-03 +-1.1243187196058406e-03 +-1.0737900216818447e-03 +-1.0288439996391555e-03 +-9.8895969333303376e-04 +-9.5363659826776411e-04 +-9.2240618802871355e-04 +-8.9483748320091981e-04 +-8.7053883254100219e-04 +-8.4915738262551354e-04 +-8.3037722264956912e-04 +-8.1391685074558013e-04 +-7.9952637539872692e-04 +-7.8698470847352075e-04 +-7.7609690176613116e-04 +-7.6669171034381134e-04 +-7.5861942164189987e-04 +-7.5174996142040012e-04 +-7.4597127076245283e-04 +-7.4118793868407202e-04 +-7.3732007009917112e-04 +-7.3430236725031538e-04 +-7.3208340311386381e-04 +-7.3062506708727328e-04 +-7.2990216590214374e-04 +-1.9091944233878078e-03 +-1.9129464340604345e-03 +-1.9205617250774476e-03 +-1.9322556611123475e-03 +-1.9483085904198959e-03 +-1.9689499911043624e-03 +-1.9941168794452607e-03 +-2.0230685652952479e-03 +-2.0539241849857354e-03 +-2.0833162400770758e-03 +-2.1064488935421586e-03 +-2.1177859791375528e-03 +-2.1122989951530705e-03 +-2.0868192420876101e-03 +-2.0408795283670140e-03 +-1.9766854399447449e-03 +-1.8983343356337235e-03 +-1.8107263110209593e-03 +-1.7186077578911529e-03 +-1.6259729111002383e-03 +-1.5358294347742299e-03 +-1.4502195786481877e-03 +-1.3703726380888826e-03 +-1.2968970895965311e-03 +-1.2299611597506646e-03 +-1.1694407698054803e-03 +-1.1150311807467614e-03 +-1.0663265893182884e-03 +-1.0228743847027070e-03 +-9.8421063075515786e-04 +-9.4988222820595845e-04 +-9.1945992962699015e-04 +-8.9254524719713571e-04 +-8.6877339805395567e-04 +-8.4781376554271960e-04 +-8.2936887603544496e-04 +-8.1317255523889319e-04 +-7.9898769627346708e-04 +-7.8660391407419088e-04 +-7.7583525450184918e-04 +-7.6651805595894505e-04 +-7.5850901503375721e-04 +-7.5168347796277478e-04 +-7.4593396114083104e-04 +-7.4116889288374475e-04 +-7.3731156265695959e-04 +-7.3429926137495358e-04 +-7.3208259597746595e-04 +-7.3062496259139204e-04 +-7.2990216461079314e-04 +-1.8021138079324576e-03 +-1.8056414190281828e-03 +-1.8127391136153095e-03 +-1.8234868965630111e-03 +-1.8379758059163518e-03 +-1.8562297318585488e-03 +-1.8780423553186503e-03 +-1.9027159249568799e-03 +-1.9287428157671446e-03 +-1.9535525304870856e-03 +-1.9735120942650057e-03 +-1.9843415320108110e-03 +-1.9819400611280663e-03 +-1.9633738596853468e-03 +-1.9276254881580893e-03 +-1.8757911491623161e-03 +-1.8106902261584310e-03 +-1.7361184530825099e-03 +-1.6560650127836339e-03 +-1.5741248253322725e-03 +-1.4931834672531701e-03 +-1.4153358194170767e-03 +-1.3419531172505759e-03 +-1.2738179545503882e-03 +-1.2112724731612469e-03 +-1.1543508731146393e-03 +-1.1028855577090862e-03 +-1.0565863508930321e-03 +-1.0150966542052358e-03 +-9.7803160363120890e-04 +-9.4500296116197847e-04 +-9.1563461169905916e-04 +-8.8957160821504595e-04 +-8.6648490551373370e-04 +-8.4607329357425847e-04 +-8.2806357405981290e-04 +-8.1220968780270654e-04 +-7.9829126507399728e-04 +-7.8611190709741046e-04 +-7.7549739556502257e-04 +-7.6629395136141351e-04 +-7.5836661321046755e-04 +-7.5159777372479876e-04 +-7.4588588893201909e-04 +-7.4114436403506490e-04 +-7.3730061034543530e-04 +-7.3429526425047474e-04 +-7.3208155749513012e-04 +-7.3062482816823996e-04 +-7.2990216295046155e-04 +-1.6665402723650129e-03 +-1.6697943779267843e-03 +-1.6762926100941746e-03 +-1.6860119735859879e-03 +-1.6989007041085331e-03 +-1.7148321346097653e-03 +-1.7335081836647103e-03 +-1.7543027114812757e-03 +-1.7760644807498776e-03 +-1.7969460859142158e-03 +-1.8143678534148025e-03 +-1.8252248423564481e-03 +-1.8263679769480719e-03 +-1.8152529482934425e-03 +-1.7905326393238322e-03 +-1.7523628521508793e-03 +-1.7023161521621186e-03 +-1.6429733933183959e-03 +-1.5773758050193533e-03 +-1.5085231337368553e-03 +-1.4390280322249130e-03 +-1.3709484853843931e-03 +-1.3057622524371047e-03 +-1.2444281458834779e-03 +-1.1874854396736979e-03 +-1.1351587627934708e-03 +-1.0874512284636958e-03 +-1.0442193731476676e-03 +-1.0052296368840219e-03 +-9.7019891056042613e-04 +-9.3882249032767209e-04 +-9.1079262001248851e-04 +-8.8581026949171541e-04 +-8.6359219771578184e-04 +-8.4387481506733751e-04 +-8.2641593111938466e-04 +-8.1099514920628048e-04 +-7.9741343193291496e-04 +-7.8549219232920285e-04 +-7.7507214638180741e-04 +-7.6601208019257767e-04 +-7.5818762849784221e-04 +-7.5149012305025342e-04 +-7.4582554391736523e-04 +-7.4111359020734941e-04 +-7.3728687635604326e-04 +-7.3429025399542210e-04 +-7.3208025621158046e-04 +-7.3062465976489769e-04 +-7.2990216087123251e-04 +-1.5143498148311853e-03 +-1.5173039739957530e-03 +-1.5231724888981513e-03 +-1.5318739801710860e-03 +-1.5432769067002059e-03 +-1.5571748850786553e-03 +-1.5732350734376597e-03 +-1.5909132564001693e-03 +-1.6093433379670546e-03 +-1.6272326605517213e-03 +-1.6428195198650963e-03 +-1.6539572581159027e-03 +-1.6583611855799565e-03 +-1.6539885823994964e-03 +-1.6394474074217249e-03 +-1.6142943114010502e-03 +-1.5791173982153571e-03 +-1.5353870451216723e-03 +-1.4851460972939848e-03 +-1.4306521626142683e-03 +-1.3740703681915818e-03 +-1.3172688260842057e-03 +-1.2617224314020532e-03 +-1.2085017185603686e-03 +-1.1583143787784347e-03 +-1.1115708665601692e-03 +-1.0684543927422542e-03 +-1.0289843237502704e-03 +-9.9306842075805530e-04 +-9.6054323291563134e-04 +-9.3120389169004778e-04 +-9.0482525576976436e-04 +-8.8117639640372073e-04 +-8.6003015947878946e-04 +-8.4116919905322758e-04 +-8.2438954721879255e-04 +-8.0950250608707180e-04 +-7.9633542763716636e-04 +-7.8473178090648433e-04 +-7.7455078388735026e-04 +-7.6566678955643697e-04 +-7.5796855311564392e-04 +-7.5135846391761768e-04 +-7.4575179548230851e-04 +-7.4107600663392769e-04 +-7.3727011328875256e-04 +-7.3428414178030232e-04 +-7.3207866934426160e-04 +-7.3062445445869651e-04 +-7.2990215833721795e-04 +-1.3589555542490638e-03 +-1.3616072665312013e-03 +-1.3668597753356685e-03 +-1.3746102105349114e-03 +-1.3846992671953341e-03 +-1.3968988215653560e-03 +-1.4108862799657280e-03 +-1.4262020348702327e-03 +-1.4421924923016098e-03 +-1.4579520896862851e-03 +-1.4722907284374297e-03 +-1.4837607522713860e-03 +-1.4907704661889930e-03 +-1.4917844081732048e-03 +-1.4855717061897709e-03 +-1.4714328951164909e-03 +-1.4493331956340484e-03 +-1.4199015250379249e-03 +-1.3843032245477657e-03 +-1.3440346934195373e-03 +-1.3007023555584205e-03 +-1.2558367815530612e-03 +-1.2107680529378447e-03 +-1.1665646692960198e-03 +-1.1240233631356340e-03 +-1.0836919820410942e-03 +-1.0459090626615791e-03 +-1.0108481353757759e-03 +-9.7855951374688677e-04 +-9.4900606176517442e-04 +-9.2209189631575804e-04 +-8.9768436117956590e-04 +-8.7563023344907351e-04 +-8.5576729571844182e-04 +-8.3793234587965337e-04 +-8.2196655686712407e-04 +-8.0771891633622556e-04 +-7.9504830713719374e-04 +-7.8382464733333626e-04 +-7.7392939572531311e-04 +-7.6525564256443423e-04 +-7.5770794082022916e-04 +-7.5120198635449098e-04 +-7.4566422155639914e-04 +-7.4103141308186620e-04 +-7.3725023770836531e-04 +-7.3427689898539065e-04 +-7.3207678982872273e-04 +-7.3062421136821972e-04 +-7.2990215533773415e-04 +-1.2115490000550830e-03 +-1.2139154382053341e-03 +-1.2185978506643654e-03 +-1.2254946738152808e-03 +-1.2344509088606580e-03 +-1.2452520988253057e-03 +-1.2576121728644389e-03 +-1.2711533366385490e-03 +-1.2853786529676394e-03 +-1.2996426649013345e-03 +-1.3131315715384604e-03 +-1.3248694135207649e-03 +-1.3337663379136820e-03 +-1.3387159185258102e-03 +-1.3387313879985273e-03 +-1.3330920167662701e-03 +-1.3214606707566278e-03 +-1.3039388480322745e-03 +-1.2810449470149288e-03 +-1.2536258022268552e-03 +-1.2227293584905986e-03 +-1.1894714261259376e-03 +-1.1549228677561548e-03 +-1.1200311869414791e-03 +-1.0855785151000909e-03 +-1.0521700327008280e-03 +-1.0202435472200179e-03 +-9.9009109622682839e-04 +-9.6188538204145977e-04 +-9.3570624384898724e-04 +-9.1156447781511898e-04 +-8.8942184764220918e-04 +-8.6920709276870893e-04 +-8.5082826390328907e-04 +-8.3418194066485073e-04 +-8.1915993432901061e-04 +-8.0565403501158916e-04 +-7.9355928031212453e-04 +-7.8277613155391262e-04 +-7.7321185929285713e-04 +-7.6478136781523787e-04 +-7.5740763019941737e-04 +-7.5102186016566769e-04 +-7.4556351247141890e-04 +-7.4098017794887831e-04 +-7.3722742051089913e-04 +-7.3426858994852661e-04 +-7.3207463477994604e-04 +-7.3062393274444452e-04 +-7.2990215190080405e-04 +-1.0795737334894982e-03 +-1.0816852167164015e-03 +-1.0858635958505773e-03 +-1.0920192835263869e-03 +-1.1000164290946017e-03 +-1.1096699825394127e-03 +-1.1207400591919309e-03 +-1.1329227979004124e-03 +-1.1458378661280372e-03 +-1.1590146922545832e-03 +-1.1718822230217536e-03 +-1.1837696303662578e-03 +-1.1939263252574849e-03 +-1.2015671577889882e-03 +-1.2059421519025658e-03 +-1.2064210952310122e-03 +-1.2025754939897781e-03 +-1.1942379435008854e-03 +-1.1815238279844198e-03 +-1.1648107401677160e-03 +-1.1446825823510738e-03 +-1.1218533102066342e-03 +-1.0970873628154347e-03 +-1.0711306345252522e-03 +-1.0446599143091996e-03 +-1.0182527451702221e-03 +-9.9237534932022009e-04 +-9.6738410337720139e-04 +-9.4353565879903140e-04 +-9.2100148905475759e-04 +-8.9988376312340559e-04 +-8.8023056490822151e-04 +-8.6204938817858090e-04 +-8.4531847940406111e-04 +-8.2999600269118804e-04 +-8.1602721979180714e-04 +-8.0334997337069846e-04 +-7.9189878189805181e-04 +-7.8160783423482307e-04 +-7.7241313353590402e-04 +-7.6425399668176436e-04 +-7.5707407407823492e-04 +-7.5082201851447506e-04 +-7.4545190181529372e-04 +-7.4092345408597379e-04 +-7.3720218171339320e-04 +-7.3425940607759908e-04 +-7.3207225425746302e-04 +-7.3062362509656708e-04 +-7.2990214810690613e-04 +-9.6691635541397186e-04 +-9.6881016233350738e-04 +-9.7256057217355303e-04 +-9.7809289481921727e-04 +-9.8529422532213189e-04 +-9.9401195903358751e-04 +-1.0040511631598098e-03 +-1.0151704998003592e-03 +-1.0270767668442641e-03 +-1.0394188911864021e-03 +-1.0517833541066413e-03 +-1.0636942795168296e-03 +-1.0746221947678463e-03 +-1.0840050349291924e-03 +-1.0912827692197732e-03 +-1.0959432423331709e-03 +-1.0975725556697925e-03 +-1.0959003255702274e-03 +-1.0908300020530720e-03 +-1.0824475291617067e-03 +-1.0710069111085838e-03 +-1.0568967005031300e-03 +-1.0405951351209260e-03 +-1.0226226890409397e-03 +-1.0034994356174312e-03 +-9.8371188020467452e-04 +-9.6369097601793218e-04 +-9.4380070924328765e-04 +-9.2433525810156787e-04 +-9.0552223104658233e-04 +-8.8752960979694348e-04 +-8.7047447122558914e-04 +-8.5443210883463414e-04 +-8.3944467949381718e-04 +-8.2552890106591639e-04 +-8.1268260927040389e-04 +-8.0089016219352918e-04 +-7.9012678248237159e-04 +-7.8036197470947245e-04 +-7.7156216865093767e-04 +-7.6369273294921527e-04 +-7.5671948770715623e-04 +-7.5060982512628930e-04 +-7.4533352787060729e-04 +-7.4086335719304166e-04 +-7.3717546772486130e-04 +-7.3424969331946474e-04 +-7.3206973825361288e-04 +-7.3062330008343739e-04 +-7.2990214409997538e-04 +-8.7486160206653920e-04 +-8.7657737037818463e-04 +-8.7997857659398589e-04 +-8.8500435915202648e-04 +-8.9156287159727595e-04 +-8.9953047796102574e-04 +-9.0875047773747604e-04 +-9.1903127847966181e-04 +-9.3014408133782682e-04 +-9.4182044992672923e-04 +-9.5375060437510298e-04 +-9.6558384191288208e-04 +-9.7693293491376318e-04 +-9.8738440172557295e-04 +-9.9651590042481599e-04 +-1.0039205639136950e-03 +-1.0092361254358147e-03 +-1.0121747843357511e-03 +-1.0125486922269971e-03 +-1.0102862508066233e-03 +-1.0054361361003397e-03 +-9.9815855656745648e-04 +-9.8870584509471631e-04 +-9.7739628511644256e-04 +-9.6458568111686452e-04 +-9.5064067991742617e-04 +-9.3591663713630895e-04 +-9.2074140007249042e-04 +-9.0540513766929412e-04 +-8.9015549522765891e-04 +-8.7519691659364198e-04 +-8.6069288019722764e-04 +-8.4676991742690813e-04 +-8.3352250986457022e-04 +-8.2101821360382741e-04 +-8.0930258568723105e-04 +-7.9840366827338969e-04 +-7.8833591693178889e-04 +-7.7910354637045307e-04 +-7.7070331945267598e-04 +-7.6312683324362106e-04 +-7.5636236729101347e-04 +-7.5039636068072852e-04 +-7.4521458006232707e-04 +-7.4080303374837112e-04 +-7.3714867896443120e-04 +-7.3423996140249410e-04 +-7.3206721892461366e-04 +-7.3062297478713805e-04 +-7.2990214009061938e-04 +-8.0313908433359623e-04 +-8.0471600334892164e-04 +-8.0784506249955053e-04 +-8.1247655594478968e-04 +-8.1853554551680351e-04 +-8.2592138156841008e-04 +-8.3450703424489247e-04 +-8.4413824119259728e-04 +-8.5463254032072493e-04 +-8.6577838013702623e-04 +-8.7733469404821594e-04 +-8.8903156798628353e-04 +-9.0057285699670546e-04 +-9.1164170500351730e-04 +-9.2190976441892524e-04 +-9.3105041067210288e-04 +-9.3875542269717272e-04 +-9.4475362580681154e-04 +-9.4882916296416256e-04 +-9.5083668783009381e-04 +-9.5071105062385886e-04 +-9.4846994640051922e-04 +-9.4420926297307409e-04 +-9.3809213204661774e-04 +-9.3033361454256645e-04 +-9.2118335389428248e-04 +-9.1090841211021996e-04 +-8.9977800941661793e-04 +-8.8805122479965182e-04 +-8.7596806685229928e-04 +-8.6374381165953834e-04 +-8.5156617367041659e-04 +-8.3959471724279634e-04 +-8.2796189088605232e-04 +-8.1677512487647401e-04 +-8.0611953325746303e-04 +-7.9606087231090929e-04 +-7.8664851056818878e-04 +-7.7791825123656416e-04 +-7.6989491407007714e-04 +-7.6259463150690342e-04 +-7.5602684634791127e-04 +-7.5019601880829028e-04 +-7.4510306261764121e-04 +-7.4074653560608360e-04 +-7.3712361191405470e-04 +-7.3423086207995624e-04 +-7.3206486481382509e-04 +-7.3062267095419791e-04 +-7.2990213634674460e-04 +-7.5076450159741281e-04 +-7.5223999323566259e-04 +-7.5517023692889262e-04 +-7.5951363926148941e-04 +-7.6520753031384433e-04 +-7.7216784448991770e-04 +-7.8028872507932500e-04 +-7.8944208812424174e-04 +-7.9947721121785326e-04 +-8.1022046632048120e-04 +-8.2147539779580845e-04 +-8.3302345288213816e-04 +-8.4462578027836362e-04 +-8.5602658256931513e-04 +-8.6695848558373026e-04 +-8.7715022242244910e-04 +-8.8633660204049758e-04 +-8.9427027644291930e-04 +-9.0073433272264342e-04 +-9.0555435317684794e-04 +-9.0860844038939030e-04 +-9.0983386809861738e-04 +-9.0922947389339784e-04 +-9.0685354745699228e-04 +-9.0281762894851771e-04 +-8.9727716322845770e-04 +-8.9042025814060563e-04 +-8.8245584483190331e-04 +-8.7360237670125636e-04 +-8.6407791047822221e-04 +-8.5409207412833865e-04 +-8.4384011115076340e-04 +-8.3349894166280547e-04 +-8.2322501314658454e-04 +-8.1315362379976049e-04 +-8.0339937388828784e-04 +-7.9405741638960089e-04 +-7.8520521973462609e-04 +-7.7690460840692773e-04 +-7.6920390160994988e-04 +-7.6214002009927805e-04 +-7.5574047354023358e-04 +-7.5002517441243532e-04 +-7.4500804984451536e-04 +-7.4069844080731375e-04 +-7.3710229007023769e-04 +-7.3422312750574511e-04 +-7.3206286485474209e-04 +-7.3062241292599678e-04 +-7.2990213316792845e-04 +-7.1661628752872240e-04 +-7.1802573997895741e-04 +-7.2082649564511939e-04 +-7.2498216177390481e-04 +-7.3043792388336544e-04 +-7.3712030408449095e-04 +-7.4493688670270364e-04 +-7.5377605425169455e-04 +-7.6350679420268078e-04 +-7.7397866334508398e-04 +-7.8502203479730395e-04 +-7.9644880234486606e-04 +-8.0805377075544025e-04 +-8.1961700357022129e-04 +-8.3090740833287194e-04 +-8.4168778715757256e-04 +-8.5172144824104145e-04 +-8.6078025948719042e-04 +-8.6865375352399531e-04 +-8.7515861609408819e-04 +-8.8014767599261959e-04 +-8.8351743005018427e-04 +-8.8521322066804778e-04 +-8.8523143355085103e-04 +-8.8361845298599406e-04 +-8.8046652423987557e-04 +-8.7590704319309774e-04 +-8.7010205476237192e-04 +-8.6323485899100728e-04 +-8.5550059811118041e-04 +-8.4709755939890740e-04 +-8.3821972271710629e-04 +-8.2905085526233167e-04 +-8.1976024741181282e-04 +-8.1050001706676035e-04 +-8.0140379571320476e-04 +-7.9258654646081439e-04 +-7.8414524426716930e-04 +-7.7616015987952013e-04 +-7.6869652001823250e-04 +-7.6180635694197854e-04 +-7.5553040322601640e-04 +-7.4989992735993000e-04 +-7.4493843983962620e-04 +-7.4066322666651609e-04 +-7.3708668756581816e-04 +-7.3421747045249435e-04 +-7.3206140266661782e-04 +-7.3062222433121365e-04 +-7.2990213084488402e-04 +-6.9978945167051862e-04 +-7.0116661915593976e-04 +-7.0390406368563607e-04 +-7.0796791864891106e-04 +-7.1330718123276701e-04 +-7.1985350053651361e-04 +-7.2752094694559946e-04 +-7.3620580693375829e-04 +-7.4578646051660458e-04 +-7.5612341577180840e-04 +-7.6705959807858140e-04 +-7.7842102137909658e-04 +-7.9001800203713768e-04 +-8.0164710538032508e-04 +-8.1309402832466227e-04 +-8.2413760253330988e-04 +-8.3455503554879184e-04 +-8.4412838280015874e-04 +-8.5265206497776391e-04 +-8.5994103454087810e-04 +-8.6583899126409659e-04 +-8.7022589938287446e-04 +-8.7302401480804761e-04 +-8.7420171830880340e-04 +-8.7377466745703811e-04 +-8.7180409139415299e-04 +-8.6839239833361528e-04 +-8.6367657837419854e-04 +-8.5782010669029833e-04 +-8.5100415241401808e-04 +-8.4341887440754157e-04 +-8.3525546022988418e-04 +-8.2669937773735677e-04 +-8.1792510187100279e-04 +-8.0909238757181272e-04 +-8.0034400665896497e-04 +-7.9180476210306632e-04 +-7.8358153680960761e-04 +-7.7576411809622699e-04 +-7.6842655252763140e-04 +-7.6162881740336123e-04 +-7.5541863531782352e-04 +-7.4983329960395687e-04 +-7.4490141642552261e-04 +-7.4064450125276981e-04 +-7.3707839250795729e-04 +-7.3421446344336828e-04 +-7.3206062555813533e-04 +-7.3062212410964433e-04 +-7.2990212961045620e-04 +-6.9978952820068418e-04 +-7.0116730880135638e-04 +-7.0390598379823960e-04 +-7.0797169301166309e-04 +-7.1331343819255215e-04 +-7.1986286514691845e-04 +-7.2753402543049609e-04 +-7.3622316227754409e-04 +-7.4580857884234226e-04 +-7.5615066445009545e-04 +-7.6709217819546157e-04 +-7.7845891912224846e-04 +-7.9006094541280987e-04 +-8.0169453397706562e-04 +-8.1314508405556354e-04 +-8.2419114796282282e-04 +-8.3460970336274548e-04 +-8.4418265546228868e-04 +-8.5270437837563608e-04 +-8.5998989457690032e-04 +-8.6588308910478574e-04 +-8.7026421037431122e-04 +-8.7305586822694202e-04 +-8.7422682973189504e-04 +-8.7379313154691397e-04 +-8.7181633895419140e-04 +-8.6839912631042149e-04 +-8.6367866424856012e-04 +-8.5781851915934973e-04 +-8.5099986874395835e-04 +-8.4341281200612226e-04 +-8.3524842664443432e-04 +-8.2669204012286940e-04 +-8.1791797446410222e-04 +-8.0908583406257993e-04 +-8.0033825356683695e-04 +-7.9179991918437655e-04 +-7.8357762093682044e-04 +-7.7576107773446527e-04 +-7.6842429071138690e-04 +-7.6162721185712469e-04 +-7.5541755499355251e-04 +-7.4983261739422968e-04 +-7.4490101815310149e-04 +-7.4064429125288817e-04 +-7.3707829623538155e-04 +-7.3421442758053593e-04 +-7.3206061609955048e-04 +-7.3062212287316585e-04 +-7.2990212959513534e-04 +-7.1661652908068605e-04 +-7.1802791670019632e-04 +-7.2083255597301993e-04 +-7.2499407387982182e-04 +-7.3045766861587621e-04 +-7.3714984798999375e-04 +-7.4497812957343486e-04 +-7.5383074740608032e-04 +-7.6357642872669094e-04 +-7.7406433202621499e-04 +-7.8512427734090610e-04 +-7.9656745004337093e-04 +-8.0818781285615536e-04 +-8.1976450142834411e-04 +-8.3106548316673370e-04 +-8.4185270141239478e-04 +-8.5188878892259357e-04 +-8.6094521570646073e-04 +-8.6881146294207653e-04 +-8.7530454007957040e-04 +-8.8027795509490296e-04 +-8.8362917239671402e-04 +-8.8530468626212466e-04 +-8.8530209480028430e-04 +-8.8366893197876510e-04 +-8.8049842570670335e-04 +-8.7592271508491620e-04 +-8.7010431406454229e-04 +-8.6322671893723367e-04 +-8.5548502604618183e-04 +-8.4707728464056221e-04 +-8.3819710334197663e-04 +-8.2902780366872237e-04 +-8.1973820787812734e-04 +-8.1047998462253175e-04 +-8.0138636420612854e-04 +-7.9257197414728188e-04 +-7.8413352689431400e-04 +-7.7615110344359157e-04 +-7.6868980770006267e-04 +-7.6180160682253915e-04 +-7.5552721510821431e-04 +-7.4989791831435687e-04 +-7.4493726897408594e-04 +-7.4066261015536515e-04 +-7.3708640524552851e-04 +-7.3421736537468093e-04 +-7.3206137497044889e-04 +-7.3062222071208164e-04 +-7.2990213080001171e-04 +-7.5076494604922519e-04 +-7.5224399834700271e-04 +-7.5518138737929949e-04 +-7.5953555391085293e-04 +-7.6524384482881105e-04 +-7.7222215349323584e-04 +-7.8036447282431613e-04 +-7.8954240070509872e-04 +-7.9960467019156726e-04 +-8.1037683371512344e-04 +-8.2166131532911482e-04 +-8.3323815207149703e-04 +-8.4486685185941515e-04 +-8.5628985913702301e-04 +-8.6723808658717720e-04 +-8.7743879321693606e-04 +-8.8662574952763640e-04 +-8.9455116786653582e-04 +-9.0099838973995241e-04 +-9.0579394972741271e-04 +-9.0881750730943353e-04 +-9.1000832214628579e-04 +-9.0936742025226355e-04 +-9.0695524464620085e-04 +-9.0288524346881333e-04 +-8.9731436984287168e-04 +-8.9043175585302070e-04 +-8.8244685818857169e-04 +-8.7357820024716712e-04 +-8.6404353601538496e-04 +-8.5405192080404552e-04 +-8.4379786112793933e-04 +-8.3345747132339764e-04 +-8.2318640205158013e-04 +-8.1311922047584326e-04 +-8.0336989784336320e-04 +-7.9403307833138617e-04 +-7.8518584565742265e-04 +-7.7688975716471906e-04 +-7.6919296924628613e-04 +-7.6213232725232257e-04 +-7.5573533457720221e-04 +-7.5002194859330039e-04 +-7.4500617586486628e-04 +-7.4069745664999398e-04 +-7.3710184033339606e-04 +-7.3422296038748523e-04 +-7.3206282085844872e-04 +-7.3062240718140242e-04 +-7.2990213309675393e-04 +-8.0313980146522017e-04 +-8.0472246562118539e-04 +-8.0786305281748761e-04 +-8.1251190698874726e-04 +-8.1859410064412201e-04 +-8.2600888083194973e-04 +-8.3462890597076447e-04 +-8.4429928821724148e-04 +-8.5483652467340280e-04 +-8.6602753115582528e-04 +-8.7762919097836235e-04 +-8.8936907439925552e-04 +-9.0094820330123028e-04 +-9.1204681783271617e-04 +-9.2233392033626109e-04 +-9.3148084458623867e-04 +-9.3917825535853319e-04 +-9.4515500512175180e-04 +-9.4919646043461331e-04 +-9.5115957136352835e-04 +-9.5098227570036636e-04 +-9.4868576352223773e-04 +-9.4436941399985114e-04 +-9.3819948071332334e-04 +-9.3039350974624018e-04 +-9.2120284926911216e-04 +-9.1089546246547162e-04 +-8.9974074121879500e-04 +-8.8799734430049790e-04 +-8.7590443513882140e-04 +-8.6367618731112003e-04 +-8.5149910387901035e-04 +-8.3953154739173895e-04 +-8.2790485916263954e-04 +-8.1672551028343879e-04 +-8.0607783019142796e-04 +-7.9602697091830314e-04 +-7.8662186814505697e-04 +-7.7789804528929744e-04 +-7.6988017197366005e-04 +-7.6258433492578325e-04 +-7.5602001081752563e-04 +-7.5019175028217980e-04 +-7.4510059355592225e-04 +-7.4074524349534954e-04 +-7.3712302312061004e-04 +-7.3423064377152046e-04 +-7.3206480743421155e-04 +-7.3062266347014709e-04 +-7.2990213625404607e-04 +-8.7486270329223360e-04 +-8.7658729371318524e-04 +-8.8000619998540998e-04 +-8.8505862532325323e-04 +-8.9165270404675345e-04 +-8.9966456142204362e-04 +-9.0893686967347912e-04 +-9.1927683692076523e-04 +-9.3045372570947269e-04 +-9.4219631560235324e-04 +-9.5419120324120898e-04 +-9.6608338808041607e-04 +-9.7748101881103030e-04 +-9.8796617837310259e-04 +-9.9711288784634731e-04 +-1.0045120313660512e-03 +-1.0098009149924999e-03 +-1.0126932943538885e-03 +-1.0130046974068227e-03 +-1.0106682620802205e-03 +-1.0057381063236070e-03 +-9.9837988088827658e-04 +-9.8885074326993789e-04 +-9.7747275009594245e-04 +-9.6460421691422864e-04 +-9.5061303637423739e-04 +-9.3585469791518166e-04 +-9.2065631525383275e-04 +-9.0530673180606229e-04 +-8.9005193610911817e-04 +-8.7509460236001688e-04 +-8.6059649083295418e-04 +-8.4668257665926458e-04 +-8.3344601040511194e-04 +-8.2095326862002783e-04 +-8.0924907972580566e-04 +-7.9836089005828816e-04 +-7.8830276387176939e-04 +-7.7907869612874883e-04 +-7.7068536774900357e-04 +-7.6311439949518581e-04 +-7.5635417109156332e-04 +-7.5039127276759095e-04 +-7.4521165157777206e-04 +-7.4080150745307514e-04 +-7.3714798574591876e-04 +-7.3423970503784064e-04 +-7.3206715167065486e-04 +-7.3062296602623524e-04 +-7.2990213998219006e-04 +-9.6691800584494583e-04 +-9.6882503442018120e-04 +-9.7260196691985486e-04 +-9.7817418683746721e-04 +-9.8542868879915074e-04 +-9.9421234977045345e-04 +-1.0043290012131407e-03 +-1.0155350380754407e-03 +-1.0275336980720559e-03 +-1.0399689367756757e-03 +-1.0524209776357116e-03 +-1.0644068436513041e-03 +-1.0753898918074497e-03 +-1.0848018330397564e-03 +-1.0920784227426384e-03 +-1.0967061550830330e-03 +-1.0982730420228655e-03 +-1.0965136775090065e-03 +-1.0913387998400155e-03 +-1.0828428222988066e-03 +-1.0712881746536725e-03 +-1.0570707413609043e-03 +-1.0406743028960170e-03 +-1.0226228031062609e-03 +-1.0034377898017100e-03 +-9.8360557350175805e-04 +-9.6355569031397379e-04 +-9.4364994802127256e-04 +-9.2417998920404833e-04 +-9.0537084210345962e-04 +-8.8738807845563134e-04 +-8.7034666303949986e-04 +-8.5432013417313809e-04 +-8.3934926064145978e-04 +-8.2544971816446400e-04 +-8.1261860746914593e-04 +-8.0083981219030375e-04 +-7.9008829310401110e-04 +-7.8033346006302394e-04 +-7.7154177442276088e-04 +-7.6367872725744107e-04 +-7.5671032199076409e-04 +-7.5060417020903891e-04 +-7.4533028978767009e-04 +-7.4086167674910391e-04 +-7.3717470714598646e-04 +-7.3424941281211454e-04 +-7.3206966481535328e-04 +-7.3062329052980314e-04 +-7.2990214398180591e-04 +-1.0795761618689304e-03 +-1.0817070984748783e-03 +-1.0859244927790218e-03 +-1.0921388206218800e-03 +-1.1002139462663017e-03 +-1.1099637504822257e-03 +-1.1211459710495537e-03 +-1.1334525371736409e-03 +-1.1464966938409807e-03 +-1.1597991810089769e-03 +-1.1727784474863097e-03 +-1.1847524247613158e-03 +-1.1949601500288369e-03 +-1.2026088291107781e-03 +-1.2069452178536722e-03 +-1.2073411370560623e-03 +-1.2033752928790483e-03 +-1.1948914408962360e-03 +-1.1820181399330109e-03 +-1.1651460276579577e-03 +-1.1448701137362761e-03 +-1.1219123966649269e-03 +-1.0970419326629189e-03 +-1.0710060808903287e-03 +-1.0444806087438539e-03 +-1.0180403620256323e-03 +-9.9214795824994410e-04 +-9.6715588121932519e-04 +-9.4331703686691907e-04 +-9.2079956366185605e-04 +-8.9970283211945445e-04 +-8.8007269366310382e-04 +-8.6191494485808855e-04 +-8.4520660748438738e-04 +-8.2990501805633044e-04 +-8.1595493181810491e-04 +-8.0329393602827004e-04 +-7.9185648387654817e-04 +-7.8157683784406558e-04 +-7.7239117164339685e-04 +-7.6423903588189869e-04 +-7.5706435103457250e-04 +-7.5081605519165633e-04 +-7.4544850422356439e-04 +-7.4092169823603493e-04 +-7.3720138972374876e-04 +-7.3425911477554195e-04 +-7.3207217814684326e-04 +-7.3062361520858017e-04 +-7.2990214798468521e-04 +-1.2115524961079378e-03 +-1.2139469397819010e-03 +-1.2186855039688150e-03 +-1.2256666328375784e-03 +-1.2347346643868920e-03 +-1.2456730413723425e-03 +-1.2581912579376999e-03 +-1.2719039109281949e-03 +-1.2863027962540297e-03 +-1.3007277627819288e-03 +-1.3143481391441564e-03 +-1.3261712574927302e-03 +-1.3350938055648267e-03 +-1.3400022136224542e-03 +-1.3399109436679137e-03 +-1.3341091166217678e-03 +-1.3222763004385376e-03 +-1.3045342806205385e-03 +-1.2814215886143030e-03 +-1.2538018876146631e-03 +-1.2227347732546923e-03 +-1.1893420744996147e-03 +-1.1546957068734101e-03 +-1.1197405492967486e-03 +-1.0852538668931955e-03 +-1.0518349917627609e-03 +-1.0199158326896533e-03 +-9.8978306334644738e-04 +-9.6160485162501261e-04 +-9.3545741864414517e-04 +-9.1134881703941928e-04 +-8.8923883293628644e-04 +-8.6905486106432137e-04 +-8.5070410806720230e-04 +-8.3408269180530487e-04 +-8.1908224467840997e-04 +-8.0559458069944011e-04 +-7.9351490142549777e-04 +-7.8274392407705221e-04 +-7.7318923061926389e-04 +-7.6476606492127111e-04 +-7.5739774740182645e-04 +-7.5101583166922357e-04 +-7.4556009359820442e-04 +-7.4097841795722535e-04 +-7.3722662918767516e-04 +-7.3426829962986578e-04 +-7.3207455907030512e-04 +-7.3062392292102651e-04 +-7.2990215177945504e-04 +-1.3589604341691234e-03 +-1.3616512361421958e-03 +-1.3669820935405064e-03 +-1.3748500004832026e-03 +-1.3850942821934872e-03 +-1.3974829044132802e-03 +-1.4116853411858265e-03 +-1.4272287686954619e-03 +-1.4434406391286400e-03 +-1.4593917144747827e-03 +-1.4738664212282325e-03 +-1.4853944802401516e-03 +-1.4923697628542764e-03 +-1.4932548453299526e-03 +-1.4868308510019124e-03 +-1.4724221204893099e-03 +-1.4500243248737725e-03 +-1.4202970946322199e-03 +-1.3844312329986189e-03 +-1.3439401181722626e-03 +-1.3004380304101047e-03 +-1.2554556265748887e-03 +-1.2103176617930395e-03 +-1.1660843660033678e-03 +-1.1235432838569569e-03 +-1.0832335301537549e-03 +-1.0454861191151327e-03 +-1.0104685540732945e-03 +-9.7822660049109935e-04 +-9.4871987659479588e-04 +-9.2185031770553808e-04 +-8.9748390979979759e-04 +-8.7546668303045553e-04 +-8.5563610951345246e-04 +-8.3782897751637502e-04 +-8.2188664964409782e-04 +-8.0765842855834880e-04 +-7.9500358472002735e-04 +-7.8379245939860537e-04 +-7.7390694450966979e-04 +-7.6524055562303146e-04 +-7.5769825106600838e-04 +-7.5119610374388272e-04 +-7.4566089903540015e-04 +-7.4102970859485232e-04 +-7.3724947352872777e-04 +-7.3427661926386996e-04 +-7.3207671700751707e-04 +-7.3062420193042781e-04 +-7.2990215522122687e-04 +-1.5143563290078035e-03 +-1.5173626663513989e-03 +-1.5233357183761654e-03 +-1.5321936811642730e-03 +-1.5438024503706897e-03 +-1.5579488159836420e-03 +-1.5742865348510097e-03 +-1.5922496861375944e-03 +-1.6109421175476326e-03 +-1.6290355068977519e-03 +-1.6447328606533289e-03 +-1.6558608974221020e-03 +-1.6601250239745102e-03 +-1.6554938303623011e-03 +-1.6406063477876361e-03 +-1.6150627822981434e-03 +-1.5794969215468539e-03 +-1.5354174054584026e-03 +-1.4848921259643677e-03 +-1.4301893261092140e-03 +-1.3734727225659939e-03 +-1.3166010416485428e-03 +-1.2610359343622078e-03 +-1.2078340306196846e-03 +-1.1576904523797702e-03 +-1.1110053618047298e-03 +-1.0679541594897811e-03 +-1.0285506673506049e-03 +-9.9269896747597474e-04 +-9.6023335997721287e-04 +-9.3094776442451230e-04 +-9.0461654460075871e-04 +-8.8100874992542402e-04 +-8.5989750065266872e-04 +-8.4106589809874945e-04 +-8.2431051141129382e-04 +-8.0944321528552885e-04 +-7.9629193544504952e-04 +-7.8470069476942964e-04 +-7.7452923275303466e-04 +-7.6565238452245968e-04 +-7.5795934437460121e-04 +-7.5135289595484140e-04 +-7.4574866164706718e-04 +-7.4107440371060508e-04 +-7.3726939641346871e-04 +-7.3428387989199972e-04 +-7.3207860126710018e-04 +-7.3062444564454972e-04 +-7.2990215822845122e-04 +-1.6665484406738237e-03 +-1.6698679702049498e-03 +-1.6764972077865474e-03 +-1.6864122530204722e-03 +-1.6995570059741437e-03 +-1.7157938070296605e-03 +-1.7348035841811273e-03 +-1.7559271340422448e-03 +-1.7779691538648160e-03 +-1.7990330311983781e-03 +-1.8164954928290393e-03 +-1.8272266232737711e-03 +-1.8280811614800291e-03 +-1.8165494389861404e-03 +-1.7913416947351760e-03 +-1.7526785776014796e-03 +-1.7021890968919400e-03 +-1.6424915450615144e-03 +-1.5766426958591095e-03 +-1.5076394093413499e-03 +-1.4380795852190823e-03 +-1.3700012270732730e-03 +-1.3048618706826384e-03 +-1.2436027651901637e-03 +-1.1867494464947732e-03 +-1.1345166653880751e-03 +-1.0869009729779916e-03 +-1.0437549212480846e-03 +-1.0048428271892565e-03 +-9.6988072209816913e-04 +-9.3856385003362466e-04 +-9.1058488432239340e-04 +-8.8564548481134321e-04 +-8.6346321780381000e-04 +-8.4377533025414343e-04 +-8.2634044628557442e-04 +-8.1093893432115677e-04 +-7.9737245983447949e-04 +-7.8546307233988281e-04 +-7.7505205844147110e-04 +-7.6599871177744378e-04 +-7.5817911518089411e-04 +-7.5148499279068654e-04 +-7.4582266479833828e-04 +-7.4111212120727104e-04 +-7.3728622072896405e-04 +-7.3429001487909055e-04 +-7.3208019413180804e-04 +-7.3062465173403884e-04 +-7.2990216077218706e-04 +-1.8021232219809064e-03 +-1.8057262296501488e-03 +-1.8129748032592924e-03 +-1.8239473898543246e-03 +-1.8387284864456862e-03 +-1.8573259876395526e-03 +-1.8795037398190201e-03 +-1.9045182380487606e-03 +-1.9308032830807739e-03 +-1.9557273888578721e-03 +-1.9756110134241845e-03 +-1.9861598212825302e-03 +-1.9833009273768688e-03 +-1.9641661701993982e-03 +-1.9278229949365718e-03 +-1.8754475579349529e-03 +-1.8099153230808904e-03 +-1.7350468839118294e-03 +-1.6548287192592833e-03 +-1.5728351210764705e-03 +-1.4919233890670195e-03 +-1.4141601868683726e-03 +-1.3408929031141032e-03 +-1.2728861774000289e-03 +-1.2104698810411500e-03 +-1.1536706137123839e-03 +-1.1023166371553505e-03 +-1.0561159969367342e-03 +-1.0147118156877723e-03 +-9.7771982677826688e-04 +-9.4475284554557419e-04 +-9.1543599913994128e-04 +-8.8941561230474701e-04 +-8.6636385327723163e-04 +-8.4598062445384267e-04 +-8.2799372329697240e-04 +-8.1215796940867636e-04 +-7.9825376209359414e-04 +-7.8608537236104332e-04 +-7.7547916355631273e-04 +-7.6628186048715219e-04 +-7.5835893716685204e-04 +-7.5159316049631811e-04 +-7.4588330603696934e-04 +-7.4114304881839116e-04 +-7.3730002433774621e-04 +-7.3429505081434832e-04 +-7.3208150213928511e-04 +-7.3062482101215120e-04 +-7.2990216286222408e-04 +-1.9092041540536711e-03 +-1.9130340908143973e-03 +-1.9208052062403159e-03 +-1.9327306276606347e-03 +-1.9490820618026741e-03 +-1.9700684087575098e-03 +-1.9955890165754466e-03 +-2.0248467571471426e-03 +-2.0558912485792208e-03 +-2.0852879346552628e-03 +-2.1081993814621048e-03 +-2.1190944850793853e-03 +-2.1130031696901920e-03 +-2.0868536529028855e-03 +-2.0402834876796236e-03 +-1.9755800143534319e-03 +-1.8968824095042904e-03 +-1.8090932064341709e-03 +-1.7169339817014195e-03 +-1.6243618617328432e-03 +-1.5343468802708356e-03 +-1.4488997721550511e-03 +-1.3692267040531561e-03 +-1.2959209972606414e-03 +-1.2291420993663135e-03 +-1.1687617036150928e-03 +-1.1144738063954367e-03 +-1.0658731015908028e-03 +-1.0225084081325264e-03 +-9.8391762114381667e-04 +-9.4964955759616098e-04 +-9.1927679826827354e-04 +-8.9240251294165707e-04 +-8.6866337690915264e-04 +-8.4773003312906610e-04 +-8.2930608476565644e-04 +-8.1312627316779400e-04 +-7.9895426859425377e-04 +-7.8658034567282548e-04 +-7.7581911085527772e-04 +-7.6650737935843804e-04 +-7.5850225325150189e-04 +-7.5167942282788219e-04 +-7.4593169491485518e-04 +-7.4116774074722987e-04 +-7.3731104999450218e-04 +-7.3429907485352594e-04 +-7.3208254764161587e-04 +-7.3062495634626165e-04 +-7.2990216453381847e-04 +-1.9822071560077897e-03 +-1.9861909039515951e-03 +-1.9943341754350527e-03 +-2.0069773559518796e-03 +-2.0245723804742121e-03 +-2.0475320268071562e-03 +-2.0759196453054608e-03 +-2.1089545090654427e-03 +-2.1444159426765265e-03 +-2.1782035950293779e-03 +-2.2044520120669243e-03 +-2.2165016337096300e-03 +-2.2085762961061043e-03 +-2.1774621825644963e-03 +-2.1233524148577170e-03 +-2.0495140537554564e-03 +-1.9611169361244034e-03 +-1.8638793792103378e-03 +-1.7630332502559991e-03 +-1.6627760807634145e-03 +-1.5661322706173172e-03 +-1.4750607721768616e-03 +-1.3906665475298832e-03 +-1.3134261121366668e-03 +-1.2433841242459112e-03 +-1.1803074581853566e-03 +-1.1237980498613029e-03 +-1.0733715383283667e-03 +-1.0285097940696513e-03 +-9.8869452491957030e-04 +-9.5342767108707346e-04 +-9.2224285185949851e-04 +-8.9471092247500920e-04 +-8.7044177576042097e-04 +-8.4908384624845091e-04 +-8.3032229306833369e-04 +-8.1387650258721083e-04 +-7.9949732192325176e-04 +-7.8696427904190874e-04 +-7.7608294142485147e-04 +-7.6668249707064200e-04 +-7.5861359746147113e-04 +-7.5174647428638715e-04 +-7.4596932474417141e-04 +-7.4118695055233998e-04 +-7.3731963086636279e-04 +-7.3430220757799271e-04 +-7.3208336176202877e-04 +-7.3062506174678037e-04 +-7.2990216583632551e-04 +-2.0242499165491930e-03 +-2.0283158218026261e-03 +-2.0366575190445945e-03 +-2.0496839648896999e-03 +-2.0679503722066607e-03 +-2.0920049412823118e-03 +-2.1220632177070160e-03 +-2.1574630150529512e-03 +-2.1959602713712521e-03 +-2.2331458671762832e-03 +-2.2624940696185482e-03 +-2.2764837871756373e-03 +-2.2686274731763471e-03 +-2.2354693524472228e-03 +-2.1774847132786171e-03 +-2.0985430019136420e-03 +-2.0044658294462278e-03 +-1.9014957770331254e-03 +-1.7952091845964402e-03 +-1.6899919829786371e-03 +-1.5889475664986525e-03 +-1.4940461541159949e-03 +-1.4063656058199009e-03 +-1.3263356398530660e-03 +-1.2539458181756412e-03 +-1.1889064338681656e-03 +-1.1307653019469622e-03 +-1.0789885170252671e-03 +-1.0330139224851405e-03 +-9.9228491680461439e-04 +-9.5627060641644945e-04 +-9.2447677101829156e-04 +-8.9645083441517684e-04 +-8.7178306015168864e-04 +-8.5010547915073892e-04 +-8.3108955142499098e-04 +-8.1444321340905159e-04 +-7.9990772342291812e-04 +-7.8725455727365900e-04 +-7.7628249979099818e-04 +-7.6681500897633748e-04 +-7.5869788532387564e-04 +-7.5179725150431565e-04 +-7.4599783128633131e-04 +-7.4120150757612125e-04 +-7.3732613517828952e-04 +-7.3430458273715039e-04 +-7.3208397912057858e-04 +-7.3062514168350178e-04 +-7.2990216682483893e-04 +-2.0445811336298110e-03 +-2.0486759802083965e-03 +-2.0570669100897108e-03 +-2.0701481353201327e-03 +-2.0884650098101660e-03 +-2.1125880200178557e-03 +-2.1428287012942296e-03 +-2.1787201305825117e-03 +-2.2182622189062477e-03 +-2.2571778061708822e-03 +-2.2887750808371328e-03 +-2.3050418273462747e-03 +-2.2988837845693251e-03 +-2.2664078341155833e-03 +-2.2079623550481111e-03 +-2.1275528235785864e-03 +-2.0312704551722236e-03 +-1.9256510283213490e-03 +-1.8165273009027726e-03 +-1.7084823837981856e-03 +-1.6047557398923443e-03 +-1.5074002241393203e-03 +-1.4175342696988961e-03 +-1.3355979181210766e-03 +-1.2615712507167858e-03 +-1.1951435475246006e-03 +-1.1358360651126907e-03 +-1.0830867840016484e-03 +-1.0363063126249896e-03 +-9.9491301747438440e-04 +-9.5835376152332867e-04 +-9.2611499802741149e-04 +-8.9772760945489992e-04 +-8.7276784020469368e-04 +-8.5085591075419772e-04 +-8.3165336225953727e-04 +-8.1485980837234402e-04 +-8.0020951852296835e-04 +-7.8746808846625433e-04 +-7.7642934326682537e-04 +-7.6691254655882220e-04 +-7.5875994485002842e-04 +-7.5183464804719192e-04 +-7.4601883119900111e-04 +-7.4121223376364808e-04 +-7.3733092877533942e-04 +-7.3430633349411394e-04 +-7.3208443424216526e-04 +-7.3062520061898490e-04 +-7.2990216755440171e-04 +-2.0529856109103069e-03 +-2.0570809040355042e-03 +-2.0654334376180934e-03 +-2.0783620223199994e-03 +-2.0963152185989086e-03 +-2.1197850249826183e-03 +-2.1490948747337835e-03 +-2.1839632507118598e-03 +-2.2227731297947231e-03 +-2.2617080137647830e-03 +-2.2943633018140232e-03 +-2.3126333225358870e-03 +-2.3089679114543194e-03 +-2.2788787395024782e-03 +-2.2222264461984388e-03 +-2.1427662064986744e-03 +-2.0465746709764669e-03 +-1.9403324448880313e-03 +-1.8300862166601142e-03 +-1.7206331917184309e-03 +-1.6153891713134186e-03 +-1.5165332745667025e-03 +-1.4252632875586784e-03 +-1.3420615466374342e-03 +-1.2669243603742985e-03 +-1.1995406255760779e-03 +-1.1394217073791521e-03 +-1.0859910471833639e-03 +-1.0386431455830204e-03 +-9.9678049454149657e-04 +-9.5983526665105250e-04 +-9.2728082576103903e-04 +-8.9863666753065658e-04 +-8.7346928128784716e-04 +-8.5139060961887257e-04 +-8.3205520740106112e-04 +-8.1515680660078577e-04 +-8.0042472637788513e-04 +-7.8762039110430427e-04 +-7.7653410346464966e-04 +-7.6698214588040935e-04 +-7.5880423716959502e-04 +-7.5186134325296527e-04 +-7.4603382442350766e-04 +-7.4121989310409371e-04 +-7.3733435225174055e-04 +-7.3430758398815559e-04 +-7.3208475934601004e-04 +-7.3062524272079620e-04 +-7.2990216807643747e-04 +-2.0560417248744701e-03 +-2.0601281436189874e-03 +-2.0684165477689097e-03 +-2.0811351503741853e-03 +-2.0986084189696047e-03 +-2.1212021676677343e-03 +-2.1491775506572034e-03 +-2.1823551863908116e-03 +-2.2194721630558554e-03 +-2.2572850877612123e-03 +-2.2899506333787186e-03 +-2.3095883464138733e-03 +-2.3083750853716326e-03 +-2.2811919678319237e-03 +-2.2272273455537475e-03 +-2.1497783722686280e-03 +-2.0547559525885533e-03 +-1.9489039793545255e-03 +-1.8384503998373849e-03 +-1.7283991405827150e-03 +-1.6223454665521462e-03 +-1.5226016269073157e-03 +-1.4304529365213507e-03 +-1.3464327237578822e-03 +-1.2705623759725593e-03 +-1.2025391057511839e-03 +-1.1418726543640937e-03 +-1.0879795453047111e-03 +-1.0402450159760631e-03 +-9.9806170223194833e-04 +-9.6085229138017758e-04 +-9.2808150381903367e-04 +-8.9926121205777590e-04 +-8.7395131731730935e-04 +-8.5175813972834889e-04 +-8.3233147108094081e-04 +-8.1536102328699138e-04 +-8.0057272640602143e-04 +-7.8772514576203913e-04 +-7.7660616796822331e-04 +-7.6703002945707700e-04 +-7.5883471357284546e-04 +-7.5187971367343643e-04 +-7.4604414318564722e-04 +-7.4122516499162104e-04 +-7.3733670881414302e-04 +-7.3430844483126365e-04 +-7.3208498316064082e-04 +-7.3062527170679643e-04 +-7.2990216843685815e-04 +-2.0570065261459060e-03 +-2.0610841870795150e-03 +-2.0693175203221480e-03 +-2.0818604983161453e-03 +-2.0989315395616472e-03 +-2.1207750084762376e-03 +-2.1475573515467757e-03 +-2.1791150854439229e-03 +-2.2144231758059272e-03 +-2.2507430517572547e-03 +-2.2828456710286380e-03 +-2.3032307186523432e-03 +-2.3039586741801436e-03 +-2.2793630592599584e-03 +-2.2279702177596230e-03 +-2.1525931280230119e-03 +-2.0589400400484047e-03 +-1.9537792777220269e-03 +-1.8434820477455846e-03 +-1.7332247042715072e-03 +-1.6267541623226124e-03 +-1.5264958517897755e-03 +-1.4338102655837245e-03 +-1.3492756276382238e-03 +-1.2729368472393218e-03 +-1.2045008343537699e-03 +-1.1434787573148574e-03 +-1.0892840420672189e-03 +-1.0412966705704253e-03 +-9.9890327490566701e-04 +-9.6152057586343994e-04 +-9.2860776275060499e-04 +-8.9967178082711737e-04 +-8.7426824684018023e-04 +-8.5199981024784927e-04 +-8.3251314548461752e-04 +-8.1549532921163512e-04 +-8.0067006756942961e-04 +-7.8779404855955186e-04 +-7.7665357167435844e-04 +-7.6706152896067288e-04 +-7.5885476317943729e-04 +-7.5189179973609644e-04 +-7.4605093233201633e-04 +-7.4122863374492917e-04 +-7.3733825942688235e-04 +-7.3430901128279083e-04 +-7.3208513043883968e-04 +-7.3062529078135770e-04 +-7.2990216867524320e-04 +-2.0572332401259199e-03 +-2.0613048631005779e-03 +-2.0695012662707746e-03 +-2.0819268926938078e-03 +-2.0987273607151425e-03 +-2.1200571082556356e-03 +-2.1459964119255777e-03 +-2.1763540302906920e-03 +-2.2102320196539858e-03 +-2.2452504118305109e-03 +-2.2766870993658297e-03 +-2.2974135509042735e-03 +-2.2994652897150576e-03 +-2.2767724394769243e-03 +-2.2273380935094091e-03 +-2.1535828855570364e-03 +-2.0610446513961702e-03 +-1.9565005604018980e-03 +-1.8464236714975455e-03 +-1.7361151800753601e-03 +-1.6294318243635631e-03 +-1.5288808399068180e-03 +-1.4358770874916583e-03 +-1.3510314877799971e-03 +-1.2744064555614604e-03 +-1.2057166174509460e-03 +-1.1444749977273679e-03 +-1.0900936441615530e-03 +-1.0419495770893894e-03 +-9.9942586483710012e-04 +-9.6193561107640272e-04 +-9.2893461638500474e-04 +-8.9992678957891451e-04 +-8.7446509808757945e-04 +-8.5214991701249975e-04 +-8.3262598694968260e-04 +-8.1557874866156988e-04 +-8.0073052720695283e-04 +-7.8783684452966537e-04 +-7.7668301424227448e-04 +-7.6708109328582847e-04 +-7.5886721592545296e-04 +-7.5189930632271133e-04 +-7.4605514901893307e-04 +-7.4123078815440779e-04 +-7.3733922249465632e-04 +-7.3430936309847809e-04 +-7.3208522191132725e-04 +-7.3062530262875728e-04 +-7.2990216882481810e-04 +-2.0572420711533401e-03 +-2.0613102008881280e-03 +-2.0694852294099882e-03 +-2.0818428227595337e-03 +-2.0984856722539480e-03 +-2.1195129250965927e-03 +-2.1449459241288113e-03 +-2.1745606276488802e-03 +-2.2075172769330316e-03 +-2.2416525253315671e-03 +-2.2725834957164027e-03 +-2.2934524553248061e-03 +-2.2963024696609434e-03 +-2.2748076348284643e-03 +-2.2266265158865104e-03 +-2.1539195501199594e-03 +-2.0621109566651128e-03 +-1.9579818939555954e-03 +-1.8480696094966879e-03 +-1.7377539763922785e-03 +-1.6309606183521183e-03 +-1.5302478411298448e-03 +-1.4370643353539753e-03 +-1.3520413541870822e-03 +-1.2752522478280779e-03 +-1.2064165533480309e-03 +-1.1450486090938744e-03 +-1.0905597926410514e-03 +-1.0423254774560187e-03 +-9.9972670499956983e-04 +-9.6217450508155947e-04 +-9.2912272852271622e-04 +-9.0007353428588576e-04 +-8.7457836202882130e-04 +-8.5223627508282601e-04 +-8.3269089877004490e-04 +-8.1562673061899322e-04 +-8.0076529960698250e-04 +-7.8786145574975233e-04 +-7.7669994473069444e-04 +-7.6709234255810041e-04 +-7.5887437558819877e-04 +-7.5190362191081283e-04 +-7.4605757306677551e-04 +-7.4123202658887681e-04 +-7.3733977607353068e-04 +-7.3430956531630738e-04 +-7.3208527448662098e-04 +-7.3062530943866170e-04 +-7.2990216891270700e-04 +-2.0572136877888940e-03 +-2.0612800774029725e-03 +-2.0694443244055594e-03 +-2.0817674930885067e-03 +-2.0983304073974155e-03 +-2.1192035606576792e-03 +-2.1443761819340068e-03 +-2.1736027609710368e-03 +-2.2060680907100244e-03 +-2.2397212954295394e-03 +-2.2703660650555662e-03 +-2.2912991802220293e-03 +-2.2945728245749794e-03 +-2.2737219639596519e-03 +-2.2262160214344471e-03 +-2.1540731845545091e-03 +-2.0626564090144542e-03 +-1.9587498176908552e-03 +-1.8489259320338034e-03 +-1.7386072561122602e-03 +-1.6317564063816881e-03 +-1.5309589118228269e-03 +-1.4376813742407572e-03 +-1.3525657385987601e-03 +-1.2756910598073564e-03 +-1.2067794045126064e-03 +-1.1453457585123038e-03 +-1.0908011166116153e-03 +-1.0425199681304989e-03 +-9.9988228005991222e-04 +-9.6229798968765451e-04 +-9.2921992485924909e-04 +-9.0014932919207273e-04 +-8.7463684505035698e-04 +-8.5228085251299083e-04 +-8.3272439692809073e-04 +-8.1565148597853598e-04 +-8.0078323568865632e-04 +-7.8787414786314972e-04 +-7.7670867411449966e-04 +-7.6709814160683869e-04 +-7.5887806577120385e-04 +-7.5190584585207749e-04 +-7.4605882205386245e-04 +-7.4123266460178418e-04 +-7.3734006122975007e-04 +-7.3430966947094444e-04 +-7.3208530156424205e-04 +-7.3062531294651196e-04 +-7.2990216896056347e-04 +-2.0571951350213218e-03 +-2.0612608121144600e-03 +-2.0694205636609042e-03 +-2.0817293346321688e-03 +-2.0982588231921819e-03 +-2.1190675689116384e-03 +-2.1441312403184406e-03 +-2.1731948654464001e-03 +-2.2054531616678883e-03 +-2.2389035398752903e-03 +-2.2694309303920609e-03 +-2.2903992788667758e-03 +-2.2938634936893474e-03 +-2.2732961857607373e-03 +-2.2260835339980366e-03 +-2.1541822930254634e-03 +-2.0629300764830895e-03 +-1.9591136751472421e-03 +-1.8493219507530465e-03 +-1.7389964840764101e-03 +-1.6321161593897595e-03 +-1.5312783123448009e-03 +-1.4379572032466091e-03 +-1.3527992680509940e-03 +-1.2758858921453140e-03 +-1.2069401147403154e-03 +-1.1454771016320140e-03 +-1.0909076032851234e-03 +-1.0426056662412367e-03 +-9.9995074729730964e-04 +-9.6235227732296535e-04 +-9.2926261660530819e-04 +-9.0018259430238109e-04 +-8.7466249420998956e-04 +-8.5230039070552507e-04 +-8.3273907069285205e-04 +-8.1566232428142461e-04 +-8.0079108456051313e-04 +-7.8787969941664516e-04 +-7.7671249071280116e-04 +-7.6710067598962750e-04 +-7.5887967788617467e-04 +-7.5190681706542844e-04 +-7.4605936731460352e-04 +-7.4123294304984815e-04 +-7.3734018564739021e-04 +-7.3430971490505816e-04 +-7.3208531337432979e-04 +-7.3062531447736433e-04 +-7.2990216898500453e-04 +-2.0571887354988313e-03 +-2.0612542041146464e-03 +-2.0694126130489663e-03 +-2.0817170822718090e-03 +-2.0982366366692536e-03 +-2.1190263978543866e-03 +-2.1440582843970475e-03 +-2.1730749879204352e-03 +-2.2052749009975610e-03 +-2.2386706527789467e-03 +-2.2691717187949957e-03 +-2.2901610824476158e-03 +-2.2936921829765475e-03 +-2.2732166330658109e-03 +-2.2260945039742990e-03 +-2.1542643786535711e-03 +-2.0630573812211784e-03 +-1.9592623978435392e-03 +-1.8494742508059305e-03 +-1.7391409355575977e-03 +-1.6322465812545917e-03 +-1.5313921999993763e-03 +-1.4380543469975176e-03 +-1.3528807338542637e-03 +-1.2759533472006452e-03 +-1.2069954175757357e-03 +-1.1455220732187927e-03 +-1.0909439129162528e-03 +-1.0426347857198865e-03 +-9.9997394322508498e-04 +-9.6237062289870673e-04 +-9.2927701202322134e-04 +-9.0019378967085549e-04 +-8.7467111182158415e-04 +-8.5230694518786552e-04 +-8.3274398651330458e-04 +-8.1566595058324529e-04 +-8.0079370754840480e-04 +-7.8788155261178060e-04 +-7.7671376341630061e-04 +-7.6710152027899151e-04 +-7.5888021443243890e-04 +-7.5190714002115223e-04 +-7.4605954848111587e-04 +-7.4123303549753796e-04 +-7.3734022692851359e-04 +-7.3430972997190111e-04 +-7.3208531728978260e-04 +-7.3062531498643444e-04 +-7.2990216899875785e-04 +-2.0571877672751048e-03 +-2.0612532076219998e-03 +-2.0694114285405257e-03 +-2.0817153038340413e-03 +-2.0982335308542548e-03 +-2.1190208759213915e-03 +-2.1440489826006401e-03 +-2.1730606377440651e-03 +-2.2052553122899640e-03 +-2.2386482198466658e-03 +-2.2691521281404626e-03 +-2.2901516224650411e-03 +-2.2936982974423974e-03 +-2.2732394495548602e-03 +-2.2261309911160115e-03 +-2.1543093206717059e-03 +-2.0631054697333299e-03 +-1.9593094739444737e-03 +-1.8495176545956849e-03 +-1.7391793220242766e-03 +-1.6322795478596831e-03 +-1.5314199251389743e-03 +-1.4380773144607880e-03 +-1.3528995504822772e-03 +-1.2759686349029875e-03 +-1.2070077565075350e-03 +-1.1455319768687749e-03 +-1.0909518215082023e-03 +-1.0426410691944010e-03 +-9.9997890857083196e-04 +-9.6237452289642212e-04 +-9.2928005387266620e-04 +-9.0019614279223694e-04 +-8.7467291457686970e-04 +-8.5230831050448592e-04 +-8.3274500650383574e-04 +-8.1566670029825129e-04 +-8.0079424800653140e-04 +-7.8788193324188084e-04 +-7.7671402402923007e-04 +-7.6710169266865275e-04 +-7.5888032368769142e-04 +-7.5190720561489610e-04 +-7.4605958518911828e-04 +-7.4123305418873509e-04 +-7.3734023525901188e-04 +-7.3430973300795234e-04 +-7.3208531807872324e-04 +-7.3062531509125402e-04 +-7.2990216900930291e-04 +-2.0571877673430457e-03 +-2.0612532084029011e-03 +-2.0694114325895290e-03 +-2.0817153221954730e-03 +-2.0982335993378841e-03 +-2.1190210858218128e-03 +-2.1440495295394057e-03 +-2.1730618835140822e-03 +-2.2052578224587760e-03 +-2.2386526899242959e-03 +-2.2691591306385058e-03 +-2.2901612750331705e-03 +-2.2937101040513756e-03 +-2.2732524547774500e-03 +-2.2261441228790626e-03 +-2.1543216926287337e-03 +-2.0631165201481076e-03 +-1.9593189570157373e-03 +-1.8495255578818038e-03 +-1.7391857722115526e-03 +-1.6322847356241071e-03 +-1.5314240561089337e-03 +-1.4380805821188085e-03 +-1.3529021240243839e-03 +-1.2759706559544856e-03 +-1.2070093404315688e-03 +-1.1455332160547212e-03 +-1.0909527891969242e-03 +-1.0426418231280570e-03 +-9.9997949417202992e-04 +-9.6237497590070812e-04 +-9.2928040244242790e-04 +-9.0019640918157808e-04 +-8.7467311642679688e-04 +-8.5230846184295003e-04 +-8.3274511851483485e-04 +-8.1566678191270336e-04 +-8.0079430635697100e-04 +-7.8788197401391427e-04 +-7.7671405173520636e-04 +-7.6710171086302650e-04 +-7.5888033513885490e-04 +-7.5190721244456932e-04 +-7.4605958898755933e-04 +-7.4123305611184076e-04 +-7.3734023611174491e-04 +-7.3430973331732423e-04 +-7.3208531815872468e-04 +-7.3062531510158170e-04 +-7.2990216900944830e-04 +-2.0571887361280224e-03 +-2.0612542171395782e-03 +-2.0694126991458433e-03 +-2.0817174423331153e-03 +-2.0982377913077617e-03 +-2.1190294979143084e-03 +-2.1440655809290528e-03 +-2.1730903889592679e-03 +-2.2053042084912147e-03 +-2.2387206214357115e-03 +-2.2692474101410911e-03 +-2.2902627069631720e-03 +-2.2938139088847275e-03 +-2.2733484708920217e-03 +-2.2262258013518083e-03 +-2.1543866783785576e-03 +-2.0631655841929566e-03 +-1.9593545138608744e-03 +-1.8495505016189846e-03 +-1.7392028066155688e-03 +-1.6322960950559697e-03 +-1.5314314574505644e-03 +-1.4380852839207374e-03 +-1.3529050195882977e-03 +-1.2759723647911769e-03 +-1.2070102846195550e-03 +-1.1455336789495537e-03 +-1.0909529584443285e-03 +-1.0426418212307739e-03 +-9.9997939977778077e-04 +-9.6237483842177840e-04 +-9.2928025199399533e-04 +-9.0019626328300675e-04 +-8.7467298448845479e-04 +-8.5230834814907150e-04 +-8.3274502419187124e-04 +-8.1566670621699465e-04 +-8.0079424750922629e-04 +-7.8788192973399177e-04 +-7.7671401958095748e-04 +-7.6710168844197385e-04 +-7.5888032023826925e-04 +-7.5190720310873720e-04 +-7.4605958356028265e-04 +-7.4123305325421928e-04 +-7.3734023480079357e-04 +-7.3430973282758219e-04 +-7.3208531802814651e-04 +-7.3062531508169125e-04 +-7.2990216899994549e-04 +-2.0571951358025540e-03 +-2.0612608727588271e-03 +-2.0694210555680234e-03 +-2.0817313758150113e-03 +-2.0982649615358131e-03 +-2.1190828344449320e-03 +-2.1441646180202288e-03 +-2.1732608365768666e-03 +-2.2055717887271903e-03 +-2.2390963144565132e-03 +-2.2697113878736176e-03 +-2.2907632973913350e-03 +-2.2942873091462311e-03 +-2.2737443622828269e-03 +-2.2265209300666518e-03 +-2.1545827546075973e-03 +-2.0632791898249586e-03 +-1.9594071320892027e-03 +-1.8495622085901763e-03 +-1.7391895774454930e-03 +-1.6322694020683851e-03 +-1.5313989265012876e-03 +-1.4380516444620680e-03 +-1.3528729866848271e-03 +-1.2759433319840395e-03 +-1.2069848209598324e-03 +-1.1455118652385040e-03 +-1.0909346050785754e-03 +-1.0426266042561361e-03 +-9.9996694280475541e-04 +-9.6236475982986217e-04 +-9.2927219048370984e-04 +-9.0018989027779324e-04 +-8.7466800879997463e-04 +-8.5230451627665892e-04 +-8.3274211831881853e-04 +-8.1566454113099983e-04 +-8.0079266715934419e-04 +-7.8788080381319019e-04 +-7.7671324033256250e-04 +-7.6710116776922230e-04 +-7.5887998713149976e-04 +-7.5190700136428402e-04 +-7.4605946974819768e-04 +-7.4123299488170044e-04 +-7.3734020861964463e-04 +-7.3430972323624156e-04 +-7.3208531552803940e-04 +-7.3062531475517434e-04 +-7.2990216898844069e-04 +-2.0572136813903829e-03 +-2.0612802236359452e-03 +-2.0694459144863153e-03 +-2.0817743441621170e-03 +-2.0983507499728162e-03 +-2.1192526586751906e-03 +-2.1444796904340055e-03 +-2.1737996728421072e-03 +-2.2064091542067688e-03 +-2.2402563980239792e-03 +-2.2711200526871807e-03 +-2.2922502892653070e-03 +-2.2956526321446491e-03 +-2.2748388281151745e-03 +-2.2272849935845124e-03 +-2.1550352325893887e-03 +-2.0634824741588794e-03 +-1.9594349197198362e-03 +-1.8494801802388572e-03 +-1.7390479937828209e-03 +-1.6321028871546870e-03 +-1.5312293237120696e-03 +-1.4378915141157675e-03 +-1.3527286651945163e-03 +-1.2758172446528434e-03 +-1.2068770878937837e-03 +-1.1454213525872814e-03 +-1.0908595811333025e-03 +-1.0425651304936316e-03 +-9.9991709467230961e-04 +-9.6232474197408045e-04 +-9.2924038876719076e-04 +-9.0016488740320654e-04 +-8.7464858010155989e-04 +-8.5228961561839393e-04 +-8.3273085990430017e-04 +-8.1565618046286210e-04 +-8.0078658285521857e-04 +-7.8787648106156598e-04 +-7.7671025625685646e-04 +-7.6709917866757133e-04 +-7.5887871741740277e-04 +-7.5190623395593958e-04 +-7.4605903764090860e-04 +-7.4123277363728269e-04 +-7.3734010953567628e-04 +-7.3430968698404652e-04 +-7.3208530609047680e-04 +-7.3062531353025302e-04 +-7.2990216896776366e-04 +-2.0572420268834776e-03 +-2.0613103606036340e-03 +-2.0694888619538737e-03 +-2.0818597515594802e-03 +-2.0985366149499961e-03 +-2.1196350309542170e-03 +-2.1451992331448697e-03 +-2.1750324827809367e-03 +-2.2083156044140871e-03 +-2.2428754702259485e-03 +-2.2742677984898727e-03 +-2.2955330137588515e-03 +-2.2986203144117730e-03 +-2.2771646651166344e-03 +-2.2288482509689794e-03 +-2.1558915884610655e-03 +-2.0637830974975834e-03 +-1.9593528881850903e-03 +-1.8491671936465511e-03 +-1.7386184626087665e-03 +-1.6316343074510215e-03 +-1.5307694421877965e-03 +-1.4374667357736517e-03 +-1.3523512829749244e-03 +-1.2754908418498578e-03 +-1.2066002491532015e-03 +-1.1451900642808481e-03 +-1.0906687072259843e-03 +-1.0424092742001736e-03 +-9.9979106977038964e-04 +-9.6222380527362361e-04 +-9.2916033201841379e-04 +-9.0010205029060107e-04 +-8.7459982193844373e-04 +-8.5225226797580730e-04 +-8.3270267288508191e-04 +-8.1563526948443790e-04 +-8.0077137936232989e-04 +-7.8786568855189498e-04 +-7.7670281189442614e-04 +-7.6709422013649048e-04 +-7.5887555439686685e-04 +-7.5190432346788373e-04 +-7.4605796252765692e-04 +-7.4123222345696591e-04 +-7.3733986325270299e-04 +-7.3430959691130548e-04 +-7.3208528265006855e-04 +-7.3062531049129201e-04 +-7.2990216892568154e-04 +-2.0572330705416453e-03 +-2.0613045912951603e-03 +-2.0695076168850335e-03 +-2.0819608975941079e-03 +-2.0988331138696802e-03 +-2.1203121409101612e-03 +-2.1465225221840604e-03 +-2.1773220429765049e-03 +-2.2118434904605249e-03 +-2.2476761099811081e-03 +-2.2799720607731100e-03 +-2.3014104508338922e-03 +-2.3038596825609037e-03 +-2.2811898675990571e-03 +-2.2314593784217782e-03 +-2.1572068997752483e-03 +-2.0640909839815605e-03 +-1.9589780065992646e-03 +-1.8483918833679166e-03 +-1.7376541961030068e-03 +-1.6306229974644886e-03 +-1.5297971894671827e-03 +-1.4365797791040102e-03 +-1.3515696674527330e-03 +-1.2748186078146888e-03 +-1.2060324094122668e-03 +-1.1447170958699183e-03 +-1.0902792926120325e-03 +-1.0420918823428153e-03 +-9.9953480277671278e-04 +-9.6201879843259308e-04 +-9.2899789349869721e-04 +-8.9997465695359602e-04 +-8.7450104193660856e-04 +-8.5217665158142614e-04 +-8.3264563494039748e-04 +-8.1559297584341006e-04 +-8.0074064323825073e-04 +-7.8784387891118492e-04 +-7.7668777400935018e-04 +-7.6708420730739935e-04 +-7.5886916939634083e-04 +-7.5190046807126004e-04 +-7.4605579354517393e-04 +-7.4123111378073296e-04 +-7.3733936662743593e-04 +-7.3430941531549114e-04 +-7.3208523539937116e-04 +-7.3062530436764192e-04 +-7.2990216884624042e-04 +-2.0570060304012680e-03 +-2.0610821893294697e-03 +-2.0693258563253165e-03 +-2.0819185946140389e-03 +-2.0991223051855471e-03 +-2.1212422535622950e-03 +-2.1485214058550983e-03 +-2.1808741698760522e-03 +-2.2173134255369788e-03 +-2.2550305071626295e-03 +-2.2885737854205553e-03 +-2.3101230729887217e-03 +-2.3114715149939245e-03 +-2.2868654369052927e-03 +-2.2349324103539616e-03 +-2.1586870056121226e-03 +-2.0640404875300802e-03 +-1.9579097901027535e-03 +-1.8467497301438637e-03 +-1.7357690116370950e-03 +-1.6287150742811285e-03 +-1.5279980100414662e-03 +-1.4349574244357623e-03 +-1.3501506941863944e-03 +-1.2736044109339241e-03 +-1.2050104423914131e-03 +-1.1438680851651878e-03 +-1.0895816192628884e-03 +-1.0415240824804906e-03 +-9.9907687772848191e-04 +-9.6165280322203404e-04 +-9.2870810778151439e-04 +-8.9974752848201163e-04 +-8.7432501762155365e-04 +-8.5204196328381599e-04 +-8.3254407746260041e-04 +-8.1551769655381059e-04 +-8.0068595220637547e-04 +-7.8780508233670477e-04 +-7.7666103047430851e-04 +-7.6706640467804298e-04 +-7.5885781951989361e-04 +-7.5189361619418325e-04 +-7.4605193951879497e-04 +-7.4122914235012793e-04 +-7.3733848446203346e-04 +-7.3430909278322375e-04 +-7.3208515148588465e-04 +-7.3062529349431093e-04 +-7.2990216870866004e-04 +-2.0560405138026908e-03 +-2.0601215912703290e-03 +-2.0684227648018571e-03 +-2.0812202980035103e-03 +-2.0989128985261286e-03 +-2.1219667339589139e-03 +-2.1507618479436547e-03 +-2.1852282404162672e-03 +-2.2241382692113950e-03 +-2.2641174707470663e-03 +-2.2989763236266809e-03 +-2.3203619924349102e-03 +-2.3200645591608801e-03 +-2.2928416030266558e-03 +-2.2380333425876791e-03 +-2.1592390024811935e-03 +-2.0626769907373587e-03 +-1.9553192412165138e-03 +-1.8435239004218741e-03 +-1.7323464399299558e-03 +-1.6253840468705377e-03 +-1.5249257487686772e-03 +-1.4322245947869577e-03 +-1.3477814611536224e-03 +-1.2715891079370838e-03 +-1.2033211913159705e-03 +-1.1424688458386450e-03 +-1.0884342607094153e-03 +-1.0405917968481779e-03 +-9.9832590894265204e-04 +-9.6105315649526457e-04 +-9.2823367455138967e-04 +-8.9937589926292714e-04 +-8.7403714752462569e-04 +-8.5182178580446599e-04 +-8.3237811915544565e-04 +-8.1539471913718068e-04 +-8.0059663337753281e-04 +-7.8774173789417459e-04 +-7.7661737574328952e-04 +-7.6703735094981829e-04 +-7.5883930035921089e-04 +-7.5188243831965926e-04 +-7.4604565327542104e-04 +-7.4122592726370688e-04 +-7.3733704597983476e-04 +-7.3430856691101545e-04 +-7.3208501468106815e-04 +-7.3062527576924483e-04 +-7.2990216848688356e-04 +-2.0529830693560170e-03 +-2.0570649311636526e-03 +-2.0654277490828833e-03 +-2.0784658897864856e-03 +-2.0967425793763242e-03 +-2.1208993649177890e-03 +-2.1514260605831372e-03 +-2.1881775633752799e-03 +-2.2295553361268146e-03 +-2.2715354976689424e-03 +-2.3072374973295610e-03 +-2.3279324569334191e-03 +-2.3255608826301625e-03 +-2.2954606215053958e-03 +-2.2376789717739841e-03 +-2.1563679749403335e-03 +-2.0580237234703756e-03 +-1.9496493229894164e-03 +-1.8374837101447867e-03 +-1.7264064432348473e-03 +-1.6198433975866434e-03 +-1.5199453398393372e-03 +-1.4278665551912856e-03 +-1.3440440765254429e-03 +-1.2684334771185623e-03 +-1.2006897195195527e-03 +-1.1402971371214147e-03 +-1.0866582214478849e-03 +-1.0391515090776655e-03 +-9.9716744823596915e-04 +-9.6012917258068346e-04 +-9.2750327398945470e-04 +-8.9880417005317272e-04 +-8.7359453082831826e-04 +-8.5148341270444830e-04 +-8.3212317576831368e-04 +-8.1520587030144565e-04 +-8.0045951582212742e-04 +-7.8764452300638169e-04 +-7.7655039647032140e-04 +-7.6699278481892088e-04 +-7.5881089981590067e-04 +-7.5186529973393017e-04 +-7.4603601663327315e-04 +-7.4122099944316842e-04 +-7.3733484150985103e-04 +-7.3430776110985268e-04 +-7.3208480507273583e-04 +-7.3062524861375008e-04 +-7.2990216814899402e-04 +-2.0445765601425541e-03 +-2.0486445240630018e-03 +-2.0570338645373087e-03 +-2.0702443933873047e-03 +-2.0889795230624479e-03 +-2.1140098190104398e-03 +-2.1458574888117590e-03 +-2.1842106443042031e-03 +-2.2270634223686245e-03 +-2.2698609465158386e-03 +-2.3053323659955422e-03 +-2.3247264239172998e-03 +-2.3203330692567513e-03 +-2.2880163208426956e-03 +-2.2283041397858313e-03 +-2.1456546128072723e-03 +-2.0466711415532152e-03 +-1.9383076547322407e-03 +-1.8266640381064043e-03 +-1.7164520481297975e-03 +-1.6109422866246155e-03 +-1.5121628261363250e-03 +-1.4211822346960462e-03 +-1.3383845167436906e-03 +-1.2636973352025160e-03 +-1.1967651843911493e-03 +-1.1370730031156188e-03 +-1.0840302508284088e-03 +-1.0370255826338338e-03 +-9.9546067319397505e-04 +-9.5876978183441692e-04 +-9.2642987439546390e-04 +-8.9796469298429680e-04 +-8.7294509665901355e-04 +-8.5098722780235965e-04 +-8.3174952184771923e-04 +-8.1492921049092194e-04 +-8.0025872132741206e-04 +-7.8750221321808016e-04 +-7.7645238004492127e-04 +-7.6692758729285956e-04 +-7.5876936321182223e-04 +-7.5184024050776641e-04 +-7.4602192967378818e-04 +-7.4121379738713745e-04 +-7.3733162023249788e-04 +-7.3430658380910327e-04 +-7.3208449886361235e-04 +-7.3062520894687190e-04 +-7.2990216765693287e-04 +-2.0242429277971675e-03 +-2.0282647985962981e-03 +-2.0365822362761617e-03 +-2.0497330128292947e-03 +-2.0684636448409571e-03 +-2.0935602695311049e-03 +-2.1254809014413100e-03 +-2.1637311113399749e-03 +-2.2060478474732951e-03 +-2.2477110559448411e-03 +-2.2815736624001784e-03 +-2.2993231215466241e-03 +-2.2937832886907967e-03 +-2.2611691524890773e-03 +-2.2020687619961708e-03 +-2.1207892552789834e-03 +-2.0237051472629104e-03 +-1.9175504974200382e-03 +-1.8082455549717851e-03 +-1.7003657634763170e-03 +-1.5970842743119930e-03 +-1.5003652860727890e-03 +-1.4112414879633548e-03 +-1.3300829466268782e-03 +-1.2568192241129410e-03 +-1.1911070434632810e-03 +-1.1324494360139246e-03 +-1.0802765249655873e-03 +-1.0339979802863580e-03 +-9.9303548310080867e-04 +-9.5684155969422569e-04 +-9.2490939682166420e-04 +-8.9677687107756149e-04 +-8.7202700203685337e-04 +-8.5028630793516837e-04 +-8.3122203348798306e-04 +-8.1453887143852395e-04 +-7.9997556515383657e-04 +-7.8730162412207099e-04 +-7.7631428247408303e-04 +-7.6683576522334237e-04 +-7.5871088570121572e-04 +-7.5180497253446812e-04 +-7.4600210990244712e-04 +-7.4120366711821349e-04 +-7.3732709030123824e-04 +-7.3430492854493546e-04 +-7.3208406840313215e-04 +-7.3062515319028060e-04 +-7.2990216696650436e-04 +-1.9821981056943752e-03 +-1.9861219990548293e-03 +-1.9942129753335856e-03 +-2.0069474247371303e-03 +-2.0249788605084295e-03 +-2.0489697757487282e-03 +-2.0792368756402590e-03 +-2.1151765119103269e-03 +-2.1545617592045288e-03 +-2.1930068738807000e-03 +-2.2240637703775327e-03 +-2.2403091483689744e-03 +-2.2352560611913568e-03 +-2.2052740609323201e-03 +-2.1505485047904334e-03 +-2.0746867256553432e-03 +-1.9833743175410126e-03 +-1.8828437675441486e-03 +-1.7787283893469161e-03 +-1.6754799064644217e-03 +-1.5762464951045991e-03 +-1.4830179921957632e-03 +-1.3968749384347622e-03 +-1.3182428392496490e-03 +-1.2471072607267114e-03 +-1.1831781792575669e-03 +-1.1260075596323585e-03 +-1.0750694490801846e-03 +-1.0298122467317004e-03 +-9.8969130056941832e-04 +-9.5418807507098092e-04 +-9.2282041523793386e-04 +-8.9514707506113938e-04 +-8.7076867398205762e-04 +-8.4932652996046697e-04 +-8.3050032135917285e-04 +-8.1400519116846129e-04 +-7.9958867910239688e-04 +-7.8702771547632070e-04 +-7.7612581115133036e-04 +-7.6671051332572176e-04 +-7.5863115595075574e-04 +-7.5175690821751434e-04 +-7.4597510957426086e-04 +-7.4118987158824381e-04 +-7.3732092326118340e-04 +-7.3430267563943626e-04 +-7.3208348263704851e-04 +-7.3062507732771188e-04 +-7.2990216602816815e-04 +-1.9091941148737153e-03 +-1.9129552660184853e-03 +-1.9206507464718306e-03 +-1.9326186990272214e-03 +-1.9493165056809840e-03 +-1.9711845249402223e-03 +-1.9983612217154062e-03 +-2.0302280723577060e-03 +-2.0648616094947727e-03 +-2.0986184636317203e-03 +-2.1261902828778501e-03 +-2.1413889724538888e-03 +-2.1385770025949737e-03 +-2.1142094829149100e-03 +-2.0677780023412463e-03 +-2.0017518016277359e-03 +-1.9206688506291051e-03 +-1.8298979496361198e-03 +-1.7345748559851489e-03 +-1.6389581769161764e-03 +-1.5461982327430663e-03 +-1.4583864075713435e-03 +-1.3767410682475384e-03 +-1.3018278420939575e-03 +-1.2337597592754178e-03 +-1.1723569197107260e-03 +-1.1172641065777058e-03 +-1.0680326972769922e-03 +-1.0241751841087382e-03 +-9.8519992396529248e-04 +-9.5063219346787624e-04 +-9.2002605294984417e-04 +-8.9297021291026362e-04 +-8.6909010271398021e-04 +-8.4804762478453411e-04 +-8.2953957664636121e-04 +-8.1329537996362709e-04 +-7.9907452383968125e-04 +-7.8666397471834103e-04 +-7.7587570279822216e-04 +-7.6654440794144752e-04 +-7.5852548498451698e-04 +-7.5169324126086534e-04 +-7.4593936269044684e-04 +-7.4117161543044542e-04 +-7.3731276540136247e-04 +-7.3429969643481628e-04 +-7.3208270822583031e-04 +-7.3062497705130155e-04 +-7.2990216478877360e-04 +-1.8021134848460289e-03 +-1.8056479692314291e-03 +-1.8128098619287067e-03 +-1.8237793670658141e-03 +-1.8387927363653145e-03 +-1.8580492689480848e-03 +-1.8815165179035325e-03 +-1.9086171047603899e-03 +-1.9378446150218574e-03 +-1.9664526437251102e-03 +-1.9904381962331146e-03 +-2.0050097360115424e-03 +-2.0055349272006689e-03 +-1.9886765903849631e-03 +-1.9532511929770471e-03 +-1.9004484155264872e-03 +-1.8333768955904022e-03 +-1.7562096798099873e-03 +-1.6733003674136676e-03 +-1.5885319700227620e-03 +-1.5049802555582234e-03 +-1.4248405326624494e-03 +-1.3495167590440338e-03 +-1.2797806609723627e-03 +-1.2159399215253617e-03 +-1.1579847474894719e-03 +-1.1057026572973510e-03 +-1.0587622987384352e-03 +-1.0167715566039015e-03 +-9.7931610553282145e-04 +-9.4598389110645193e-04 +-9.1637987201696942e-04 +-8.9013422663189489e-04 +-8.6690629600177222e-04 +-8.4638583018716961e-04 +-8.2829259607703843e-04 +-8.1237504869156787e-04 +-7.9840852339512392e-04 +-7.8619324080091678e-04 +-7.7555230517741881e-04 +-7.6632980359187626e-04 +-7.5838906484011759e-04 +-7.5161110618746324e-04 +-7.4589327648688967e-04 +-7.4114809257219249e-04 +-7.3730225937767430e-04 +-7.3429586129544278e-04 +-7.3208171164603061e-04 +-7.3062484803563578e-04 +-7.2990216319505626e-04 +-1.6665399750108436e-03 +-1.6697986820314284e-03 +-1.6763433627307350e-03 +-1.6862251204931801e-03 +-1.6995002327453480e-03 +-1.7161746818388397e-03 +-1.7360873125953880e-03 +-1.7587190957767799e-03 +-1.7829510391189367e-03 +-1.8068488833098808e-03 +-1.8276037736151757e-03 +-1.8417577090244839e-03 +-1.8457520142177318e-03 +-1.8366753588703458e-03 +-1.8129494026540591e-03 +-1.7746836941970425e-03 +-1.7235785470917535e-03 +-1.6624586447547321e-03 +-1.5946506139984018e-03 +-1.5234183548485036e-03 +-1.4515805617216489e-03 +-1.3813320683854760e-03 +-1.3142248683424046e-03 +-1.2512442190780100e-03 +-1.1929241405140530e-03 +-1.1394659207866829e-03 +-1.0908411466104243e-03 +-1.0468730287019987e-03 +-1.0072965267831217e-03 +-9.7180065152223459e-04 +-9.4005699467955344e-04 +-9.1173818299449861e-04 +-8.8652924169087613e-04 +-8.6413412070622054e-04 +-8.4427901191455905e-04 +-8.2671359972735911e-04 +-8.1121102904488016e-04 +-7.9756711870543914e-04 +-7.8559916990821206e-04 +-7.7514459621035535e-04 +-7.6605951822468921e-04 +-7.5821741009585598e-04 +-7.5150784771081593e-04 +-7.4583538447197935e-04 +-7.4111856523351345e-04 +-7.3728907984458593e-04 +-7.3429105272128619e-04 +-7.3208046261930471e-04 +-7.3062468638348177e-04 +-7.2990216119904147e-04 +-1.5143495667285743e-03 +-1.5173065179507367e-03 +-1.5232061128462016e-03 +-1.5320177818012924e-03 +-1.5436845164075680e-03 +-1.5580929076721862e-03 +-1.5750097844055505e-03 +-1.5939770713147823e-03 +-1.6141732978116414e-03 +-1.6342786841379666e-03 +-1.6524109225641269e-03 +-1.6662089808959688e-03 +-1.6731095425033457e-03 +-1.6707828974737017e-03 +-1.6576068192339082e-03 +-1.6330152775808737e-03 +-1.5975994651018129e-03 +-1.5529414657009955e-03 +-1.5012635442916364e-03 +-1.4450237288416974e-03 +-1.3865708234380759e-03 +-1.3279178773508420e-03 +-1.2706391138750473e-03 +-1.2158624316165043e-03 +-1.1643198024125913e-03 +-1.1164229390688743e-03 +-1.0723421899156485e-03 +-1.0320767506182544e-03 +-9.9551157365194726e-04 +-9.6246064889019608e-04 +-9.3269837502752025e-04 +-9.0598140480300051e-04 +-8.8206329232942715e-04 +-8.6070391764527226e-04 +-8.4167523918646204e-04 +-8.2476453396280558e-04 +-8.0977596457839870e-04 +-7.9653106559112515e-04 +-7.8486855939062343e-04 +-7.7464378054160898e-04 +-7.6572789485424963e-04 +-7.5800703496810924e-04 +-7.5138143001061747e-04 +-7.4576457702467674e-04 +-7.4108248209788473e-04 +-7.3727298642479490e-04 +-7.3428518474335982e-04 +-7.3207893916451389e-04 +-7.3062448928096419e-04 +-7.2990215876621452e-04 +-1.3589553616955982e-03 +-1.3616086297713592e-03 +-1.3668807800307570e-03 +-1.3747019350747794e-03 +-1.3849614514648419e-03 +-1.3974927744185379e-03 +-1.4120414963480041e-03 +-1.4282116884946460e-03 +-1.4453928748949592e-03 +-1.4626832773441038e-03 +-1.4788408389969250e-03 +-1.4923032396500643e-03 +-1.5013101804161393e-03 +-1.5041297811662581e-03 +-1.4993448537502371e-03 +-1.4861178146158187e-03 +-1.4643496309950778e-03 +-1.4346845187515425e-03 +-1.3983690397677492e-03 +-1.3570211980808093e-03 +-1.3123816255947512e-03 +-1.2661052680976229e-03 +-1.2196231445212743e-03 +-1.1740762522211828e-03 +-1.1303066562964325e-03 +-1.0888851079094951e-03 +-1.0501565046491554e-03 +-1.0142897606073131e-03 +-9.8132413319616048e-04 +-9.5120832009169441e-04 +-9.2383139427916819e-04 +-8.9904614103371056e-04 +-8.7668600001387627e-04 +-8.5657695457536001e-04 +-8.3854560020429881e-04 +-8.2242441765402593e-04 +-8.0805505577742891e-04 +-7.9529023152969790e-04 +-7.8399469277050274e-04 +-7.7404556370875535e-04 +-7.6533229841402697e-04 +-7.5775639868722532e-04 +-7.5123100294386541e-04 +-7.4568041772954646e-04 +-7.4103963919477456e-04 +-7.3725389535105718e-04 +-7.3427822901318276e-04 +-7.3207713436470613e-04 +-7.3062425587246105e-04 +-7.2990215588625187e-04 +-1.2115488581885857e-03 +-1.2139160973130086e-03 +-1.2186104492437741e-03 +-1.2255510108915057e-03 +-1.2346133987171804e-03 +-1.2456223606473727e-03 +-1.2583364241661422e-03 +-1.2724219867832505e-03 +-1.2874172115184697e-03 +-1.3026918249186264e-03 +-1.3174164987255807e-03 +-1.3305617380273247e-03 +-1.3409461252556396e-03 +-1.3473432662904758e-03 +-1.3486365601570564e-03 +-1.3439886665268090e-03 +-1.3329800739787792e-03 +-1.3156769261851373e-03 +-1.2926108170787680e-03 +-1.2646816263584821e-03 +-1.2330153442373288e-03 +-1.1988147961918170e-03 +-1.1632335296107058e-03 +-1.1272887695884439e-03 +-1.0918155358759225e-03 +-1.0574549151171689e-03 +-1.0246657903160924e-03 +-9.9374961774343121e-04 +-9.6488015204942035e-04 +-9.3813281058617885e-04 +-9.1351077708556536e-04 +-8.9096667029019063e-04 +-8.7041966756517966e-04 +-8.5176853162954804e-04 +-8.3490121263025518e-04 +-8.1970172809941891e-04 +-8.0605495681528418e-04 +-7.9384987868239476e-04 +-7.8298168403961497e-04 +-7.7335307780727609e-04 +-7.6487502225591286e-04 +-7.5746709745800559e-04 +-7.5105760888532797e-04 +-7.4558353456649965e-04 +-7.4099037712888169e-04 +-7.3723196661888528e-04 +-7.3427024633519332e-04 +-7.3207506450442318e-04 +-7.3062398830909137e-04 +-7.2990215258599174e-04 +-1.0795736327458227e-03 +-1.0816854960435617e-03 +-1.0858709696705223e-03 +-1.0920531400082504e-03 +-1.1001150096856768e-03 +-1.1098959121394133e-03 +-1.1211843060573408e-03 +-1.1337057112945212e-03 +-1.1471056947736397e-03 +-1.1609301748215129e-03 +-1.1746086881205997e-03 +-1.1874495984990395e-03 +-1.1986575832037137e-03 +-1.2073810087741901e-03 +-1.2127891771066977e-03 +-1.2141686816813280e-03 +-1.2110186666192415e-03 +-1.2031215715119592e-03 +-1.1905713788137376e-03 +-1.1737535027415294e-03 +-1.1532839651955348e-03 +-1.1299248949085115e-03 +-1.1044958846737171e-03 +-1.0777970948523715e-03 +-1.0505531560708807e-03 +-1.0233800509763119e-03 +-9.9677222866397853e-04 +-9.7110476825716218e-04 +-9.4664501164107729e-04 +-9.2356891146359952e-04 +-9.0197864231461372e-04 +-8.8191930773326736e-04 +-8.6339360587278646e-04 +-8.4637403334257241e-04 +-8.3081264581384511e-04 +-8.1664862533472183e-04 +-8.0381399795422578e-04 +-7.9223785716967888e-04 +-7.8184941809109532e-04 +-7.7258017889290985e-04 +-7.6436541437945244e-04 +-7.5714517863823894e-04 +-7.5086495285936396e-04 +-7.4547604115305299e-04 +-7.4093579110371354e-04 +-7.3720769585578936e-04 +-7.3426141961667837e-04 +-7.3207277751387832e-04 +-7.3062369283135762e-04 +-7.2990214894264093e-04 +-9.6691628577700857e-04 +-9.6881025757340332e-04 +-9.7256485366468927e-04 +-9.7811310690938420e-04 +-9.8535363733233752e-04 +-9.9414886609541114e-04 +-1.0043216293580755e-03 +-1.0156496545744667e-03 +-1.0278577993804380e-03 +-1.0406088975562972e-03 +-1.0534954921083638e-03 +-1.0660363386515925e-03 +-1.0776826332266564e-03 +-1.0878385432756741e-03 +-1.0958981253652896e-03 +-1.1012962536306604e-03 +-1.1035660608022914e-03 +-1.1023917069149227e-03 +-1.0976449144289742e-03 +-1.0893971798887204e-03 +-1.0779056683158520e-03 +-1.0635771543615691e-03 +-1.0469187394426889e-03 +-1.0284853408281129e-03 +-1.0088324120321002e-03 +-9.8847921912865577e-04 +-9.6788462290101085e-04 +-9.4743465721481115e-04 +-9.2743962761416188e-04 +-9.0813790196706511e-04 +-8.8970372020667949e-04 +-8.7225687364831913e-04 +-8.5587273216743988e-04 +-8.4059167066053645e-04 +-8.2642739482252344e-04 +-8.1337397896191570e-04 +-8.0141162397368351e-04 +-7.9051125066121458e-04 +-7.8063809063174305e-04 +-7.7175444691539741e-04 +-7.6382178583779146e-04 +-7.5680230146547563e-04 +-7.5066007080848841e-04 +-7.4536189559446973e-04 +-7.4087790659983159e-04 +-7.3718198985729233e-04 +-7.3425208055039938e-04 +-7.3207035972289430e-04 +-7.3062338062763760e-04 +-7.2990214509435205e-04 +-8.7486155506293192e-04 +-8.7657739020916502e-04 +-8.7998109596437973e-04 +-8.8501655202599715e-04 +-8.9159900536671594e-04 +-8.9961412805969205e-04 +-9.0891637808109568e-04 +-9.1932645713642630e-04 +-9.3062782877821007e-04 +-9.4256263542847793e-04 +-9.5482794935665633e-04 +-9.6707401834073752e-04 +-9.7890678175570930e-04 +-9.8989707447876040e-04 +-9.9959824816825177e-04 +-1.0075722868963407e-03 +-1.0134221566625867e-03 +-1.0168258223710919e-03 +-1.0175660011381127e-03 +-1.0155499706990785e-03 +-1.0108156781199660e-03 +-1.0035233743497013e-03 +-9.9393501779709349e-04 +-9.8238581002285945e-04 +-9.6925297291365685e-04 +-9.5492632955331480e-04 +-9.3978387838196571e-04 +-9.2417392872195365e-04 +-9.0840395209830851e-04 +-8.9273533515549111e-04 +-8.7738273054621403e-04 +-8.6251659908685501e-04 +-8.4826768057271449e-04 +-8.3473239248176468e-04 +-8.2197844153262200e-04 +-8.1005018807466997e-04 +-7.9897350424656976e-04 +-7.8876001064872431e-04 +-7.7941067038697913e-04 +-7.7091877504262241e-04 +-7.6327238563263526e-04 +-7.5645630234290751e-04 +-7.5045363681436176e-04 +-7.4524705494927298e-04 +-7.4081974976705181e-04 +-7.3715619469116910e-04 +-7.3424271885348799e-04 +-7.3206793805539138e-04 +-7.3062306809992469e-04 +-7.2990214124332427e-04 +-8.0313905358653291e-04 +-8.0471600509898593e-04 +-8.0784661703369625e-04 +-8.1248416679740763e-04 +-8.1855818856487806e-04 +-8.2597393167454039e-04 +-8.3461151476268297e-04 +-8.4432471477542193e-04 +-8.5493939893503397e-04 +-8.6625175947602716e-04 +-8.7802675851901470e-04 +-8.8999751035013011e-04 +-9.0186664115711197e-04 +-9.1331083525606697e-04 +-9.2398964111508242e-04 +-9.3355905505733503e-04 +-9.4168944090851272e-04 +-9.4808617752010712e-04 +-9.5251040247047844e-04 +-9.5479671768976531e-04 +-9.5486498101939878e-04 +-9.5272430510385370e-04 +-9.4846883430279054e-04 +-9.4226633957490301e-04 +-9.3434176225103951e-04 +-9.2495832760313269e-04 +-9.1439873579268857e-04 +-9.0294838813154252e-04 +-8.9088185743926786e-04 +-8.7845307669234211e-04 +-8.6588913863386633e-04 +-8.5338722451543483e-04 +-8.4111400190191039e-04 +-8.2920680356674827e-04 +-8.1777596658742921e-04 +-8.0690782420431650e-04 +-7.9666796777281765e-04 +-7.8710451111095440e-04 +-7.7825118474104027e-04 +-7.7013016042369652e-04 +-7.6275455866357843e-04 +-7.5613062707373456e-04 +-7.5025959956721573e-04 +-7.4513925889476253e-04 +-7.4076523100434608e-04 +-7.3713204129246092e-04 +-7.3423396166414745e-04 +-7.3206567452470048e-04 +-7.3062277613784507e-04 +-7.2990213764681934e-04 +-7.5076448270108267e-04 +-7.5224000725324851e-04 +-7.5517130032932522e-04 +-7.5951874152552451e-04 +-7.6522262343915596e-04 +-7.7220280383309789e-04 +-7.8035822066293984e-04 +-7.8956626786876667e-04 +-7.9968206105643597e-04 +-8.1053768677900092e-04 +-8.2194163488387602e-04 +-8.3367875564692396e-04 +-8.4551123651505663e-04 +-8.5718120680641319e-04 +-8.6841558447242628e-04 +-8.7893361226693055e-04 +-8.8845716203368730e-04 +-8.9672335129785462e-04 +-9.0349842718982104e-04 +-9.0859139204742842e-04 +-9.1186563331225690e-04 +-9.1324697141236953e-04 +-9.1272703793674229e-04 +-9.1036161973971500e-04 +-9.0626436781348295e-04 +-9.0059689271259583e-04 +-8.9355663250999728e-04 +-8.8536395305603113e-04 +-8.7624976914159650e-04 +-8.6644464946254523e-04 +-8.5616998692202918e-04 +-8.4563145901867388e-04 +-8.3501472001649242e-04 +-8.2448307580404272e-04 +-8.1417678954668108e-04 +-8.0421363426950586e-04 +-7.9469032586396008e-04 +-7.8568451645586064e-04 +-7.7725708748048147e-04 +-7.6945454292192295e-04 +-7.6231135912050254e-04 +-7.5585219488579142e-04 +-7.5009390327935199e-04 +-7.4504731470298067e-04 +-7.4071878096392018e-04 +-7.3711148320198649e-04 +-7.3422651439293812e-04 +-7.3206375087919956e-04 +-7.3062252813218794e-04 +-7.2990213459255872e-04 +-7.1661627771692161e-04 +-7.1802578472136066e-04 +-7.2082736038203406e-04 +-7.2498603836067797e-04 +-7.3044914831410447e-04 +-7.3714606014174883e-04 +-7.4498785966980281e-04 +-7.5386697541380112e-04 +-7.6365679303892656e-04 +-7.7421132519021895e-04 +-7.8536505395965402e-04 +-7.9693313143854244e-04 +-8.0871220238937030e-04 +-8.2048218295063975e-04 +-8.3200936105324815e-04 +-8.4305114406264185e-04 +-8.5336264022241955e-04 +-8.6270501705778158e-04 +-8.7085525866197793e-04 +-8.7761660540868034e-04 +-8.8282868674587620e-04 +-8.8637623098586230e-04 +-8.8819530640508819e-04 +-8.8827631691412278e-04 +-8.8666339165957130e-04 +-8.8345028229031583e-04 +-8.7877331526313744e-04 +-8.7280225878840802e-04 +-8.6573011157526746e-04 +-8.5776280251201309e-04 +-8.4910964009167250e-04 +-8.3997511975203356e-04 +-8.3055244072323267e-04 +-8.2101884604172720e-04 +-8.1153270875761868e-04 +-8.0223215628641279e-04 +-7.9323495239047137e-04 +-7.8463933303921617e-04 +-7.7652550519273001e-04 +-7.6895755291765222e-04 +-7.6198554161272967e-04 +-7.5564765980286038e-04 +-7.4997228321745915e-04 +-7.4497988450770243e-04 +-7.4068474270805329e-04 +-7.3709642942559796e-04 +-7.3422106452313799e-04 +-7.3206234386985697e-04 +-7.3062234679673510e-04 +-7.2990213235980665e-04 +-6.9978944951417006e-04 +-7.0116671051601205e-04 +-7.0390493389868017e-04 +-7.0797144063124856e-04 +-7.1331701388123263e-04 +-7.1987567824981019e-04 +-7.2756443418971195e-04 +-7.3628297418099292e-04 +-7.4591341947913151e-04 +-7.5632013597079733e-04 +-7.6734971785773426e-04 +-7.7883126953733376e-04 +-7.9057716605814585e-04 +-8.0238452178508178e-04 +-8.1403762958800476e-04 +-8.2531162809862900e-04 +-8.3597759120253366e-04 +-8.4580909807743983e-04 +-8.5459013572849649e-04 +-8.6212393316330565e-04 +-8.6824207337415883e-04 +-8.7281303631785460e-04 +-8.7574925111442840e-04 +-8.7701181557615026e-04 +-8.7661227685206203e-04 +-8.7461121951695189e-04 +-8.7111380750962445e-04 +-8.6626279385750601e-04 +-8.6022977875084832e-04 +-8.5320562271180237e-04 +-8.4539090304865821e-04 +-8.3698716477631746e-04 +-8.2818950638173863e-04 +-8.1918080502491367e-04 +-8.1012766632169260e-04 +-8.0117800812155393e-04 +-7.9246006782487661e-04 +-7.8408255826944713e-04 +-7.7613567922300928e-04 +-7.6869270735925534e-04 +-7.6181192422673891e-04 +-7.5553868796372184e-04 +-7.4990750202341379e-04 +-7.4494397754467430e-04 +-7.4066662233581446e-04 +-7.3708841770444287e-04 +-7.3421816477466702e-04 +-7.3206159538144813e-04 +-7.3062225034498107e-04 +-7.2990213117229594e-04 +-6.9978953343288795e-04 +-7.0116746674280406e-04 +-7.0390703938731604e-04 +-7.0797557938730952e-04 +-7.1332387491455874e-04 +-7.1988594695835176e-04 +-7.2757877532260787e-04 +-7.3630200507145442e-04 +-7.4593767317575181e-04 +-7.5635001530131418e-04 +-7.6738544330758247e-04 +-7.7887282594273424e-04 +-7.9062425514561316e-04 +-8.0243652901851824e-04 +-8.1409361402074365e-04 +-8.2537034247373792e-04 +-8.3603753620266731e-04 +-8.4586860967407126e-04 +-8.5464749883414418e-04 +-8.6217750947574306e-04 +-8.6829042774680626e-04 +-8.7285504521802579e-04 +-8.7578417910174852e-04 +-8.7703935079211446e-04 +-8.7663252310726521e-04 +-8.7462464920084570e-04 +-8.7112118483840260e-04 +-8.6626508100458462e-04 +-8.6022803791055056e-04 +-8.5320092547670702e-04 +-8.4538425537816742e-04 +-8.3697945216821494e-04 +-8.2818146039239618e-04 +-8.1917298953303967e-04 +-8.1012048012796441e-04 +-8.0117169961474693e-04 +-7.9245475735872386e-04 +-7.8407826434665298e-04 +-7.7613234533448834e-04 +-7.6869022717895895e-04 +-7.6181016367479369e-04 +-7.5553750334053996e-04 +-7.4990675395029667e-04 +-7.4494354082133127e-04 +-7.4066639206163615e-04 +-7.3708831213729323e-04 +-7.3421812544947950e-04 +-7.3206158500968902e-04 +-7.3062224898912652e-04 +-7.2990213115549504e-04 +-7.1661654258936309e-04 +-7.1802817159276691e-04 +-7.2083400580037933e-04 +-7.2499910051276135e-04 +-7.3047079928680481e-04 +-7.3717845633659309e-04 +-7.4503308428501384e-04 +-7.5392694883241653e-04 +-7.6373315027752865e-04 +-7.7430526450087398e-04 +-7.8547716710167107e-04 +-7.9706323335306396e-04 +-8.0885918467128108e-04 +-8.2064391972341214e-04 +-8.3218269555541317e-04 +-8.4323197788131960e-04 +-8.5354613433889488e-04 +-8.6288589619315016e-04 +-8.7102819116546804e-04 +-8.7777661462044919e-04 +-8.8297154076768820e-04 +-8.8649875889714109e-04 +-8.8829560033248239e-04 +-8.8835379839073106e-04 +-8.8671874284217828e-04 +-8.8348526280238385e-04 +-8.7879049967094054e-04 +-8.7280473596013542e-04 +-8.6572118557355952e-04 +-8.5774572709028840e-04 +-8.4908740801224660e-04 +-8.3995031671193381e-04 +-8.3052716372902595e-04 +-8.2099467879780054e-04 +-8.1151074235520919e-04 +-8.0221304190776878e-04 +-7.9321897322914945e-04 +-7.8462648443607791e-04 +-7.7651557441780735e-04 +-7.6895019256751132e-04 +-7.6198033289813960e-04 +-7.5564416389114141e-04 +-7.4997008021018949e-04 +-7.4497860060179842e-04 +-7.4068406667625254e-04 +-7.3709611984888106e-04 +-7.3422094930065507e-04 +-7.3206231349977975e-04 +-7.3062234282819714e-04 +-7.2990213231060295e-04 +-7.5076497006220213e-04 +-7.5224439903550842e-04 +-7.5518352729271685e-04 +-7.5954277190945951e-04 +-7.6526244390980329e-04 +-7.7226235604434875e-04 +-7.8044128137121614e-04 +-7.8967626493785931e-04 +-7.9982182521719811e-04 +-8.1070915008356911e-04 +-8.2214550088470419e-04 +-8.3391418152620786e-04 +-8.4577558025847213e-04 +-8.5746989854009598e-04 +-8.6872217583419133e-04 +-8.7925003856873028e-04 +-8.8877421998070027e-04 +-8.9703135559566312e-04 +-9.0378797160166986e-04 +-9.0885411459559957e-04 +-9.1209487921125915e-04 +-9.1343826346421640e-04 +-9.1287829855068211e-04 +-9.1047313244286307e-04 +-9.0633850821986183e-04 +-9.0063769023986757e-04 +-8.9356923966214666e-04 +-8.8535409861024148e-04 +-8.7622325864858441e-04 +-8.6640695653272478e-04 +-8.5612595725980680e-04 +-8.4558513022516425e-04 +-8.3496924614446708e-04 +-8.2444073717517058e-04 +-8.1413906488226446e-04 +-8.0418131254932318e-04 +-7.9466363814739748e-04 +-7.8566327194631001e-04 +-7.7724080244844667e-04 +-7.6944255510716017e-04 +-7.6230292357576097e-04 +-7.5584655978618996e-04 +-7.5009036602605638e-04 +-7.4504525980131355e-04 +-7.4071770179179623e-04 +-7.3711099004559338e-04 +-7.3422633114035162e-04 +-7.3206370263531064e-04 +-7.3062252183298437e-04 +-7.2990213451451188e-04 +-8.0313983995316369e-04 +-8.0472309126720443e-04 +-8.0786634421505410e-04 +-8.1252293078229779e-04 +-8.1862239684540232e-04 +-8.2606987845126000e-04 +-8.3474515238911220e-04 +-8.4450130968902854e-04 +-8.5516307622924420e-04 +-8.6652496351902544e-04 +-8.7834968560367003e-04 +-8.9036759818707017e-04 +-9.0227822077987481e-04 +-9.1375505365575067e-04 +-9.2445473951039520e-04 +-9.3403103610310921e-04 +-9.4215308575386109e-04 +-9.4852629727601098e-04 +-9.5291315007662355e-04 +-9.5515076418783453e-04 +-9.5516238299491818e-04 +-9.5296095139624703e-04 +-9.4864444195942327e-04 +-9.4238404871753543e-04 +-9.3440743794694818e-04 +-9.2497970416339657e-04 +-9.1438453569476174e-04 +-9.0290752211762127e-04 +-8.9082277552836602e-04 +-8.7838330221093309e-04 +-8.6581498602188005e-04 +-8.5331367992159078e-04 +-8.4104473367230552e-04 +-8.2914426597820298e-04 +-8.1772156213818310e-04 +-8.0686209504000070e-04 +-7.9663079345064654e-04 +-7.8707529654536588e-04 +-7.7822902804115552e-04 +-7.7011399506970990e-04 +-7.6274326800956547e-04 +-7.5612313161305784e-04 +-7.5025491893956702e-04 +-7.4513655145923784e-04 +-7.4076381414765041e-04 +-7.3713139565433647e-04 +-7.3423372227926378e-04 +-7.3206561160540928e-04 +-7.3062276793125222e-04 +-7.2990213754517224e-04 +-8.7486276260574300e-04 +-8.7658827158619676e-04 +-8.8001138623762098e-04 +-8.8507605728278848e-04 +-8.9169751059914423e-04 +-8.9976115641157012e-04 +-9.0912076480975169e-04 +-9.1959572217946309e-04 +-9.3096736619206137e-04 +-9.4297478630794233e-04 +-9.5531108138182362e-04 +-9.6762178646248758e-04 +-9.7950777094600095e-04 +-9.9053500633209442e-04 +-1.0002528565288362e-03 +-1.0082208401788013e-03 +-1.0140414552551266e-03 +-1.0173943734378729e-03 +-1.0180660141653056e-03 +-1.0159688484404207e-03 +-1.0111467902534201e-03 +-1.0037660578227435e-03 +-9.9409389955805016e-04 +-9.8246965421705588e-04 +-9.6927329704745162e-04 +-9.5489601723510549e-04 +-9.3971596004509576e-04 +-9.2408063052134832e-04 +-9.0829604682192628e-04 +-8.9262177899113605e-04 +-8.7727053926924480e-04 +-8.6241090449541995e-04 +-8.4817190799198661e-04 +-8.3464850773305689e-04 +-8.2190722667162903e-04 +-8.0999151653374072e-04 +-7.9892659610546017e-04 +-7.8872365688592973e-04 +-7.7938342101436598e-04 +-7.7089909021276176e-04 +-7.6325875148017133e-04 +-7.5644731484834492e-04 +-7.5044805769251745e-04 +-7.4524384373623326e-04 +-7.4081807611659444e-04 +-7.3715543454632370e-04 +-7.3424243773827170e-04 +-7.3206786430844099e-04 +-7.3062305849320541e-04 +-7.2990214112442621e-04 +-9.6691809554777064e-04 +-9.6882656547613868e-04 +-9.7261024483818559e-04 +-9.7820224719628304e-04 +-9.8550108242089537e-04 +-9.9436860316729219e-04 +-1.0046262904150720e-03 +-1.0160493853902006e-03 +-1.0283588415946972e-03 +-1.0412120412931422e-03 +-1.0541946653595819e-03 +-1.0668176830103107e-03 +-1.0785244280304678e-03 +-1.0887122435032307e-03 +-1.0967705662278139e-03 +-1.1021327902780164e-03 +-1.1043341439622857e-03 +-1.1030642455678932e-03 +-1.0982028090596027e-03 +-1.0898306170970540e-03 +-1.0782140727940179e-03 +-1.0637679897092785e-03 +-1.0470055465567820e-03 +-1.0284854651487585e-03 +-1.0087648158501406e-03 +-9.8836265129419046e-04 +-9.6773627860989315e-04 +-9.4726934320514989e-04 +-9.2726937039063157e-04 +-9.0797189886352965e-04 +-8.8954852599380503e-04 +-8.7211672713699930e-04 +-8.5574994754629191e-04 +-8.4048704001881238e-04 +-8.2634056748241160e-04 +-8.1330379827989935e-04 +-8.0135641303607835e-04 +-7.9046904539030590e-04 +-7.8060682307714842e-04 +-7.7173208374904873e-04 +-7.6380642797964208e-04 +-7.5679225085251893e-04 +-7.5065386994145253e-04 +-7.4535834489305878e-04 +-7.4087606391854744e-04 +-7.3718115584882110e-04 +-7.3425177296164575e-04 +-7.3207027919458458e-04 +-7.3062337015165392e-04 +-7.2990214496477417e-04 +-1.0795762955715753e-03 +-1.0817094903622744e-03 +-1.0859377458488676e-03 +-1.0921842176957824e-03 +-1.1003315958434778e-03 +-1.1102180411194534e-03 +-1.1216294048265675e-03 +-1.1342865903341919e-03 +-1.1478281215383532e-03 +-1.1617903891102269e-03 +-1.1755914181819230e-03 +-1.1885272473855497e-03 +-1.1997911797908783e-03 +-1.2085232013149606e-03 +-1.2138890320081900e-03 +-1.2151774960945092e-03 +-1.2118956330879225e-03 +-1.2038381195402684e-03 +-1.1911133828902004e-03 +-1.1741211398885499e-03 +-1.1534895905968665e-03 +-1.1299896820974036e-03 +-1.1044460697651518e-03 +-1.0776605203845246e-03 +-1.0503565448514802e-03 +-1.0231471687627836e-03 +-9.9652288899338142e-04 +-9.7085451639031587e-04 +-9.4640528594357035e-04 +-9.2334749345617971e-04 +-9.0178024493207021e-04 +-8.8174619590350217e-04 +-8.6324618344583905e-04 +-8.4625136121428267e-04 +-8.3071287736016298e-04 +-8.1656935849886813e-04 +-8.0375255059577299e-04 +-7.9219147555102546e-04 +-7.8181542919254418e-04 +-7.7255609671232303e-04 +-7.6434900920251266e-04 +-7.5713451689102414e-04 +-7.5085841381186864e-04 +-7.4547231554315081e-04 +-7.4093386573639679e-04 +-7.3720682740401403e-04 +-7.3426110019104952e-04 +-7.3207269405520703e-04 +-7.3062368198874121e-04 +-7.2990214880862031e-04 +-1.2115526917656071e-03 +-1.2139506401887352e-03 +-1.2187065649686990e-03 +-1.2257395714966170e-03 +-1.2349245488297326e-03 +-1.2460839414856352e-03 +-1.2589714131270191e-03 +-1.2732450169841592e-03 +-1.2884305604829950e-03 +-1.3038816567677121e-03 +-1.3187504786672018e-03 +-1.3319892112755394e-03 +-1.3424016811569967e-03 +-1.3487536644419863e-03 +-1.3499299110508382e-03 +-1.3451038832183947e-03 +-1.3338743828523664e-03 +-1.3163297967431478e-03 +-1.2930237919867471e-03 +-1.2648746986288950e-03 +-1.2330212807355337e-03 +-1.1986729630620873e-03 +-1.1629844481017863e-03 +-1.1269700839474572e-03 +-1.0914595553317235e-03 +-1.0570875368023074e-03 +-1.0243064438090457e-03 +-9.9341185123726365e-04 +-9.6457254170533686e-04 +-9.3785996523949920e-04 +-9.1327429714464976e-04 +-8.9076598760856824e-04 +-8.7025273940323110e-04 +-8.5163238963844538e-04 +-8.3479238207829663e-04 +-8.1961653807635269e-04 +-8.0598976259140323e-04 +-7.9380121529863364e-04 +-7.8294636712901943e-04 +-7.7332826447039393e-04 +-7.6485824195702222e-04 +-7.5745626053326932e-04 +-7.5105099837196655e-04 +-7.4557978562047439e-04 +-7.4098844721998418e-04 +-7.3723109889786849e-04 +-7.3426992798790230e-04 +-7.3207498148544303e-04 +-7.3062397753727803e-04 +-7.2990215245292750e-04 +-1.3589607127443924e-03 +-1.3616568443993548e-03 +-1.3670149073432467e-03 +-1.3749648751974109e-03 +-1.3853946020702744e-03 +-1.3981332443686071e-03 +-1.4129176951337889e-03 +-1.4293375316985950e-03 +-1.4467614928537300e-03 +-1.4642618387859523e-03 +-1.4805685799692623e-03 +-1.4940945935512011e-03 +-1.5030637596682810e-03 +-1.5057420529414971e-03 +-1.5007254416671231e-03 +-1.4872024449710689e-03 +-1.4651074151172290e-03 +-1.4351182395757596e-03 +-1.3985093946662110e-03 +-1.3569174993280021e-03 +-1.3120917997321460e-03 +-1.2656873375762492e-03 +-1.2191292932515496e-03 +-1.1735495981382350e-03 +-1.1297802440201287e-03 +-1.0883824071754354e-03 +-1.0496927370331223e-03 +-1.0138735389441642e-03 +-9.8095908311778045e-04 +-9.5089450800700721e-04 +-9.2356649429026769e-04 +-8.9882633823128665e-04 +-8.7650666033788213e-04 +-8.5643310343738461e-04 +-8.3843225240799193e-04 +-8.2233679594752632e-04 +-8.0798872830229699e-04 +-7.9524119144368558e-04 +-7.8395939728567992e-04 +-7.7402094496090178e-04 +-7.6531575491603314e-04 +-7.5774577344283332e-04 +-7.5122455240069440e-04 +-7.4567677443796766e-04 +-7.4103777014916704e-04 +-7.3725305739418424e-04 +-7.3427792228612462e-04 +-7.3207705451302238e-04 +-7.3062424552350260e-04 +-7.2990215575849577e-04 +-1.5143567098121805e-03 +-1.5173708767203093e-03 +-1.5233851011606627e-03 +-1.5323683477496621e-03 +-1.5442607966953993e-03 +-1.5589415518853680e-03 +-1.5761627447065892e-03 +-1.5954424960748384e-03 +-1.6159263753071473e-03 +-1.6362554954961743e-03 +-1.6545088577443082e-03 +-1.6682962452453894e-03 +-1.6750434924429109e-03 +-1.6724332984418347e-03 +-1.6588775086592534e-03 +-1.6338578453502692e-03 +-1.5980155836261174e-03 +-1.5529747535215372e-03 +-1.5009850788560838e-03 +-1.4445162486683653e-03 +-1.3859155230835243e-03 +-1.3271856634533689e-03 +-1.2698863739957942e-03 +-1.2151303090450491e-03 +-1.1636356592069116e-03 +-1.1158028519391930e-03 +-1.0717936714210983e-03 +-1.0316012333697515e-03 +-9.9510645573381218e-04 +-9.6212086196447648e-04 +-9.3241752164274739e-04 +-9.0575254465517872e-04 +-8.8187946105622533e-04 +-8.6055845165577895e-04 +-8.4156196527124640e-04 +-8.2467786778102413e-04 +-8.0971094962910598e-04 +-7.9648337449517907e-04 +-7.8483447207268312e-04 +-7.7462014877138113e-04 +-7.6571209909735412e-04 +-7.5799693717574970e-04 +-7.5137532449266243e-04 +-7.4576114063537537e-04 +-7.4108072442136456e-04 +-7.3727220033924451e-04 +-7.3428489757121752e-04 +-7.3207886451488670e-04 +-7.3062447961586160e-04 +-7.2990215864694751e-04 +-1.6665489319237670e-03 +-1.6698793792254559e-03 +-1.6765677130926274e-03 +-1.6866640440169798e-03 +-1.7002198940496054e-03 +-1.7172291893230507e-03 +-1.7375077538844370e-03 +-1.7605002988155662e-03 +-1.7850395102932625e-03 +-1.8091371750403691e-03 +-1.8299366403207984e-03 +-1.8439525354919002e-03 +-1.8476303825064263e-03 +-1.8380968400319431e-03 +-1.8138364520496701e-03 +-1.7750298565427979e-03 +-1.7234392423742320e-03 +-1.6619303351236372e-03 +-1.5938468048713958e-03 +-1.5224493911063317e-03 +-1.4505406177323448e-03 +-1.3802934142697356e-03 +-1.3132376024962457e-03 +-1.2503391830886394e-03 +-1.1921171123451793e-03 +-1.1387618464650028e-03 +-1.0902377760975269e-03 +-1.0463637422993284e-03 +-1.0068723763224229e-03 +-9.7145174589520109e-04 +-9.3977338539163362e-04 +-9.1151039233180130e-04 +-8.8634854839761098e-04 +-8.6399268874337966e-04 +-8.4416992252910397e-04 +-8.2663082732423025e-04 +-8.1114938696284929e-04 +-7.9752219099809857e-04 +-7.8556723855561031e-04 +-7.7512256889591914e-04 +-7.6604485916577955e-04 +-7.5820807486664643e-04 +-7.5150222215376958e-04 +-7.4583222739028215e-04 +-7.4111695440976476e-04 +-7.3728836092040663e-04 +-7.3429079051961902e-04 +-7.3208039454607905e-04 +-7.3062467757728814e-04 +-7.2990216109043292e-04 +-1.8021238077677217e-03 +-1.8057409678354465e-03 +-1.8130683059586650e-03 +-1.8242843174856183e-03 +-1.8396180799741624e-03 +-1.8592513493914224e-03 +-1.8831189590932875e-03 +-1.9105933552057215e-03 +-1.9401038936168967e-03 +-1.9688373007822422e-03 +-1.9927395372806526e-03 +-2.0070033414010600e-03 +-2.0070269811837526e-03 +-1.9895452714457618e-03 +-1.9534677371910013e-03 +-1.9000717047022130e-03 +-1.8325272875727625e-03 +-1.7550347874547129e-03 +-1.6719448448049479e-03 +-1.5871178622243077e-03 +-1.5035986104711600e-03 +-1.4235514630721398e-03 +-1.3483542317310245e-03 +-1.2787589559376780e-03 +-1.2150598631886834e-03 +-1.1572388252932609e-03 +-1.1050788183997876e-03 +-1.0582465394804441e-03 +-1.0163495669317595e-03 +-9.7897423005593293e-04 +-9.4570962920854744e-04 +-9.1616208508841395e-04 +-8.8996317050505757e-04 +-8.6677355702317589e-04 +-8.4628421447557889e-04 +-8.2821600166339447e-04 +-8.1231833720145808e-04 +-7.9836739972459405e-04 +-7.8616414429048440e-04 +-7.7553231297327609e-04 +-7.6631654541276146e-04 +-7.5838064771808957e-04 +-7.5160604757788178e-04 +-7.4589044422790861e-04 +-7.4114665037876639e-04 +-7.3730161679424545e-04 +-7.3429562725326099e-04 +-7.3208165094589103e-04 +-7.3062484018866737e-04 +-7.2990216309830054e-04 +-1.9092047849804336e-03 +-1.9130513855316908e-03 +-1.9209177342307659e-03 +-1.9331395198893780e-03 +-1.9501646468457045e-03 +-1.9724109052639736e-03 +-1.9999754501243139e-03 +-2.0321778671418479e-03 +-2.0670184613209518e-03 +-2.1007803444447245e-03 +-2.1281095748169614e-03 +-2.1428236308090130e-03 +-2.1393490545724998e-03 +-2.1142472108379136e-03 +-2.0671245122512909e-03 +-2.0005398181566097e-03 +-1.9190769423104567e-03 +-1.8281073640397257e-03 +-1.7327396439194801e-03 +-1.6371917119839736e-03 +-1.5445726343632680e-03 +-1.4569392419719511e-03 +-1.3754845409048467e-03 +-1.3007575392934034e-03 +-1.2328616393418690e-03 +-1.1716123033973030e-03 +-1.1166529268454102e-03 +-1.0675354314180841e-03 +-1.0237738766482078e-03 +-9.8487862713396586e-04 +-9.5037706051017768e-04 +-9.1982524167677493e-04 +-8.9281369867972725e-04 +-8.6896945976264043e-04 +-8.4795580853883176e-04 +-8.2947072326441950e-04 +-8.1324462963481788e-04 +-7.9903786891379394e-04 +-7.8663813092400676e-04 +-7.7585800057500135e-04 +-7.6653270057591076e-04 +-7.5851807039050204e-04 +-7.5168879462561794e-04 +-7.4593687767314032e-04 +-7.4117035206164436e-04 +-7.3731220324423259e-04 +-7.3429949190579463e-04 +-7.3208265522342565e-04 +-7.3062497020323863e-04 +-7.2990216470436705e-04 +-1.9822077559941021e-03 +-1.9862089245022102e-03 +-1.9944542866831118e-03 +-2.0074172763325784e-03 +-2.0257406157604347e-03 +-2.0500615698234876e-03 +-2.0806512137396148e-03 +-2.1168385860464690e-03 +-2.1563163611898091e-03 +-2.1946269724859380e-03 +-2.2252896253218252e-03 +-2.2409122362956660e-03 +-2.2351037899706323e-03 +-2.2043649072358523e-03 +-2.1490019339632572e-03 +-2.0726974583331888e-03 +-1.9811560644312502e-03 +-1.8805849280516256e-03 +-1.7765691479757688e-03 +-1.6735083724841962e-03 +-1.5745063672757611e-03 +-1.4815205455666635e-03 +-1.3956107091344240e-03 +-1.3171909288397310e-03 +-1.2462418435242495e-03 +-1.1824725964770810e-03 +-1.1254366263547958e-03 +-1.0746105659636828e-03 +-1.0294457769082471e-03 +-9.8940053244373546e-04 +-9.5395897760066056e-04 +-9.2264131013289384e-04 +-8.9500829574718421e-04 +-8.7066224698944758e-04 +-8.4924589409886048e-04 +-8.3044008865588168e-04 +-8.1396094763236859e-04 +-7.9955682068213909e-04 +-7.8700531370027216e-04 +-7.7611050301865092e-04 +-7.6670041056329640e-04 +-7.5862476947865241e-04 +-7.5175308442040174e-04 +-7.4597297567888937e-04 +-7.4118878805796203e-04 +-7.3732044162292212e-04 +-7.3430250055165052e-04 +-7.3208343729292704e-04 +-7.3062507147162489e-04 +-7.2990216595599585e-04 +-2.0242504115102577e-03 +-2.0283322012812424e-03 +-2.0367692161178796e-03 +-2.0500962143531090e-03 +-2.0690491502589397e-03 +-2.0943897229875269e-03 +-2.1265318513061901e-03 +-2.1649162316467710e-03 +-2.2072035548057257e-03 +-2.2486101831184595e-03 +-2.2819719097596446e-03 +-2.2990302234710681e-03 +-2.2927273550263291e-03 +-2.2594192409943928e-03 +-2.1998051474377040e-03 +-2.1182421598598053e-03 +-2.0210943817112596e-03 +-1.9150474094118803e-03 +-1.8059607615677218e-03 +-1.6983549121577554e-03 +-1.5953618722183238e-03 +-1.4989194097221508e-03 +-1.4100458329523084e-03 +-1.3291052854982797e-03 +-1.2560266631876896e-03 +-1.1904689028222511e-03 +-1.1319385593409705e-03 +-1.0798696466604537e-03 +-1.0336755806915861e-03 +-9.9278140304119881e-04 +-9.5664253265532182e-04 +-9.2475458389240206e-04 +-8.9665743930775546e-04 +-8.7193576140960876e-04 +-8.5021740854614668e-04 +-8.3117071793214689e-04 +-8.1450127477388173e-04 +-7.9994855429722637e-04 +-7.8728266905886077e-04 +-7.7630135263458730e-04 +-7.6682724547101286e-04 +-7.5870550743291018e-04 +-7.5180175633571917e-04 +-7.4600031700631879e-04 +-7.4120275757840273e-04 +-7.3732668631746831e-04 +-7.3430478177907775e-04 +-7.3208403041204585e-04 +-7.3062514828541698e-04 +-7.2990216690607082e-04 +-2.0445814855183805e-03 +-2.0486888780116013e-03 +-2.0571567760233975e-03 +-2.0704823127949694e-03 +-2.0893598072905008e-03 +-2.1145388554281641e-03 +-2.1465035217178696e-03 +-2.1848851445865824e-03 +-2.2276110829024254e-03 +-2.2700739028501402e-03 +-2.3049994312481169e-03 +-2.3237057942449872e-03 +-2.3186111009488837e-03 +-2.2857157825508265e-03 +-2.2256387932448191e-03 +-2.1428606238407849e-03 +-2.0439505718224129e-03 +-1.9358007332648988e-03 +-1.8244473353508151e-03 +-1.7145511851919025e-03 +-1.6093487651118088e-03 +-1.5108489551341443e-03 +-1.4201120032768643e-03 +-1.3375204726636428e-03 +-1.2630043846482745e-03 +-1.1962123304740341e-03 +-1.1366338458570519e-03 +-1.0836828196729761e-03 +-1.0367518599460604e-03 +-9.9524601569552906e-04 +-9.5860234921908412e-04 +-9.2630011578566016e-04 +-8.9786490902796538e-04 +-8.7286907797100126e-04 +-8.5092996250396330e-04 +-8.3170696203944733e-04 +-8.1489808716328970e-04 +-8.0023639809784751e-04 +-7.8748657062648064e-04 +-7.7644172356964409e-04 +-7.6692057357901418e-04 +-7.5876494016841327e-04 +-7.5183759790757099e-04 +-7.4602045769194014e-04 +-7.4121305115352608e-04 +-7.3733128897238544e-04 +-7.3430646351920436e-04 +-7.3208446773694762e-04 +-7.3062520492920050e-04 +-7.2990216760743460e-04 +-2.0529858282546764e-03 +-2.0570897688045775e-03 +-2.0654964501461881e-03 +-2.0785980514732507e-03 +-2.0969505759414067e-03 +-2.1211789067892969e-03 +-2.1517421145154599e-03 +-2.1884484012921418e-03 +-2.2296437036484029e-03 +-2.2712625620194089e-03 +-2.3064310124585800e-03 +-2.3264960417763701e-03 +-2.3235239748370037e-03 +-2.2929741959504843e-03 +-2.2349615283936081e-03 +-2.1536380073538097e-03 +-2.0554520852546468e-03 +-1.9473420600131213e-03 +-1.8354877796106443e-03 +-1.7247257264848628e-03 +-1.6184556402891476e-03 +-1.5188155815243974e-03 +-1.4269560895101517e-03 +-1.3433156287322948e-03 +-1.2678537261492054e-03 +-1.2002301770836072e-03 +-1.1399341191822372e-03 +-1.0863723843369418e-03 +-1.0389272264291112e-03 +-9.9699217606615182e-04 +-9.5999287203701249e-04 +-9.2739791758730144e-04 +-8.9872333448907883e-04 +-8.7353306886860332e-04 +-8.5143719268003504e-04 +-8.3208887662306562e-04 +-8.1518082111419008e-04 +-8.0044157028710242e-04 +-7.8763196101829674e-04 +-7.7654184650260028e-04 +-7.6698716211716356e-04 +-7.5880735654356921e-04 +-7.5186318411270584e-04 +-7.4603483884688932e-04 +-7.4122040264191147e-04 +-7.3733457669171183e-04 +-7.3430766497860898e-04 +-7.3208478020370983e-04 +-7.3062524540432993e-04 +-7.2990216810945869e-04 +-2.0560418437203139e-03 +-2.0601335576182194e-03 +-2.0684557401679762e-03 +-2.0812829363209013e-03 +-2.0990083161026691e-03 +-2.1220852721789097e-03 +-2.1508699748268743e-03 +-2.1852554495645619e-03 +-2.2239695396326933e-03 +-2.2636059059981495e-03 +-2.2979870947719729e-03 +-2.3188340692578530e-03 +-2.3180504976457522e-03 +-2.2904950154258715e-03 +-2.2355542203713859e-03 +-2.1568136502437959e-03 +-2.0604409633115479e-03 +-1.9533484364607926e-03 +-1.8418440700634009e-03 +-1.7309492887517348e-03 +-1.6242423229564007e-03 +-1.5240043415470329e-03 +-1.4314874636793735e-03 +-1.3471953367281072e-03 +-1.2711250687279302e-03 +-1.2029550038673046e-03 +-1.1421806704824753e-03 +-1.0882080891459777e-03 +-1.0404148238582368e-03 +-9.9818793861724728e-04 +-9.6094608477108963e-04 +-9.2815105864676138e-04 +-8.9931260951983964e-04 +-8.7398909098226690e-04 +-8.5178568925761526e-04 +-8.3235136006690755e-04 +-8.1537519426688992e-04 +-8.0058265670751485e-04 +-7.8773196105697528e-04 +-7.7661072558597125e-04 +-7.6703298005333879e-04 +-7.5883654730074599e-04 +-7.5188079523736903e-04 +-7.4604473890546499e-04 +-7.4122546409220171e-04 +-7.3733684051431961e-04 +-7.3430849234214766e-04 +-7.3208499539352794e-04 +-7.3062527328042308e-04 +-7.2990216845622710e-04 +-2.0570065846478550e-03 +-2.0610871704548838e-03 +-2.0693394717650735e-03 +-2.0819437405239973e-03 +-2.0991577329762669e-03 +-2.1212771711369240e-03 +-2.1485270430950348e-03 +-2.1807935113191852e-03 +-2.2170551087465433e-03 +-2.2544794623020545e-03 +-2.2876284310985708e-03 +-2.3087465029909726e-03 +-2.3097213741021727e-03 +-2.2848782358095561e-03 +-2.2328748119300195e-03 +-2.1567068640724980e-03 +-2.0622397313336716e-03 +-1.9563407181706237e-03 +-1.8454251215506807e-03 +-1.7346761648859841e-03 +-1.6278280573624067e-03 +-1.5272862302300922e-03 +-1.4343907260378466e-03 +-1.3497019129896498e-03 +-1.2732503263243316e-03 +-1.2047318377672275e-03 +-1.1436493784876924e-03 +-1.0894103336852733e-03 +-1.0413902999592416e-03 +-9.9897274223807796e-04 +-9.6157209787588876e-04 +-9.2864590857081100e-04 +-8.9969992755457048e-04 +-8.7428890554310521e-04 +-8.5201485937182891e-04 +-8.3252399831437154e-04 +-8.1550305439751793e-04 +-8.0067547624873656e-04 +-7.8779775767439406e-04 +-7.7665605031759549e-04 +-7.6706313260168648e-04 +-7.5885575923141776e-04 +-7.5189238692229194e-04 +-7.4605125560404440e-04 +-7.4122879598988709e-04 +-7.3733833084266385e-04 +-7.3430903703895344e-04 +-7.3208513706902990e-04 +-7.3062529163413301e-04 +-7.2990216868574543e-04 +-2.0572332660448414e-03 +-2.0613063434619535e-03 +-2.0695123145626844e-03 +-2.0819689760005946e-03 +-2.0988420322208619e-03 +-2.1203125214364496e-03 +-2.1464920495369456e-03 +-2.1772178773224386e-03 +-2.2115976446009915e-03 +-2.2472036766273437e-03 +-2.2792001096435264e-03 +-2.3003171786506690e-03 +-2.3024955835049834e-03 +-2.2796630654131288e-03 +-2.2298969019770359e-03 +-2.1557179478979109e-03 +-2.0627481191051794e-03 +-1.9578160946500550e-03 +-1.8474167824150509e-03 +-1.7368536983143027e-03 +-1.6299759809757031e-03 +-1.5292798210890740e-03 +-1.4361690858669569e-03 +-1.3512452442097484e-03 +-1.2745631830800681e-03 +-1.2058317951220588e-03 +-1.1445598535885946e-03 +-1.0901563056676083e-03 +-1.0419959312203508e-03 +-9.9946018702283036e-04 +-9.6196101903280767e-04 +-9.2895339519249206e-04 +-8.9994062370931738e-04 +-8.7447523687383488e-04 +-8.5215729276494334e-04 +-8.3263129946974036e-04 +-8.1558252591569025e-04 +-8.0073316908179900e-04 +-7.8783865456062436e-04 +-7.7668422278654012e-04 +-7.6708187459696286e-04 +-7.5886770087951478e-04 +-7.5189959203436868e-04 +-7.4605530623058107e-04 +-7.4123086701912983e-04 +-7.3733925719484826e-04 +-7.3430937560903199e-04 +-7.3208522513101121e-04 +-7.3062530304280194e-04 +-7.2990216882992350e-04 +-2.0572420812143854e-03 +-2.0613108437783508e-03 +-2.0694900863253403e-03 +-2.0818613850869497e-03 +-2.0985363293793470e-03 +-2.1196259188928381e-03 +-2.1451656987976496e-03 +-2.1749450598354805e-03 +-2.2081277420502501e-03 +-2.2425292935860917e-03 +-2.2737144189310288e-03 +-2.2947597691563714e-03 +-2.2976647776361669e-03 +-2.2761033436655928e-03 +-2.2277691102031553e-03 +-2.1548688625872871e-03 +-2.0628650257302076e-03 +-1.9585616800489119e-03 +-1.8485054225306590e-03 +-1.7380767252497902e-03 +-1.6311974806148680e-03 +-1.5304208457005797e-03 +-1.4371904828979069e-03 +-1.3521333707929135e-03 +-1.2753194824758807e-03 +-1.2064657989729899e-03 +-1.1450847736758547e-03 +-1.0905864156424776e-03 +-1.0423451135082905e-03 +-9.9974120300985693e-04 +-9.6218520874459773e-04 +-9.2913061938411801e-04 +-9.0007933349498589e-04 +-8.7458260267005931e-04 +-8.5223935365291324e-04 +-8.3269311190666223e-04 +-8.1562830139731237e-04 +-8.0076639645322546e-04 +-7.8786220611936036e-04 +-7.7670044507091118e-04 +-7.6709266562720909e-04 +-7.5887457589378089e-04 +-7.5190373980487475e-04 +-7.4605763788090159e-04 +-7.4123205907798586e-04 +-7.3733979035941165e-04 +-7.3430957046412238e-04 +-7.3208527581091832e-04 +-7.3062530960891787e-04 +-7.2990216891481371e-04 +-2.0572136909901254e-03 +-2.0612803062589106e-03 +-2.0694460715266110e-03 +-2.0817741859300975e-03 +-2.0983486797412354e-03 +-2.1192443129418770e-03 +-2.1444554480049790e-03 +-2.1737414888732664e-03 +-2.2062885761820533e-03 +-2.2400381267918550e-03 +-2.2707745288582169e-03 +-2.2917704820419236e-03 +-2.2950624375509378e-03 +-2.2741857573653182e-03 +-2.2266230828637129e-03 +-2.1544096511321035e-03 +-2.0629222315906451e-03 +-1.9589530631755397e-03 +-1.8490778371834571e-03 +-1.7387191005297394e-03 +-1.6318380057531372e-03 +-1.5310181576768161e-03 +-1.4377243141655591e-03 +-1.3525968707931856e-03 +-1.2757136690163431e-03 +-1.2067958636689789e-03 +-1.1453577724049382e-03 +-1.0908099077688931e-03 +-1.0425264139362483e-03 +-9.9988701187748085e-04 +-9.6230146367220213e-04 +-9.2922247221955453e-04 +-9.0015119176384143e-04 +-8.7463820046519366e-04 +-8.5228183202936086e-04 +-8.3272509809688747e-04 +-8.1565198167076023e-04 +-8.0078358055910622e-04 +-7.8787438300280573e-04 +-7.7670883042208242e-04 +-7.6709824225212582e-04 +-7.5887812801414198e-04 +-7.5190588240320474e-04 +-7.4605884210790486e-04 +-7.4123267463650755e-04 +-7.3734006563554882e-04 +-7.3430967105660053e-04 +-7.3208530197177814e-04 +-7.3062531299887502e-04 +-7.2990216896122017e-04 +-2.0571951357361037e-03 +-2.0612608701773014e-03 +-2.0694210112254985e-03 +-2.0817310510000135e-03 +-2.0982635028567167e-03 +-2.1190779799560989e-03 +-2.1441514272237411e-03 +-2.1732300705874790e-03 +-2.2055088903701072e-03 +-2.2389832389095067e-03 +-2.2695330806078847e-03 +-2.2905163144356865e-03 +-2.2939840771400597e-03 +-2.2734093487658414e-03 +-2.2261818360413931e-03 +-2.1542626420590146e-03 +-2.0629927957614073e-03 +-1.9591610168623427e-03 +-1.8493568531077484e-03 +-1.7390218120034411e-03 +-1.6321343571590117e-03 +-1.5312913134466013e-03 +-1.4379664678408621e-03 +-1.3528058671447717e-03 +-1.2758905971396179e-03 +-1.2069434752357200e-03 +-1.1454795069240800e-03 +-1.0909093284811819e-03 +-1.0426069057815385e-03 +-9.9995163886622707e-04 +-9.6235291871684520e-04 +-9.2926307756070064e-04 +-9.0018292476878176e-04 +-8.7466273013464091e-04 +-8.5230055808374464e-04 +-8.3273918841101117e-04 +-8.1566240611870126e-04 +-8.0079114060389650e-04 +-7.8787973706552429e-04 +-7.7671251539610485e-04 +-7.6710069168095475e-04 +-7.5887968747689991e-04 +-7.5190682263751008e-04 +-7.4605937034254687e-04 +-7.4123294455220640e-04 +-7.3734018630223315e-04 +-7.3430971513933050e-04 +-7.3208531343426546e-04 +-7.3062531448504406e-04 +-7.2990216898511241e-04 +-2.0571887355665926e-03 +-2.0612542113607035e-03 +-2.0694126697077854e-03 +-2.0817172990965195e-03 +-2.0982372232901825e-03 +-2.1190276881102497e-03 +-2.1440607498505538e-03 +-2.1730792118063811e-03 +-2.2052814476454866e-03 +-2.2386797860739389e-03 +-2.2691830912099260e-03 +-2.2901736820759720e-03 +-2.2937046710008540e-03 +-2.2732278406372925e-03 +-2.2261037512132601e-03 +-2.1542715005596533e-03 +-2.0630625694102091e-03 +-1.9592660099059106e-03 +-1.8494766710548038e-03 +-1.7391425016829391e-03 +-1.6322475593257104e-03 +-1.5313927858697947e-03 +-1.4380546783941241e-03 +-1.3528809045310496e-03 +-1.2759534194237850e-03 +-1.2069954318605109e-03 +-1.1455220554238595e-03 +-1.0909438792012834e-03 +-1.0426347459174445e-03 +-9.9997390309248830e-04 +-9.6237058560278668e-04 +-9.2927697911017839e-04 +-9.0019376169499254e-04 +-8.7467108875011375e-04 +-8.5230692665956521e-04 +-8.3274397200221498e-04 +-8.1566593950082038e-04 +-8.0079369930588051e-04 +-7.8788154665684548e-04 +-7.7671375925322339e-04 +-7.6710151747808844e-04 +-7.5888021263272379e-04 +-7.5190713892862230e-04 +-7.4605954786429124e-04 +-7.4123303518128084e-04 +-7.3734022678681585e-04 +-7.3430972992006638e-04 +-7.3208531727629719e-04 +-7.3062531498469148e-04 +-7.2990216899875091e-04 +-2.0571877672731025e-03 +-2.0612532076825832e-03 +-2.0694114291004849e-03 +-2.0817153058623849e-03 +-2.0982335355780525e-03 +-2.1190208838987598e-03 +-2.1440489919049687e-03 +-2.1730606411139433e-03 +-2.2052552939274793e-03 +-2.2386481548140598e-03 +-2.2691519886690629e-03 +-2.2901513907902663e-03 +-2.2936979766027973e-03 +-2.2732390634815770e-03 +-2.2261305747612510e-03 +-2.1543089080233021e-03 +-2.0631050861282859e-03 +-1.9593091339784592e-03 +-1.8495173637015536e-03 +-1.7391790793702035e-03 +-1.6322793490893424e-03 +-1.5314197643869862e-03 +-1.4380771856114674e-03 +-1.3528994478455745e-03 +-1.2759685535082882e-03 +-1.2070076921751594e-03 +-1.1455319261669606e-03 +-1.0909517816608356e-03 +-1.0426410379755678e-03 +-9.9997888420418502e-04 +-9.6237450396698511e-04 +-9.2928003925315942e-04 +-9.0019613158332304e-04 +-8.7467290605958506e-04 +-8.5230830410282330e-04 +-8.3274500175551530e-04 +-8.1566669683196230e-04 +-8.0079424552421073e-04 +-7.8788193150486764e-04 +-7.7671402284737782e-04 +-7.6710169189167727e-04 +-7.5888032319820645e-04 +-7.5190720532271338e-04 +-7.4605958502649815e-04 +-7.4123305410635199e-04 +-7.3734023522246375e-04 +-7.3430973299468821e-04 +-7.3208531807529413e-04 +-7.3062531509081655e-04 +-7.2990216900931386e-04 +-2.0571877673445271e-03 +-2.0612532084470342e-03 +-2.0694114328993012e-03 +-2.0817153234314275e-03 +-2.0982336030097759e-03 +-2.1190210949303856e-03 +-2.1440495494839478e-03 +-2.1730619230597536e-03 +-2.2052578938400224e-03 +-2.2386528063679115e-03 +-2.2691593006423298e-03 +-2.2901614963637901e-03 +-2.2937103624085711e-03 +-2.2732527285834561e-03 +-2.2261443905948588e-03 +-2.1543219381268950e-03 +-2.0631167344606783e-03 +-1.9593191373766363e-03 +-1.8495257057002550e-03 +-1.7391858911214378e-03 +-1.6322848300702327e-03 +-1.5314241304993539e-03 +-1.4380806404042539e-03 +-1.3529021695467961e-03 +-1.2759706914426609e-03 +-1.2070093680651268e-03 +-1.1455332375513577e-03 +-1.0909528058999725e-03 +-1.0426418360842855e-03 +-9.9997950419651095e-04 +-9.6237498362892419e-04 +-9.2928040837117227e-04 +-9.0019641370059735e-04 +-8.7467311984304897e-04 +-8.5230846439910714e-04 +-8.3274512040336498e-04 +-8.1566678328658777e-04 +-8.0079430733788351e-04 +-7.8788197469849459e-04 +-7.7671405219990929e-04 +-7.6710171116791141e-04 +-7.5888033533058738e-04 +-7.5190721255884109e-04 +-7.4605958905107461e-04 +-7.4123305614398106e-04 +-7.3734023612599014e-04 +-7.3430973332248991e-04 +-7.3208531816005868e-04 +-7.3062531510174943e-04 +-7.2990216900943453e-04 +-2.0571887361698440e-03 +-2.0612542199329540e-03 +-2.0694127205018020e-03 +-2.0817175250024788e-03 +-2.0982380205385991e-03 +-2.1190300193918892e-03 +-2.1440666197358061e-03 +-2.1730922581537954e-03 +-2.2053072733219303e-03 +-2.2387251773857064e-03 +-2.2692534986657447e-03 +-2.2902700005853014e-03 +-2.2938217858229958e-03 +-2.2733562371923615e-03 +-2.2262329039890527e-03 +-2.1543928019818522e-03 +-2.0631706346904014e-03 +-1.9593585478718590e-03 +-1.8495536528236518e-03 +-1.7392052322930591e-03 +-1.6322979454162949e-03 +-1.5314328619486675e-03 +-1.4380863477343898e-03 +-1.3529058251611204e-03 +-1.2759729753420690e-03 +-1.2070107479993386e-03 +-1.1455340311265075e-03 +-1.0909532263818546e-03 +-1.0426420251478680e-03 +-9.9997955487325261e-04 +-9.6237495616629252e-04 +-9.2928034108813830e-04 +-9.0019633036358439e-04 +-8.7467303464783611e-04 +-8.5230838531692938e-04 +-8.3274505141618703e-04 +-8.1566672587150574e-04 +-8.0079426144726495e-04 +-7.8788193940327158e-04 +-7.7671402610994490e-04 +-7.6710169270558242e-04 +-7.5888032290852118e-04 +-7.5190720469448240e-04 +-7.4605958443893820e-04 +-7.4123305369765558e-04 +-7.3734023499689614e-04 +-7.3430973289857478e-04 +-7.3208531804647310e-04 +-7.3062531508404928e-04 +-7.2990216899996045e-04 +-2.0571951360626095e-03 +-2.0612608937929321e-03 +-2.0694212184585704e-03 +-2.0817320052593969e-03 +-2.0982666953912551e-03 +-2.1190867414740445e-03 +-2.1441723102634791e-03 +-2.1732744909945170e-03 +-2.2055938412498125e-03 +-2.2391285656938945e-03 +-2.2697537540181615e-03 +-2.2908131542413120e-03 +-2.2943401817263360e-03 +-2.2737955373718960e-03 +-2.2265668678480965e-03 +-2.1546216277061997e-03 +-2.0633106602493466e-03 +-1.9594318102408924e-03 +-1.8495811400026931e-03 +-1.7392038938355032e-03 +-1.6322801357804458e-03 +-1.5314069384764729e-03 +-1.4380576157736744e-03 +-1.3528774389580487e-03 +-1.2759466569081960e-03 +-1.2069873092980540e-03 +-1.1455137315798218e-03 +-1.0909360074997400e-03 +-1.0426276593166332e-03 +-9.9996773670874852e-04 +-9.6236535661559021e-04 +-9.2927263798287061e-04 +-9.0019022443435764e-04 +-8.7466825679613177e-04 +-8.5230469879688019e-04 +-8.3274225119335488e-04 +-8.1566463653298140e-04 +-8.0079273448092892e-04 +-7.8788085031075163e-04 +-7.7671327160568624e-04 +-7.6710118811996347e-04 +-7.5887999983740250e-04 +-7.5190700888912903e-04 +-7.4605947390773638e-04 +-7.4123299697661203e-04 +-7.3734020954448968e-04 +-7.3430972357058685e-04 +-7.3208531561426318e-04 +-7.3062531476627472e-04 +-7.2990216898856440e-04 +-2.0572136822495659e-03 +-2.0612803036792575e-03 +-2.0694465401635042e-03 +-2.0817767644367752e-03 +-2.0983574081843426e-03 +-2.1192676233225314e-03 +-2.1445090448251988e-03 +-2.1738515336518615e-03 +-2.2064924455540819e-03 +-2.2403774736833057e-03 +-2.2712781234836771e-03 +-2.2924351803896262e-03 +-2.2958475370286426e-03 +-2.2750263546705025e-03 +-2.2274523188147897e-03 +-2.1551759600443934e-03 +-2.0635956911347828e-03 +-1.9595231349575806e-03 +-1.8495474141749901e-03 +-1.7390985041750354e-03 +-1.6321405075529743e-03 +-1.5312572197481841e-03 +-1.4379121690823930e-03 +-1.3527439665519893e-03 +-1.2758285995563929e-03 +-1.2068855337284753e-03 +-1.1454276498244005e-03 +-1.0908642862705908e-03 +-1.0425686511827542e-03 +-9.9991973043563010e-04 +-9.6232671386929408e-04 +-9.2924186083497191e-04 +-9.0016598211649238e-04 +-8.7464938948351686e-04 +-8.5229020925059473e-04 +-8.3273129070882807e-04 +-8.1565648889173894e-04 +-8.0078679994046039e-04 +-7.8787663064909064e-04 +-7.7671035665564101e-04 +-7.6709924387913448e-04 +-7.5887875806414427e-04 +-7.5190625799275216e-04 +-7.4605905091066867e-04 +-7.4123278031302132e-04 +-7.3734011248006287e-04 +-7.3430968804767628e-04 +-7.3208530636461819e-04 +-7.3062531356553957e-04 +-7.2990216896818595e-04 +-2.0572420288383054e-03 +-2.0613105777111309e-03 +-2.0694905770025653e-03 +-2.0818664001586475e-03 +-2.0985549055098154e-03 +-2.1196760906190102e-03 +-2.1452795825960985e-03 +-2.1751739182382605e-03 +-2.2085417117567239e-03 +-2.2432025678538079e-03 +-2.2746930101193961e-03 +-2.2960286653131807e-03 +-2.2991414359678857e-03 +-2.2776650149270252e-03 +-2.2292938931465691e-03 +-2.1562657370997051e-03 +-2.0640835565054433e-03 +-1.9595865366837306e-03 +-1.8493448906516325e-03 +-1.7387516528147352e-03 +-1.6317332654699744e-03 +-1.5308426325922196e-03 +-1.4375207840395293e-03 +-1.3523912138211885e-03 +-1.2755203929007779e-03 +-1.2066221694313449e-03 +-1.1452063641159357e-03 +-1.0906808540387348e-03 +-1.0424183401222845e-03 +-9.9979784043132975e-04 +-9.6222885888614231e-04 +-9.2916409643539375e-04 +-9.0010484401759137e-04 +-8.7460188358588298e-04 +-8.5225377742864487e-04 +-8.3270376655543378e-04 +-8.1563605133918248e-04 +-8.0077192893378290e-04 +-7.8786606679129376e-04 +-7.7670306548241008e-04 +-7.6709438468793034e-04 +-7.5887565687348508e-04 +-7.5190438402157720e-04 +-7.4605799593427955e-04 +-7.4123224025330454e-04 +-7.3733987065720426e-04 +-7.3430959958503596e-04 +-7.3208528333899099e-04 +-7.3062531057995438e-04 +-7.2990216892676141e-04 +-2.0572330738641274e-03 +-2.0613050714894492e-03 +-2.0695114591965380e-03 +-2.0819758358940768e-03 +-2.0988742227494874e-03 +-2.1204043056985782e-03 +-2.1467023337591287e-03 +-2.1776370114541810e-03 +-2.2123439164306244e-03 +-2.2483955985813475e-03 +-2.2809027936786098e-03 +-2.3024920631293760e-03 +-2.3049953596483495e-03 +-2.2822801585490314e-03 +-2.2324310215398992e-03 +-2.1580233512283010e-03 +-2.0647471728123439e-03 +-1.9594886135281780e-03 +-1.8487803689567566e-03 +-1.7379454158242473e-03 +-1.6308393393535266e-03 +-1.5299571393818058e-03 +-1.4366978289980766e-03 +-1.3516568190778276e-03 +-1.2748830495633143e-03 +-1.2060801652350834e-03 +-1.1447525707438148e-03 +-1.0903057009186102e-03 +-1.0421115713700095e-03 +-9.9954949135494780e-04 +-9.6202975051839818e-04 +-9.2900604344209011e-04 +-8.9998069954418884e-04 +-8.7450549705865512e-04 +-8.5217991067282600e-04 +-8.3264799445189382e-04 +-8.1559466141633630e-04 +-8.0074182725597130e-04 +-7.8784469331403802e-04 +-7.7668831972257544e-04 +-7.6708456124311222e-04 +-7.5886938971780026e-04 +-7.5190059820904871e-04 +-7.4605586531581133e-04 +-7.4123114985525740e-04 +-7.3733938252657785e-04 +-7.3430942105543893e-04 +-7.3208523687811862e-04 +-7.3062530455793643e-04 +-7.2990216884857146e-04 +-2.0570060344150616e-03 +-2.0610831123324476e-03 +-2.0693333583737135e-03 +-2.0819478602784724e-03 +-2.0992028435640408e-03 +-2.1214224026409696e-03 +-2.1488711851894416e-03 +-2.1814823865282805e-03 +-2.2182712323422981e-03 +-2.2563959342714020e-03 +-2.2903289843915343e-03 +-2.3121561042600647e-03 +-2.3136051713462998e-03 +-2.2889170758557901e-03 +-2.2367658728805139e-03 +-2.1602326743622178e-03 +-2.0652868503665501e-03 +-1.9588825850792991e-03 +-1.8474918257767718e-03 +-1.7363265419273301e-03 +-1.6291299965661722e-03 +-1.5283052086431698e-03 +-1.4351843902192872e-03 +-1.3503183819950173e-03 +-1.2737284666247736e-03 +-1.2051024047715661e-03 +-1.1439364082364788e-03 +-1.0896324812007176e-03 +-1.0415619998927600e-03 +-9.9910516061619214e-04 +-9.6167388694778130e-04 +-9.2872379321498773e-04 +-8.9975915495131846e-04 +-8.7433358727974798e-04 +-8.5204823057823641e-04 +-8.3254861362634528e-04 +-8.1552093623866236e-04 +-8.0068822735063683e-04 +-7.8780664690073182e-04 +-7.7666207864032419e-04 +-7.6706708436653759e-04 +-7.5885824254933235e-04 +-7.5189386602942331e-04 +-7.4605207728463386e-04 +-7.4122921158864400e-04 +-7.3733851497475049e-04 +-7.3430910379819058e-04 +-7.3208515432344231e-04 +-7.3062529385945570e-04 +-7.2990216871314279e-04 +-2.0560405156637789e-03 +-2.0601231759639900e-03 +-2.0684358916979646e-03 +-2.0812717003003901e-03 +-2.0990542743860529e-03 +-2.1222817818117089e-03 +-2.1513692925059897e-03 +-2.1862740763790756e-03 +-2.2257665248041091e-03 +-2.2664143477679941e-03 +-2.3019070674366359e-03 +-2.3237457336150852e-03 +-2.3236183453769544e-03 +-2.2962712605848639e-03 +-2.2411148115151079e-03 +-2.1618527116268466e-03 +-2.0647975853969039e-03 +-1.9569839699417860e-03 +-1.8448004477543481e-03 +-1.7333098564605810e-03 +-1.6261038218894634e-03 +-1.5254603987783844e-03 +-1.4326206859415639e-03 +-1.3480747631566079e-03 +-1.2718064945507438e-03 +-1.2034825824586786e-03 +-1.1425888966776800e-03 +-1.0885237178661228e-03 +-1.0406585388978203e-03 +-9.9837572314536382e-04 +-9.6109030904256308e-04 +-9.2826132511545549e-04 +-8.9939640075039696e-04 +-8.7405226233406316e-04 +-8.5183284182719591e-04 +-8.3238612247896377e-04 +-8.1540043569458727e-04 +-8.0060064833993030e-04 +-7.8774449910609342e-04 +-7.7661922571597877e-04 +-7.6703855064353343e-04 +-7.5884004707193000e-04 +-7.5188287933839186e-04 +-7.4604589647529382e-04 +-7.4122604949608322e-04 +-7.3733709984822053e-04 +-7.3430858635784772e-04 +-7.3208501969086075e-04 +-7.3062527641393400e-04 +-7.2990216849480572e-04 +-2.0529830626787437e-03 +-2.0570673641186333e-03 +-2.0654483702961688e-03 +-2.0785469934741802e-03 +-2.0969654576658337e-03 +-2.1213937804502895e-03 +-2.1523716730020232e-03 +-2.1897878476301049e-03 +-2.2320321054635677e-03 +-2.2749919924905382e-03 +-2.3116173657222153e-03 +-2.3329794911520763e-03 +-2.3308766144132485e-03 +-2.3006239829866256e-03 +-2.2423585435761015e-03 +-2.1603755440275534e-03 +-2.0613067072078480e-03 +-1.9522501250513373e-03 +-1.8394946094323933e-03 +-1.7279352235167154e-03 +-1.6209928554351378e-03 +-1.5208038490424776e-03 +-1.4285055563623512e-03 +-1.3445191346029622e-03 +-1.2687867618022264e-03 +-1.2009527494671163e-03 +-1.1404932613646261e-03 +-1.0868046610512817e-03 +-1.0392609507803637e-03 +-9.9724924965479680e-04 +-9.6019025607898460e-04 +-9.2754878183031657e-04 +-8.9883794131990873e-04 +-8.7361944741992106e-04 +-8.5150165009519540e-04 +-8.3213638488703644e-04 +-8.1521530974230461e-04 +-8.0046614829401650e-04 +-7.8764908604725815e-04 +-7.7655345464695358e-04 +-7.6699476860536935e-04 +-7.5881213488699663e-04 +-7.5186602935480940e-04 +-7.4603641906660970e-04 +-7.4122120174329061e-04 +-7.3733493067838307e-04 +-7.3430779330441772e-04 +-7.3208481336734963e-04 +-7.3062524968122724e-04 +-7.2990216816211752e-04 +-2.0445765351829182e-03 +-2.0486478104077646e-03 +-2.0570625044815521e-03 +-2.0703576552852094e-03 +-2.0892907158583701e-03 +-2.1146975365531392e-03 +-2.1471637624737683e-03 +-2.1864147108209848e-03 +-2.2304203826218482e-03 +-2.2745083179670400e-03 +-2.3111976009687809e-03 +-2.3314931869388347e-03 +-2.3275051335114347e-03 +-2.2950548672838059e-03 +-2.2347651910989293e-03 +-2.1512649022771210e-03 +-2.0513309573648225e-03 +-1.9420477621469613e-03 +-1.8295905880400527e-03 +-1.7187008040412124e-03 +-1.6126489936376060e-03 +-1.5134479564147642e-03 +-1.4221455226432343e-03 +-1.3391050005702684e-03 +-1.2642359159306229e-03 +-1.1971679534790653e-03 +-1.1373744630363777e-03 +-1.0842560732833724e-03 +-1.0371948213728534e-03 +-9.9558747180890296e-04 +-9.5886466052011161e-04 +-9.2650068505465560e-04 +-8.9801732171907931e-04 +-8.7298397780581150e-04 +-8.5101571917788152e-04 +-8.3177017859399659e-04 +-8.1494398518852239e-04 +-8.0026911064713039e-04 +-7.8750936587324027e-04 +-7.7645717676141804e-04 +-7.6693070056124040e-04 +-7.5877130243817844e-04 +-7.5184138661600359e-04 +-7.4602256207439662e-04 +-7.4121411539876413e-04 +-7.3733176044448292e-04 +-7.3430663444519853e-04 +-7.3208451191190363e-04 +-7.3062521062634128e-04 +-7.2990216767758627e-04 +-2.0242428755436340e-03 +-2.0282686303707107e-03 +-2.0366167783323623e-03 +-2.0498705852307008e-03 +-2.0688421212924214e-03 +-2.0943953258979473e-03 +-2.1270611597633843e-03 +-2.1663843128972150e-03 +-2.2100696943450930e-03 +-2.2532640354199678e-03 +-2.2885903733853995e-03 +-2.3074684030698904e-03 +-2.3025125982631136e-03 +-2.2698656956647943e-03 +-2.2101931521942512e-03 +-2.1279765179939643e-03 +-2.0297863646534056e-03 +-1.9225180921235588e-03 +-1.8121960034437265e-03 +-1.7034457915698416e-03 +-1.5994522100002027e-03 +-1.5021685686273877e-03 +-1.4126065148814002e-03 +-1.3311126373814028e-03 +-1.2575946278664671e-03 +-1.1916906089164769e-03 +-1.1328886138686912e-03 +-1.0806070688885122e-03 +-1.0342467130791001e-03 +-9.9322249925798715e-04 +-9.5698192488546160e-04 +-9.2501443330066351e-04 +-8.9685511767317655e-04 +-8.7208492554356808e-04 +-8.5032882796642916e-04 +-8.3125290896615234e-04 +-8.1456098521656760e-04 +-7.9999113400360314e-04 +-7.8731235422495685e-04 +-7.7632148521446882e-04 +-7.6684044412032718e-04 +-7.5871380238505840e-04 +-7.5180669751547175e-04 +-7.4600306229179430e-04 +-7.4120414629437849e-04 +-7.3732730166631961e-04 +-7.3430500490546892e-04 +-7.3208408808587999e-04 +-7.3062515572417709e-04 +-7.2990216699767246e-04 +-1.9821980245019479e-03 +-1.9861258207802056e-03 +-1.9942488778214697e-03 +-2.0070916931453327e-03 +-2.0253769662021866e-03 +-2.0498489819500438e-03 +-2.0809008131119394e-03 +-2.1179704877737956e-03 +-2.1588022689119934e-03 +-2.1988836937294064e-03 +-2.2315456156937244e-03 +-2.2490994463145657e-03 +-2.2448334490504560e-03 +-2.2150101344591178e-03 +-2.1598520082842907e-03 +-2.0831140158484936e-03 +-1.9906741015352351e-03 +-1.8889419130934592e-03 +-1.7836797035354931e-03 +-1.6794137371443248e-03 +-1.5793222059551284e-03 +-1.4853953993792979e-03 +-1.3986982077597442e-03 +-1.3196339598028157e-03 +-1.2481652739368854e-03 +-1.1839813204768954e-03 +-1.1266165182707922e-03 +-1.0755307588177271e-03 +-1.0301613400780156e-03 +-9.8995506280208736e-04 +-9.5438688684293892e-04 +-9.2296974101311203e-04 +-8.9525867607664553e-04 +-8.7085152361648065e-04 +-8.4938749940965063e-04 +-8.3054469107603343e-04 +-8.1403703166556653e-04 +-7.9961113459352273e-04 +-7.8704321567500896e-04 +-7.7613623018273515e-04 +-7.6671728984340436e-04 +-7.5863538487224325e-04 +-7.5175941173047779e-04 +-7.4597649300049544e-04 +-7.4119056815746863e-04 +-7.3732123071583043e-04 +-7.3430278677294361e-04 +-7.3208351129446252e-04 +-7.3062508101799488e-04 +-7.2990216607357063e-04 +-1.9091940133852394e-03 +-1.9129585421493209e-03 +-1.9206831200830846e-03 +-1.9327501972195345e-03 +-1.9496810360598994e-03 +-1.9719920764247356e-03 +-1.9998944389067446e-03 +-2.0328136177077474e-03 +-2.0688106808230996e-03 +-2.1041426162038517e-03 +-2.1333160715402274e-03 +-2.1499077161884908e-03 +-2.1480603445660478e-03 +-2.1240934545937559e-03 +-2.0774838868057467e-03 +-2.0107960958818511e-03 +-1.9287270626775679e-03 +-1.8368146972049275e-03 +-1.7403352213436242e-03 +-1.6436426030851685e-03 +-1.5499386089549289e-03 +-1.4613323299740811e-03 +-1.3790381733243030e-03 +-1.3036062937143897e-03 +-1.2351297973852171e-03 +-1.1734086378114388e-03 +-1.1180693819581925e-03 +-1.0686479558571702e-03 +-1.0246442600149027e-03 +-9.8555665440245937e-04 +-9.5090261386974648e-04 +-9.2023017665198380e-04 +-8.9312343498541976e-04 +-8.6920428742891655e-04 +-8.4813193790256780e-04 +-8.2960111754023602e-04 +-8.1333965955737806e-04 +-7.9910582536599239e-04 +-7.8668562626085597e-04 +-7.7589028391951875e-04 +-7.6655390735137416e-04 +-7.5853142201196466e-04 +-7.5169676065141614e-04 +-7.4594130977205931e-04 +-7.4117259680929633e-04 +-7.3731319894315445e-04 +-7.3429985325559801e-04 +-7.3208274868642894e-04 +-7.3062498226344216e-04 +-7.2990216485291554e-04 +-1.8021133777779551e-03 +-1.8056504190136838e-03 +-1.8128356330456832e-03 +-1.8238853834366430e-03 +-1.8390883211496798e-03 +-1.8587070306473341e-03 +-1.8827717783606837e-03 +-1.9107485704390422e-03 +-1.9411313547289604e-03 +-1.9711101668309756e-03 +-1.9965484260749183e-03 +-2.0124699839010221e-03 +-2.0140507422683092e-03 +-1.9978080680379427e-03 +-1.9624986031503986e-03 +-1.9093458431787937e-03 +-1.8415628439183791e-03 +-1.7634588085381187e-03 +-1.6795188168770129e-03 +-1.5937298114214950e-03 +-1.5092361643859304e-03 +-1.4282694017657669e-03 +-1.3522452720819544e-03 +-1.2819315675825255e-03 +-1.2176235282046440e-03 +-1.1592954800587357e-03 +-1.1067187414123595e-03 +-1.0595470998038185e-03 +-1.0173756230904814e-03 +-9.7977935479556170e-04 +-9.4633764679877698e-04 +-9.1664862895806125e-04 +-8.9033711293371332e-04 +-8.6705824976972734e-04 +-8.4649852826179715e-04 +-8.2837517753775263e-04 +-8.1243467373547150e-04 +-7.9845080300803303e-04 +-7.8622256661560269e-04 +-7.7557210315698662e-04 +-7.6634273013316578e-04 +-7.5839715968189646e-04 +-7.5161591309589042e-04 +-7.4589593998129506e-04 +-7.4114943683983099e-04 +-7.3730285390691882e-04 +-7.3429607654810374e-04 +-7.3208176722181211e-04 +-7.3062485519837298e-04 +-7.2990216328322781e-04 +-1.6665398759680887e-03 +-1.6698003098567023e-03 +-1.6763618860919632e-03 +-1.6863024486997379e-03 +-1.6997172617590998e-03 +-1.7166601673143077e-03 +-1.7370194011521389e-03 +-1.7603145491938033e-03 +-1.7854382013814097e-03 +-1.8104246929535424e-03 +-1.8323824103695006e-03 +-1.8477259190775406e-03 +-1.8527487508803919e-03 +-1.8444071893349134e-03 +-1.8210395347024726e-03 +-1.7827387202179899e-03 +-1.7312512104633619e-03 +-1.6694896996287448e-03 +-1.6008838022004387e-03 +-1.5287927265365704e-03 +-1.4561095003222558e-03 +-1.3850783219580189e-03 +-1.3172779570284246e-03 +-1.2537031930471563e-03 +-1.1948861441421067e-03 +-1.1410196685353459e-03 +-1.0920639713628837e-03 +-1.0478302342248772e-03 +-1.0080420549724368e-03 +-9.7237838247265585e-04 +-9.4050225421821924e-04 +-9.1207921804553160e-04 +-8.8678854576699194e-04 +-8.6432956557872009e-04 +-8.4442478248908295e-04 +-8.2682094946631560e-04 +-8.1128888140975005e-04 +-7.9762254153731618e-04 +-7.8563774777252852e-04 +-7.7517072243352841e-04 +-7.6607662469524863e-04 +-7.5822814941673387e-04 +-7.5151423920481481e-04 +-7.4583893293444657e-04 +-7.4112035919337476e-04 +-7.3728987440218946e-04 +-7.3429134073296981e-04 +-7.3208053704734851e-04 +-7.3062469598178319e-04 +-7.2990216131723360e-04 +-1.5143494837855914e-03 +-1.5173074954666942e-03 +-1.5232184127196527e-03 +-1.5320700023060314e-03 +-1.5438321513037278e-03 +-1.5584249968764456e-03 +-1.5756513228711122e-03 +-1.5950841156977212e-03 +-1.6159179735293963e-03 +-1.6368232853972997e-03 +-1.6558741779457073e-03 +-1.6706322271381044e-03 +-1.6784335625866405e-03 +-1.6768449321699771e-03 +-1.6641610894807082e-03 +-1.6397717882942577e-03 +-1.6042693847886818e-03 +-1.5592763068406569e-03 +-1.5070795807004219e-03 +-1.4502095597480964e-03 +-1.3910813228334156e-03 +-1.3317602103229446e-03 +-1.2738562772162045e-03 +-1.2185181114787087e-03 +-1.1664864373182625e-03 +-1.1181734138625290e-03 +-1.0737447418696165e-03 +-1.0331923337311519e-03 +-9.9639290802996526e-04 +-9.6315231180107259e-04 +-9.3323746081703759e-04 +-9.0639843731830081e-04 +-8.8238319562659450e-04 +-8.6094693693604830e-04 +-8.4185776026112370e-04 +-8.2489978357017720e-04 +-8.0987459348747198e-04 +-7.9660162570920924e-04 +-7.8491789016883729e-04 +-7.7467732046677528e-04 +-7.6574993268148459e-04 +-7.5802091343689620e-04 +-7.5138971265242360e-04 +-7.4576918660819067e-04 +-7.4108481741814915e-04 +-7.3727402259081399e-04 +-7.3428556087523774e-04 +-7.3207903647156010e-04 +-7.3062450183911652e-04 +-7.2990215892091499e-04 +-1.3589552971452576e-03 +-1.3616091662707712e-03 +-1.3668884842972877e-03 +-1.3747352804877157e-03 +-1.3850564714827905e-03 +-1.3977077179950644e-03 +-1.4124592114204886e-03 +-1.4289379890831417e-03 +-1.4465491139105840e-03 +-1.4643921456748970e-03 +-1.4812062468323676e-03 +-1.4953876916587922e-03 +-1.5051153219097914e-03 +-1.5085863778961739e-03 +-1.5043164551070767e-03 +-1.4914181592258092e-03 +-1.4697693061911348e-03 +-1.4400196639905224e-03 +-1.4034451263907010e-03 +-1.3617075921533626e-03 +-1.3165961272422028e-03 +-1.2698105572334641e-03 +-1.2228183196462013e-03 +-1.1767865662156527e-03 +-1.1325737133857350e-03 +-1.0907587704663472e-03 +-1.0516889245296339e-03 +-1.0155314189590758e-03 +-9.8232151760879716e-04 +-9.5200280320741049e-04 +-9.2445891791465094e-04 +-8.9953739199855585e-04 +-8.7706685126445847e-04 +-8.5686902068159241e-04 +-8.3876681387261482e-04 +-8.2258957491414004e-04 +-8.0817630450520910e-04 +-7.9537749479635157e-04 +-7.8405602820511185e-04 +-7.7408746506761681e-04 +-7.6535994761963116e-04 +-7.5777387693248528e-04 +-7.5124146884272597e-04 +-7.4568625943492533e-04 +-7.4104260620740700e-04 +-7.3725521459135697e-04 +-7.3427870872637229e-04 +-7.3207725863125913e-04 +-7.3062427192412897e-04 +-7.2990215608407898e-04 +-1.2115488105296736e-03 +-1.2139163670734034e-03 +-1.2186150847144511e-03 +-1.2255715165854623e-03 +-1.2346723272459697e-03 +-1.2457564111099291e-03 +-1.2585983860150746e-03 +-1.2728805895215343e-03 +-1.2881538393315457e-03 +-1.3037933248660806e-03 +-1.3189640950359359e-03 +-1.3326173160164547e-03 +-1.3435385119003817e-03 +-1.3504579885707470e-03 +-1.3522122954543691e-03 +-1.3479220244930362e-03 +-1.3371379571909972e-03 +-1.3199135013962694e-03 +-1.2967850330606232e-03 +-1.2686715892829706e-03 +-1.2367273334731718e-03 +-1.2021864958045921e-03 +-1.1662324615741495e-03 +-1.1299076131177168e-03 +-1.0940660514399975e-03 +-1.0593618156063578e-03 +-1.0262613892254194e-03 +-9.9506962304752840e-04 +-9.6596064767893986e-04 +-9.3900828166827938e-04 +-9.1421295922857414e-04 +-8.9152399714884144e-04 +-8.7085712083561761e-04 +-8.5210774038339484e-04 +-8.3516069129145143e-04 +-8.1989717829343610e-04 +-8.0619958599722130e-04 +-7.9395470833152672e-04 +-7.8305583365719856e-04 +-7.7340401951952130e-04 +-7.6490880589707359e-04 +-7.5748854870865876e-04 +-7.5107050420827773e-04 +-7.4559075691889754e-04 +-7.4099405614943940e-04 +-7.3723360647172018e-04 +-7.3427084381796155e-04 +-7.3207521951189770e-04 +-7.3062400835198081e-04 +-7.2990215283313736e-04 +-1.0795735988468440e-03 +-1.0816856190046409e-03 +-1.0858736924780393e-03 +-1.0920654795646785e-03 +-1.1001507865898144e-03 +-1.1099777456527965e-03 +-1.1213450417913600e-03 +-1.1339887936715248e-03 +-1.1475639080766160e-03 +-1.1616222447975296e-03 +-1.1755935417664110e-03 +-1.1887786410030017e-03 +-1.2003660647857621e-03 +-1.2094801791011848e-03 +-1.2152611523902797e-03 +-1.2169655588847494e-03 +-1.2140664382037038e-03 +-1.2063281429505175e-03 +-1.1938369463870692e-03 +-1.1769810982875941e-03 +-1.1563882218732114e-03 +-1.1328378370073226e-03 +-1.1071694434012485e-03 +-1.0802027852339139e-03 +-1.0526797565836548e-03 +-1.0252302093725566e-03 +-9.9835877583173954e-04 +-9.7244728095942856e-04 +-9.4776692131501143e-04 +-9.2449526307928818e-04 +-9.0273448041064722e-04 +-8.8252859931255568e-04 +-8.6387858576499564e-04 +-8.4675486023971867e-04 +-8.3110727321277552e-04 +-8.1687281219061290e-04 +-8.0398140385145949e-04 +-7.9236018383428784e-04 +-7.8193657235968862e-04 +-7.7264044197713328e-04 +-7.6440560898260101e-04 +-7.5717082985894604e-04 +-7.5088044148272732e-04 +-7.4548474940687556e-04 +-7.4094024165698657e-04 +-7.3720968506382257e-04 +-7.3426214599189995e-04 +-7.3207296627587556e-04 +-7.3062371726628935e-04 +-7.2990214924411711e-04 +-9.6691626231656155e-04 +-9.6881030700193317e-04 +-9.7256644073059125e-04 +-9.7812048359421488e-04 +-9.8537521478198292e-04 +-9.9419847760756110e-04 +-1.0044195196006506e-03 +-1.0158229463367837e-03 +-1.0281401292444126e-03 +-1.0410389156015293e-03 +-1.0541140292343342e-03 +-1.0668822806819309e-03 +-1.0787878818249612e-03 +-1.0892228072924622e-03 +-1.0975645403533676e-03 +-1.1032288381692915e-03 +-1.1057297208872450e-03 +-1.1047349502815427e-03 +-1.1001048071516289e-03 +-1.0919055831742387e-03 +-1.0803955924275660e-03 +-1.0659881923893886e-03 +-1.0492009056270318e-03 +-1.0306010820348424e-03 +-1.0107569440596623e-03 +-9.9019957997956653e-04 +-9.6939792039129919e-04 +-9.4874595367525939e-04 +-9.2855980309908888e-04 +-9.0908171707530555e-04 +-8.9048819184662533e-04 +-8.7289999641875643e-04 +-8.5639252663618083e-04 +-8.4100551303959705e-04 +-8.2675157331618080e-04 +-8.1362342365095652e-04 +-8.0159976422011249e-04 +-7.9064996310041033e-04 +-7.8073770974977099e-04 +-7.7182381793663827e-04 +-7.6386834580521130e-04 +-7.5683217900562980e-04 +-7.5067819834695297e-04 +-7.4537213000041918e-04 +-7.4088315566293958e-04 +-7.3718434287266483e-04 +-7.3425294179895134e-04 +-7.3207058393183499e-04 +-7.3062340968572156e-04 +-7.2990214545308506e-04 +-8.7486153921464028e-04 +-8.7657740741286746e-04 +-8.7998203315224057e-04 +-8.8502100727808227e-04 +-8.9161213670320687e-04 +-8.9964445244994893e-04 +-9.0897643884633517e-04 +-9.1943323319887752e-04 +-9.3080272241159343e-04 +-9.4283086374791865e-04 +-9.5521719848266874e-04 +-9.6761231283764367e-04 +-9.7961967529527883e-04 +-9.9080445606560615e-04 +-1.0007112311898440e-03 +-1.0088907414168705e-03 +-1.0149334056667458e-03 +-1.0185048362210596e-03 +-1.0193771316808183e-03 +-1.0174499516754369e-03 +-1.0127573770490209e-03 +-1.0054596795148554e-03 +-9.9582229576923240e-04 +-9.8418653626284854e-04 +-9.7093735420430624e-04 +-9.5647293754366227e-04 +-9.4117945607940709e-04 +-9.2541260273356198e-04 +-9.0948609195218712e-04 +-8.9366626784793902e-04 +-8.7817146563025361e-04 +-8.6317466436868959e-04 +-8.4880812117710442e-04 +-8.3516895094162260e-04 +-8.2232491373772257e-04 +-8.1031993727073465e-04 +-7.9917910998720859e-04 +-7.8891302901227319e-04 +-7.7952148377842111e-04 +-7.7099651304327792e-04 +-7.6332490172705816e-04 +-7.5649019444961533e-04 +-7.5047430216023823e-04 +-7.4525877191087447e-04 +-7.4082578089910273e-04 +-7.3715890635497416e-04 +-7.3424371373594110e-04 +-7.3206819751584623e-04 +-7.3062310176689202e-04 +-7.2990214165920676e-04 +-8.0313904321622272e-04 +-8.0471601227328463e-04 +-8.0784719626689314e-04 +-8.1248694928423158e-04 +-8.1856641954286048e-04 +-8.2599298517063355e-04 +-8.3464934431357930e-04 +-8.4439217458516503e-04 +-8.5505034810024079e-04 +-8.6642285012902246e-04 +-8.7827681633957807e-04 +-8.9034645126193752e-04 +-9.0233393460305506e-04 +-9.1391361641323765e-04 +-9.2474067422075395e-04 +-9.3446483036712844e-04 +-9.4274871920280287e-04 +-9.4928925827796539e-04 +-9.5383928433048141e-04 +-9.5622616547870335e-04 +-9.5636435234520978e-04 +-9.5425986392674888e-04 +-9.5000621888869676e-04 +-9.4377286544225177e-04 +-9.3578831292111383e-04 +-9.2632068959196329e-04 +-9.1565833992641251e-04 +-9.0409250480708307e-04 +-8.9190334807723445e-04 +-8.7934982697950579e-04 +-8.6666329766292615e-04 +-8.5404435667401355e-04 +-8.4166223390463347e-04 +-8.2965602376231678e-04 +-8.1813711145725979e-04 +-8.0719226948932363e-04 +-7.9688702912689125e-04 +-7.8726905096859008e-04 +-7.7837131726334074e-04 +-7.7021504399753845e-04 +-7.6281226465822933e-04 +-7.5616807378207993e-04 +-7.5028254103116899e-04 +-7.4515231934134364e-04 +-7.4077197671572770e-04 +-7.3713508279156536e-04 +-7.3423508005826445e-04 +-7.3206596668478566e-04 +-7.3062281409020378e-04 +-7.2990213811590255e-04 +-7.5076447633153336e-04 +-7.5224001636705023e-04 +-7.5517169539128591e-04 +-7.5952060507920611e-04 +-7.6522810719351704e-04 +-7.7221547536326300e-04 +-7.8038337774508646e-04 +-7.8961118487871679e-04 +-7.9975611869524199e-04 +-8.1065232724172420e-04 +-8.2211008397518935e-04 +-8.3391546581622540e-04 +-8.4583103335967528e-04 +-8.5759816585291766e-04 +-8.6894171953962377e-04 +-8.7957751068537364e-04 +-8.8922274123573702e-04 +-8.9760892212047117e-04 +-9.0449622349614419e-04 +-9.0968766529726049e-04 +-9.1304132616453013e-04 +-9.1447889528180261e-04 +-9.1398940594278842e-04 +-9.1162774391971698e-04 +-9.0750832382805672e-04 +-9.0179498275168865e-04 +-8.9468852683338392e-04 +-8.8641344898167829e-04 +-8.7720516113624122e-04 +-8.6729874705665792e-04 +-8.5691984488275137e-04 +-8.4627789689631187e-04 +-8.3556170864012408e-04 +-8.2493706036901576e-04 +-8.1454600636297057e-04 +-8.0450746407265258e-04 +-7.9491871295317624e-04 +-7.8585747106463093e-04 +-7.7738427925634775e-04 +-7.6954498626627518e-04 +-7.6237318619999748e-04 +-7.5589250901712997e-04 +-7.5011870370966891e-04 +-7.4506148317841187e-04 +-7.4072612056719298e-04 +-7.3711480047434618e-04 +-7.3422773652423771e-04 +-7.3206407059379594e-04 +-7.3062256970336369e-04 +-7.2990213510661485e-04 +-7.1661627442048091e-04 +-7.1802580307235358e-04 +-7.2082767859443678e-04 +-7.2498744945020618e-04 +-7.3045321911170246e-04 +-7.3715538520740837e-04 +-7.4500629715796164e-04 +-7.5389984349452210e-04 +-7.6371099688424661e-04 +-7.7429537763814801e-04 +-7.8548895016274664e-04 +-7.9710804169871928e-04 +-8.0894996015797829e-04 +-8.2079456750244523e-04 +-8.3240720527796679e-04 +-8.4354333303865740e-04 +-8.5395509905394202e-04 +-8.6339980880846025e-04 +-8.7164991775937864e-04 +-8.7850381439529837e-04 +-8.8379636544168967e-04 +-8.8740805314819842e-04 +-8.8927160009235273e-04 +-8.8937525267620751e-04 +-8.8776232733979801e-04 +-8.8452712031024394e-04 +-8.7980773810815796e-04 +-8.7377673658222397e-04 +-8.6663061470141820e-04 +-8.5857919403254475e-04 +-8.4983576022958920e-04 +-8.4060860330263415e-04 +-8.3109432596316444e-04 +-8.2147304083186542e-04 +-8.1190537795722642e-04 +-8.0253108691993738e-04 +-7.9346894190322704e-04 +-7.8481763372490148e-04 +-7.7665734615344807e-04 +-7.6905175077251662e-04 +-7.6205020310231319e-04 +-7.5568997352939223e-04 +-7.4999839383135358e-04 +-7.4499484037077407e-04 +-7.4069250705099423e-04 +-7.3709994489901186e-04 +-7.3422236148810007e-04 +-7.3206268351453752e-04 +-7.3062239098989714e-04 +-7.2990213290647515e-04 +-6.9978944881344456e-04 +-7.0116674418536223e-04 +-7.0390524989562221e-04 +-7.0797271550783599e-04 +-7.1332056874013098e-04 +-7.1988369148961767e-04 +-7.2758014162678064e-04 +-7.3631084078591919e-04 +-7.4595926032335546e-04 +-7.5639115824923157e-04 +-7.6745445263171216e-04 +-7.7897936295109004e-04 +-7.9077900693134723e-04 +-8.0265069675870501e-04 +-8.1437821826354497e-04 +-8.2573537698789627e-04 +-8.3649103299159369e-04 +-8.4641570630751767e-04 +-8.5528961850707820e-04 +-8.6291176784312681e-04 +-8.6910936473944878e-04 +-8.7374674495542006e-04 +-8.7673279164655416e-04 +-8.7802597471459511e-04 +-8.7763635829388056e-04 +-8.7562429465890608e-04 +-8.7209594247925895e-04 +-8.6719613467812551e-04 +-8.6109940370079528e-04 +-8.5400010753855623e-04 +-8.4610258330493728e-04 +-8.3761211378089112e-04 +-8.2872727290602170e-04 +-8.1963396997601873e-04 +-8.1050128281930382e-04 +-8.0147898632732949e-04 +-7.9269655726342233e-04 +-7.8426336880157922e-04 +-7.7626976950957716e-04 +-7.6878875818292558e-04 +-7.6187800437280432e-04 +-7.5558201290290691e-04 +-7.4993428038995968e-04 +-7.4495933710817688e-04 +-7.4067460544495652e-04 +-7.3709203562016910e-04 +-7.3421950051921802e-04 +-7.3206194537334883e-04 +-7.3062229590105149e-04 +-7.2990213173592658e-04 +-6.9978953524366637e-04 +-7.0116752304437999e-04 +-7.0390741839695709e-04 +-7.0797697812783147e-04 +-7.1332763510904916e-04 +-7.1989426751749633e-04 +-7.2759491195642869e-04 +-7.3633044122444640e-04 +-7.4598423986977345e-04 +-7.5642193178316480e-04 +-7.6749124723191845e-04 +-7.7902216299329755e-04 +-7.9082750520785832e-04 +-8.0270426033422694e-04 +-8.1443587802485927e-04 +-8.2579584834725848e-04 +-8.3655277176157214e-04 +-8.4647699866525691e-04 +-8.5534869804784492e-04 +-8.6296694724949982e-04 +-8.6915916593164352e-04 +-8.7379001079287608e-04 +-8.7676876469268829e-04 +-8.7805433378665648e-04 +-8.7765721031258538e-04 +-8.7563812614922917e-04 +-8.7210354052252685e-04 +-8.6719849023489512e-04 +-8.6109761074524671e-04 +-8.5399526972509846e-04 +-8.4609573669213053e-04 +-8.3760417036245823e-04 +-8.2871898612900429e-04 +-8.1962592059309518e-04 +-8.1049388156578404e-04 +-8.0147248902578646e-04 +-7.9269108786990308e-04 +-7.8425894637301665e-04 +-7.7626633584613536e-04 +-7.6878620377679495e-04 +-7.6187619113163210e-04 +-7.5558079282663892e-04 +-7.4993350992868038e-04 +-7.4495888731466499e-04 +-7.4067436827917493e-04 +-7.3709192689362408e-04 +-7.3421946001711277e-04 +-7.3206193469118523e-04 +-7.3062229450461893e-04 +-7.2990213171862238e-04 +-7.1661654721997875e-04 +-7.1802826137764154e-04 +-7.2083452289571019e-04 +-7.2500090252396003e-04 +-7.3047551805011774e-04 +-7.3718875094700180e-04 +-7.4505287523949314e-04 +-7.5396161176823420e-04 +-7.6378963928980324e-04 +-7.7439212827461071e-04 +-7.8560441848033531e-04 +-7.9724203707655535e-04 +-8.0910134099278881e-04 +-8.2096114427011575e-04 +-8.3258572672355313e-04 +-8.4372957808589262e-04 +-8.5414408387216327e-04 +-8.6358610026874064e-04 +-8.7182802469064585e-04 +-8.7866861125314943e-04 +-8.8394349373603913e-04 +-8.8753424711395467e-04 +-8.8937489479862253e-04 +-8.8945505236663028e-04 +-8.8781933459024113e-04 +-8.8456314739288619e-04 +-8.7982543661589078e-04 +-8.7377928779616503e-04 +-8.6662142153723040e-04 +-8.5856160759477211e-04 +-8.4981286282668057e-04 +-8.4058305800159419e-04 +-8.3106829252086042e-04 +-8.2144815034544758e-04 +-8.1188275417088806e-04 +-8.0251140050510608e-04 +-7.9345248453030232e-04 +-7.8480440059691204e-04 +-7.7664711817527425e-04 +-7.6904417014474820e-04 +-7.6204483850298333e-04 +-7.5568637299295248e-04 +-7.4999612489298003e-04 +-7.4499351804039162e-04 +-7.4069181078703899e-04 +-7.3709962605733766e-04 +-7.3422224281725868e-04 +-7.3206265223554998e-04 +-7.3062238690258972e-04 +-7.2990213285579911e-04 +-7.5076497827831026e-04 +-7.5224453958582026e-04 +-7.5518428828109929e-04 +-7.5954535463989463e-04 +-7.6526911940217766e-04 +-7.7227680983543148e-04 +-7.8046892425981959e-04 +-7.8972447387451114e-04 +-7.9990006559794036e-04 +-8.1082892189220730e-04 +-8.2232005093728778e-04 +-8.3415793699545158e-04 +-8.4610328761654361e-04 +-8.5789549649907646e-04 +-8.6925748519870187e-04 +-8.7990340531299825e-04 +-8.8954928614329971e-04 +-8.9792614223346931e-04 +-9.0479443117984064e-04 +-9.0995824844292844e-04 +-9.1327743094301336e-04 +-9.1467591059813367e-04 +-9.1414519208772430e-04 +-9.1174259292408613e-04 +-9.0758468238421111e-04 +-9.0183700082328920e-04 +-8.9470151106737681e-04 +-8.8640329954209167e-04 +-8.7717785726455072e-04 +-8.6725992613123333e-04 +-8.5687449759720919e-04 +-8.4623018166837620e-04 +-8.3551487390624726e-04 +-8.2489345469252196e-04 +-8.1450715272081257e-04 +-8.0447417505982700e-04 +-7.9489122654752959e-04 +-7.8583559076253441e-04 +-7.7736750685381483e-04 +-7.6953263968483350e-04 +-7.6236449819890929e-04 +-7.5588670527172751e-04 +-7.5011506059424315e-04 +-7.4505936677805515e-04 +-7.4072500909780369e-04 +-7.3711429255885472e-04 +-7.3422754778729876e-04 +-7.3206402090607184e-04 +-7.3062256321563841e-04 +-7.2990213502623178e-04 +-8.0313985311709728e-04 +-8.0472331051513631e-04 +-8.0786751383983644e-04 +-8.1252687338990504e-04 +-8.1863254943255600e-04 +-8.2609180340847933e-04 +-8.3478698137668425e-04 +-8.4457405449216453e-04 +-8.5528071934815487e-04 +-8.6670423016635835e-04 +-8.7860940723812509e-04 +-8.9072761394008910e-04 +-9.0275783033030919e-04 +-9.1437112715354559e-04 +-9.2521968925669015e-04 +-9.3495093349681114e-04 +-9.4322623624272105e-04 +-9.4974254597162658e-04 +-9.5425408144598025e-04 +-9.5659080424427643e-04 +-9.5667065181161354e-04 +-9.5450359001800883e-04 +-9.5018708022471610e-04 +-9.4389409608815764e-04 +-9.3585595338534190e-04 +-9.2634270554087358e-04 +-9.1564371476192603e-04 +-9.0405041584321305e-04 +-8.9184249813901843e-04 +-8.7927796449085061e-04 +-8.6658692600488055e-04 +-8.5396861120169904e-04 +-8.4159089274415488e-04 +-8.2959161464358935e-04 +-8.1808107885782773e-04 +-8.0714517178667679e-04 +-7.9684874227979629e-04 +-7.8723896208684628e-04 +-7.7834849746809482e-04 +-7.7019839485284220e-04 +-7.6280063610092465e-04 +-7.5616035399914214e-04 +-7.5027772032271547e-04 +-7.4514953087821884e-04 +-7.4077051745560362e-04 +-7.3713441783089615e-04 +-7.3423483350911129e-04 +-7.3206590188245680e-04 +-7.3062280563800574e-04 +-7.2990213801121351e-04 +-8.7486278289658178e-04 +-8.7658861444588738e-04 +-8.8001322994727673e-04 +-8.8508229339531491e-04 +-8.9171358997092501e-04 +-8.9979588099984025e-04 +-9.0918694231536515e-04 +-9.1971055650696227e-04 +-9.3115242093167372e-04 +-9.4325534847628791e-04 +-9.5571478804786609e-04 +-9.6817647208696854e-04 +-9.8023864739866726e-04 +-9.9146147535587523e-04 +-1.0013854250453158e-03 +-1.0095586981660187e-03 +-1.0155712317529147e-03 +-1.0190903960335639e-03 +-1.0198921027378986e-03 +-1.0178813601040713e-03 +-1.0130983943337937e-03 +-1.0057096228318675e-03 +-9.9598593046615726e-04 +-9.8427288859890064e-04 +-9.7095828615289528e-04 +-9.5644171806335513e-04 +-9.4110950537917989e-04 +-9.2531651272087252e-04 +-9.0937495772072435e-04 +-8.9354931356698108e-04 +-8.7805591701635270e-04 +-8.6306580679896302e-04 +-8.4870948249657038e-04 +-8.3508255581683376e-04 +-8.2225156764295453e-04 +-8.1025950986233456e-04 +-7.9913079801309018e-04 +-7.8887558727449485e-04 +-7.7949341889860756e-04 +-7.7097623909275659e-04 +-7.6331085953560026e-04 +-7.5648093797949585e-04 +-7.5046855606761959e-04 +-7.4525546459326968e-04 +-7.4082405715993689e-04 +-7.3715812346064613e-04 +-7.3424342420755644e-04 +-7.3206812156180955e-04 +-7.3062309187266411e-04 +-7.2990214153675003e-04 +-9.6691812624982883e-04 +-9.6882710296477593e-04 +-9.7261319036256511e-04 +-9.7821229164992904e-04 +-9.8552707255257499e-04 +-9.9442479083604188e-04 +-1.0047332982437830e-03 +-1.0162346396428372e-03 +-1.0286561653946047e-03 +-1.0416601080199652e-03 +-1.0548341237907688e-03 +-1.0676870038424115e-03 +-1.0796548626368283e-03 +-1.0901226464586069e-03 +-1.0984630808759902e-03 +-1.1040903990104994e-03 +-1.1065207795122260e-03 +-1.1054276057937719e-03 +-1.1006793891719547e-03 +-1.0923519850616944e-03 +-1.0807132217734493e-03 +-1.0661847359868565e-03 +-1.0492903092537012e-03 +-1.0306012097947631e-03 +-1.0106873253129102e-03 +-9.9007952433360197e-04 +-9.6924513740114708e-04 +-9.4857569305272350e-04 +-9.2838445119378847e-04 +-9.0891074644968079e-04 +-8.9032835344700877e-04 +-8.7275565593678537e-04 +-8.5626606754698304e-04 +-8.4089775116477422e-04 +-8.2666214750554362e-04 +-8.1355114266265830e-04 +-8.0154290096671229e-04 +-7.9060649473220628e-04 +-7.8070550643265387e-04 +-7.7180078549282736e-04 +-7.6385252832126866e-04 +-7.5682182760026899e-04 +-7.5067181190164830e-04 +-7.4536847303428909e-04 +-7.4088125783422010e-04 +-7.3718348390413278e-04 +-7.3425262500473407e-04 +-7.3207050099348772e-04 +-7.3062339889621436e-04 +-7.2990214531962921e-04 +-1.0795763413651847e-03 +-1.0817103314211616e-03 +-1.0859424671205093e-03 +-1.0922004801077671e-03 +-1.1003738546330416e-03 +-1.1103095150303871e-03 +-1.1218034608096259e-03 +-1.1345870558315413e-03 +-1.1483079528859283e-03 +-1.1625081988117319e-03 +-1.1766056754374866e-03 +-1.1898885308894065e-03 +-1.2015335732832653e-03 +-1.2106565377863472e-03 +-1.2163939044531446e-03 +-1.2180045454989719e-03 +-1.2149696323514860e-03 +-1.2070661205210327e-03 +-1.1943951599830769e-03 +-1.1773597304120444e-03 +-1.1565999970776775e-03 +-1.1329045617483901e-03 +-1.1071181381122803e-03 +-1.0800621249193968e-03 +-1.0524772631824652e-03 +-1.0249903594795953e-03 +-9.9810197572246131e-04 +-9.7218954102981181e-04 +-9.4752002224409815e-04 +-9.2426721930836291e-04 +-9.0253014597885890e-04 +-8.8235030699098174e-04 +-8.6372675154203530e-04 +-8.4662851694756222e-04 +-8.3100451899309328e-04 +-8.1679117312030128e-04 +-8.0391811753426177e-04 +-7.9231241412873021e-04 +-7.8190156625424206e-04 +-7.7261563907243900e-04 +-7.6438871283574265e-04 +-7.5715984902933792e-04 +-7.5087370673592921e-04 +-7.4548091229761373e-04 +-7.4093825866761859e-04 +-7.3720879062117253e-04 +-7.3426181700655512e-04 +-7.3207288031946723e-04 +-7.3062370609917697e-04 +-7.2990214910608549e-04 +-1.2115527588373259e-03 +-1.2139519437422482e-03 +-1.2187140769699574e-03 +-1.2257657203662213e-03 +-1.2349927892535677e-03 +-1.2462318055631836e-03 +-1.2592523775119644e-03 +-1.2737282483287866e-03 +-1.2891975100012701e-03 +-1.3050187560933416e-03 +-1.3203379830828369e-03 +-1.3340874894706080e-03 +-1.3450376029423491e-03 +-1.3519105665923557e-03 +-1.3535443222296611e-03 +-1.3490705880536975e-03 +-1.3380590065351526e-03 +-1.3205858932286798e-03 +-1.2972103565162170e-03 +-1.2688704348929882e-03 +-1.2367334472547600e-03 +-1.2020404203950275e-03 +-1.1659759294901245e-03 +-1.1295793941554454e-03 +-1.0936994211168780e-03 +-1.0589834457776924e-03 +-1.0258912908643265e-03 +-9.9472174986033903e-04 +-9.6564383260118165e-04 +-9.3872727159260950e-04 +-9.1396940257591471e-04 +-8.9131730886506425e-04 +-8.7068519711969562e-04 +-8.5196752410336208e-04 +-8.3504860376111122e-04 +-8.1980943876448222e-04 +-8.0613244067661368e-04 +-7.9390458857102808e-04 +-7.8301945979429577e-04 +-7.7337846357614483e-04 +-7.6489152340145821e-04 +-7.5747738745875247e-04 +-7.5106369585676040e-04 +-7.4558689577510179e-04 +-7.4099206848256792e-04 +-7.3723271278169813e-04 +-7.3427051594322681e-04 +-7.3207513400833969e-04 +-7.3062399725779058e-04 +-7.2990215269609084e-04 +-1.3589608083393169e-03 +-1.3616588238575329e-03 +-1.3670266257396347e-03 +-1.3750060897655954e-03 +-1.3855025850245135e-03 +-1.3983673547782475e-03 +-1.4133616302242295e-03 +-1.4300975203893644e-03 +-1.4479586803319573e-03 +-1.4660179310771518e-03 +-1.4829856670670446e-03 +-1.4972326192468630e-03 +-1.5069213372014435e-03 +-1.5102468539690186e-03 +-1.5057383163408389e-03 +-1.4925352133643088e-03 +-1.4705497432250783e-03 +-1.4404663507234250e-03 +-1.4035896773294566e-03 +-1.3616007925984258e-03 +-1.3162976343549658e-03 +-1.2693801274406000e-03 +-1.2223096968800716e-03 +-1.1762441578727207e-03 +-1.1320315526610301e-03 +-1.0902410294872874e-03 +-1.0512112806060911e-03 +-1.0151027429427233e-03 +-9.8194554388877269e-04 +-9.5167960039338310e-04 +-9.2418609066639238e-04 +-8.9931101135748111e-04 +-8.7688214456929333e-04 +-8.5672086452346524e-04 +-8.3865007389703620e-04 +-8.2249933092046754e-04 +-8.0810799201379692e-04 +-7.9532698705757463e-04 +-7.8401967640807913e-04 +-7.7406210953634370e-04 +-7.6534290901160049e-04 +-7.5776293369795439e-04 +-7.5123482524892197e-04 +-7.4568250710757241e-04 +-7.4104068122532831e-04 +-7.3725435155625396e-04 +-7.3427839281963857e-04 +-7.3207717638978736e-04 +-7.3062426126544854e-04 +-7.2990215595249901e-04 +-1.5143568406461732e-03 +-1.5173737803537491e-03 +-1.5234027577474640e-03 +-1.5324310597934858e-03 +-1.5444256777921734e-03 +-1.5592990371774175e-03 +-1.5768387836478735e-03 +-1.5965933863881371e-03 +-1.6177234962974011e-03 +-1.6388592251123783e-03 +-1.6580348522458178e-03 +-1.6727818990912369e-03 +-1.6804253256283920e-03 +-1.6785446628036684e-03 +-1.6654697558163285e-03 +-1.6406395371088708e-03 +-1.6046979398737016e-03 +-1.5593105895422962e-03 +-1.5067927908364739e-03 +-1.4496869068789892e-03 +-1.3904064273327879e-03 +-1.3310060982252377e-03 +-1.2730810223185176e-03 +-1.2177640880569321e-03 +-1.1657818265393399e-03 +-1.1175347740455628e-03 +-1.0731798109227123e-03 +-1.0327025875998751e-03 +-9.9597566729701416e-04 +-9.6280235671871253e-04 +-9.3294820266668092e-04 +-9.0616272822051109e-04 +-8.8219386287847991e-04 +-8.6079711757617217e-04 +-8.4174109636448650e-04 +-8.2481052369017330e-04 +-8.0980763279855819e-04 +-7.9655250733051013e-04 +-7.8488278269532921e-04 +-7.7465298145067574e-04 +-7.6573366419258038e-04 +-7.5801051343979691e-04 +-7.5138342440965770e-04 +-7.4576564737524110e-04 +-7.4108300713819077e-04 +-7.3727321297942954e-04 +-7.3428526510865648e-04 +-7.3207895958783155e-04 +-7.3062449188475865e-04 +-7.2990215879807879e-04 +-1.6665491009419595e-03 +-1.6698834221412022e-03 +-1.6765929507418812e-03 +-1.6867545080163778e-03 +-1.7004584599208672e-03 +-1.7177462305783906e-03 +-1.7384823446747423e-03 +-1.7621490417977176e-03 +-1.7875891434834077e-03 +-1.8127814176101549e-03 +-1.8347850262164607e-03 +-1.8499863519920250e-03 +-1.8546832549199638e-03 +-1.8458711460442251e-03 +-1.8219530885436284e-03 +-1.7830952258704258e-03 +-1.7311077429841822e-03 +-1.6689456005253222e-03 +-1.6000559656467724e-03 +-1.5277947932705828e-03 +-1.4550384591675684e-03 +-1.3840086042321883e-03 +-1.3162611603254439e-03 +-1.2527710826523810e-03 +-1.1940549711780676e-03 +-1.1402945279893435e-03 +-1.0914425466395079e-03 +-1.0473057081078090e-03 +-1.0076052119210033e-03 +-9.7201903565204248e-04 +-9.4021015759140198e-04 +-9.1184461037675931e-04 +-8.8660244487143440e-04 +-8.6418390095065656e-04 +-8.4431242834180707e-04 +-8.2673569988930579e-04 +-8.1122539452640194e-04 +-7.9757626924724715e-04 +-7.8560486078665275e-04 +-7.7514803589060974e-04 +-7.6606152692302459e-04 +-7.5821853480456235e-04 +-7.5150844528711687e-04 +-7.4583568136816255e-04 +-7.4111870016117006e-04 +-7.3728913396216950e-04 +-7.3429107068417540e-04 +-7.3208046693683856e-04 +-7.3062468691203900e-04 +-7.2990216120537440e-04 +-1.8021240096422690e-03 +-1.8057462008620557e-03 +-1.8131018116996952e-03 +-1.8244054455908868e-03 +-1.8399383640209876e-03 +-1.8599450820459902e-03 +-1.8844221653375964e-03 +-1.9127839413085670e-03 +-1.9434582058041009e-03 +-1.9735661277107863e-03 +-1.9989185606461004e-03 +-2.0145231682971144e-03 +-2.0155873772643548e-03 +-1.9987027012890466e-03 +-1.9627216166425787e-03 +-1.9089578776155798e-03 +-1.8406878489580047e-03 +-1.7622488028066624e-03 +-1.6781227740213633e-03 +-1.5922734233772696e-03 +-1.5078132018256174e-03 +-1.4269417767786528e-03 +-1.3510479693973443e-03 +-1.2808792962644509e-03 +-1.2167171388904694e-03 +-1.1585272386453204e-03 +-1.1060762352432688e-03 +-1.0590159067455861e-03 +-1.0169410052370681e-03 +-9.7942724834979965e-04 +-9.4605517719860335e-04 +-9.1642432434519924e-04 +-8.9016093758322598e-04 +-8.6692153826441784e-04 +-8.4639387144597861e-04 +-8.2829629083687852e-04 +-8.1237626500222661e-04 +-7.9840844859947670e-04 +-7.8619259931168352e-04 +-7.7555151263039774e-04 +-7.6632907516586165e-04 +-7.5838849065379790e-04 +-7.5161070309314273e-04 +-7.4589302295895990e-04 +-7.4114795148468721e-04 +-7.3730219209236232e-04 +-7.3429583550154744e-04 +-7.3208170470504929e-04 +-7.3062484711656193e-04 +-7.2990216318357640e-04 +-1.9092050028250681e-03 +-1.9130575383086194e-03 +-1.9209580981549683e-03 +-1.9332866047371913e-03 +-1.9505545585687479e-03 +-1.9732551543534429e-03 +-2.0015569645617259e-03 +-2.0348217390551786e-03 +-2.0710320376946937e-03 +-2.1063691343246845e-03 +-2.1352927309830918e-03 +-2.1513852451768055e-03 +-2.1488554627531924e-03 +-2.1241323097502874e-03 +-2.0768108744668567e-03 +-2.0095479015933789e-03 +-1.9270875837578022e-03 +-1.8349705924050790e-03 +-1.7384451440029230e-03 +-1.6418233170970864e-03 +-1.5482643928005641e-03 +-1.4598418764361855e-03 +-1.3777440557737675e-03 +-1.3025039686441972e-03 +-1.2342048046606966e-03 +-1.1726417404238347e-03 +-1.1174399131623292e-03 +-1.0681358092307983e-03 +-1.0242309430679060e-03 +-9.8522574230271859e-04 +-9.5063984559208385e-04 +-9.2002335567685565e-04 +-8.9296223670274461e-04 +-8.6908003393857281e-04 +-8.4803737381840369e-04 +-8.2953020353753902e-04 +-8.1328739038709200e-04 +-7.9906807344045511e-04 +-7.8665900901908874e-04 +-7.7587205190770973e-04 +-7.6654184961000803e-04 +-7.5852378551531934e-04 +-7.5169218093804979e-04 +-7.4593875038358342e-04 +-7.4117129563060929e-04 +-7.3731261996188126e-04 +-7.3429964260546634e-04 +-7.3208269409777719e-04 +-7.3062497521043154e-04 +-7.2990216476598280e-04 +-1.9822079636141712e-03 +-1.9862153477155390e-03 +-1.9944974110513354e-03 +-2.0075756060465226e-03 +-2.0261615176793836e-03 +-2.0509734464956072e-03 +-2.0823574681627793e-03 +-2.1196822822090269e-03 +-2.1606093468540329e-03 +-2.2005522323795407e-03 +-2.2328081127437624e-03 +-2.2497205568301933e-03 +-2.2446766283442192e-03 +-2.2140738183721348e-03 +-2.1582592289134572e-03 +-2.0810653048790643e-03 +-1.9883895493302138e-03 +-1.8866155468430050e-03 +-1.7814558991241661e-03 +-1.6773832414356251e-03 +-1.5775300284855906e-03 +-1.4838531561109348e-03 +-1.3973961546477197e-03 +-1.3185505753036673e-03 +-1.2472739611051689e-03 +-1.1832546237802231e-03 +-1.1260284997589806e-03 +-1.0750581432346258e-03 +-1.0297839031322095e-03 +-9.8965559291611560e-04 +-9.5415093315057468e-04 +-9.2278527577416931e-04 +-8.9511574344982648e-04 +-8.7074191152212684e-04 +-8.4930445030590275e-04 +-8.3048265574587005e-04 +-8.1399146402001004e-04 +-7.9957832272156855e-04 +-7.8702014346317942e-04 +-7.7612046391118956e-04 +-7.6670688472735174e-04 +-7.5862880726693474e-04 +-7.5175547349542917e-04 +-7.4597429524226916e-04 +-7.4118945219947714e-04 +-7.3732073466318084e-04 +-7.3430260644516030e-04 +-7.3208346459328986e-04 +-7.3062507498664812e-04 +-7.2990216599923849e-04 +-2.0242505832279815e-03 +-2.0283380502704191e-03 +-2.0368093540462139e-03 +-2.0502446563738816e-03 +-2.0694451486837065e-03 +-2.0952496001994257e-03 +-2.1281435553229607e-03 +-2.1676048879941453e-03 +-2.2112599695020716e-03 +-2.2541900495197660e-03 +-2.2890005267830588e-03 +-2.3071667505670085e-03 +-2.3014251078997939e-03 +-2.2680634898236841e-03 +-2.2078618876663482e-03 +-2.1253532901034568e-03 +-2.0270975494350372e-03 +-1.9199401590575143e-03 +-1.8098428797398249e-03 +-1.7013747930013821e-03 +-1.5976782817428694e-03 +-1.5006794339096534e-03 +-1.4113750848241870e-03 +-1.3301057219701742e-03 +-1.2567783502676203e-03 +-1.1910333718392512e-03 +-1.1323624487665984e-03 +-1.0801880141732445e-03 +-1.0339146650909141e-03 +-9.9296081531764541e-04 +-9.5677694150170473e-04 +-9.2485498721272652e-04 +-8.9673211160015557e-04 +-8.7199095429852931e-04 +-8.5025786657660864e-04 +-8.3120005765133101e-04 +-8.1452226336741493e-04 +-7.9996331477164560e-04 +-7.8729283187827567e-04 +-7.7630816841311946e-04 +-7.6683166939037000e-04 +-7.5870826315687777e-04 +-7.5180338506288013e-04 +-7.4600121573817639e-04 +-7.4120320953401455e-04 +-7.3732688559219176e-04 +-7.3430485374722740e-04 +-7.3208404895780269e-04 +-7.3062515067252149e-04 +-7.2990216693543015e-04 +-2.0445816079645170e-03 +-2.0486934917731533e-03 +-2.0571890944280579e-03 +-2.0706026950031552e-03 +-2.0896823807288307e-03 +-2.1152424045359514e-03 +-2.1478291265985983e-03 +-2.1871093918019190e-03 +-2.2309844262961408e-03 +-2.2747276436581899e-03 +-2.3108547105607879e-03 +-2.3304420428365098e-03 +-2.3257316880264168e-03 +-2.2926855575235118e-03 +-2.2320201630581160e-03 +-2.1483873761442766e-03 +-2.0485290334781147e-03 +-1.9394658637213499e-03 +-1.8273075787119649e-03 +-1.7167430750656557e-03 +-1.6110077957593885e-03 +-1.5120947728279434e-03 +-1.4210432667345707e-03 +-1.3382151005933295e-03 +-1.2635222286531394e-03 +-1.1965985548709839e-03 +-1.1369221633410805e-03 +-1.0838982446005081e-03 +-1.0369129069466249e-03 +-9.9536639018209228e-04 +-9.5869221706782869e-04 +-9.2636704308284089e-04 +-8.9791455146245760e-04 +-8.7290568405239599e-04 +-8.5095674005799865e-04 +-8.3172634506534292e-04 +-8.1491193040836177e-04 +-8.0024611933227356e-04 +-7.8749325513305228e-04 +-7.7644620136105703e-04 +-7.6692347694219578e-04 +-7.5876674702268993e-04 +-7.5183866492852132e-04 +-7.4602104603932603e-04 +-7.4121334683199954e-04 +-7.3733141927047384e-04 +-7.3430651055528381e-04 +-7.3208447985368536e-04 +-7.3062520648842959e-04 +-7.2990216762660654e-04 +-2.0529859041452125e-03 +-2.0570929450960023e-03 +-2.0655191274283075e-03 +-2.0786831104372141e-03 +-2.0971796789615959e-03 +-2.1216816879412377e-03 +-2.1526971847346935e-03 +-2.1900667896381800e-03 +-2.2321231168671175e-03 +-2.2747108920513266e-03 +-2.3107867586270410e-03 +-2.3315001179218123e-03 +-2.3287787949235294e-03 +-2.2980632045969075e-03 +-2.2395598354311621e-03 +-2.1575639298460707e-03 +-2.0586581491432690e-03 +-1.9498738421660220e-03 +-1.8374389661740887e-03 +-1.7262042200630267e-03 +-1.6195635738776328e-03 +-1.5196402844851946e-03 +-1.4275678453400833e-03 +-1.3437688876409095e-03 +-1.2681896611159331e-03 +-1.2004794544767203e-03 +-1.1401193793996148e-03 +-1.0865102696322165e-03 +-1.0390299559374298e-03 +-9.9706873202398119e-04 +-9.6004987638587450e-04 +-9.2744027235599287e-04 +-8.9875468653152584e-04 +-8.7355614604170938e-04 +-8.5145404680810218e-04 +-8.3210105924397466e-04 +-8.1518951088779704e-04 +-8.0044766568833099e-04 +-7.8763614810624274e-04 +-7.7654464879729735e-04 +-7.6698897762836565e-04 +-7.5880848557221745e-04 +-7.5186385041763298e-04 +-7.4603520603163439e-04 +-7.4122058708106649e-04 +-7.3733465793481120e-04 +-7.3430769429617417e-04 +-7.3208478775404757e-04 +-7.3062524637575611e-04 +-7.2990216812139901e-04 +-2.0560418853829087e-03 +-2.0601355004386079e-03 +-2.0684698539438239e-03 +-2.0813362132365357e-03 +-2.0991525475614631e-03 +-2.1224038675070863e-03 +-2.1514806551868005e-03 +-2.1863020997513129e-03 +-2.2255927464472601e-03 +-2.2658874771799642e-03 +-2.3008882441198203e-03 +-2.3221721040489135e-03 +-2.3215440384622764e-03 +-2.2938544817193646e-03 +-2.2385615313465983e-03 +-2.1593548054845329e-03 +-2.0624946627618625e-03 +-1.9549542002948160e-03 +-1.8430703549069821e-03 +-1.7318708985886719e-03 +-1.6249279328972961e-03 +-1.5245114183420551e-03 +-1.4318614955528088e-03 +-1.3474710981324939e-03 +-1.2713285681291758e-03 +-1.2031054360823446e-03 +-1.1422920970091831e-03 +-1.0882907775629229e-03 +-1.0404762695372320e-03 +-9.9823362369341750e-04 +-9.6098003290819901e-04 +-9.2817623670373784e-04 +-8.9933121688671547e-04 +-8.7400276756580434e-04 +-8.5179566499011357e-04 +-8.3235856254951007e-04 +-8.1538032648755313e-04 +-8.0058625337862336e-04 +-7.8773442966942081e-04 +-7.7661237653390061e-04 +-7.6703404893561239e-04 +-7.5883721162040008e-04 +-7.5188118708221347e-04 +-7.4604495474022824e-04 +-7.4122557246285932e-04 +-7.3733688823356797e-04 +-7.3430850955729526e-04 +-7.3208499982608632e-04 +-7.3062527385062712e-04 +-7.2990216846323169e-04 +-2.0570066052490042e-03 +-2.0610882425320825e-03 +-2.0693473812936902e-03 +-2.0819737587486902e-03 +-2.0992393316230742e-03 +-2.1214583652041513e-03 +-2.1488769911347104e-03 +-2.1813993141894584e-03 +-2.2180051854879127e-03 +-2.2558284003961837e-03 +-2.2893553437343611e-03 +-2.3107383475539601e-03 +-2.3118026683696378e-03 +-2.2868704205371466e-03 +-2.2346467128909965e-03 +-2.1581932865519667e-03 +-2.0634322127846627e-03 +-1.9572665620613502e-03 +-1.8461275795982615e-03 +-1.7352009917844459e-03 +-1.6282164350354079e-03 +-1.5275721279059832e-03 +-1.4346007324010368e-03 +-1.3498561701114653e-03 +-1.2733637852350452e-03 +-1.2048154622301948e-03 +-1.1437111562068918e-03 +-1.0894560694532053e-03 +-1.0414242135707631e-03 +-9.9899790858742682e-04 +-9.6159076627168999e-04 +-9.2865973252007257e-04 +-8.9971012943310276e-04 +-8.7429639444603052e-04 +-8.5202031550542050e-04 +-8.3252793355299631e-04 +-8.1550585587450474e-04 +-8.0067743787036135e-04 +-7.8779910302718894e-04 +-7.7665694943833245e-04 +-7.6706371436403647e-04 +-7.5885612060089236e-04 +-7.5189259996809061e-04 +-7.4605137290179827e-04 +-7.4122885486259220e-04 +-7.3733835675788607e-04 +-7.3430904638561523e-04 +-7.3208513947512258e-04 +-7.3062529194360681e-04 +-7.2990216868954242e-04 +-2.0572332752182673e-03 +-2.0613068760947486e-03 +-2.0695162974653939e-03 +-2.0819841560693461e-03 +-2.0988834080064721e-03 +-2.1204046976131823e-03 +-2.1466709491483873e-03 +-2.1775297284474305e-03 +-2.2120907133218641e-03 +-2.2479090274450829e-03 +-2.2801077422840263e-03 +-2.3013660762432504e-03 +-2.3035904425129034e-03 +-2.2807076698763600e-03 +-2.2308217906625940e-03 +-2.1564898441580331e-03 +-2.0633641232989759e-03 +-1.9582919310804914e-03 +-1.8477760872781755e-03 +-1.7371209620584244e-03 +-1.6301729597695308e-03 +-1.5294242877003593e-03 +-1.4362748448382258e-03 +-1.3513226866841985e-03 +-1.2746199805955651e-03 +-1.2058735470364687e-03 +-1.1445906225656332e-03 +-1.0901790332548133e-03 +-1.0420127486458323e-03 +-9.9947264251739275e-04 +-9.6197024190868398e-04 +-9.2896021339927617e-04 +-8.9994564775935514e-04 +-8.7447891970665256e-04 +-8.5215997248912364e-04 +-8.3263322995177740e-04 +-8.1558389874498614e-04 +-8.0073412941424678e-04 +-7.8783931261000443e-04 +-7.7668466221937204e-04 +-7.6708215871971292e-04 +-7.5886787725145083e-04 +-7.5189969595427304e-04 +-7.4605536341694923e-04 +-7.4123089570861432e-04 +-7.3733926981890989e-04 +-7.3430938016065159e-04 +-7.3208522630244894e-04 +-7.3062530319344685e-04 +-7.2990216883176611e-04 +-2.0572420847951760e-03 +-2.0613110753461756e-03 +-2.0694918380167642e-03 +-2.0818680825739778e-03 +-2.0985546113926404e-03 +-2.1196667058544991e-03 +-2.1452450446465756e-03 +-2.1750838789504207e-03 +-2.2083482272096861e-03 +-2.2428460312641251e-03 +-2.2741230699313661e-03 +-2.2952322806280190e-03 +-2.2981573040854711e-03 +-2.2765719327458122e-03 +-2.2281824582499857e-03 +-2.1552124050869823e-03 +-2.0631380101932871e-03 +-1.9587716503233058e-03 +-1.8486633147490224e-03 +-1.7381937027906762e-03 +-1.6312833655667879e-03 +-1.5304836034915651e-03 +-1.4372362635848804e-03 +-1.3521667800401147e-03 +-1.2753439051348555e-03 +-1.2064836954614278e-03 +-1.1450979223985203e-03 +-1.0905960996505199e-03 +-1.0423522592422124e-03 +-9.9974648126799912e-04 +-9.6218910724736335e-04 +-9.2913349456674754e-04 +-9.0008144735773999e-04 +-8.7458414898223982e-04 +-8.5224047660812611e-04 +-8.3269391943769126e-04 +-8.1562887471233381e-04 +-8.0076679689702131e-04 +-7.8786248013710831e-04 +-7.7670062782500093e-04 +-7.6709278365555780e-04 +-7.5887464908592367e-04 +-7.5190378289079988e-04 +-7.4605766157155053e-04 +-7.4123207095481806e-04 +-7.3733979558237455e-04 +-7.3430957234634604e-04 +-7.3208527629515976e-04 +-7.3062530967117276e-04 +-7.2990216891556832e-04 +-2.0572136921365642e-03 +-2.0612803887749059e-03 +-2.0694467019036315e-03 +-2.0817766014691731e-03 +-2.0983552759952211e-03 +-2.1192590278198546e-03 +-2.1444840768749056e-03 +-2.1737916083718525e-03 +-2.2063682589207839e-03 +-2.2401526701504386e-03 +-2.2709222590625799e-03 +-2.2919410139055100e-03 +-2.2952396796507898e-03 +-2.2743537394516325e-03 +-2.2267705990380031e-03 +-2.1545316566997440e-03 +-2.0630186820229635e-03 +-1.9590268576963224e-03 +-1.8491330299948256e-03 +-1.7387597679396633e-03 +-1.6318676988725492e-03 +-1.5310397339986859e-03 +-1.4377399652158352e-03 +-1.3526082278388521e-03 +-1.2757219241306698e-03 +-1.2068018786415497e-03 +-1.1453621668266372e-03 +-1.0908131262909752e-03 +-1.0425287759232528e-03 +-9.9988874732825765e-04 +-9.6230273889846949e-04 +-9.2922340808399906e-04 +-9.0015187659638486e-04 +-8.7463869920716641e-04 +-8.5228219271563316e-04 +-8.3272535646302021e-04 +-8.1565216443889776e-04 +-8.0078370779213741e-04 +-7.8787446979998162e-04 +-7.7670888814872381e-04 +-7.6709827943880512e-04 +-7.5887815102132180e-04 +-7.5190589591880592e-04 +-7.4605884952578584e-04 +-7.4123267834936722e-04 +-7.3734006726609966e-04 +-7.3430967164355625e-04 +-7.3208530212265572e-04 +-7.3062531301825860e-04 +-7.2990216896144655e-04 +-2.0571951359941282e-03 +-2.0612608911341045e-03 +-2.0694211727889269e-03 +-2.0817316707233491e-03 +-2.0982651930570211e-03 +-2.1190817417009004e-03 +-2.1441587246953096e-03 +-2.1732428042469582e-03 +-2.2055290604853475e-03 +-2.2390121060522094e-03 +-2.2695701104276087e-03 +-2.2905587796653343e-03 +-2.2940278747051808e-03 +-2.2734504976964268e-03 +-2.2262176255400650e-03 +-2.1542919349375783e-03 +-2.0630156950725699e-03 +-1.9591783293461335e-03 +-1.8493696386932901e-03 +-1.7390311075481280e-03 +-1.6321410492760313e-03 +-1.5312961048000455e-03 +-1.4379698900029781e-03 +-1.3528083106768875e-03 +-1.2758923438249037e-03 +-1.2069447261864534e-03 +-1.1454804048514284e-03 +-1.0909099744287182e-03 +-1.0426073713094735e-03 +-9.9995197475656410e-04 +-9.6235316112375864e-04 +-9.2926325232984826e-04 +-9.0018305046277191e-04 +-8.7466282015179382e-04 +-8.5230062214383640e-04 +-8.3273923359976061e-04 +-8.1566243762439406e-04 +-8.0079116223898659e-04 +-7.8787975163764059e-04 +-7.7671252497345179e-04 +-7.6710069778340587e-04 +-7.5887969121478979e-04 +-7.5190682481344996e-04 +-7.4605937152708978e-04 +-7.4123294514086529e-04 +-7.3734018655916640e-04 +-7.3430971523135260e-04 +-7.3208531345782724e-04 +-7.3062531448806010e-04 +-7.2990216898513659e-04 +-2.0571887355915692e-03 +-2.0612542139810874e-03 +-2.0694126901826836e-03 +-2.0817173774790791e-03 +-2.0982374355214438e-03 +-2.1190281554242809e-03 +-2.1440616440735788e-03 +-2.1730807464929833e-03 +-2.2052838312936075e-03 +-2.2386831199106105e-03 +-2.2691872548095968e-03 +-2.2901783113783210e-03 +-2.2937092786890043e-03 +-2.2732319967389471e-03 +-2.2261072011576146e-03 +-2.1542741771431377e-03 +-2.0630645369004719e-03 +-1.9592673951867186e-03 +-1.8494776126716009e-03 +-1.7391431225650647e-03 +-1.6322479571171738e-03 +-1.5313930330115156e-03 +-1.4380548262508304e-03 +-1.3528809883925567e-03 +-1.2759534629809438e-03 +-1.2069954507294403e-03 +-1.1455220597339024e-03 +-1.0909438754167567e-03 +-1.0426347380857539e-03 +-9.9997389368408802e-04 +-9.6237057606964895e-04 +-9.2927697025400413e-04 +-9.0019375390846385e-04 +-8.7467108217415543e-04 +-8.5230692128532293e-04 +-8.3274396773677423e-04 +-8.1566593620917770e-04 +-8.0079369683738028e-04 +-7.8788154486145602e-04 +-7.7671375799116544e-04 +-7.6710151662511764e-04 +-7.5888021208257456e-04 +-7.5190713859359538e-04 +-7.4605954767464270e-04 +-7.4123303508383308e-04 +-7.3734022674307718e-04 +-7.3430972990404339e-04 +-7.3208531727212247e-04 +-7.3062531498414645e-04 +-7.2990216899873020e-04 +-2.0571877672724472e-03 +-2.0612532077051164e-03 +-2.0694114293057951e-03 +-2.0817153066094818e-03 +-2.0982335373417073e-03 +-2.1190208869641689e-03 +-2.1440489957592324e-03 +-2.1730606434772265e-03 +-2.2052552896352205e-03 +-2.2386481355316165e-03 +-2.2691519449291870e-03 +-2.2901513163068924e-03 +-2.2936978720117210e-03 +-2.2732389365151071e-03 +-2.2261304370112330e-03 +-2.1543087709059213e-03 +-2.0631049582454149e-03 +-1.9593090203571324e-03 +-1.8495172662859405e-03 +-1.7391789979778437e-03 +-1.6322792823281480e-03 +-1.5314197103354615e-03 +-1.4380771422468014e-03 +-1.3528994132757475e-03 +-1.2759685260747987e-03 +-1.2070076704799688e-03 +-1.1455319090600464e-03 +-1.0909517682105069e-03 +-1.0426410274338791e-03 +-9.9997887597364638e-04 +-9.6237449757124386e-04 +-9.2928003431243299e-04 +-9.0019612779442502e-04 +-8.7467290317999981e-04 +-8.5230830193815815e-04 +-8.3274500014968991e-04 +-8.1566669565956277e-04 +-8.0079424468452900e-04 +-7.8788193091724307e-04 +-7.7671402244752991e-04 +-7.6710169162879001e-04 +-7.5888032303258058e-04 +-7.5190720522384292e-04 +-7.4605958497146719e-04 +-7.4123305407847184e-04 +-7.3734023521009452e-04 +-7.3430973299019799e-04 +-7.3208531807413121e-04 +-7.3062531509066216e-04 +-7.2990216900929619e-04 +-2.0571877673430474e-03 +-2.0612532084029024e-03 +-2.0694114325895303e-03 +-2.0817153221954739e-03 +-2.0982335993378854e-03 +-2.1190210858218136e-03 +-2.1440495295394070e-03 +-2.1730618835140835e-03 +-2.2052578224587773e-03 +-2.2386526899242968e-03 +-2.2691591306385067e-03 +-2.2901612750331713e-03 +-2.2937101040513773e-03 +-2.2732524547774509e-03 +-2.2261441228790635e-03 +-2.1543216926287346e-03 +-2.0631165201481089e-03 +-1.9593189570157382e-03 +-1.8495255578818046e-03 +-1.7391857722115532e-03 +-1.6322847356241084e-03 +-1.5314240561089348e-03 +-1.4380805821188093e-03 +-1.3529021240243843e-03 +-1.2759706559544862e-03 +-1.2070093404315694e-03 +-1.1455332160547219e-03 +-1.0909527891969251e-03 +-1.0426418231280579e-03 +-9.9997949417203035e-04 +-9.6237497590070855e-04 +-9.2928040244242833e-04 +-9.0019640918157862e-04 +-8.7467311642679742e-04 +-8.5230846184295036e-04 +-8.3274511851483550e-04 +-8.1566678191270390e-04 +-8.0079430635697155e-04 +-7.8788197401391470e-04 +-7.7671405173520690e-04 +-7.6710171086302704e-04 +-7.5888033513885544e-04 +-7.5190721244456976e-04 +-7.4605958898755977e-04 +-7.4123305611184119e-04 +-7.3734023611174546e-04 +-7.3430973331732466e-04 +-7.3208531815872533e-04 +-7.3062531510158224e-04 +-7.2990216900944884e-04 +-2.0571887361280237e-03 +-2.0612542171395791e-03 +-2.0694126991458446e-03 +-2.0817174423331166e-03 +-2.0982377913077630e-03 +-2.1190294979143093e-03 +-2.1440655809290537e-03 +-2.1730903889592692e-03 +-2.2053042084912164e-03 +-2.2387206214357128e-03 +-2.2692474101410924e-03 +-2.2902627069631733e-03 +-2.2938139088847288e-03 +-2.2733484708920230e-03 +-2.2262258013518092e-03 +-2.1543866783785589e-03 +-2.0631655841929579e-03 +-1.9593545138608757e-03 +-1.8495505016189859e-03 +-1.7392028066155701e-03 +-1.6322960950559710e-03 +-1.5314314574505655e-03 +-1.4380852839207382e-03 +-1.3529050195882986e-03 +-1.2759723647911777e-03 +-1.2070102846195555e-03 +-1.1455336789495544e-03 +-1.0909529584443292e-03 +-1.0426418212307745e-03 +-9.9997939977778142e-04 +-9.6237483842177927e-04 +-9.2928025199399598e-04 +-9.0019626328300718e-04 +-8.7467298448845555e-04 +-8.5230834814907183e-04 +-8.3274502419187189e-04 +-8.1566670621699509e-04 +-8.0079424750922684e-04 +-7.8788192973399231e-04 +-7.7671401958095802e-04 +-7.6710168844197439e-04 +-7.5888032023826968e-04 +-7.5190720310873763e-04 +-7.4605958356028319e-04 +-7.4123305325421971e-04 +-7.3734023480079389e-04 +-7.3430973282758263e-04 +-7.3208531802814705e-04 +-7.3062531508169179e-04 +-7.2990216899994581e-04 +-2.0571951358025549e-03 +-2.0612608727588284e-03 +-2.0694210555680247e-03 +-2.0817313758150122e-03 +-2.0982649615358139e-03 +-2.1190828344449333e-03 +-2.1441646180202305e-03 +-2.1732608365768688e-03 +-2.2055717887271916e-03 +-2.2390963144565150e-03 +-2.2697113878736189e-03 +-2.2907632973913359e-03 +-2.2942873091462324e-03 +-2.2737443622828282e-03 +-2.2265209300666531e-03 +-2.1545827546075986e-03 +-2.0632791898249599e-03 +-1.9594071320892031e-03 +-1.8495622085901776e-03 +-1.7391895774454941e-03 +-1.6322694020683862e-03 +-1.5313989265012887e-03 +-1.4380516444620689e-03 +-1.3528729866848282e-03 +-1.2759433319840404e-03 +-1.2069848209598330e-03 +-1.1455118652385046e-03 +-1.0909346050785760e-03 +-1.0426266042561369e-03 +-9.9996694280475606e-04 +-9.6236475982986282e-04 +-9.2927219048371016e-04 +-9.0018989027779357e-04 +-8.7466800879997517e-04 +-8.5230451627665946e-04 +-8.3274211831881897e-04 +-8.1566454113100027e-04 +-8.0079266715934452e-04 +-7.8788080381319073e-04 +-7.7671324033256304e-04 +-7.6710116776922284e-04 +-7.5887998713150019e-04 +-7.5190700136428445e-04 +-7.4605946974819811e-04 +-7.4123299488170098e-04 +-7.3734020861964495e-04 +-7.3430972323624210e-04 +-7.3208531552803983e-04 +-7.3062531475517466e-04 +-7.2990216898844113e-04 +-2.0572136813903842e-03 +-2.0612802236359461e-03 +-2.0694459144863166e-03 +-2.0817743441621179e-03 +-2.0983507499728175e-03 +-2.1192526586751919e-03 +-2.1444796904340068e-03 +-2.1737996728421090e-03 +-2.2064091542067696e-03 +-2.2402563980239805e-03 +-2.2711200526871820e-03 +-2.2922502892653088e-03 +-2.2956526321446504e-03 +-2.2748388281151758e-03 +-2.2272849935845137e-03 +-2.1550352325893896e-03 +-2.0634824741588803e-03 +-1.9594349197198371e-03 +-1.8494801802388585e-03 +-1.7390479937828220e-03 +-1.6321028871546879e-03 +-1.5312293237120704e-03 +-1.4378915141157684e-03 +-1.3527286651945172e-03 +-1.2758172446528440e-03 +-1.2068770878937843e-03 +-1.1454213525872825e-03 +-1.0908595811333032e-03 +-1.0425651304936320e-03 +-9.9991709467231026e-04 +-9.6232474197408078e-04 +-9.2924038876719130e-04 +-9.0016488740320708e-04 +-8.7464858010156043e-04 +-8.5228961561839458e-04 +-8.3273085990430049e-04 +-8.1565618046286253e-04 +-8.0078658285521890e-04 +-7.8787648106156641e-04 +-7.7671025625685700e-04 +-7.6709917866757166e-04 +-7.5887871741740320e-04 +-7.5190623395593990e-04 +-7.4605903764090903e-04 +-7.4123277363728323e-04 +-7.3734010953567671e-04 +-7.3430968698404684e-04 +-7.3208530609047712e-04 +-7.3062531353025346e-04 +-7.2990216896776420e-04 +-2.0572420268834797e-03 +-2.0613103606036353e-03 +-2.0694888619538750e-03 +-2.0818597515594815e-03 +-2.0985366149499974e-03 +-2.1196350309542183e-03 +-2.1451992331448710e-03 +-2.1750324827809384e-03 +-2.2083156044140884e-03 +-2.2428754702259494e-03 +-2.2742677984898740e-03 +-2.2955330137588532e-03 +-2.2986203144117743e-03 +-2.2771646651166353e-03 +-2.2288482509689811e-03 +-2.1558915884610673e-03 +-2.0637830974975851e-03 +-1.9593528881850916e-03 +-1.8491671936465524e-03 +-1.7386184626087674e-03 +-1.6316343074510224e-03 +-1.5307694421877974e-03 +-1.4374667357736526e-03 +-1.3523512829749253e-03 +-1.2754908418498587e-03 +-1.2066002491532021e-03 +-1.1451900642808488e-03 +-1.0906687072259847e-03 +-1.0424092742001741e-03 +-9.9979106977039008e-04 +-9.6222380527362416e-04 +-9.2916033201841434e-04 +-9.0010205029060161e-04 +-8.7459982193844438e-04 +-8.5225226797580795e-04 +-8.3270267288508234e-04 +-8.1563526948443845e-04 +-8.0077137936233054e-04 +-7.8786568855189541e-04 +-7.7670281189442668e-04 +-7.6709422013649092e-04 +-7.5887555439686728e-04 +-7.5190432346788417e-04 +-7.4605796252765735e-04 +-7.4123222345696634e-04 +-7.3733986325270342e-04 +-7.3430959691130591e-04 +-7.3208528265006898e-04 +-7.3062531049129255e-04 +-7.2990216892568208e-04 +-2.0572330705416466e-03 +-2.0613045912951612e-03 +-2.0695076168850343e-03 +-2.0819608975941092e-03 +-2.0988331138696815e-03 +-2.1203121409101625e-03 +-2.1465225221840617e-03 +-2.1773220429765058e-03 +-2.2118434904605262e-03 +-2.2476761099811094e-03 +-2.2799720607731117e-03 +-2.3014104508338939e-03 +-2.3038596825609055e-03 +-2.2811898675990584e-03 +-2.2314593784217795e-03 +-2.1572068997752492e-03 +-2.0640909839815618e-03 +-1.9589780065992659e-03 +-1.8483918833679177e-03 +-1.7376541961030077e-03 +-1.6306229974644892e-03 +-1.5297971894671835e-03 +-1.4365797791040112e-03 +-1.3515696674527339e-03 +-1.2748186078146897e-03 +-1.2060324094122674e-03 +-1.1447170958699187e-03 +-1.0902792926120331e-03 +-1.0420918823428158e-03 +-9.9953480277671300e-04 +-9.6201879843259373e-04 +-9.2899789349869775e-04 +-8.9997465695359656e-04 +-8.7450104193660910e-04 +-8.5217665158142657e-04 +-8.3264563494039781e-04 +-8.1559297584341049e-04 +-8.0074064323825127e-04 +-7.8784387891118535e-04 +-7.7668777400935073e-04 +-7.6708420730739978e-04 +-7.5886916939634126e-04 +-7.5190046807126047e-04 +-7.4605579354517437e-04 +-7.4123111378073339e-04 +-7.3733936662743636e-04 +-7.3430941531549157e-04 +-7.3208523539937159e-04 +-7.3062530436764225e-04 +-7.2990216884624085e-04 +-2.0570060304012689e-03 +-2.0610821893294710e-03 +-2.0693258563253174e-03 +-2.0819185946140402e-03 +-2.0991223051855484e-03 +-2.1212422535622963e-03 +-2.1485214058551000e-03 +-2.1808741698760535e-03 +-2.2173134255369801e-03 +-2.2550305071626308e-03 +-2.2885737854205566e-03 +-2.3101230729887234e-03 +-2.3114715149939258e-03 +-2.2868654369052940e-03 +-2.2349324103539629e-03 +-2.1586870056121235e-03 +-2.0640404875300815e-03 +-1.9579097901027548e-03 +-1.8467497301438650e-03 +-1.7357690116370963e-03 +-1.6287150742811296e-03 +-1.5279980100414670e-03 +-1.4349574244357632e-03 +-1.3501506941863950e-03 +-1.2736044109339247e-03 +-1.2050104423914137e-03 +-1.1438680851651884e-03 +-1.0895816192628891e-03 +-1.0415240824804912e-03 +-9.9907687772848234e-04 +-9.6165280322203469e-04 +-9.2870810778151482e-04 +-8.9974752848201206e-04 +-8.7432501762155419e-04 +-8.5204196328381642e-04 +-8.3254407746260084e-04 +-8.1551769655381103e-04 +-8.0068595220637580e-04 +-7.8780508233670520e-04 +-7.7666103047430895e-04 +-7.6706640467804341e-04 +-7.5885781951989405e-04 +-7.5189361619418368e-04 +-7.4605193951879530e-04 +-7.4122914235012825e-04 +-7.3733848446203389e-04 +-7.3430909278322408e-04 +-7.3208515148588508e-04 +-7.3062529349431126e-04 +-7.2990216870866048e-04 +-2.0560405138026917e-03 +-2.0601215912703307e-03 +-2.0684227648018584e-03 +-2.0812202980035111e-03 +-2.0989128985261299e-03 +-2.1219667339589148e-03 +-2.1507618479436560e-03 +-2.1852282404162685e-03 +-2.2241382692113963e-03 +-2.2641174707470676e-03 +-2.2989763236266822e-03 +-2.3203619924349115e-03 +-2.3200645591608814e-03 +-2.2928416030266571e-03 +-2.2380333425876804e-03 +-2.1592390024811944e-03 +-2.0626769907373600e-03 +-1.9553192412165156e-03 +-1.8435239004218754e-03 +-1.7323464399299571e-03 +-1.6253840468705390e-03 +-1.5249257487686780e-03 +-1.4322245947869586e-03 +-1.3477814611536233e-03 +-1.2715891079370845e-03 +-1.2033211913159711e-03 +-1.1424688458386457e-03 +-1.0884342607094160e-03 +-1.0405917968481786e-03 +-9.9832590894265269e-04 +-9.6105315649526522e-04 +-9.2823367455139010e-04 +-8.9937589926292769e-04 +-8.7403714752462623e-04 +-8.5182178580446642e-04 +-8.3237811915544619e-04 +-8.1539471913718111e-04 +-8.0059663337753325e-04 +-7.8774173789417513e-04 +-7.7661737574328995e-04 +-7.6703735094981861e-04 +-7.5883930035921133e-04 +-7.5188243831965970e-04 +-7.4604565327542158e-04 +-7.4122592726370720e-04 +-7.3733704597983519e-04 +-7.3430856691101588e-04 +-7.3208501468106848e-04 +-7.3062527576924527e-04 +-7.2990216848688400e-04 +-2.0529830693560183e-03 +-2.0570649311636539e-03 +-2.0654277490828846e-03 +-2.0784658897864869e-03 +-2.0967425793763255e-03 +-2.1208993649177903e-03 +-2.1514260605831385e-03 +-2.1881775633752812e-03 +-2.2295553361268154e-03 +-2.2715354976689437e-03 +-2.3072374973295623e-03 +-2.3279324569334204e-03 +-2.3255608826301638e-03 +-2.2954606215053971e-03 +-2.2376789717739854e-03 +-2.1563679749403344e-03 +-2.0580237234703769e-03 +-1.9496493229894175e-03 +-1.8374837101447880e-03 +-1.7264064432348481e-03 +-1.6198433975866443e-03 +-1.5199453398393379e-03 +-1.4278665551912862e-03 +-1.3440440765254437e-03 +-1.2684334771185630e-03 +-1.2006897195195533e-03 +-1.1402971371214155e-03 +-1.0866582214478855e-03 +-1.0391515090776662e-03 +-9.9716744823596980e-04 +-9.6012917258068411e-04 +-9.2750327398945503e-04 +-8.9880417005317327e-04 +-8.7359453082831880e-04 +-8.5148341270444873e-04 +-8.3212317576831423e-04 +-8.1520587030144609e-04 +-8.0045951582212774e-04 +-7.8764452300638223e-04 +-7.7655039647032173e-04 +-7.6699278481892131e-04 +-7.5881089981590110e-04 +-7.5186529973393049e-04 +-7.4603601663327348e-04 +-7.4122099944316886e-04 +-7.3733484150985136e-04 +-7.3430776110985322e-04 +-7.3208480507273616e-04 +-7.3062524861375040e-04 +-7.2990216814899434e-04 +-2.0445765601425554e-03 +-2.0486445240630027e-03 +-2.0570338645373104e-03 +-2.0702443933873064e-03 +-2.0889795230624487e-03 +-2.1140098190104411e-03 +-2.1458574888117603e-03 +-2.1842106443042044e-03 +-2.2270634223686258e-03 +-2.2698609465158399e-03 +-2.3053323659955435e-03 +-2.3247264239173011e-03 +-2.3203330692567526e-03 +-2.2880163208426965e-03 +-2.2283041397858326e-03 +-2.1456546128072736e-03 +-2.0466711415532165e-03 +-1.9383076547322420e-03 +-1.8266640381064056e-03 +-1.7164520481297986e-03 +-1.6109422866246166e-03 +-1.5121628261363259e-03 +-1.4211822346960471e-03 +-1.3383845167436912e-03 +-1.2636973352025168e-03 +-1.1967651843911502e-03 +-1.1370730031156197e-03 +-1.0840302508284094e-03 +-1.0370255826338342e-03 +-9.9546067319397570e-04 +-9.5876978183441746e-04 +-9.2642987439546444e-04 +-8.9796469298429734e-04 +-8.7294509665901399e-04 +-8.5098722780236019e-04 +-8.3174952184771967e-04 +-8.1492921049092237e-04 +-8.0025872132741249e-04 +-7.8750221321808060e-04 +-7.7645238004492171e-04 +-7.6692758729286000e-04 +-7.5876936321182266e-04 +-7.5184024050776684e-04 +-7.4602192967378851e-04 +-7.4121379738713788e-04 +-7.3733162023249831e-04 +-7.3430658380910371e-04 +-7.3208449886361278e-04 +-7.3062520894687233e-04 +-7.2990216765693341e-04 +-2.0242429277971684e-03 +-2.0282647985962986e-03 +-2.0365822362761626e-03 +-2.0497330128292960e-03 +-2.0684636448409580e-03 +-2.0935602695311066e-03 +-2.1254809014413113e-03 +-2.1637311113399762e-03 +-2.2060478474732964e-03 +-2.2477110559448424e-03 +-2.2815736624001797e-03 +-2.2993231215466254e-03 +-2.2937832886907980e-03 +-2.2611691524890786e-03 +-2.2020687619961721e-03 +-2.1207892552789847e-03 +-2.0237051472629117e-03 +-1.9175504974200393e-03 +-1.8082455549717860e-03 +-1.7003657634763179e-03 +-1.5970842743119940e-03 +-1.5003652860727901e-03 +-1.4112414879633554e-03 +-1.3300829466268789e-03 +-1.2568192241129417e-03 +-1.1911070434632816e-03 +-1.1324494360139255e-03 +-1.0802765249655880e-03 +-1.0339979802863586e-03 +-9.9303548310080932e-04 +-9.5684155969422624e-04 +-9.2490939682166474e-04 +-8.9677687107756203e-04 +-8.7202700203685391e-04 +-8.5028630793516880e-04 +-8.3122203348798360e-04 +-8.1453887143852449e-04 +-7.9997556515383700e-04 +-7.8730162412207132e-04 +-7.7631428247408357e-04 +-7.6683576522334281e-04 +-7.5871088570121615e-04 +-7.5180497253446844e-04 +-7.4600210990244755e-04 +-7.4120366711821393e-04 +-7.3732709030123868e-04 +-7.3430492854493590e-04 +-7.3208406840313258e-04 +-7.3062515319028093e-04 +-7.2990216696650480e-04 +-1.9821981056943770e-03 +-1.9861219990548297e-03 +-1.9942129753335864e-03 +-2.0069474247371311e-03 +-2.0249788605084308e-03 +-2.0489697757487295e-03 +-2.0792368756402599e-03 +-2.1151765119103282e-03 +-2.1545617592045301e-03 +-2.1930068738807008e-03 +-2.2240637703775340e-03 +-2.2403091483689753e-03 +-2.2352560611913577e-03 +-2.2052740609323214e-03 +-2.1505485047904347e-03 +-2.0746867256553445e-03 +-1.9833743175410139e-03 +-1.8828437675441497e-03 +-1.7787283893469172e-03 +-1.6754799064644227e-03 +-1.5762464951046002e-03 +-1.4830179921957642e-03 +-1.3968749384347630e-03 +-1.3182428392496499e-03 +-1.2471072607267123e-03 +-1.1831781792575678e-03 +-1.1260075596323589e-03 +-1.0750694490801850e-03 +-1.0298122467317010e-03 +-9.8969130056941919e-04 +-9.5418807507098146e-04 +-9.2282041523793440e-04 +-8.9514707506113992e-04 +-8.7076867398205805e-04 +-8.4932652996046751e-04 +-8.3050032135917329e-04 +-8.1400519116846173e-04 +-7.9958867910239731e-04 +-7.8702771547632113e-04 +-7.7612581115133090e-04 +-7.6671051332572219e-04 +-7.5863115595075617e-04 +-7.5175690821751478e-04 +-7.4597510957426119e-04 +-7.4118987158824413e-04 +-7.3732092326118384e-04 +-7.3430267563943670e-04 +-7.3208348263704905e-04 +-7.3062507732771231e-04 +-7.2990216602816847e-04 +-1.9091941148737168e-03 +-1.9129552660184861e-03 +-1.9206507464718317e-03 +-1.9326186990272227e-03 +-1.9493165056809853e-03 +-1.9711845249402232e-03 +-1.9983612217154070e-03 +-2.0302280723577073e-03 +-2.0648616094947740e-03 +-2.0986184636317216e-03 +-2.1261902828778514e-03 +-2.1413889724538897e-03 +-2.1385770025949750e-03 +-2.1142094829149118e-03 +-2.0677780023412476e-03 +-2.0017518016277368e-03 +-1.9206688506291062e-03 +-1.8298979496361209e-03 +-1.7345748559851500e-03 +-1.6389581769161773e-03 +-1.5461982327430672e-03 +-1.4583864075713444e-03 +-1.3767410682475392e-03 +-1.3018278420939581e-03 +-1.2337597592754187e-03 +-1.1723569197107267e-03 +-1.1172641065777065e-03 +-1.0680326972769929e-03 +-1.0241751841087389e-03 +-9.8519992396529335e-04 +-9.5063219346787678e-04 +-9.2002605294984460e-04 +-8.9297021291026406e-04 +-8.6909010271398065e-04 +-8.4804762478453465e-04 +-8.2953957664636175e-04 +-8.1329537996362763e-04 +-7.9907452383968169e-04 +-7.8666397471834147e-04 +-7.7587570279822270e-04 +-7.6654440794144795e-04 +-7.5852548498451741e-04 +-7.5169324126086567e-04 +-7.4593936269044716e-04 +-7.4117161543044575e-04 +-7.3731276540136279e-04 +-7.3429969643481661e-04 +-7.3208270822583074e-04 +-7.3062497705130198e-04 +-7.2990216478877393e-04 +-1.8021134848460302e-03 +-1.8056479692314302e-03 +-1.8128098619287077e-03 +-1.8237793670658152e-03 +-1.8387927363653156e-03 +-1.8580492689480861e-03 +-1.8815165179035338e-03 +-1.9086171047603909e-03 +-1.9378446150218585e-03 +-1.9664526437251115e-03 +-1.9904381962331159e-03 +-2.0050097360115437e-03 +-2.0055349272006698e-03 +-1.9886765903849640e-03 +-1.9532511929770484e-03 +-1.9004484155264883e-03 +-1.8333768955904033e-03 +-1.7562096798099884e-03 +-1.6733003674136685e-03 +-1.5885319700227629e-03 +-1.5049802555582241e-03 +-1.4248405326624503e-03 +-1.3495167590440347e-03 +-1.2797806609723635e-03 +-1.2159399215253624e-03 +-1.1579847474894726e-03 +-1.1057026572973514e-03 +-1.0587622987384359e-03 +-1.0167715566039022e-03 +-9.7931610553282211e-04 +-9.4598389110645258e-04 +-9.1637987201696985e-04 +-8.9013422663189532e-04 +-8.6690629600177265e-04 +-8.4638583018717005e-04 +-8.2829259607703897e-04 +-8.1237504869156830e-04 +-7.9840852339512446e-04 +-7.8619324080091721e-04 +-7.7555230517741924e-04 +-7.6632980359187669e-04 +-7.5838906484011802e-04 +-7.5161110618746367e-04 +-7.4589327648688999e-04 +-7.4114809257219293e-04 +-7.3730225937767473e-04 +-7.3429586129544321e-04 +-7.3208171164603094e-04 +-7.3062484803563632e-04 +-7.2990216319505669e-04 +-1.6665399750108443e-03 +-1.6697986820314293e-03 +-1.6763433627307359e-03 +-1.6862251204931807e-03 +-1.6995002327453489e-03 +-1.7161746818388406e-03 +-1.7360873125953889e-03 +-1.7587190957767810e-03 +-1.7829510391189378e-03 +-1.8068488833098818e-03 +-1.8276037736151768e-03 +-1.8417577090244850e-03 +-1.8457520142177329e-03 +-1.8366753588703467e-03 +-1.8129494026540602e-03 +-1.7746836941970434e-03 +-1.7235785470917546e-03 +-1.6624586447547332e-03 +-1.5946506139984029e-03 +-1.5234183548485044e-03 +-1.4515805617216497e-03 +-1.3813320683854768e-03 +-1.3142248683424055e-03 +-1.2512442190780106e-03 +-1.1929241405140537e-03 +-1.1394659207866835e-03 +-1.0908411466104249e-03 +-1.0468730287019994e-03 +-1.0072965267831223e-03 +-9.7180065152223513e-04 +-9.4005699467955399e-04 +-9.1173818299449916e-04 +-8.8652924169087667e-04 +-8.6413412070622108e-04 +-8.4427901191455948e-04 +-8.2671359972735965e-04 +-8.1121102904488070e-04 +-7.9756711870543969e-04 +-7.8559916990821250e-04 +-7.7514459621035579e-04 +-7.6605951822468965e-04 +-7.5821741009585641e-04 +-7.5150784771081636e-04 +-7.4583538447197967e-04 +-7.4111856523351378e-04 +-7.3728907984458626e-04 +-7.3429105272128663e-04 +-7.3208046261930514e-04 +-7.3062468638348231e-04 +-7.2990216119904179e-04 +-1.5143495667285754e-03 +-1.5173065179507380e-03 +-1.5232061128462027e-03 +-1.5320177818012933e-03 +-1.5436845164075691e-03 +-1.5580929076721870e-03 +-1.5750097844055512e-03 +-1.5939770713147834e-03 +-1.6141732978116423e-03 +-1.6342786841379675e-03 +-1.6524109225641277e-03 +-1.6662089808959699e-03 +-1.6731095425033466e-03 +-1.6707828974737026e-03 +-1.6576068192339093e-03 +-1.6330152775808745e-03 +-1.5975994651018137e-03 +-1.5529414657009964e-03 +-1.5012635442916372e-03 +-1.4450237288416985e-03 +-1.3865708234380766e-03 +-1.3279178773508427e-03 +-1.2706391138750479e-03 +-1.2158624316165050e-03 +-1.1643198024125919e-03 +-1.1164229390688749e-03 +-1.0723421899156494e-03 +-1.0320767506182551e-03 +-9.9551157365194791e-04 +-9.6246064889019662e-04 +-9.3269837502752068e-04 +-9.0598140480300095e-04 +-8.8206329232942769e-04 +-8.6070391764527269e-04 +-8.4167523918646247e-04 +-8.2476453396280612e-04 +-8.0977596457839913e-04 +-7.9653106559112569e-04 +-7.8486855939062397e-04 +-7.7464378054160942e-04 +-7.6572789485425017e-04 +-7.5800703496810957e-04 +-7.5138143001061779e-04 +-7.4576457702467717e-04 +-7.4108248209788516e-04 +-7.3727298642479533e-04 +-7.3428518474336014e-04 +-7.3207893916451433e-04 +-7.3062448928096473e-04 +-7.2990215876621496e-04 +-1.3589553616955991e-03 +-1.3616086297713603e-03 +-1.3668807800307577e-03 +-1.3747019350747803e-03 +-1.3849614514648428e-03 +-1.3974927744185386e-03 +-1.4120414963480050e-03 +-1.4282116884946467e-03 +-1.4453928748949601e-03 +-1.4626832773441047e-03 +-1.4788408389969259e-03 +-1.4923032396500654e-03 +-1.5013101804161402e-03 +-1.5041297811662589e-03 +-1.4993448537502379e-03 +-1.4861178146158196e-03 +-1.4643496309950789e-03 +-1.4346845187515435e-03 +-1.3983690397677501e-03 +-1.3570211980808101e-03 +-1.3123816255947523e-03 +-1.2661052680976235e-03 +-1.2196231445212749e-03 +-1.1740762522211834e-03 +-1.1303066562964332e-03 +-1.0888851079094959e-03 +-1.0501565046491560e-03 +-1.0142897606073135e-03 +-9.8132413319616113e-04 +-9.5120832009169495e-04 +-9.2383139427916873e-04 +-8.9904614103371110e-04 +-8.7668600001387671e-04 +-8.5657695457536044e-04 +-8.3854560020429913e-04 +-8.2242441765402647e-04 +-8.0805505577742946e-04 +-7.9529023152969845e-04 +-7.8399469277050317e-04 +-7.7404556370875579e-04 +-7.6533229841402751e-04 +-7.5775639868722576e-04 +-7.5123100294386595e-04 +-7.4568041772954678e-04 +-7.4103963919477499e-04 +-7.3725389535105761e-04 +-7.3427822901318308e-04 +-7.3207713436470668e-04 +-7.3062425587246160e-04 +-7.2990215588625220e-04 +-1.2115488581885864e-03 +-1.2139160973130092e-03 +-1.2186104492437747e-03 +-1.2255510108915063e-03 +-1.2346133987171811e-03 +-1.2456223606473736e-03 +-1.2583364241661428e-03 +-1.2724219867832514e-03 +-1.2874172115184706e-03 +-1.3026918249186272e-03 +-1.3174164987255817e-03 +-1.3305617380273255e-03 +-1.3409461252556405e-03 +-1.3473432662904766e-03 +-1.3486365601570571e-03 +-1.3439886665268098e-03 +-1.3329800739787798e-03 +-1.3156769261851381e-03 +-1.2926108170787686e-03 +-1.2646816263584830e-03 +-1.2330153442373297e-03 +-1.1988147961918176e-03 +-1.1632335296107067e-03 +-1.1272887695884448e-03 +-1.0918155358759232e-03 +-1.0574549151171695e-03 +-1.0246657903160931e-03 +-9.9374961774343165e-04 +-9.6488015204942101e-04 +-9.3813281058617950e-04 +-9.1351077708556590e-04 +-8.9096667029019117e-04 +-8.7041966756518021e-04 +-8.5176853162954847e-04 +-8.3490121263025561e-04 +-8.1970172809941945e-04 +-8.0605495681528472e-04 +-7.9384987868239530e-04 +-7.8298168403961540e-04 +-7.7335307780727653e-04 +-7.6487502225591330e-04 +-7.5746709745800592e-04 +-7.5105760888532829e-04 +-7.4558353456649997e-04 +-7.4099037712888223e-04 +-7.3723196661888560e-04 +-7.3427024633519375e-04 +-7.3207506450442350e-04 +-7.3062398830909181e-04 +-7.2990215258599217e-04 +-1.0795736327458231e-03 +-1.0816854960435621e-03 +-1.0858709696705230e-03 +-1.0920531400082510e-03 +-1.1001150096856774e-03 +-1.1098959121394140e-03 +-1.1211843060573415e-03 +-1.1337057112945218e-03 +-1.1471056947736406e-03 +-1.1609301748215135e-03 +-1.1746086881206006e-03 +-1.1874495984990402e-03 +-1.1986575832037146e-03 +-1.2073810087741910e-03 +-1.2127891771066984e-03 +-1.2141686816813286e-03 +-1.2110186666192421e-03 +-1.2031215715119599e-03 +-1.1905713788137383e-03 +-1.1737535027415301e-03 +-1.1532839651955354e-03 +-1.1299248949085121e-03 +-1.1044958846737178e-03 +-1.0777970948523722e-03 +-1.0505531560708813e-03 +-1.0233800509763123e-03 +-9.9677222866397918e-04 +-9.7110476825716283e-04 +-9.4664501164107794e-04 +-9.2356891146360006e-04 +-9.0197864231461426e-04 +-8.8191930773326790e-04 +-8.6339360587278690e-04 +-8.4637403334257295e-04 +-8.3081264581384544e-04 +-8.1664862533472227e-04 +-8.0381399795422621e-04 +-7.9223785716967942e-04 +-7.8184941809109586e-04 +-7.7258017889291039e-04 +-7.6436541437945287e-04 +-7.5714517863823927e-04 +-7.5086495285936429e-04 +-7.4547604115305342e-04 +-7.4093579110371386e-04 +-7.3720769585578969e-04 +-7.3426141961667869e-04 +-7.3207277751387875e-04 +-7.3062369283135805e-04 +-7.2990214894264125e-04 +-9.6691628577700933e-04 +-9.6881025757340387e-04 +-9.7256485366468992e-04 +-9.7811310690938485e-04 +-9.8535363733233817e-04 +-9.9414886609541201e-04 +-1.0043216293580761e-03 +-1.0156496545744673e-03 +-1.0278577993804387e-03 +-1.0406088975562979e-03 +-1.0534954921083643e-03 +-1.0660363386515933e-03 +-1.0776826332266570e-03 +-1.0878385432756747e-03 +-1.0958981253652903e-03 +-1.1012962536306611e-03 +-1.1035660608022921e-03 +-1.1023917069149236e-03 +-1.0976449144289749e-03 +-1.0893971798887211e-03 +-1.0779056683158526e-03 +-1.0635771543615698e-03 +-1.0469187394426894e-03 +-1.0284853408281133e-03 +-1.0088324120321008e-03 +-9.8847921912865642e-04 +-9.6788462290101150e-04 +-9.4743465721481169e-04 +-9.2743962761416242e-04 +-9.0813790196706565e-04 +-8.8970372020668004e-04 +-8.7225687364831945e-04 +-8.5587273216744043e-04 +-8.4059167066053700e-04 +-8.2642739482252376e-04 +-8.1337397896191614e-04 +-8.0141162397368395e-04 +-7.9051125066121502e-04 +-7.8063809063174359e-04 +-7.7175444691539785e-04 +-7.6382178583779211e-04 +-7.5680230146547606e-04 +-7.5066007080848885e-04 +-7.4536189559447016e-04 +-7.4087790659983202e-04 +-7.3718198985729265e-04 +-7.3425208055039970e-04 +-7.3207035972289473e-04 +-7.3062338062763804e-04 +-7.2990214509435249e-04 +-8.7486155506293246e-04 +-8.7657739020916556e-04 +-8.7998109596438016e-04 +-8.8501655202599758e-04 +-8.9159900536671648e-04 +-8.9961412805969249e-04 +-9.0891637808109612e-04 +-9.1932645713642684e-04 +-9.3062782877821072e-04 +-9.4256263542847859e-04 +-9.5482794935665698e-04 +-9.6707401834073817e-04 +-9.7890678175570995e-04 +-9.8989707447876105e-04 +-9.9959824816825242e-04 +-1.0075722868963413e-03 +-1.0134221566625874e-03 +-1.0168258223710925e-03 +-1.0175660011381134e-03 +-1.0155499706990790e-03 +-1.0108156781199666e-03 +-1.0035233743497017e-03 +-9.9393501779709414e-04 +-9.8238581002285988e-04 +-9.6925297291365739e-04 +-9.5492632955331545e-04 +-9.3978387838196636e-04 +-9.2417392872195419e-04 +-9.0840395209830906e-04 +-8.9273533515549165e-04 +-8.7738273054621446e-04 +-8.6251659908685545e-04 +-8.4826768057271493e-04 +-8.3473239248176511e-04 +-8.2197844153262254e-04 +-8.1005018807467041e-04 +-7.9897350424657030e-04 +-7.8876001064872485e-04 +-7.7941067038697967e-04 +-7.7091877504262296e-04 +-7.6327238563263580e-04 +-7.5645630234290795e-04 +-7.5045363681436219e-04 +-7.4524705494927342e-04 +-7.4081974976705225e-04 +-7.3715619469116953e-04 +-7.3424271885348831e-04 +-7.3206793805539170e-04 +-7.3062306809992524e-04 +-7.2990214124332481e-04 +-8.0313905358653335e-04 +-8.0471600509898647e-04 +-8.0784661703369657e-04 +-8.1248416679740806e-04 +-8.1855818856487849e-04 +-8.2597393167454082e-04 +-8.3461151476268351e-04 +-8.4432471477542247e-04 +-8.5493939893503451e-04 +-8.6625175947602760e-04 +-8.7802675851901513e-04 +-8.8999751035013066e-04 +-9.0186664115711262e-04 +-9.1331083525606751e-04 +-9.2398964111508285e-04 +-9.3355905505733557e-04 +-9.4168944090851326e-04 +-9.4808617752010756e-04 +-9.5251040247047898e-04 +-9.5479671768976585e-04 +-9.5486498101939933e-04 +-9.5272430510385424e-04 +-9.4846883430279108e-04 +-9.4226633957490344e-04 +-9.3434176225104006e-04 +-9.2495832760313334e-04 +-9.1439873579268901e-04 +-9.0294838813154317e-04 +-8.9088185743926851e-04 +-8.7845307669234265e-04 +-8.6588913863386687e-04 +-8.5338722451543537e-04 +-8.4111400190191082e-04 +-8.2920680356674871e-04 +-8.1777596658742975e-04 +-8.0690782420431693e-04 +-7.9666796777281819e-04 +-7.8710451111095494e-04 +-7.7825118474104081e-04 +-7.7013016042369706e-04 +-7.6275455866357898e-04 +-7.5613062707373510e-04 +-7.5025959956721627e-04 +-7.4513925889476296e-04 +-7.4076523100434651e-04 +-7.3713204129246136e-04 +-7.3423396166414777e-04 +-7.3206567452470091e-04 +-7.3062277613784551e-04 +-7.2990213764681988e-04 +-7.5076448270108322e-04 +-7.5224000725324905e-04 +-7.5517130032932576e-04 +-7.5951874152552505e-04 +-7.6522262343915650e-04 +-7.7220280383309822e-04 +-7.8035822066294038e-04 +-7.8956626786876722e-04 +-7.9968206105643640e-04 +-8.1053768677900146e-04 +-8.2194163488387645e-04 +-8.3367875564692450e-04 +-8.4551123651505728e-04 +-8.5718120680641373e-04 +-8.6841558447242682e-04 +-8.7893361226693098e-04 +-8.8845716203368784e-04 +-8.9672335129785516e-04 +-9.0349842718982169e-04 +-9.0859139204742885e-04 +-9.1186563331225744e-04 +-9.1324697141236997e-04 +-9.1272703793674273e-04 +-9.1036161973971543e-04 +-9.0626436781348339e-04 +-9.0059689271259637e-04 +-8.9355663250999782e-04 +-8.8536395305603179e-04 +-8.7624976914159704e-04 +-8.6644464946254577e-04 +-8.5616998692202972e-04 +-8.4563145901867442e-04 +-8.3501472001649296e-04 +-8.2448307580404315e-04 +-8.1417678954668162e-04 +-8.0421363426950629e-04 +-7.9469032586396062e-04 +-7.8568451645586119e-04 +-7.7725708748048201e-04 +-7.6945454292192338e-04 +-7.6231135912050297e-04 +-7.5585219488579186e-04 +-7.5009390327935243e-04 +-7.4504731470298121e-04 +-7.4071878096392061e-04 +-7.3711148320198692e-04 +-7.3422651439293855e-04 +-7.3206375087919999e-04 +-7.3062252813218837e-04 +-7.2990213459255926e-04 +-7.1661627771692216e-04 +-7.1802578472136109e-04 +-7.2082736038203438e-04 +-7.2498603836067851e-04 +-7.3044914831410491e-04 +-7.3714606014174937e-04 +-7.4498785966980324e-04 +-7.5386697541380155e-04 +-7.6365679303892677e-04 +-7.7421132519021939e-04 +-7.8536505395965434e-04 +-7.9693313143854277e-04 +-8.0871220238937062e-04 +-8.2048218295064019e-04 +-8.3200936105324870e-04 +-8.4305114406264228e-04 +-8.5336264022241998e-04 +-8.6270501705778201e-04 +-8.7085525866197847e-04 +-8.7761660540868088e-04 +-8.8282868674587674e-04 +-8.8637623098586273e-04 +-8.8819530640508874e-04 +-8.8827631691412333e-04 +-8.8666339165957195e-04 +-8.8345028229031626e-04 +-8.7877331526313787e-04 +-8.7280225878840834e-04 +-8.6573011157526790e-04 +-8.5776280251201353e-04 +-8.4910964009167304e-04 +-8.3997511975203410e-04 +-8.3055244072323311e-04 +-8.2101884604172763e-04 +-8.1153270875761912e-04 +-8.0223215628641323e-04 +-7.9323495239047191e-04 +-7.8463933303921671e-04 +-7.7652550519273034e-04 +-7.6895755291765276e-04 +-7.6198554161273011e-04 +-7.5564765980286081e-04 +-7.4997228321745969e-04 +-7.4497988450770286e-04 +-7.4068474270805372e-04 +-7.3709642942559840e-04 +-7.3422106452313842e-04 +-7.3206234386985741e-04 +-7.3062234679673553e-04 +-7.2990213235980697e-04 +-6.9978944951417038e-04 +-7.0116671051601248e-04 +-7.0390493389868060e-04 +-7.0797144063124899e-04 +-7.1331701388123306e-04 +-7.1987567824981062e-04 +-7.2756443418971238e-04 +-7.3628297418099325e-04 +-7.4591341947913184e-04 +-7.5632013597079777e-04 +-7.6734971785773470e-04 +-7.7883126953733420e-04 +-7.9057716605814628e-04 +-8.0238452178508222e-04 +-8.1403762958800530e-04 +-8.2531162809862944e-04 +-8.3597759120253409e-04 +-8.4580909807744037e-04 +-8.5459013572849692e-04 +-8.6212393316330597e-04 +-8.6824207337415915e-04 +-8.7281303631785503e-04 +-8.7574925111442894e-04 +-8.7701181557615069e-04 +-8.7661227685206257e-04 +-8.7461121951695243e-04 +-8.7111380750962500e-04 +-8.6626279385750645e-04 +-8.6022977875084875e-04 +-8.5320562271180280e-04 +-8.4539090304865865e-04 +-8.3698716477631800e-04 +-8.2818950638173917e-04 +-8.1918080502491411e-04 +-8.1012766632169303e-04 +-8.0117800812155437e-04 +-7.9246006782487716e-04 +-7.8408255826944756e-04 +-7.7613567922300971e-04 +-7.6869270735925577e-04 +-7.6181192422673934e-04 +-7.5553868796372217e-04 +-7.4990750202341423e-04 +-7.4494397754467474e-04 +-7.4066662233581489e-04 +-7.3708841770444330e-04 +-7.3421816477466735e-04 +-7.3206159538144846e-04 +-7.3062225034498151e-04 +-7.2990213117229638e-04 +-6.9978953343288839e-04 +-7.0116746674280428e-04 +-7.0390703938731647e-04 +-7.0797557938731006e-04 +-7.1332387491455929e-04 +-7.1988594695835209e-04 +-7.2757877532260819e-04 +-7.3630200507145485e-04 +-7.4593767317575224e-04 +-7.5635001530131461e-04 +-7.6738544330758290e-04 +-7.7887282594273478e-04 +-7.9062425514561370e-04 +-8.0243652901851878e-04 +-8.1409361402074419e-04 +-8.2537034247373835e-04 +-8.3603753620266764e-04 +-8.4586860967407181e-04 +-8.5464749883414461e-04 +-8.6217750947574360e-04 +-8.6829042774680669e-04 +-8.7285504521802634e-04 +-8.7578417910174906e-04 +-8.7703935079211522e-04 +-8.7663252310726575e-04 +-8.7462464920084625e-04 +-8.7112118483840303e-04 +-8.6626508100458516e-04 +-8.6022803791055110e-04 +-8.5320092547670756e-04 +-8.4538425537816796e-04 +-8.3697945216821537e-04 +-8.2818146039239661e-04 +-8.1917298953304010e-04 +-8.1012048012796484e-04 +-8.0117169961474747e-04 +-7.9245475735872429e-04 +-7.8407826434665341e-04 +-7.7613234533448878e-04 +-7.6869022717895939e-04 +-7.6181016367479412e-04 +-7.5553750334054039e-04 +-7.4990675395029710e-04 +-7.4494354082133170e-04 +-7.4066639206163659e-04 +-7.3708831213729355e-04 +-7.3421812544947993e-04 +-7.3206158500968956e-04 +-7.3062224898912695e-04 +-7.2990213115549547e-04 +-7.1661654258936352e-04 +-7.1802817159276756e-04 +-7.2083400580037987e-04 +-7.2499910051276178e-04 +-7.3047079928680524e-04 +-7.3717845633659352e-04 +-7.4503308428501428e-04 +-7.5392694883241696e-04 +-7.6373315027752908e-04 +-7.7430526450087453e-04 +-7.8547716710167150e-04 +-7.9706323335306450e-04 +-8.0885918467128162e-04 +-8.2064391972341269e-04 +-8.3218269555541372e-04 +-8.4323197788132003e-04 +-8.5354613433889543e-04 +-8.6288589619315070e-04 +-8.7102819116546858e-04 +-8.7777661462044962e-04 +-8.8297154076768874e-04 +-8.8649875889714163e-04 +-8.8829560033248283e-04 +-8.8835379839073149e-04 +-8.8671874284217871e-04 +-8.8348526280238428e-04 +-8.7879049967094119e-04 +-8.7280473596013596e-04 +-8.6572118557355995e-04 +-8.5774572709028895e-04 +-8.4908740801224714e-04 +-8.3995031671193435e-04 +-8.3052716372902639e-04 +-8.2099467879780097e-04 +-8.1151074235520974e-04 +-8.0221304190776922e-04 +-7.9321897322914999e-04 +-7.8462648443607835e-04 +-7.7651557441780789e-04 +-7.6895019256751176e-04 +-7.6198033289814004e-04 +-7.5564416389114185e-04 +-7.4997008021018992e-04 +-7.4497860060179885e-04 +-7.4068406667625298e-04 +-7.3709611984888138e-04 +-7.3422094930065550e-04 +-7.3206231349978008e-04 +-7.3062234282819758e-04 +-7.2990213231060338e-04 +-7.5076497006220256e-04 +-7.5224439903550885e-04 +-7.5518352729271739e-04 +-7.5954277190945995e-04 +-7.6526244390980362e-04 +-7.7226235604434929e-04 +-7.8044128137121657e-04 +-7.8967626493785974e-04 +-7.9982182521719854e-04 +-8.1070915008356955e-04 +-8.2214550088470463e-04 +-8.3391418152620818e-04 +-8.4577558025847256e-04 +-8.5746989854009641e-04 +-8.6872217583419177e-04 +-8.7925003856873071e-04 +-8.8877421998070081e-04 +-8.9703135559566366e-04 +-9.0378797160167040e-04 +-9.0885411459560000e-04 +-9.1209487921125958e-04 +-9.1343826346421705e-04 +-9.1287829855068265e-04 +-9.1047313244286361e-04 +-9.0633850821986237e-04 +-9.0063769023986801e-04 +-8.9356923966214721e-04 +-8.8535409861024202e-04 +-8.7622325864858484e-04 +-8.6640695653272533e-04 +-8.5612595725980734e-04 +-8.4558513022516468e-04 +-8.3496924614446762e-04 +-8.2444073717517113e-04 +-8.1413906488226489e-04 +-8.0418131254932361e-04 +-7.9466363814739780e-04 +-7.8566327194631044e-04 +-7.7724080244844721e-04 +-7.6944255510716071e-04 +-7.6230292357576141e-04 +-7.5584655978619040e-04 +-7.5009036602605671e-04 +-7.4504525980131399e-04 +-7.4071770179179677e-04 +-7.3711099004559381e-04 +-7.3422633114035205e-04 +-7.3206370263531107e-04 +-7.3062252183298481e-04 +-7.2990213451451221e-04 +-8.0313983995316412e-04 +-8.0472309126720497e-04 +-8.0786634421505465e-04 +-8.1252293078229823e-04 +-8.1862239684540265e-04 +-8.2606987845126054e-04 +-8.3474515238911274e-04 +-8.4450130968902908e-04 +-8.5516307622924474e-04 +-8.6652496351902588e-04 +-8.7834968560367057e-04 +-8.9036759818707050e-04 +-9.0227822077987535e-04 +-9.1375505365575121e-04 +-9.2445473951039575e-04 +-9.3403103610310975e-04 +-9.4215308575386163e-04 +-9.4852629727601163e-04 +-9.5291315007662420e-04 +-9.5515076418783518e-04 +-9.5516238299491883e-04 +-9.5296095139624768e-04 +-9.4864444195942382e-04 +-9.4238404871753608e-04 +-9.3440743794694883e-04 +-9.2497970416339712e-04 +-9.1438453569476239e-04 +-9.0290752211762192e-04 +-8.9082277552836656e-04 +-8.7838330221093363e-04 +-8.6581498602188059e-04 +-8.5331367992159122e-04 +-8.4104473367230606e-04 +-8.2914426597820352e-04 +-8.1772156213818364e-04 +-8.0686209504000125e-04 +-7.9663079345064708e-04 +-7.8707529654536642e-04 +-7.7822902804115595e-04 +-7.7011399506971034e-04 +-7.6274326800956579e-04 +-7.5612313161305827e-04 +-7.5025491893956735e-04 +-7.4513655145923828e-04 +-7.4076381414765096e-04 +-7.3713139565433690e-04 +-7.3423372227926422e-04 +-7.3206561160540971e-04 +-7.3062276793125266e-04 +-7.2990213754517267e-04 +-8.7486276260574343e-04 +-8.7658827158619719e-04 +-8.8001138623762130e-04 +-8.8507605728278902e-04 +-8.9169751059914467e-04 +-8.9976115641157066e-04 +-9.0912076480975223e-04 +-9.1959572217946374e-04 +-9.3096736619206180e-04 +-9.4297478630794287e-04 +-9.5531108138182416e-04 +-9.6762178646248801e-04 +-9.7950777094600139e-04 +-9.9053500633209507e-04 +-1.0002528565288369e-03 +-1.0082208401788020e-03 +-1.0140414552551270e-03 +-1.0173943734378733e-03 +-1.0180660141653063e-03 +-1.0159688484404213e-03 +-1.0111467902534207e-03 +-1.0037660578227441e-03 +-9.9409389955805081e-04 +-9.8246965421705632e-04 +-9.6927329704745227e-04 +-9.5489601723510614e-04 +-9.3971596004509619e-04 +-9.2408063052134876e-04 +-9.0829604682192682e-04 +-8.9262177899113648e-04 +-8.7727053926924523e-04 +-8.6241090449542038e-04 +-8.4817190799198704e-04 +-8.3464850773305743e-04 +-8.2190722667162947e-04 +-8.0999151653374116e-04 +-7.9892659610546072e-04 +-7.8872365688593016e-04 +-7.7938342101436641e-04 +-7.7089909021276219e-04 +-7.6325875148017188e-04 +-7.5644731484834546e-04 +-7.5044805769251799e-04 +-7.4524384373623369e-04 +-7.4081807611659487e-04 +-7.3715543454632424e-04 +-7.3424243773827214e-04 +-7.3206786430844142e-04 +-7.3062305849320595e-04 +-7.2990214112442654e-04 +-9.6691809554777129e-04 +-9.6882656547613933e-04 +-9.7261024483818602e-04 +-9.7820224719628369e-04 +-9.8550108242089580e-04 +-9.9436860316729284e-04 +-1.0046262904150726e-03 +-1.0160493853902011e-03 +-1.0283588415946976e-03 +-1.0412120412931426e-03 +-1.0541946653595826e-03 +-1.0668176830103114e-03 +-1.0785244280304685e-03 +-1.0887122435032314e-03 +-1.0967705662278146e-03 +-1.1021327902780173e-03 +-1.1043341439622863e-03 +-1.1030642455678939e-03 +-1.0982028090596035e-03 +-1.0898306170970546e-03 +-1.0782140727940185e-03 +-1.0637679897092791e-03 +-1.0470055465567826e-03 +-1.0284854651487589e-03 +-1.0087648158501412e-03 +-9.8836265129419111e-04 +-9.6773627860989380e-04 +-9.4726934320515054e-04 +-9.2726937039063200e-04 +-9.0797189886353009e-04 +-8.8954852599380547e-04 +-8.7211672713699985e-04 +-8.5574994754629235e-04 +-8.4048704001881292e-04 +-8.2634056748241214e-04 +-8.1330379827989989e-04 +-8.0135641303607878e-04 +-7.9046904539030634e-04 +-7.8060682307714885e-04 +-7.7173208374904916e-04 +-7.6380642797964251e-04 +-7.5679225085251937e-04 +-7.5065386994145307e-04 +-7.4535834489305921e-04 +-7.4087606391854788e-04 +-7.3718115584882153e-04 +-7.3425177296164619e-04 +-7.3207027919458502e-04 +-7.3062337015165435e-04 +-7.2990214496477450e-04 +-1.0795762955715757e-03 +-1.0817094903622750e-03 +-1.0859377458488681e-03 +-1.0921842176957828e-03 +-1.1003315958434785e-03 +-1.1102180411194538e-03 +-1.1216294048265682e-03 +-1.1342865903341927e-03 +-1.1478281215383539e-03 +-1.1617903891102275e-03 +-1.1755914181819239e-03 +-1.1885272473855504e-03 +-1.1997911797908790e-03 +-1.2085232013149614e-03 +-1.2138890320081909e-03 +-1.2151774960945099e-03 +-1.2118956330879232e-03 +-1.2038381195402690e-03 +-1.1911133828902010e-03 +-1.1741211398885506e-03 +-1.1534895905968674e-03 +-1.1299896820974045e-03 +-1.1044460697651527e-03 +-1.0776605203845252e-03 +-1.0503565448514809e-03 +-1.0231471687627842e-03 +-9.9652288899338207e-04 +-9.7085451639031641e-04 +-9.4640528594357089e-04 +-9.2334749345618025e-04 +-9.0178024493207075e-04 +-8.8174619590350261e-04 +-8.6324618344583960e-04 +-8.4625136121428311e-04 +-8.3071287736016352e-04 +-8.1656935849886878e-04 +-8.0375255059577354e-04 +-7.9219147555102589e-04 +-7.8181542919254462e-04 +-7.7255609671232346e-04 +-7.6434900920251299e-04 +-7.5713451689102458e-04 +-7.5085841381186908e-04 +-7.4547231554315124e-04 +-7.4093386573639733e-04 +-7.3720682740401457e-04 +-7.3426110019104995e-04 +-7.3207269405520746e-04 +-7.3062368198874164e-04 +-7.2990214880862075e-04 +-1.2115526917656078e-03 +-1.2139506401887359e-03 +-1.2187065649686998e-03 +-1.2257395714966178e-03 +-1.2349245488297335e-03 +-1.2460839414856360e-03 +-1.2589714131270200e-03 +-1.2732450169841601e-03 +-1.2884305604829956e-03 +-1.3038816567677129e-03 +-1.3187504786672027e-03 +-1.3319892112755403e-03 +-1.3424016811569974e-03 +-1.3487536644419870e-03 +-1.3499299110508391e-03 +-1.3451038832183956e-03 +-1.3338743828523671e-03 +-1.3163297967431484e-03 +-1.2930237919867480e-03 +-1.2648746986288959e-03 +-1.2330212807355344e-03 +-1.1986729630620880e-03 +-1.1629844481017869e-03 +-1.1269700839474579e-03 +-1.0914595553317241e-03 +-1.0570875368023081e-03 +-1.0243064438090466e-03 +-9.9341185123726430e-04 +-9.6457254170533751e-04 +-9.3785996523949974e-04 +-9.1327429714465041e-04 +-8.9076598760856878e-04 +-8.7025273940323164e-04 +-8.5163238963844603e-04 +-8.3479238207829706e-04 +-8.1961653807635323e-04 +-8.0598976259140366e-04 +-7.9380121529863397e-04 +-7.8294636712901986e-04 +-7.7332826447039447e-04 +-7.6485824195702266e-04 +-7.5745626053326986e-04 +-7.5105099837196709e-04 +-7.4557978562047483e-04 +-7.4098844721998472e-04 +-7.3723109889786893e-04 +-7.3426992798790263e-04 +-7.3207498148544347e-04 +-7.3062397753727846e-04 +-7.2990215245292793e-04 +-1.3589607127443932e-03 +-1.3616568443993557e-03 +-1.3670149073432476e-03 +-1.3749648751974117e-03 +-1.3853946020702750e-03 +-1.3981332443686080e-03 +-1.4129176951337898e-03 +-1.4293375316985959e-03 +-1.4467614928537311e-03 +-1.4642618387859529e-03 +-1.4805685799692632e-03 +-1.4940945935512022e-03 +-1.5030637596682819e-03 +-1.5057420529414980e-03 +-1.5007254416671239e-03 +-1.4872024449710697e-03 +-1.4651074151172299e-03 +-1.4351182395757607e-03 +-1.3985093946662121e-03 +-1.3569174993280030e-03 +-1.3120917997321469e-03 +-1.2656873375762499e-03 +-1.2191292932515504e-03 +-1.1735495981382358e-03 +-1.1297802440201293e-03 +-1.0883824071754361e-03 +-1.0496927370331230e-03 +-1.0138735389441649e-03 +-9.8095908311778110e-04 +-9.5089450800700775e-04 +-9.2356649429026823e-04 +-8.9882633823128719e-04 +-8.7650666033788267e-04 +-8.5643310343738526e-04 +-8.3843225240799258e-04 +-8.2233679594752686e-04 +-8.0798872830229742e-04 +-7.9524119144368602e-04 +-7.8395939728568035e-04 +-7.7402094496090222e-04 +-7.6531575491603358e-04 +-7.5774577344283375e-04 +-7.5122455240069484e-04 +-7.4567677443796809e-04 +-7.4103777014916737e-04 +-7.3725305739418467e-04 +-7.3427792228612505e-04 +-7.3207705451302282e-04 +-7.3062424552350314e-04 +-7.2990215575849610e-04 +-1.5143567098121814e-03 +-1.5173708767203102e-03 +-1.5233851011606638e-03 +-1.5323683477496629e-03 +-1.5442607966954004e-03 +-1.5589415518853689e-03 +-1.5761627447065901e-03 +-1.5954424960748393e-03 +-1.6159263753071482e-03 +-1.6362554954961752e-03 +-1.6545088577443090e-03 +-1.6682962452453903e-03 +-1.6750434924429117e-03 +-1.6724332984418360e-03 +-1.6588775086592545e-03 +-1.6338578453502701e-03 +-1.5980155836261183e-03 +-1.5529747535215381e-03 +-1.5009850788560851e-03 +-1.4445162486683664e-03 +-1.3859155230835254e-03 +-1.3271856634533695e-03 +-1.2698863739957949e-03 +-1.2151303090450498e-03 +-1.1636356592069123e-03 +-1.1158028519391936e-03 +-1.0717936714210990e-03 +-1.0316012333697520e-03 +-9.9510645573381283e-04 +-9.6212086196447713e-04 +-9.3241752164274793e-04 +-9.0575254465517915e-04 +-8.8187946105622588e-04 +-8.6055845165577938e-04 +-8.4156196527124683e-04 +-8.2467786778102467e-04 +-8.0971094962910652e-04 +-7.9648337449517951e-04 +-7.8483447207268367e-04 +-7.7462014877138167e-04 +-7.6571209909735444e-04 +-7.5799693717575013e-04 +-7.5137532449266286e-04 +-7.4576114063537569e-04 +-7.4108072442136499e-04 +-7.3727220033924495e-04 +-7.3428489757121796e-04 +-7.3207886451488713e-04 +-7.3062447961586203e-04 +-7.2990215864694795e-04 +-1.6665489319237679e-03 +-1.6698793792254570e-03 +-1.6765677130926282e-03 +-1.6866640440169802e-03 +-1.7002198940496063e-03 +-1.7172291893230516e-03 +-1.7375077538844378e-03 +-1.7605002988155673e-03 +-1.7850395102932634e-03 +-1.8091371750403702e-03 +-1.8299366403207997e-03 +-1.8439525354919013e-03 +-1.8476303825064274e-03 +-1.8380968400319442e-03 +-1.8138364520496714e-03 +-1.7750298565427987e-03 +-1.7234392423742329e-03 +-1.6619303351236383e-03 +-1.5938468048713969e-03 +-1.5224493911063328e-03 +-1.4505406177323459e-03 +-1.3802934142697365e-03 +-1.3132376024962466e-03 +-1.2503391830886400e-03 +-1.1921171123451800e-03 +-1.1387618464650034e-03 +-1.0902377760975276e-03 +-1.0463637422993288e-03 +-1.0068723763224235e-03 +-9.7145174589520153e-04 +-9.3977338539163416e-04 +-9.1151039233180195e-04 +-8.8634854839761163e-04 +-8.6399268874338031e-04 +-8.4416992252910441e-04 +-8.2663082732423057e-04 +-8.1114938696284983e-04 +-7.9752219099809901e-04 +-7.8556723855561085e-04 +-7.7512256889591957e-04 +-7.6604485916577998e-04 +-7.5820807486664686e-04 +-7.5150222215376991e-04 +-7.4583222739028259e-04 +-7.4111695440976519e-04 +-7.3728836092040707e-04 +-7.3429079051961946e-04 +-7.3208039454607948e-04 +-7.3062467757728847e-04 +-7.2990216109043314e-04 +-1.8021238077677222e-03 +-1.8057409678354473e-03 +-1.8130683059586657e-03 +-1.8242843174856196e-03 +-1.8396180799741637e-03 +-1.8592513493914235e-03 +-1.8831189590932888e-03 +-1.9105933552057226e-03 +-1.9401038936168978e-03 +-1.9688373007822431e-03 +-1.9927395372806539e-03 +-2.0070033414010609e-03 +-2.0070269811837539e-03 +-1.9895452714457627e-03 +-1.9534677371910022e-03 +-1.9000717047022138e-03 +-1.8325272875727634e-03 +-1.7550347874547140e-03 +-1.6719448448049487e-03 +-1.5871178622243087e-03 +-1.5035986104711609e-03 +-1.4235514630721406e-03 +-1.3483542317310254e-03 +-1.2787589559376787e-03 +-1.2150598631886840e-03 +-1.1572388252932618e-03 +-1.1050788183997883e-03 +-1.0582465394804448e-03 +-1.0163495669317599e-03 +-9.7897423005593336e-04 +-9.4570962920854788e-04 +-9.1616208508841449e-04 +-8.8996317050505822e-04 +-8.6677355702317643e-04 +-8.4628421447557932e-04 +-8.2821600166339501e-04 +-8.1231833720145851e-04 +-7.9836739972459448e-04 +-7.8616414429048484e-04 +-7.7553231297327653e-04 +-7.6631654541276190e-04 +-7.5838064771809001e-04 +-7.5160604757788221e-04 +-7.4589044422790894e-04 +-7.4114665037876683e-04 +-7.3730161679424588e-04 +-7.3429562725326153e-04 +-7.3208165094589136e-04 +-7.3062484018866780e-04 +-7.2990216309830086e-04 +-1.9092047849804345e-03 +-1.9130513855316919e-03 +-1.9209177342307663e-03 +-1.9331395198893789e-03 +-1.9501646468457058e-03 +-1.9724109052639744e-03 +-1.9999754501243152e-03 +-2.0321778671418488e-03 +-2.0670184613209531e-03 +-2.1007803444447258e-03 +-2.1281095748169627e-03 +-2.1428236308090143e-03 +-2.1393490545725011e-03 +-2.1142472108379149e-03 +-2.0671245122512922e-03 +-2.0005398181566106e-03 +-1.9190769423104578e-03 +-1.8281073640397266e-03 +-1.7327396439194812e-03 +-1.6371917119839747e-03 +-1.5445726343632689e-03 +-1.4569392419719520e-03 +-1.3754845409048476e-03 +-1.3007575392934042e-03 +-1.2328616393418698e-03 +-1.1716123033973036e-03 +-1.1166529268454108e-03 +-1.0675354314180847e-03 +-1.0237738766482084e-03 +-9.8487862713396651e-04 +-9.5037706051017833e-04 +-9.1982524167677558e-04 +-8.9281369867972779e-04 +-8.6896945976264108e-04 +-8.4795580853883230e-04 +-8.2947072326441994e-04 +-8.1324462963481832e-04 +-7.9903786891379449e-04 +-7.8663813092400730e-04 +-7.7585800057500178e-04 +-7.6653270057591130e-04 +-7.5851807039050258e-04 +-7.5168879462561837e-04 +-7.4593687767314076e-04 +-7.4117035206164468e-04 +-7.3731220324423303e-04 +-7.3429949190579517e-04 +-7.3208265522342597e-04 +-7.3062497020323896e-04 +-7.2990216470436738e-04 +-1.9822077559941025e-03 +-1.9862089245022111e-03 +-1.9944542866831123e-03 +-2.0074172763325793e-03 +-2.0257406157604360e-03 +-2.0500615698234889e-03 +-2.0806512137396161e-03 +-2.1168385860464703e-03 +-2.1563163611898100e-03 +-2.1946269724859397e-03 +-2.2252896253218265e-03 +-2.2409122362956673e-03 +-2.2351037899706336e-03 +-2.2043649072358536e-03 +-2.1490019339632585e-03 +-2.0726974583331896e-03 +-1.9811560644312520e-03 +-1.8805849280516265e-03 +-1.7765691479757696e-03 +-1.6735083724841971e-03 +-1.5745063672757619e-03 +-1.4815205455666644e-03 +-1.3956107091344246e-03 +-1.3171909288397317e-03 +-1.2462418435242504e-03 +-1.1824725964770817e-03 +-1.1254366263547966e-03 +-1.0746105659636834e-03 +-1.0294457769082477e-03 +-9.8940053244373611e-04 +-9.5395897760066121e-04 +-9.2264131013289439e-04 +-8.9500829574718475e-04 +-8.7066224698944823e-04 +-8.4924589409886102e-04 +-8.3044008865588211e-04 +-8.1396094763236913e-04 +-7.9955682068213953e-04 +-7.8700531370027259e-04 +-7.7611050301865136e-04 +-7.6670041056329694e-04 +-7.5862476947865306e-04 +-7.5175308442040217e-04 +-7.4597297567888981e-04 +-7.4118878805796247e-04 +-7.3732044162292255e-04 +-7.3430250055165095e-04 +-7.3208343729292747e-04 +-7.3062507147162521e-04 +-7.2990216595599628e-04 +-2.0242504115102590e-03 +-2.0283322012812437e-03 +-2.0367692161178804e-03 +-2.0500962143531103e-03 +-2.0690491502589410e-03 +-2.0943897229875278e-03 +-2.1265318513061914e-03 +-2.1649162316467719e-03 +-2.2072035548057270e-03 +-2.2486101831184608e-03 +-2.2819719097596459e-03 +-2.2990302234710694e-03 +-2.2927273550263309e-03 +-2.2594192409943941e-03 +-2.1998051474377053e-03 +-2.1182421598598066e-03 +-2.0210943817112609e-03 +-1.9150474094118816e-03 +-1.8059607615677228e-03 +-1.6983549121577565e-03 +-1.5953618722183249e-03 +-1.4989194097221514e-03 +-1.4100458329523093e-03 +-1.3291052854982803e-03 +-1.2560266631876905e-03 +-1.1904689028222517e-03 +-1.1319385593409712e-03 +-1.0798696466604544e-03 +-1.0336755806915868e-03 +-9.9278140304119946e-04 +-9.5664253265532236e-04 +-9.2475458389240260e-04 +-8.9665743930775600e-04 +-8.7193576140960930e-04 +-8.5021740854614722e-04 +-8.3117071793214743e-04 +-8.1450127477388228e-04 +-7.9994855429722680e-04 +-7.8728266905886142e-04 +-7.7630135263458773e-04 +-7.6682724547101340e-04 +-7.5870550743291061e-04 +-7.5180175633571961e-04 +-7.4600031700631933e-04 +-7.4120275757840316e-04 +-7.3732668631746874e-04 +-7.3430478177907829e-04 +-7.3208403041204629e-04 +-7.3062514828541730e-04 +-7.2990216690607126e-04 +-2.0445814855183813e-03 +-2.0486888780116021e-03 +-2.0571567760233993e-03 +-2.0704823127949703e-03 +-2.0893598072905016e-03 +-2.1145388554281654e-03 +-2.1465035217178704e-03 +-2.1848851445865837e-03 +-2.2276110829024262e-03 +-2.2700739028501415e-03 +-2.3049994312481182e-03 +-2.3237057942449885e-03 +-2.3186111009488850e-03 +-2.2857157825508282e-03 +-2.2256387932448204e-03 +-2.1428606238407862e-03 +-2.0439505718224137e-03 +-1.9358007332648996e-03 +-1.8244473353508162e-03 +-1.7145511851919036e-03 +-1.6093487651118097e-03 +-1.5108489551341449e-03 +-1.4201120032768650e-03 +-1.3375204726636437e-03 +-1.2630043846482751e-03 +-1.1962123304740347e-03 +-1.1366338458570523e-03 +-1.0836828196729767e-03 +-1.0367518599460608e-03 +-9.9524601569552971e-04 +-9.5860234921908477e-04 +-9.2630011578566070e-04 +-8.9786490902796581e-04 +-8.7286907797100169e-04 +-8.5092996250396384e-04 +-8.3170696203944776e-04 +-8.1489808716329025e-04 +-8.0023639809784794e-04 +-7.8748657062648118e-04 +-7.7644172356964452e-04 +-7.6692057357901472e-04 +-7.5876494016841370e-04 +-7.5183759790757132e-04 +-7.4602045769194057e-04 +-7.4121305115352652e-04 +-7.3733128897238587e-04 +-7.3430646351920479e-04 +-7.3208446773694806e-04 +-7.3062520492920083e-04 +-7.2990216760743492e-04 +-2.0529858282546773e-03 +-2.0570897688045788e-03 +-2.0654964501461894e-03 +-2.0785980514732520e-03 +-2.0969505759414076e-03 +-2.1211789067892978e-03 +-2.1517421145154612e-03 +-2.1884484012921427e-03 +-2.2296437036484038e-03 +-2.2712625620194102e-03 +-2.3064310124585813e-03 +-2.3264960417763714e-03 +-2.3235239748370050e-03 +-2.2929741959504856e-03 +-2.2349615283936094e-03 +-2.1536380073538114e-03 +-2.0554520852546481e-03 +-1.9473420600131226e-03 +-1.8354877796106454e-03 +-1.7247257264848641e-03 +-1.6184556402891487e-03 +-1.5188155815243983e-03 +-1.4269560895101526e-03 +-1.3433156287322957e-03 +-1.2678537261492063e-03 +-1.2002301770836078e-03 +-1.1399341191822379e-03 +-1.0863723843369424e-03 +-1.0389272264291118e-03 +-9.9699217606615247e-04 +-9.5999287203701303e-04 +-9.2739791758730198e-04 +-8.9872333448907926e-04 +-8.7353306886860376e-04 +-8.5143719268003547e-04 +-8.3208887662306616e-04 +-8.1518082111419051e-04 +-8.0044157028710285e-04 +-7.8763196101829739e-04 +-7.7654184650260071e-04 +-7.6698716211716399e-04 +-7.5880735654356964e-04 +-7.5186318411270628e-04 +-7.4603483884688976e-04 +-7.4122040264191190e-04 +-7.3733457669171226e-04 +-7.3430766497860941e-04 +-7.3208478020371026e-04 +-7.3062524540433037e-04 +-7.2990216810945913e-04 +-2.0560418437203143e-03 +-2.0601335576182207e-03 +-2.0684557401679780e-03 +-2.0812829363209026e-03 +-2.0990083161026704e-03 +-2.1220852721789110e-03 +-2.1508699748268756e-03 +-2.1852554495645632e-03 +-2.2239695396326946e-03 +-2.2636059059981508e-03 +-2.2979870947719742e-03 +-2.3188340692578547e-03 +-2.3180504976457535e-03 +-2.2904950154258728e-03 +-2.2355542203713872e-03 +-2.1568136502437972e-03 +-2.0604409633115492e-03 +-1.9533484364607934e-03 +-1.8418440700634017e-03 +-1.7309492887517359e-03 +-1.6242423229564016e-03 +-1.5240043415470337e-03 +-1.4314874636793746e-03 +-1.3471953367281081e-03 +-1.2711250687279308e-03 +-1.2029550038673053e-03 +-1.1421806704824760e-03 +-1.0882080891459784e-03 +-1.0404148238582374e-03 +-9.9818793861724772e-04 +-9.6094608477109017e-04 +-9.2815105864676192e-04 +-8.9931260951984018e-04 +-8.7398909098226744e-04 +-8.5178568925761591e-04 +-8.3235136006690798e-04 +-8.1537519426689035e-04 +-8.0058265670751529e-04 +-7.8773196105697582e-04 +-7.7661072558597168e-04 +-7.6703298005333933e-04 +-7.5883654730074654e-04 +-7.5188079523736957e-04 +-7.4604473890546553e-04 +-7.4122546409220215e-04 +-7.3733684051431993e-04 +-7.3430849234214809e-04 +-7.3208499539352838e-04 +-7.3062527328042351e-04 +-7.2990216845622753e-04 +-2.0570065846478563e-03 +-2.0610871704548855e-03 +-2.0693394717650744e-03 +-2.0819437405239986e-03 +-2.0991577329762682e-03 +-2.1212771711369253e-03 +-2.1485270430950357e-03 +-2.1807935113191861e-03 +-2.2170551087465442e-03 +-2.2544794623020558e-03 +-2.2876284310985721e-03 +-2.3087465029909744e-03 +-2.3097213741021740e-03 +-2.2848782358095578e-03 +-2.2328748119300208e-03 +-2.1567068640724997e-03 +-2.0622397313336729e-03 +-1.9563407181706250e-03 +-1.8454251215506818e-03 +-1.7346761648859852e-03 +-1.6278280573624074e-03 +-1.5272862302300933e-03 +-1.4343907260378475e-03 +-1.3497019129896507e-03 +-1.2732503263243324e-03 +-1.2047318377672283e-03 +-1.1436493784876933e-03 +-1.0894103336852741e-03 +-1.0413902999592420e-03 +-9.9897274223807861e-04 +-9.6157209787588931e-04 +-9.2864590857081155e-04 +-8.9969992755457103e-04 +-8.7428890554310586e-04 +-8.5201485937182945e-04 +-8.3252399831437198e-04 +-8.1550305439751847e-04 +-8.0067547624873699e-04 +-7.8779775767439449e-04 +-7.7665605031759593e-04 +-7.6706313260168702e-04 +-7.5885575923141820e-04 +-7.5189238692229237e-04 +-7.4605125560404484e-04 +-7.4122879598988764e-04 +-7.3733833084266428e-04 +-7.3430903703895387e-04 +-7.3208513706903044e-04 +-7.3062529163413334e-04 +-7.2990216868574587e-04 +-2.0572332660448427e-03 +-2.0613063434619548e-03 +-2.0695123145626857e-03 +-2.0819689760005959e-03 +-2.0988420322208632e-03 +-2.1203125214364509e-03 +-2.1464920495369469e-03 +-2.1772178773224395e-03 +-2.2115976446009929e-03 +-2.2472036766273450e-03 +-2.2792001096435277e-03 +-2.3003171786506703e-03 +-2.3024955835049851e-03 +-2.2796630654131301e-03 +-2.2298969019770368e-03 +-2.1557179478979126e-03 +-2.0627481191051807e-03 +-1.9578160946500563e-03 +-1.8474167824150520e-03 +-1.7368536983143037e-03 +-1.6299759809757040e-03 +-1.5292798210890749e-03 +-1.4361690858669578e-03 +-1.3512452442097495e-03 +-1.2745631830800689e-03 +-1.2058317951220596e-03 +-1.1445598535885953e-03 +-1.0901563056676092e-03 +-1.0419959312203513e-03 +-9.9946018702283122e-04 +-9.6196101903280842e-04 +-9.2895339519249271e-04 +-8.9994062370931781e-04 +-8.7447523687383553e-04 +-8.5215729276494399e-04 +-8.3263129946974080e-04 +-8.1558252591569069e-04 +-8.0073316908179954e-04 +-7.8783865456062479e-04 +-7.7668422278654055e-04 +-7.6708187459696329e-04 +-7.5886770087951522e-04 +-7.5189959203436911e-04 +-7.4605530623058150e-04 +-7.4123086701913016e-04 +-7.3733925719484869e-04 +-7.3430937560903242e-04 +-7.3208522513101176e-04 +-7.3062530304280238e-04 +-7.2990216882992383e-04 +-2.0572420812143867e-03 +-2.0613108437783521e-03 +-2.0694900863253412e-03 +-2.0818613850869510e-03 +-2.0985363293793487e-03 +-2.1196259188928394e-03 +-2.1451656987976505e-03 +-2.1749450598354814e-03 +-2.2081277420502509e-03 +-2.2425292935860930e-03 +-2.2737144189310301e-03 +-2.2947597691563727e-03 +-2.2976647776361682e-03 +-2.2761033436655945e-03 +-2.2277691102031562e-03 +-2.1548688625872884e-03 +-2.0628650257302089e-03 +-1.9585616800489132e-03 +-1.8485054225306601e-03 +-1.7380767252497911e-03 +-1.6311974806148687e-03 +-1.5304208457005807e-03 +-1.4371904828979077e-03 +-1.3521333707929143e-03 +-1.2753194824758815e-03 +-1.2064657989729907e-03 +-1.1450847736758554e-03 +-1.0905864156424783e-03 +-1.0423451135082910e-03 +-9.9974120300985758e-04 +-9.6218520874459849e-04 +-9.2913061938411866e-04 +-9.0007933349498632e-04 +-8.7458260267005974e-04 +-8.5223935365291378e-04 +-8.3269311190666256e-04 +-8.1562830139731291e-04 +-8.0076639645322589e-04 +-7.8786220611936090e-04 +-7.7670044507091162e-04 +-7.6709266562720963e-04 +-7.5887457589378143e-04 +-7.5190373980487508e-04 +-7.4605763788090213e-04 +-7.4123205907798619e-04 +-7.3733979035941197e-04 +-7.3430957046412293e-04 +-7.3208527581091886e-04 +-7.3062530960891841e-04 +-7.2990216891481404e-04 +-2.0572136909901267e-03 +-2.0612803062589119e-03 +-2.0694460715266118e-03 +-2.0817741859300984e-03 +-2.0983486797412367e-03 +-2.1192443129418783e-03 +-2.1444554480049803e-03 +-2.1737414888732677e-03 +-2.2062885761820546e-03 +-2.2400381267918567e-03 +-2.2707745288582182e-03 +-2.2917704820419253e-03 +-2.2950624375509391e-03 +-2.2741857573653195e-03 +-2.2266230828637142e-03 +-2.1544096511321052e-03 +-2.0629222315906464e-03 +-1.9589530631755406e-03 +-1.8490778371834577e-03 +-1.7387191005297405e-03 +-1.6318380057531380e-03 +-1.5310181576768170e-03 +-1.4377243141655599e-03 +-1.3525968707931864e-03 +-1.2757136690163440e-03 +-1.2067958636689795e-03 +-1.1453577724049389e-03 +-1.0908099077688936e-03 +-1.0425264139362488e-03 +-9.9988701187748151e-04 +-9.6230146367220267e-04 +-9.2922247221955507e-04 +-9.0015119176384197e-04 +-8.7463820046519421e-04 +-8.5228183202936119e-04 +-8.3272509809688780e-04 +-8.1565198167076088e-04 +-8.0078358055910676e-04 +-7.8787438300280627e-04 +-7.7670883042208296e-04 +-7.6709824225212615e-04 +-7.5887812801414252e-04 +-7.5190588240320517e-04 +-7.4605884210790529e-04 +-7.4123267463650799e-04 +-7.3734006563554925e-04 +-7.3430967105660085e-04 +-7.3208530197177858e-04 +-7.3062531299887535e-04 +-7.2990216896122060e-04 +-2.0571951357361050e-03 +-2.0612608701773031e-03 +-2.0694210112254994e-03 +-2.0817310510000148e-03 +-2.0982635028567180e-03 +-2.1190779799560998e-03 +-2.1441514272237425e-03 +-2.1732300705874803e-03 +-2.2055088903701085e-03 +-2.2389832389095076e-03 +-2.2695330806078856e-03 +-2.2905163144356874e-03 +-2.2939840771400606e-03 +-2.2734093487658427e-03 +-2.2261818360413944e-03 +-2.1542626420590159e-03 +-2.0629927957614091e-03 +-1.9591610168623436e-03 +-1.8493568531077493e-03 +-1.7390218120034420e-03 +-1.6321343571590126e-03 +-1.5312913134466024e-03 +-1.4379664678408628e-03 +-1.3528058671447725e-03 +-1.2758905971396188e-03 +-1.2069434752357204e-03 +-1.1454795069240806e-03 +-1.0909093284811823e-03 +-1.0426069057815389e-03 +-9.9995163886622794e-04 +-9.6235291871684574e-04 +-9.2926307756070108e-04 +-9.0018292476878230e-04 +-8.7466273013464123e-04 +-8.5230055808374530e-04 +-8.3273918841101149e-04 +-8.1566240611870169e-04 +-8.0079114060389704e-04 +-7.8787973706552473e-04 +-7.7671251539610539e-04 +-7.6710069168095508e-04 +-7.5887968747690045e-04 +-7.5190682263751062e-04 +-7.4605937034254741e-04 +-7.4123294455220683e-04 +-7.3734018630223358e-04 +-7.3430971513933072e-04 +-7.3208531343426590e-04 +-7.3062531448504450e-04 +-7.2990216898511273e-04 +-2.0571887355665935e-03 +-2.0612542113607052e-03 +-2.0694126697077858e-03 +-2.0817172990965208e-03 +-2.0982372232901843e-03 +-2.1190276881102514e-03 +-2.1440607498505546e-03 +-2.1730792118063824e-03 +-2.2052814476454874e-03 +-2.2386797860739398e-03 +-2.2691830912099273e-03 +-2.2901736820759733e-03 +-2.2937046710008553e-03 +-2.2732278406372933e-03 +-2.2261037512132610e-03 +-2.1542715005596546e-03 +-2.0630625694102100e-03 +-1.9592660099059119e-03 +-1.8494766710548049e-03 +-1.7391425016829401e-03 +-1.6322475593257113e-03 +-1.5313927858697958e-03 +-1.4380546783941248e-03 +-1.3528809045310502e-03 +-1.2759534194237859e-03 +-1.2069954318605115e-03 +-1.1455220554238601e-03 +-1.0909438792012841e-03 +-1.0426347459174450e-03 +-9.9997390309248895e-04 +-9.6237058560278712e-04 +-9.2927697911017893e-04 +-9.0019376169499297e-04 +-8.7467108875011429e-04 +-8.5230692665956575e-04 +-8.3274397200221531e-04 +-8.1566593950082092e-04 +-8.0079369930588084e-04 +-7.8788154665684592e-04 +-7.7671375925322382e-04 +-7.6710151747808866e-04 +-7.5888021263272422e-04 +-7.5190713892862274e-04 +-7.4605954786429157e-04 +-7.4123303518128139e-04 +-7.3734022678681628e-04 +-7.3430972992006693e-04 +-7.3208531727629762e-04 +-7.3062531498469202e-04 +-7.2990216899875124e-04 +-2.0571877672731029e-03 +-2.0612532076825845e-03 +-2.0694114291004862e-03 +-2.0817153058623862e-03 +-2.0982335355780538e-03 +-2.1190208838987607e-03 +-2.1440489919049696e-03 +-2.1730606411139441e-03 +-2.2052552939274806e-03 +-2.2386481548140615e-03 +-2.2691519886690642e-03 +-2.2901513907902672e-03 +-2.2936979766027986e-03 +-2.2732390634815783e-03 +-2.2261305747612523e-03 +-2.1543089080233034e-03 +-2.0631050861282872e-03 +-1.9593091339784605e-03 +-1.8495173637015547e-03 +-1.7391790793702048e-03 +-1.6322793490893437e-03 +-1.5314197643869873e-03 +-1.4380771856114683e-03 +-1.3528994478455754e-03 +-1.2759685535082891e-03 +-1.2070076921751598e-03 +-1.1455319261669615e-03 +-1.0909517816608363e-03 +-1.0426410379755686e-03 +-9.9997888420418567e-04 +-9.6237450396698565e-04 +-9.2928003925315996e-04 +-9.0019613158332315e-04 +-8.7467290605958560e-04 +-8.5230830410282384e-04 +-8.3274500175551562e-04 +-8.1566669683196251e-04 +-8.0079424552421117e-04 +-7.8788193150486818e-04 +-7.7671402284737825e-04 +-7.6710169189167759e-04 +-7.5888032319820688e-04 +-7.5190720532271403e-04 +-7.4605958502649847e-04 +-7.4123305410635221e-04 +-7.3734023522246429e-04 +-7.3430973299468865e-04 +-7.3208531807529478e-04 +-7.3062531509081687e-04 +-7.2990216900931429e-04 +-2.0571877673387627e-03 +-2.0612532082787695e-03 +-2.0694114317222510e-03 +-2.0817153187289669e-03 +-2.0982335890002723e-03 +-2.1190210600661582e-03 +-2.1440494728993485e-03 +-2.1730617707579431e-03 +-2.2052576181986134e-03 +-2.2386523556666262e-03 +-2.2691586413008105e-03 +-2.2901606364575939e-03 +-2.2937093571393920e-03 +-2.2732516618247365e-03 +-2.2261433464005730e-03 +-2.1543209796667305e-03 +-2.0631158970539783e-03 +-1.9593184321202496e-03 +-1.8495251273258498e-03 +-1.7391854255997250e-03 +-1.6322844601412687e-03 +-1.5314238389996643e-03 +-1.4380804119253280e-03 +-1.3529019910390374e-03 +-1.2759705522409671e-03 +-1.2070092596445058e-03 +-1.1455331531893798e-03 +-1.0909527403365645e-03 +-1.0426417852187520e-03 +-9.9997946483453156e-04 +-9.6237495327910539e-04 +-9.2928038508521447e-04 +-9.0019639594956613e-04 +-8.7467310642245979e-04 +-8.5230845435650161e-04 +-8.3274511298316793e-04 +-8.1566677788812104e-04 +-8.0079430348331537e-04 +-7.8788197200824813e-04 +-7.7671405037364912e-04 +-7.6710170996968164e-04 +-7.5888033457703261e-04 +-7.5190721210971186e-04 +-7.4605958880142947e-04 +-7.4123305601765091e-04 +-7.3734023606999608e-04 +-7.3430973330218129e-04 +-7.3208531815480767e-04 +-7.3062531510107104e-04 +-7.2990216900942488e-04 +-2.0571887360107022e-03 +-2.0612542093845962e-03 +-2.0694126398950454e-03 +-2.0817172128971247e-03 +-2.0982371546760530e-03 +-2.1190280483155796e-03 +-2.1440626901270319e-03 +-2.1730851809898971e-03 +-2.2052956578832669e-03 +-2.2387078928252750e-03 +-2.2692303748202843e-03 +-2.2902422692150570e-03 +-2.2937918031056066e-03 +-2.2733266425345308e-03 +-2.2262058083139117e-03 +-2.1543694157400736e-03 +-2.0631513261546441e-03 +-1.9593431095419290e-03 +-1.8495415810193246e-03 +-1.7391959309920415e-03 +-1.6322908436961464e-03 +-1.5314274667722633e-03 +-1.4380822578853336e-03 +-1.3529027257207765e-03 +-1.2759706245384363e-03 +-1.2070089626355623e-03 +-1.1455326733605092e-03 +-1.0909521927846342e-03 +-1.0426412380929295e-03 +-9.9997895595912707e-04 +-9.6237450128165681e-04 +-9.2927999674860204e-04 +-9.0019607100855345e-04 +-8.7467284065115747e-04 +-8.5230824152346288e-04 +-8.3274494606376125e-04 +-8.1566664979450417e-04 +-8.0079420748562261e-04 +-7.8788190196120282e-04 +-7.7671400082368473e-04 +-7.6710167619049592e-04 +-7.5888031256393781e-04 +-7.5190719855057822e-04 +-7.4605958103428067e-04 +-7.4123305197925759e-04 +-7.3734023423690576e-04 +-7.3430973262342595e-04 +-7.3208531797543509e-04 +-7.3062531507489309e-04 +-7.2990216899984650e-04 +-2.0571951350817934e-03 +-2.0612608144685691e-03 +-2.0694206040991988e-03 +-2.0817296308489625e-03 +-2.0982601534429365e-03 +-2.1190719959909071e-03 +-2.1441432697424348e-03 +-2.1732229226718021e-03 +-2.2055105221995149e-03 +-2.2390066598040612e-03 +-2.2695935387989602e-03 +-2.2906245165141203e-03 +-2.2941400280275235e-03 +-2.2736017034522336e-03 +-2.2263927729240830e-03 +-2.1544742216550060e-03 +-2.0631912553094093e-03 +-1.9593381214230449e-03 +-1.8495092259192677e-03 +-1.7391494787706502e-03 +-1.6322393143937952e-03 +-1.5313764507033415e-03 +-1.4380348805656468e-03 +-1.3528604781078996e-03 +-1.2759339839943115e-03 +-1.2069778202142482e-03 +-1.1455066109851287e-03 +-1.0909306544250733e-03 +-1.0426236303796076e-03 +-9.9996470381294032e-04 +-9.6236307589473715e-04 +-9.2927092718834894e-04 +-9.0018894653875331e-04 +-8.7466730811947501e-04 +-8.5230400040252124e-04 +-8.3274174263927615e-04 +-8.1566427131827635e-04 +-8.0079247671160870e-04 +-7.8788067224336614e-04 +-7.7671315182280753e-04 +-7.6710111016108312e-04 +-7.5887995115792343e-04 +-7.5190698005634510e-04 +-7.4605945796816207e-04 +-7.4123298894812086e-04 +-7.3734020599988193e-04 +-7.3430972228908232e-04 +-7.3208531528375835e-04 +-7.3062531472371036e-04 +-7.2990216898803932e-04 +-2.0572136790342247e-03 +-2.0612800020543510e-03 +-2.0694441811916209e-03 +-2.0817676373889897e-03 +-2.0983322953570978e-03 +-2.1192111715984036e-03 +-2.1443982899628671e-03 +-2.1736558222007203e-03 +-2.2061780526134549e-03 +-2.2399203493520640e-03 +-2.2706811679746000e-03 +-2.2917367440106889e-03 +-2.2951110570884640e-03 +-2.2743175369010302e-03 +-2.2268196559752872e-03 +-2.1546436881981160e-03 +-2.0631673262153480e-03 +-1.9591892500641622e-03 +-1.8492928514377248e-03 +-1.7389071924180397e-03 +-1.6319979666283161e-03 +-1.5311514859808930e-03 +-1.4378338532437711e-03 +-1.3526859292894524e-03 +-1.2757855162222631e-03 +-1.2068534774225704e-03 +-1.1454037408323520e-03 +-1.0908464165266612e-03 +-1.0425552759208514e-03 +-9.9990971423987406e-04 +-9.6231921847049018e-04 +-9.2923626395902657e-04 +-9.0016181900996869e-04 +-8.7464631082002605e-04 +-8.5228795080220310e-04 +-8.3272965144180788e-04 +-8.1565531509136271e-04 +-8.0078597365001850e-04 +-7.8787606120000954e-04 +-7.7670997441279383e-04 +-7.6709899557633580e-04 +-7.5887860328092559e-04 +-7.5190616645263205e-04 +-7.4605900037131808e-04 +-7.4123275488611410e-04 +-7.3734010126472475e-04 +-7.3430968399607022e-04 +-7.3208530532031205e-04 +-7.3062531343110425e-04 +-7.2990216896652994e-04 +-2.0572420216058264e-03 +-2.0613097602540111e-03 +-2.0694841128371800e-03 +-2.0818413330544730e-03 +-2.0984859326816951e-03 +-2.1195212348965281e-03 +-2.1449765059909243e-03 +-2.1746403536015251e-03 +-2.2076885994246733e-03 +-2.2419682240257459e-03 +-2.2730881554304467e-03 +-2.2941576237880922e-03 +-2.2971738819653640e-03 +-2.2757755187747908e-03 +-2.2276106499974843e-03 +-2.1548522354016791e-03 +-2.0629482008586220e-03 +-1.9587034430625012e-03 +-1.8486731169477853e-03 +-1.7382480178018296e-03 +-1.6313589856424388e-03 +-1.5305657460220963e-03 +-1.4373162659402244e-03 +-1.3522400805640526e-03 +-1.2754085200587582e-03 +-1.2065391660010184e-03 +-1.1451446294893761e-03 +-1.0906348389377856e-03 +-1.0423839891766378e-03 +-9.9977218128415426e-04 +-9.6220970341178954e-04 +-9.2914982513285678e-04 +-9.0009425099993963e-04 +-8.7459406524079369e-04 +-8.5224805237465757e-04 +-8.3269961795986005e-04 +-8.1563308520651314e-04 +-8.0076984379986950e-04 +-7.8786463157431562e-04 +-7.7670210316913447e-04 +-7.6709376020185952e-04 +-7.5887526793976467e-04 +-7.5190415418567927e-04 +-7.4605786913026619e-04 +-7.4123217649523995e-04 +-7.3733984254898950e-04 +-7.3430958943496833e-04 +-7.3208528072362278e-04 +-7.3062531024334701e-04 +-7.2990216892261737e-04 +-2.0572330618355175e-03 +-2.0613032652017655e-03 +-2.0694969821961136e-03 +-2.0819195255431184e-03 +-2.0987192275702905e-03 +-2.1200567612324269e-03 +-2.1460242016736902e-03 +-2.1764490250073460e-03 +-2.2104562211548245e-03 +-2.2456812529248501e-03 +-2.2773910909547140e-03 +-2.2984105780105590e-03 +-2.3007093035828778e-03 +-2.2781648337259954e-03 +-2.2287630203878463e-03 +-2.1549407583568068e-03 +-2.0622692955998886e-03 +-1.9575601801227402e-03 +-1.8473129252080864e-03 +-1.7368452015881300e-03 +-1.6300218765351844e-03 +-1.5293526580079787e-03 +-1.4362516221493175e-03 +-1.3513273477664721e-03 +-1.2746393918150328e-03 +-1.2058995689206741e-03 +-1.1446183957962289e-03 +-1.0902058028514831e-03 +-1.0420370802902200e-03 +-9.9949391111671415e-04 +-9.6198830334072937e-04 +-9.2897519687649716e-04 +-8.9995782639509456e-04 +-8.7448863116514704e-04 +-8.5216757139795611e-04 +-8.3263906026555181e-04 +-8.1558827853389984e-04 +-8.0073734330735069e-04 +-7.8784160890649755e-04 +-7.7668625280053231e-04 +-7.6708322061465014e-04 +-7.5886855514789402e-04 +-7.5190010522963675e-04 +-7.4605559342830240e-04 +-7.4123101319008224e-04 +-7.3733932229233837e-04 +-7.3430939930901277e-04 +-7.3208523127561665e-04 +-7.3062530383695196e-04 +-7.2990216883969748e-04 +-2.0570060206973866e-03 +-2.0610796445131177e-03 +-2.0693051036419340e-03 +-2.0818375663519901e-03 +-2.0988992309611135e-03 +-2.1207431651454477e-03 +-2.1475522106207305e-03 +-2.1791886428600754e-03 +-2.2146587512583658e-03 +-2.2512455866040056e-03 +-2.2837078072804190e-03 +-2.3044861167532136e-03 +-2.3055547641788574e-03 +-2.2811753439681282e-03 +-2.2298467004847689e-03 +-2.1543989665697492e-03 +-2.0605822779404970e-03 +-1.9552102211977942e-03 +-1.8446900446960493e-03 +-1.7342213399156549e-03 +-1.6275630871633055e-03 +-1.5271449662188734e-03 +-1.4343270710311124e-03 +-1.3496848971409486e-03 +-1.2732597572551207e-03 +-1.2047549097397149e-03 +-1.1436782082967045e-03 +-1.0894402470319599e-03 +-1.0414186743660390e-03 +-9.9899824189749603e-04 +-9.6159417558700595e-04 +-9.2866448568977784e-04 +-8.9971519077342195e-04 +-8.7430117946194245e-04 +-8.5202452781883893e-04 +-8.3253145678095428e-04 +-8.1550868221132427e-04 +-8.0067962117992748e-04 +-7.8780072832791335e-04 +-7.7665811335719934e-04 +-7.6706451294970433e-04 +-7.5885664207147176e-04 +-7.5189292077773140e-04 +-7.4605155603204101e-04 +-7.4122894961015963e-04 +-7.3733839952095693e-04 +-7.3430906211910071e-04 +-7.3208514358637320e-04 +-7.3062529247775723e-04 +-7.2990216869613979e-04 +-2.0560405120482465e-03 +-2.0601172308382862e-03 +-2.0683864756888310e-03 +-2.0810780269719955e-03 +-2.0985214022532462e-03 +-2.1210940657643428e-03 +-2.1490789432142901e-03 +-2.1823303726369960e-03 +-2.2196260392615382e-03 +-2.2577516224693930e-03 +-2.2908527933929814e-03 +-2.3109817964414828e-03 +-2.3102118967514257e-03 +-2.2833320428296009e-03 +-2.2294882857380369e-03 +-2.1519902639188927e-03 +-2.0567951702567889e-03 +-1.9507013079508929e-03 +-1.8399823583381770e-03 +-1.7296732979095474e-03 +-1.6233866787107125e-03 +-1.5234419157166802e-03 +-1.4311251710805975e-03 +-1.3469672453760822e-03 +-1.2709855603870029e-03 +-1.2028730531788111e-03 +-1.1421354579232111e-03 +-1.0881858039821163e-03 +-1.0404064076368778e-03 +-9.9818752513483751e-04 +-9.6094993609548509e-04 +-9.2815684589173651e-04 +-8.9931892951646247e-04 +-8.7399514276536444e-04 +-8.5179105818649660e-04 +-8.3235587418841860e-04 +-8.1537882910644383e-04 +-8.0058547251167706e-04 +-7.8773406180560653e-04 +-7.7661223261784478e-04 +-7.6703401552151158e-04 +-7.5883722424049753e-04 +-7.5188121209186797e-04 +-7.4604497705063459e-04 +-7.4122558738356202e-04 +-7.3733689618961070e-04 +-7.3430851283477435e-04 +-7.3208500075002422e-04 +-7.3062527397649106e-04 +-7.2990216846481484e-04 +-2.0529830949165338e-03 +-2.0570582532040103e-03 +-2.0653707852724499e-03 +-2.0782414966134906e-03 +-2.0961255345429922e-03 +-2.1195300940158443e-03 +-2.1488066450418937e-03 +-2.1837162548208468e-03 +-2.2226925406403511e-03 +-2.2619569278041138e-03 +-2.2950988150155739e-03 +-2.3139433450453566e-03 +-2.3108256004317498e-03 +-2.2811463981423671e-03 +-2.2247047876265929e-03 +-2.1452559522520476e-03 +-2.0489199986105876e-03 +-1.9424366439599564e-03 +-1.8319064689826569e-03 +-1.7221659642443199e-03 +-1.6166547650141479e-03 +-1.5175635764218443e-03 +-1.4260935991897545e-03 +-1.3427258629853114e-03 +-1.2674530700206184e-03 +-1.1999597093266504e-03 +-1.1397527644653280e-03 +-1.0862517184289800e-03 +-1.0388476816885158e-03 +-9.9694033514864579e-04 +-9.5995956679699782e-04 +-9.2737690618375059e-04 +-8.9871038601410181e-04 +-8.7352533189011857e-04 +-8.5143276024427243e-04 +-8.3208648670859866e-04 +-8.1517965035393192e-04 +-8.0044109191338569e-04 +-7.8763184708255298e-04 +-7.7654190065746609e-04 +-7.6698727353596147e-04 +-7.5880746847738006e-04 +-7.5186327260602420e-04 +-7.4603489851263638e-04 +-7.4122043736046274e-04 +-7.3733459375417839e-04 +-7.3430767165560018e-04 +-7.3208478202546167e-04 +-7.3062524564764463e-04 +-7.2990216811249110e-04 +-2.0445766419046126e-03 +-2.0486355313658407e-03 +-2.0569548202128223e-03 +-2.0699311630863219e-03 +-2.0881182063224625e-03 +-2.1121055588803374e-03 +-2.1422395401197950e-03 +-2.1781050023169015e-03 +-2.2177627591569507e-03 +-2.2569835896785900e-03 +-2.2890787231116096e-03 +-2.3059726720820323e-03 +-2.3004542849003602e-03 +-2.2685060163634588e-03 +-2.2103932456511940e-03 +-2.1301010164533432e-03 +-2.0337516579354855e-03 +-1.9279373520084938e-03 +-1.8185489205781939e-03 +-1.7102159424032368e-03 +-1.6062089961147604e-03 +-1.5085984378318510e-03 +-1.4185102862497197e-03 +-1.3363858956628577e-03 +-1.2622031953731746e-03 +-1.1956477283842867e-03 +-1.1362365585648262e-03 +-1.0834036266784382e-03 +-1.0365559360797079e-03 +-9.9510877588346400e-04 +-9.5850645281108466e-04 +-9.2623333222256916e-04 +-8.9781860805493246e-04 +-8.7283716591061078e-04 +-8.5090813418692095e-04 +-8.3169217492950597e-04 +-8.1488819147445808e-04 +-8.0022987632307569e-04 +-7.8748235381905960e-04 +-7.7643906150156423e-04 +-7.6691894275597442e-04 +-7.5876397847017389e-04 +-7.5183705798178917e-04 +-7.4602017358139309e-04 +-7.4121291429572072e-04 +-7.3733123086992065e-04 +-7.3430644319318463e-04 +-7.3208446262830690e-04 +-7.3062520428292309e-04 +-7.2990216759954150e-04 +-2.0242430917334778e-03 +-2.0282543535294424e-03 +-2.0364870016216503e-03 +-2.0493527406259173e-03 +-2.0674164148512162e-03 +-2.0912485092788148e-03 +-2.1211047808129702e-03 +-2.1563822051020301e-03 +-2.1949062683149401e-03 +-2.2323258489497866e-03 +-2.2621308546079215e-03 +-2.2767509251926947e-03 +-2.2695905486946597e-03 +-2.2370653826288729e-03 +-2.1795492630901983e-03 +-2.1008660773337465e-03 +-2.0068469405320239e-03 +-1.9037786469172143e-03 +-1.7972929344793175e-03 +-1.6918258718937934e-03 +-1.5905183740709213e-03 +-1.4953647627555882e-03 +-1.4074560107479321e-03 +-1.3272272358475143e-03 +-1.2546686059635634e-03 +-1.1894883941717092e-03 +-1.1312312013513162e-03 +-1.0793595734678908e-03 +-1.0333079374694526e-03 +-9.9251662704191008e-04 +-9.5645211053173849e-04 +-9.2461795370627463e-04 +-8.9655975098590194e-04 +-8.7186626761118192e-04 +-8.5016831236921794e-04 +-8.3113634895450234e-04 +-8.1447749991076304e-04 +-7.9993235613283194e-04 +-7.8727184345468465e-04 +-7.7629429123365174e-04 +-7.6682277861411634e-04 +-7.5870279006694339e-04 +-7.5180018453545436e-04 +-7.4599946632836699e-04 +-7.4120233703623090e-04 +-7.3732650359363214e-04 +-7.3430471658112492e-04 +-7.3208401376676933e-04 +-7.3062514615651988e-04 +-7.2990216687995077e-04 +-1.9821983553608229e-03 +-1.9861116317800714e-03 +-1.9941141100390338e-03 +-2.0065488712444637e-03 +-2.0238776897756384e-03 +-2.0465363476814139e-03 +-2.0746298041829621e-03 +-2.1074387169924681e-03 +-2.1428157361676999e-03 +-2.1767260238484765e-03 +-2.2033339759310595e-03 +-2.2159515790852752e-03 +-2.2087151795315437e-03 +-2.1782914049292036e-03 +-2.1247630079739162e-03 +-2.0513284004747556e-03 +-1.9631401018674667e-03 +-1.8659395260350630e-03 +-1.7650025261842152e-03 +-1.6645741356929573e-03 +-1.5677192604918082e-03 +-1.4764264231804764e-03 +-1.3918194978017214e-03 +-1.3143854258702045e-03 +-1.2441733573569712e-03 +-1.1809509249892285e-03 +-1.1243187196058396e-03 +-1.0737900216818436e-03 +-1.0288439996391546e-03 +-9.8895969333303267e-04 +-9.5363659826776324e-04 +-9.2240618802871257e-04 +-8.9483748320091895e-04 +-8.7053883254100122e-04 +-8.4915738262551256e-04 +-8.3037722264956836e-04 +-8.1391685074557927e-04 +-7.9952637539872605e-04 +-7.8698470847351999e-04 +-7.7609690176613040e-04 +-7.6669171034381047e-04 +-7.5861942164189911e-04 +-7.5174996142039936e-04 +-7.4597127076245207e-04 +-7.4118793868407137e-04 +-7.3732007009917036e-04 +-7.3430236725031462e-04 +-7.3208340311386305e-04 +-7.3062506708727252e-04 +-7.2990216590214309e-04 +-1.9091944233878061e-03 +-1.9129464340604321e-03 +-1.9205617250774457e-03 +-1.9322556611123453e-03 +-1.9483085904198939e-03 +-1.9689499911043603e-03 +-1.9941168794452590e-03 +-2.0230685652952458e-03 +-2.0539241849857337e-03 +-2.0833162400770737e-03 +-2.1064488935421560e-03 +-2.1177859791375506e-03 +-2.1122989951530683e-03 +-2.0868192420876079e-03 +-2.0408795283670123e-03 +-1.9766854399447427e-03 +-1.8983343356337216e-03 +-1.8107263110209576e-03 +-1.7186077578911513e-03 +-1.6259729111002368e-03 +-1.5358294347742284e-03 +-1.4502195786481862e-03 +-1.3703726380888813e-03 +-1.2968970895965300e-03 +-1.2299611597506633e-03 +-1.1694407698054792e-03 +-1.1150311807467603e-03 +-1.0663265893182876e-03 +-1.0228743847027061e-03 +-9.8421063075515699e-04 +-9.4988222820595759e-04 +-9.1945992962698918e-04 +-8.9254524719713474e-04 +-8.6877339805395480e-04 +-8.4781376554271873e-04 +-8.2936887603544420e-04 +-8.1317255523889233e-04 +-7.9898769627346621e-04 +-7.8660391407419012e-04 +-7.7583525450184842e-04 +-7.6651805595894429e-04 +-7.5850901503375656e-04 +-7.5168347796277413e-04 +-7.4593396114083039e-04 +-7.4116889288374399e-04 +-7.3731156265695894e-04 +-7.3429926137495282e-04 +-7.3208259597746519e-04 +-7.3062496259139139e-04 +-7.2990216461079238e-04 +-1.8021138079324550e-03 +-1.8056414190281808e-03 +-1.8127391136153078e-03 +-1.8234868965630096e-03 +-1.8379758059163503e-03 +-1.8562297318585469e-03 +-1.8780423553186483e-03 +-1.9027159249568779e-03 +-1.9287428157671429e-03 +-1.9535525304870838e-03 +-1.9735120942650035e-03 +-1.9843415320108088e-03 +-1.9819400611280646e-03 +-1.9633738596853451e-03 +-1.9276254881580876e-03 +-1.8757911491623144e-03 +-1.8106902261584294e-03 +-1.7361184530825084e-03 +-1.6560650127836322e-03 +-1.5741248253322712e-03 +-1.4931834672531686e-03 +-1.4153358194170754e-03 +-1.3419531172505746e-03 +-1.2738179545503871e-03 +-1.2112724731612459e-03 +-1.1543508731146383e-03 +-1.1028855577090854e-03 +-1.0565863508930310e-03 +-1.0150966542052350e-03 +-9.7803160363120782e-04 +-9.4500296116197750e-04 +-9.1563461169905840e-04 +-8.8957160821504508e-04 +-8.6648490551373284e-04 +-8.4607329357425760e-04 +-8.2806357405981214e-04 +-8.1220968780270589e-04 +-7.9829126507399652e-04 +-7.8611190709740981e-04 +-7.7549739556502170e-04 +-7.6629395136141264e-04 +-7.5836661321046690e-04 +-7.5159777372479811e-04 +-7.4588588893201844e-04 +-7.4114436403506414e-04 +-7.3730061034543465e-04 +-7.3429526425047398e-04 +-7.3208155749512937e-04 +-7.3062482816823931e-04 +-7.2990216295046090e-04 +-1.6665402723650112e-03 +-1.6697943779267828e-03 +-1.6762926100941729e-03 +-1.6860119735859864e-03 +-1.6989007041085318e-03 +-1.7148321346097638e-03 +-1.7335081836647088e-03 +-1.7543027114812740e-03 +-1.7760644807498760e-03 +-1.7969460859142139e-03 +-1.8143678534148005e-03 +-1.8252248423564462e-03 +-1.8263679769480701e-03 +-1.8152529482934408e-03 +-1.7905326393238305e-03 +-1.7523628521508778e-03 +-1.7023161521621170e-03 +-1.6429733933183944e-03 +-1.5773758050193517e-03 +-1.5085231337368537e-03 +-1.4390280322249117e-03 +-1.3709484853843918e-03 +-1.3057622524371034e-03 +-1.2444281458834766e-03 +-1.1874854396736966e-03 +-1.1351587627934697e-03 +-1.0874512284636947e-03 +-1.0442193731476665e-03 +-1.0052296368840208e-03 +-9.7019891056042526e-04 +-9.3882249032767122e-04 +-9.1079262001248775e-04 +-8.8581026949171465e-04 +-8.6359219771578097e-04 +-8.4387481506733664e-04 +-8.2641593111938390e-04 +-8.1099514920627983e-04 +-7.9741343193291420e-04 +-7.8549219232920220e-04 +-7.7507214638180665e-04 +-7.6601208019257691e-04 +-7.5818762849784145e-04 +-7.5149012305025277e-04 +-7.4582554391736458e-04 +-7.4111359020734866e-04 +-7.3728687635604250e-04 +-7.3429025399542134e-04 +-7.3208025621157981e-04 +-7.3062465976489704e-04 +-7.2990216087123186e-04 +-1.5143498148311844e-03 +-1.5173039739957517e-03 +-1.5231724888981500e-03 +-1.5318739801710845e-03 +-1.5432769067002044e-03 +-1.5571748850786537e-03 +-1.5732350734376579e-03 +-1.5909132564001678e-03 +-1.6093433379670528e-03 +-1.6272326605517198e-03 +-1.6428195198650948e-03 +-1.6539572581159012e-03 +-1.6583611855799550e-03 +-1.6539885823994951e-03 +-1.6394474074217234e-03 +-1.6142943114010489e-03 +-1.5791173982153555e-03 +-1.5353870451216708e-03 +-1.4851460972939833e-03 +-1.4306521626142670e-03 +-1.3740703681915805e-03 +-1.3172688260842046e-03 +-1.2617224314020519e-03 +-1.2085017185603673e-03 +-1.1583143787784337e-03 +-1.1115708665601681e-03 +-1.0684543927422531e-03 +-1.0289843237502694e-03 +-9.9306842075805421e-04 +-9.6054323291563048e-04 +-9.3120389169004680e-04 +-9.0482525576976349e-04 +-8.8117639640371986e-04 +-8.6003015947878870e-04 +-8.4116919905322671e-04 +-8.2438954721879168e-04 +-8.0950250608707104e-04 +-7.9633542763716560e-04 +-7.8473178090648367e-04 +-7.7455078388734961e-04 +-7.6566678955643621e-04 +-7.5796855311564327e-04 +-7.5135846391761703e-04 +-7.4575179548230775e-04 +-7.4107600663392693e-04 +-7.3727011328875180e-04 +-7.3428414178030156e-04 +-7.3207866934426084e-04 +-7.3062445445869597e-04 +-7.2990215833721730e-04 +-1.3589555542490625e-03 +-1.3616072665312000e-03 +-1.3668597753356674e-03 +-1.3746102105349101e-03 +-1.3846992671953328e-03 +-1.3968988215653543e-03 +-1.4108862799657267e-03 +-1.4262020348702312e-03 +-1.4421924923016085e-03 +-1.4579520896862838e-03 +-1.4722907284374284e-03 +-1.4837607522713843e-03 +-1.4907704661889917e-03 +-1.4917844081732035e-03 +-1.4855717061897696e-03 +-1.4714328951164893e-03 +-1.4493331956340473e-03 +-1.4199015250379234e-03 +-1.3843032245477646e-03 +-1.3440346934195360e-03 +-1.3007023555584194e-03 +-1.2558367815530599e-03 +-1.2107680529378434e-03 +-1.1665646692960187e-03 +-1.1240233631356329e-03 +-1.0836919820410933e-03 +-1.0459090626615782e-03 +-1.0108481353757750e-03 +-9.7855951374688590e-04 +-9.4900606176517366e-04 +-9.2209189631575707e-04 +-8.9768436117956504e-04 +-8.7563023344907254e-04 +-8.5576729571844106e-04 +-8.3793234587965250e-04 +-8.2196655686712320e-04 +-8.0771891633622480e-04 +-7.9504830713719298e-04 +-7.8382464733333561e-04 +-7.7392939572531235e-04 +-7.6525564256443336e-04 +-7.5770794082022841e-04 +-7.5120198635449033e-04 +-7.4566422155639839e-04 +-7.4103141308186544e-04 +-7.3725023770836466e-04 +-7.3427689898538989e-04 +-7.3207678982872208e-04 +-7.3062421136821907e-04 +-7.2990215533773350e-04 +-1.2115490000550819e-03 +-1.2139154382053332e-03 +-1.2185978506643643e-03 +-1.2254946738152798e-03 +-1.2344509088606567e-03 +-1.2452520988253044e-03 +-1.2576121728644376e-03 +-1.2711533366385479e-03 +-1.2853786529676381e-03 +-1.2996426649013329e-03 +-1.3131315715384591e-03 +-1.3248694135207639e-03 +-1.3337663379136807e-03 +-1.3387159185258089e-03 +-1.3387313879985260e-03 +-1.3330920167662688e-03 +-1.3214606707566267e-03 +-1.3039388480322732e-03 +-1.2810449470149275e-03 +-1.2536258022268541e-03 +-1.2227293584905975e-03 +-1.1894714261259365e-03 +-1.1549228677561535e-03 +-1.1200311869414780e-03 +-1.0855785151000900e-03 +-1.0521700327008269e-03 +-1.0202435472200168e-03 +-9.9009109622682731e-04 +-9.6188538204145880e-04 +-9.3570624384898627e-04 +-9.1156447781511822e-04 +-8.8942184764220843e-04 +-8.6920709276870807e-04 +-8.5082826390328842e-04 +-8.3418194066484997e-04 +-8.1915993432900974e-04 +-8.0565403501158840e-04 +-7.9355928031212388e-04 +-7.8277613155391197e-04 +-7.7321185929285637e-04 +-7.6478136781523711e-04 +-7.5740763019941661e-04 +-7.5102186016566704e-04 +-7.4556351247141836e-04 +-7.4098017794887755e-04 +-7.3722742051089837e-04 +-7.3426858994852574e-04 +-7.3207463477994539e-04 +-7.3062393274444376e-04 +-7.2990215190080329e-04 +-1.0795737334894971e-03 +-1.0816852167164004e-03 +-1.0858635958505762e-03 +-1.0920192835263858e-03 +-1.1000164290946007e-03 +-1.1096699825394118e-03 +-1.1207400591919298e-03 +-1.1329227979004113e-03 +-1.1458378661280361e-03 +-1.1590146922545821e-03 +-1.1718822230217525e-03 +-1.1837696303662567e-03 +-1.1939263252574838e-03 +-1.2015671577889871e-03 +-1.2059421519025645e-03 +-1.2064210952310108e-03 +-1.2025754939897770e-03 +-1.1942379435008841e-03 +-1.1815238279844185e-03 +-1.1648107401677149e-03 +-1.1446825823510727e-03 +-1.1218533102066329e-03 +-1.0970873628154336e-03 +-1.0711306345252511e-03 +-1.0446599143091987e-03 +-1.0182527451702212e-03 +-9.9237534932021900e-04 +-9.6738410337720031e-04 +-9.4353565879903053e-04 +-9.2100148905475683e-04 +-8.9988376312340472e-04 +-8.8023056490822075e-04 +-8.6204938817858014e-04 +-8.4531847940406035e-04 +-8.2999600269118728e-04 +-8.1602721979180638e-04 +-8.0334997337069760e-04 +-7.9189878189805116e-04 +-7.8160783423482242e-04 +-7.7241313353590326e-04 +-7.6425399668176371e-04 +-7.5707407407823427e-04 +-7.5082201851447441e-04 +-7.4545190181529307e-04 +-7.4092345408597303e-04 +-7.3720218171339244e-04 +-7.3425940607759822e-04 +-7.3207225425746226e-04 +-7.3062362509656643e-04 +-7.2990214810690548e-04 +-9.6691635541397121e-04 +-9.6881016233350641e-04 +-9.7256057217355216e-04 +-9.7809289481921662e-04 +-9.8529422532213102e-04 +-9.9401195903358664e-04 +-1.0040511631598090e-03 +-1.0151704998003581e-03 +-1.0270767668442632e-03 +-1.0394188911864010e-03 +-1.0517833541066402e-03 +-1.0636942795168285e-03 +-1.0746221947678454e-03 +-1.0840050349291916e-03 +-1.0912827692197721e-03 +-1.0959432423331701e-03 +-1.0975725556697914e-03 +-1.0959003255702265e-03 +-1.0908300020530711e-03 +-1.0824475291617058e-03 +-1.0710069111085827e-03 +-1.0568967005031289e-03 +-1.0405951351209249e-03 +-1.0226226890409388e-03 +-1.0034994356174301e-03 +-9.8371188020467343e-04 +-9.6369097601793131e-04 +-9.4380070924328667e-04 +-9.2433525810156701e-04 +-9.0552223104658136e-04 +-8.8752960979694262e-04 +-8.7047447122558827e-04 +-8.5443210883463317e-04 +-8.3944467949381620e-04 +-8.2552890106591564e-04 +-8.1268260927040313e-04 +-8.0089016219352831e-04 +-7.9012678248237083e-04 +-7.8036197470947170e-04 +-7.7156216865093702e-04 +-7.6369273294921451e-04 +-7.5671948770715547e-04 +-7.5060982512628865e-04 +-7.4533352787060653e-04 +-7.4086335719304090e-04 +-7.3717546772486054e-04 +-7.3424969331946409e-04 +-7.3206973825361223e-04 +-7.3062330008343663e-04 +-7.2990214409997473e-04 +-8.7486160206653833e-04 +-8.7657737037818376e-04 +-8.7997857659398481e-04 +-8.8500435915202539e-04 +-8.9156287159727508e-04 +-8.9953047796102498e-04 +-9.0875047773747517e-04 +-9.1903127847966094e-04 +-9.3014408133782584e-04 +-9.4182044992672826e-04 +-9.5375060437510189e-04 +-9.6558384191288110e-04 +-9.7693293491376231e-04 +-9.8738440172557208e-04 +-9.9651590042481512e-04 +-1.0039205639136939e-03 +-1.0092361254358136e-03 +-1.0121747843357502e-03 +-1.0125486922269963e-03 +-1.0102862508066224e-03 +-1.0054361361003386e-03 +-9.9815855656745561e-04 +-9.8870584509471544e-04 +-9.7739628511644169e-04 +-9.6458568111686366e-04 +-9.5064067991742541e-04 +-9.3591663713630798e-04 +-9.2074140007248955e-04 +-9.0540513766929325e-04 +-8.9015549522765804e-04 +-8.7519691659364112e-04 +-8.6069288019722688e-04 +-8.4676991742690727e-04 +-8.3352250986456925e-04 +-8.2101821360382665e-04 +-8.0930258568723029e-04 +-7.9840366827338893e-04 +-7.8833591693178824e-04 +-7.7910354637045242e-04 +-7.7070331945267533e-04 +-7.6312683324362030e-04 +-7.5636236729101271e-04 +-7.5039636068072787e-04 +-7.4521458006232642e-04 +-7.4080303374837037e-04 +-7.3714867896443044e-04 +-7.3423996140249334e-04 +-7.3206721892461290e-04 +-7.3062297478713740e-04 +-7.2990214009061862e-04 +-8.0313908433359558e-04 +-8.0471600334892088e-04 +-8.0784506249954977e-04 +-8.1247655594478892e-04 +-8.1853554551680275e-04 +-8.2592138156840932e-04 +-8.3450703424489160e-04 +-8.4413824119259641e-04 +-8.5463254032072406e-04 +-8.6577838013702536e-04 +-8.7733469404821507e-04 +-8.8903156798628255e-04 +-9.0057285699670460e-04 +-9.1164170500351632e-04 +-9.2190976441892426e-04 +-9.3105041067210201e-04 +-9.3875542269717175e-04 +-9.4475362580681056e-04 +-9.4882916296416158e-04 +-9.5083668783009273e-04 +-9.5071105062385789e-04 +-9.4846994640051824e-04 +-9.4420926297307311e-04 +-9.3809213204661688e-04 +-9.3033361454256569e-04 +-9.2118335389428162e-04 +-9.1090841211021909e-04 +-8.9977800941661717e-04 +-8.8805122479965095e-04 +-8.7596806685229841e-04 +-8.6374381165953747e-04 +-8.5156617367041583e-04 +-8.3959471724279547e-04 +-8.2796189088605145e-04 +-8.1677512487647326e-04 +-8.0611953325746217e-04 +-7.9606087231090842e-04 +-7.8664851056818802e-04 +-7.7791825123656329e-04 +-7.6989491407007638e-04 +-7.6259463150690266e-04 +-7.5602684634791051e-04 +-7.5019601880828963e-04 +-7.4510306261764056e-04 +-7.4074653560608295e-04 +-7.3712361191405405e-04 +-7.3423086207995549e-04 +-7.3206486481382433e-04 +-7.3062267095419704e-04 +-7.2990213634674384e-04 +-7.5076450159741205e-04 +-7.5223999323566215e-04 +-7.5517023692889197e-04 +-7.5951363926148876e-04 +-7.6520753031384357e-04 +-7.7216784448991694e-04 +-7.8028872507932424e-04 +-7.8944208812424088e-04 +-7.9947721121785260e-04 +-8.1022046632048044e-04 +-8.2147539779580780e-04 +-8.3302345288213740e-04 +-8.4462578027836275e-04 +-8.5602658256931426e-04 +-8.6695848558372940e-04 +-8.7715022242244812e-04 +-8.8633660204049671e-04 +-8.9427027644291843e-04 +-9.0073433272264255e-04 +-9.0555435317684707e-04 +-9.0860844038938933e-04 +-9.0983386809861651e-04 +-9.0922947389339697e-04 +-9.0685354745699141e-04 +-9.0281762894851673e-04 +-8.9727716322845683e-04 +-8.9042025814060476e-04 +-8.8245584483190244e-04 +-8.7360237670125549e-04 +-8.6407791047822134e-04 +-8.5409207412833767e-04 +-8.4384011115076264e-04 +-8.3349894166280471e-04 +-8.2322501314658378e-04 +-8.1315362379975973e-04 +-8.0339937388828708e-04 +-7.9405741638960013e-04 +-7.8520521973462533e-04 +-7.7690460840692697e-04 +-7.6920390160994912e-04 +-7.6214002009927730e-04 +-7.5574047354023293e-04 +-7.5002517441243467e-04 +-7.4500804984451460e-04 +-7.4069844080731299e-04 +-7.3710229007023715e-04 +-7.3422312750574435e-04 +-7.3206286485474144e-04 +-7.3062241292599591e-04 +-7.2990213316792779e-04 +-7.1661628752872175e-04 +-7.1802573997895654e-04 +-7.2082649564511863e-04 +-7.2498216177390416e-04 +-7.3043792388336457e-04 +-7.3712030408449008e-04 +-7.4493688670270299e-04 +-7.5377605425169390e-04 +-7.6350679420268013e-04 +-7.7397866334508322e-04 +-7.8502203479730319e-04 +-7.9644880234486519e-04 +-8.0805377075543938e-04 +-8.1961700357022042e-04 +-8.3090740833287140e-04 +-8.4168778715757169e-04 +-8.5172144824104048e-04 +-8.6078025948718956e-04 +-8.6865375352399444e-04 +-8.7515861609408743e-04 +-8.8014767599261872e-04 +-8.8351743005018340e-04 +-8.8521322066804691e-04 +-8.8523143355085027e-04 +-8.8361845298599319e-04 +-8.8046652423987471e-04 +-8.7590704319309687e-04 +-8.7010205476237105e-04 +-8.6323485899100652e-04 +-8.5550059811117965e-04 +-8.4709755939890653e-04 +-8.3821972271710542e-04 +-8.2905085526233080e-04 +-8.1976024741181196e-04 +-8.1050001706675959e-04 +-8.0140379571320389e-04 +-7.9258654646081352e-04 +-7.8414524426716843e-04 +-7.7616015987951937e-04 +-7.6869652001823174e-04 +-7.6180635694197778e-04 +-7.5553040322601565e-04 +-7.4989992735992924e-04 +-7.4493843983962544e-04 +-7.4066322666651544e-04 +-7.3708668756581740e-04 +-7.3421747045249359e-04 +-7.3206140266661706e-04 +-7.3062222433121278e-04 +-7.2990213084488337e-04 +-6.9978945167051786e-04 +-7.0116661915593911e-04 +-7.0390406368563542e-04 +-7.0796791864891030e-04 +-7.1330718123276636e-04 +-7.1985350053651285e-04 +-7.2752094694559870e-04 +-7.3620580693375753e-04 +-7.4578646051660393e-04 +-7.5612341577180775e-04 +-7.6705959807858064e-04 +-7.7842102137909582e-04 +-7.9001800203713692e-04 +-8.0164710538032432e-04 +-8.1309402832466140e-04 +-8.2413760253330901e-04 +-8.3455503554879097e-04 +-8.4412838280015787e-04 +-8.5265206497776294e-04 +-8.5994103454087724e-04 +-8.6583899126409572e-04 +-8.7022589938287348e-04 +-8.7302401480804674e-04 +-8.7420171830880254e-04 +-8.7377466745703724e-04 +-8.7180409139415223e-04 +-8.6839239833361452e-04 +-8.6367657837419778e-04 +-8.5782010669029746e-04 +-8.5100415241401732e-04 +-8.4341887440754070e-04 +-8.3525546022988342e-04 +-8.2669937773735590e-04 +-8.1792510187100203e-04 +-8.0909238757181196e-04 +-8.0034400665896432e-04 +-7.9180476210306556e-04 +-7.8358153680960685e-04 +-7.7576411809622623e-04 +-7.6842655252763053e-04 +-7.6162881740336047e-04 +-7.5541863531782276e-04 +-7.4983329960395622e-04 +-7.4490141642552185e-04 +-7.4064450125276905e-04 +-7.3707839250795654e-04 +-7.3421446344336741e-04 +-7.3206062555813457e-04 +-7.3062212410964357e-04 +-7.2990212961045555e-04 +-6.9978952820068364e-04 +-7.0116730880135562e-04 +-7.0390598379823906e-04 +-7.0797169301166233e-04 +-7.1331343819255140e-04 +-7.1986286514691769e-04 +-7.2753402543049544e-04 +-7.3622316227754344e-04 +-7.4580857884234161e-04 +-7.5615066445009480e-04 +-7.6709217819546081e-04 +-7.7845891912224771e-04 +-7.9006094541280911e-04 +-8.0169453397706497e-04 +-8.1314508405556278e-04 +-8.2419114796282206e-04 +-8.3460970336274472e-04 +-8.4418265546228792e-04 +-8.5270437837563521e-04 +-8.5998989457689934e-04 +-8.6588308910478477e-04 +-8.7026421037431035e-04 +-8.7305586822694116e-04 +-8.7422682973189417e-04 +-8.7379313154691311e-04 +-8.7181633895419054e-04 +-8.6839912631042062e-04 +-8.6367866424855936e-04 +-8.5781851915934897e-04 +-8.5099986874395759e-04 +-8.4341281200612161e-04 +-8.3524842664443356e-04 +-8.2669204012286864e-04 +-8.1791797446410146e-04 +-8.0908583406257917e-04 +-8.0033825356683620e-04 +-7.9179991918437568e-04 +-7.8357762093681969e-04 +-7.7576107773446451e-04 +-7.6842429071138614e-04 +-7.6162721185712393e-04 +-7.5541755499355175e-04 +-7.4983261739422892e-04 +-7.4490101815310062e-04 +-7.4064429125288752e-04 +-7.3707829623538080e-04 +-7.3421442758053517e-04 +-7.3206061609954972e-04 +-7.3062212287316520e-04 +-7.2990212959513469e-04 +-7.1661652908068519e-04 +-7.1802791670019567e-04 +-7.2083255597301917e-04 +-7.2499407387982106e-04 +-7.3045766861587545e-04 +-7.3714984798999299e-04 +-7.4497812957343421e-04 +-7.5383074740607966e-04 +-7.6357642872669019e-04 +-7.7406433202621423e-04 +-7.8512427734090523e-04 +-7.9656745004337028e-04 +-8.0818781285615460e-04 +-8.1976450142834335e-04 +-8.3106548316673294e-04 +-8.4185270141239402e-04 +-8.5188878892259292e-04 +-8.6094521570645997e-04 +-8.6881146294207577e-04 +-8.7530454007956953e-04 +-8.8027795509490209e-04 +-8.8362917239671304e-04 +-8.8530468626212379e-04 +-8.8530209480028343e-04 +-8.8366893197876412e-04 +-8.8049842570670259e-04 +-8.7592271508491533e-04 +-8.7010431406454143e-04 +-8.6322671893723280e-04 +-8.5548502604618096e-04 +-8.4707728464056135e-04 +-8.3819710334197576e-04 +-8.2902780366872161e-04 +-8.1973820787812647e-04 +-8.1047998462253099e-04 +-8.0138636420612778e-04 +-7.9257197414728112e-04 +-7.8413352689431324e-04 +-7.7615110344359071e-04 +-7.6868980770006202e-04 +-7.6180160682253850e-04 +-7.5552721510821366e-04 +-7.4989791831435622e-04 +-7.4493726897408507e-04 +-7.4066261015536439e-04 +-7.3708640524552775e-04 +-7.3421736537468028e-04 +-7.3206137497044813e-04 +-7.3062222071208099e-04 +-7.2990213080001106e-04 +-7.5076494604922432e-04 +-7.5224399834700195e-04 +-7.5518138737929884e-04 +-7.5953555391085228e-04 +-7.6524384482881019e-04 +-7.7222215349323508e-04 +-7.8036447282431537e-04 +-7.8954240070509797e-04 +-7.9960467019156640e-04 +-8.1037683371512257e-04 +-8.2166131532911395e-04 +-8.3323815207149638e-04 +-8.4486685185941428e-04 +-8.5628985913702225e-04 +-8.6723808658717633e-04 +-8.7743879321693519e-04 +-8.8662574952763553e-04 +-8.9455116786653496e-04 +-9.0099838973995165e-04 +-9.0579394972741185e-04 +-9.0881750730943266e-04 +-9.1000832214628493e-04 +-9.0936742025226269e-04 +-9.0695524464619998e-04 +-9.0288524346881247e-04 +-8.9731436984287081e-04 +-8.9043175585301994e-04 +-8.8244685818857083e-04 +-8.7357820024716614e-04 +-8.6404353601538420e-04 +-8.5405192080404465e-04 +-8.4379786112793857e-04 +-8.3345747132339688e-04 +-8.2318640205157948e-04 +-8.1311922047584240e-04 +-8.0336989784336233e-04 +-7.9403307833138530e-04 +-7.8518584565742189e-04 +-7.7688975716471830e-04 +-7.6919296924628526e-04 +-7.6213232725232192e-04 +-7.5573533457720145e-04 +-7.5002194859329974e-04 +-7.4500617586486552e-04 +-7.4069745664999333e-04 +-7.3710184033339541e-04 +-7.3422296038748447e-04 +-7.3206282085844796e-04 +-7.3062240718140177e-04 +-7.2990213309675328e-04 +-8.0313980146521941e-04 +-8.0472246562118452e-04 +-8.0786305281748696e-04 +-8.1251190698874650e-04 +-8.1859410064412125e-04 +-8.2600888083194908e-04 +-8.3462890597076371e-04 +-8.4429928821724062e-04 +-8.5483652467340193e-04 +-8.6602753115582430e-04 +-8.7762919097836148e-04 +-8.8936907439925465e-04 +-9.0094820330122942e-04 +-9.1204681783271530e-04 +-9.2233392033626023e-04 +-9.3148084458623780e-04 +-9.3917825535853221e-04 +-9.4515500512175094e-04 +-9.4919646043461244e-04 +-9.5115957136352749e-04 +-9.5098227570036549e-04 +-9.4868576352223686e-04 +-9.4436941399985016e-04 +-9.3819948071332247e-04 +-9.3039350974623931e-04 +-9.2120284926911118e-04 +-9.1089546246547065e-04 +-8.9974074121879424e-04 +-8.8799734430049704e-04 +-8.7590443513882053e-04 +-8.6367618731111905e-04 +-8.5149910387900959e-04 +-8.3953154739173808e-04 +-8.2790485916263879e-04 +-8.1672551028343803e-04 +-8.0607783019142720e-04 +-7.9602697091830238e-04 +-7.8662186814505621e-04 +-7.7789804528929668e-04 +-7.6988017197365940e-04 +-7.6258433492578260e-04 +-7.5602001081752487e-04 +-7.5019175028217915e-04 +-7.4510059355592159e-04 +-7.4074524349534879e-04 +-7.3712302312060939e-04 +-7.3423064377151970e-04 +-7.3206480743421079e-04 +-7.3062266347014644e-04 +-7.2990213625404542e-04 +-8.7486270329223262e-04 +-8.7658729371318449e-04 +-8.8000619998540922e-04 +-8.8505862532325236e-04 +-8.9165270404675248e-04 +-8.9966456142204275e-04 +-9.0893686967347814e-04 +-9.1927683692076437e-04 +-9.3045372570947193e-04 +-9.4219631560235216e-04 +-9.5419120324120789e-04 +-9.6608338808041509e-04 +-9.7748101881102922e-04 +-9.8796617837310172e-04 +-9.9711288784634644e-04 +-1.0045120313660501e-03 +-1.0098009149924990e-03 +-1.0126932943538875e-03 +-1.0130046974068218e-03 +-1.0106682620802194e-03 +-1.0057381063236059e-03 +-9.9837988088827571e-04 +-9.8885074326993680e-04 +-9.7747275009594159e-04 +-9.6460421691422777e-04 +-9.5061303637423652e-04 +-9.3585469791518079e-04 +-9.2065631525383178e-04 +-9.0530673180606142e-04 +-8.9005193610911730e-04 +-8.7509460236001601e-04 +-8.6059649083295331e-04 +-8.4668257665926382e-04 +-8.3344601040511129e-04 +-8.2095326862002707e-04 +-8.0924907972580490e-04 +-7.9836089005828729e-04 +-7.8830276387176852e-04 +-7.7907869612874807e-04 +-7.7068536774900270e-04 +-7.6311439949518515e-04 +-7.5635417109156267e-04 +-7.5039127276759030e-04 +-7.4521165157777141e-04 +-7.4080150745307438e-04 +-7.3714798574591811e-04 +-7.3423970503783977e-04 +-7.3206715167065421e-04 +-7.3062296602623459e-04 +-7.2990213998218941e-04 +-9.6691800584494496e-04 +-9.6882503442018012e-04 +-9.7260196691985399e-04 +-9.7817418683746635e-04 +-9.8542868879914966e-04 +-9.9421234977045236e-04 +-1.0043290012131394e-03 +-1.0155350380754396e-03 +-1.0275336980720546e-03 +-1.0399689367756749e-03 +-1.0524209776357105e-03 +-1.0644068436513031e-03 +-1.0753898918074486e-03 +-1.0848018330397553e-03 +-1.0920784227426374e-03 +-1.0967061550830319e-03 +-1.0982730420228644e-03 +-1.0965136775090052e-03 +-1.0913387998400144e-03 +-1.0828428222988055e-03 +-1.0712881746536714e-03 +-1.0570707413609032e-03 +-1.0406743028960159e-03 +-1.0226228031062600e-03 +-1.0034377898017091e-03 +-9.8360557350175718e-04 +-9.6355569031397292e-04 +-9.4364994802127158e-04 +-9.2417998920404747e-04 +-9.0537084210345876e-04 +-8.8738807845563047e-04 +-8.7034666303949910e-04 +-8.5432013417313711e-04 +-8.3934926064145902e-04 +-8.2544971816446335e-04 +-8.1261860746914517e-04 +-8.0083981219030299e-04 +-7.9008829310401023e-04 +-7.8033346006302318e-04 +-7.7154177442276012e-04 +-7.6367872725744042e-04 +-7.5671032199076344e-04 +-7.5060417020903836e-04 +-7.4533028978766933e-04 +-7.4086167674910326e-04 +-7.3717470714598592e-04 +-7.3424941281211400e-04 +-7.3206966481535263e-04 +-7.3062329052980238e-04 +-7.2990214398180515e-04 +-1.0795761618689291e-03 +-1.0817070984748772e-03 +-1.0859244927790205e-03 +-1.0921388206218791e-03 +-1.1002139462663008e-03 +-1.1099637504822246e-03 +-1.1211459710495527e-03 +-1.1334525371736398e-03 +-1.1464966938409796e-03 +-1.1597991810089758e-03 +-1.1727784474863086e-03 +-1.1847524247613147e-03 +-1.1949601500288358e-03 +-1.2026088291107770e-03 +-1.2069452178536709e-03 +-1.2073411370560610e-03 +-1.2033752928790472e-03 +-1.1948914408962349e-03 +-1.1820181399330098e-03 +-1.1651460276579566e-03 +-1.1448701137362750e-03 +-1.1219123966649258e-03 +-1.0970419326629178e-03 +-1.0710060808903279e-03 +-1.0444806087438528e-03 +-1.0180403620256315e-03 +-9.9214795824994323e-04 +-9.6715588121932432e-04 +-9.4331703686691810e-04 +-9.2079956366185507e-04 +-8.9970283211945369e-04 +-8.8007269366310284e-04 +-8.6191494485808769e-04 +-8.4520660748438662e-04 +-8.2990501805632957e-04 +-8.1595493181810415e-04 +-8.0329393602826917e-04 +-7.9185648387654730e-04 +-7.8157683784406493e-04 +-7.7239117164339610e-04 +-7.6423903588189793e-04 +-7.5706435103457185e-04 +-7.5081605519165579e-04 +-7.4544850422356374e-04 +-7.4092169823603427e-04 +-7.3720138972374822e-04 +-7.3425911477554130e-04 +-7.3207217814684261e-04 +-7.3062361520857952e-04 +-7.2990214798468456e-04 +-1.2115524961079365e-03 +-1.2139469397818997e-03 +-1.2186855039688137e-03 +-1.2256666328375771e-03 +-1.2347346643868905e-03 +-1.2456730413723412e-03 +-1.2581912579376986e-03 +-1.2719039109281938e-03 +-1.2863027962540284e-03 +-1.3007277627819275e-03 +-1.3143481391441551e-03 +-1.3261712574927291e-03 +-1.3350938055648254e-03 +-1.3400022136224531e-03 +-1.3399109436679124e-03 +-1.3341091166217665e-03 +-1.3222763004385363e-03 +-1.3045342806205374e-03 +-1.2814215886143016e-03 +-1.2538018876146620e-03 +-1.2227347732546910e-03 +-1.1893420744996136e-03 +-1.1546957068734091e-03 +-1.1197405492967476e-03 +-1.0852538668931946e-03 +-1.0518349917627598e-03 +-1.0199158326896524e-03 +-9.8978306334644652e-04 +-9.6160485162501163e-04 +-9.3545741864414420e-04 +-9.1134881703941841e-04 +-8.8923883293628558e-04 +-8.6905486106432050e-04 +-8.5070410806720143e-04 +-8.3408269180530411e-04 +-8.1908224467840921e-04 +-8.0559458069943935e-04 +-7.9351490142549712e-04 +-7.8274392407705145e-04 +-7.7318923061926313e-04 +-7.6476606492127035e-04 +-7.5739774740182580e-04 +-7.5101583166922281e-04 +-7.4556009359820366e-04 +-7.4097841795722460e-04 +-7.3722662918767462e-04 +-7.3426829962986502e-04 +-7.3207455907030447e-04 +-7.3062392292102575e-04 +-7.2990215177945429e-04 +-1.3589604341691223e-03 +-1.3616512361421945e-03 +-1.3669820935405051e-03 +-1.3748500004832013e-03 +-1.3850942821934859e-03 +-1.3974829044132789e-03 +-1.4116853411858252e-03 +-1.4272287686954606e-03 +-1.4434406391286387e-03 +-1.4593917144747812e-03 +-1.4738664212282310e-03 +-1.4853944802401501e-03 +-1.4923697628542749e-03 +-1.4932548453299511e-03 +-1.4868308510019108e-03 +-1.4724221204893086e-03 +-1.4500243248737712e-03 +-1.4202970946322188e-03 +-1.3844312329986176e-03 +-1.3439401181722613e-03 +-1.3004380304101036e-03 +-1.2554556265748876e-03 +-1.2103176617930384e-03 +-1.1660843660033667e-03 +-1.1235432838569558e-03 +-1.0832335301537541e-03 +-1.0454861191151316e-03 +-1.0104685540732936e-03 +-9.7822660049109848e-04 +-9.4871987659479490e-04 +-9.2185031770553711e-04 +-8.9748390979979672e-04 +-8.7546668303045466e-04 +-8.5563610951345159e-04 +-8.3782897751637426e-04 +-8.2188664964409706e-04 +-8.0765842855834804e-04 +-7.9500358472002659e-04 +-7.8379245939860450e-04 +-7.7390694450966914e-04 +-7.6524055562303070e-04 +-7.5769825106600762e-04 +-7.5119610374388196e-04 +-7.4566089903539939e-04 +-7.4102970859485156e-04 +-7.3724947352872712e-04 +-7.3427661926386931e-04 +-7.3207671700751631e-04 +-7.3062420193042705e-04 +-7.2990215522122622e-04 +-1.5143563290078025e-03 +-1.5173626663513976e-03 +-1.5233357183761641e-03 +-1.5321936811642715e-03 +-1.5438024503706882e-03 +-1.5579488159836404e-03 +-1.5742865348510079e-03 +-1.5922496861375931e-03 +-1.6109421175476313e-03 +-1.6290355068977506e-03 +-1.6447328606533271e-03 +-1.6558608974221005e-03 +-1.6601250239745085e-03 +-1.6554938303622994e-03 +-1.6406063477876346e-03 +-1.6150627822981419e-03 +-1.5794969215468524e-03 +-1.5354174054584013e-03 +-1.4848921259643664e-03 +-1.4301893261092127e-03 +-1.3734727225659926e-03 +-1.3166010416485415e-03 +-1.2610359343622065e-03 +-1.2078340306196835e-03 +-1.1576904523797691e-03 +-1.1110053618047287e-03 +-1.0679541594897800e-03 +-1.0285506673506036e-03 +-9.9269896747597387e-04 +-9.6023335997721189e-04 +-9.3094776442451132e-04 +-9.0461654460075784e-04 +-8.8100874992542327e-04 +-8.5989750065266785e-04 +-8.4106589809874869e-04 +-8.2431051141129306e-04 +-8.0944321528552798e-04 +-7.9629193544504876e-04 +-7.8470069476942877e-04 +-7.7452923275303401e-04 +-7.6565238452245893e-04 +-7.5795934437460045e-04 +-7.5135289595484064e-04 +-7.4574866164706652e-04 +-7.4107440371060432e-04 +-7.3726939641346806e-04 +-7.3428387989199907e-04 +-7.3207860126709952e-04 +-7.3062444564454896e-04 +-7.2990215822845057e-04 +-1.6665484406738222e-03 +-1.6698679702049483e-03 +-1.6764972077865457e-03 +-1.6864122530204704e-03 +-1.6995570059741419e-03 +-1.7157938070296586e-03 +-1.7348035841811256e-03 +-1.7559271340422430e-03 +-1.7779691538648142e-03 +-1.7990330311983764e-03 +-1.8164954928290376e-03 +-1.8272266232737691e-03 +-1.8280811614800273e-03 +-1.8165494389861389e-03 +-1.7913416947351747e-03 +-1.7526785776014781e-03 +-1.7021890968919385e-03 +-1.6424915450615129e-03 +-1.5766426958591082e-03 +-1.5076394093413484e-03 +-1.4380795852190808e-03 +-1.3700012270732717e-03 +-1.3048618706826371e-03 +-1.2436027651901624e-03 +-1.1867494464947721e-03 +-1.1345166653880740e-03 +-1.0869009729779905e-03 +-1.0437549212480835e-03 +-1.0048428271892554e-03 +-9.6988072209816816e-04 +-9.3856385003362379e-04 +-9.1058488432239264e-04 +-8.8564548481134234e-04 +-8.6346321780380914e-04 +-8.4377533025414256e-04 +-8.2634044628557355e-04 +-8.1093893432115590e-04 +-7.9737245983447862e-04 +-7.8546307233988205e-04 +-7.7505205844147034e-04 +-7.6599871177744302e-04 +-7.5817911518089335e-04 +-7.5148499279068578e-04 +-7.4582266479833752e-04 +-7.4111212120727039e-04 +-7.3728622072896340e-04 +-7.3429001487908990e-04 +-7.3208019413180728e-04 +-7.3062465173403819e-04 +-7.2990216077218630e-04 +-1.8021232219809042e-03 +-1.8057262296501471e-03 +-1.8129748032592904e-03 +-1.8239473898543225e-03 +-1.8387284864456845e-03 +-1.8573259876395508e-03 +-1.8795037398190179e-03 +-1.9045182380487589e-03 +-1.9308032830807722e-03 +-1.9557273888578704e-03 +-1.9756110134241827e-03 +-1.9861598212825280e-03 +-1.9833009273768666e-03 +-1.9641661701993965e-03 +-1.9278229949365698e-03 +-1.8754475579349512e-03 +-1.8099153230808885e-03 +-1.7350468839118277e-03 +-1.6548287192592818e-03 +-1.5728351210764692e-03 +-1.4919233890670182e-03 +-1.4141601868683713e-03 +-1.3408929031141022e-03 +-1.2728861774000278e-03 +-1.2104698810411487e-03 +-1.1536706137123826e-03 +-1.1023166371553492e-03 +-1.0561159969367331e-03 +-1.0147118156877714e-03 +-9.7771982677826580e-04 +-9.4475284554557321e-04 +-9.1543599913994063e-04 +-8.8941561230474614e-04 +-8.6636385327723076e-04 +-8.4598062445384180e-04 +-8.2799372329697154e-04 +-8.1215796940867549e-04 +-7.9825376209359327e-04 +-7.8608537236104256e-04 +-7.7547916355631197e-04 +-7.6628186048715143e-04 +-7.5835893716685138e-04 +-7.5159316049631746e-04 +-7.4588330603696858e-04 +-7.4114304881839040e-04 +-7.3730002433774556e-04 +-7.3429505081434778e-04 +-7.3208150213928446e-04 +-7.3062482101215055e-04 +-7.2990216286222332e-04 +-1.9092041540536692e-03 +-1.9130340908143952e-03 +-1.9208052062403139e-03 +-1.9327306276606328e-03 +-1.9490820618026721e-03 +-1.9700684087575080e-03 +-1.9955890165754444e-03 +-2.0248467571471404e-03 +-2.0558912485792186e-03 +-2.0852879346552611e-03 +-2.1081993814621031e-03 +-2.1190944850793831e-03 +-2.1130031696901899e-03 +-2.0868536529028833e-03 +-2.0402834876796219e-03 +-1.9755800143534301e-03 +-1.8968824095042887e-03 +-1.8090932064341689e-03 +-1.7169339817014178e-03 +-1.6243618617328417e-03 +-1.5343468802708343e-03 +-1.4488997721550496e-03 +-1.3692267040531548e-03 +-1.2959209972606403e-03 +-1.2291420993663124e-03 +-1.1687617036150917e-03 +-1.1144738063954356e-03 +-1.0658731015908017e-03 +-1.0225084081325253e-03 +-9.8391762114381559e-04 +-9.4964955759616011e-04 +-9.1927679826827279e-04 +-8.9240251294165609e-04 +-8.6866337690915177e-04 +-8.4773003312906534e-04 +-8.2930608476565557e-04 +-8.1312627316779324e-04 +-7.9895426859425301e-04 +-7.8658034567282472e-04 +-7.7581911085527696e-04 +-7.6650737935843728e-04 +-7.5850225325150113e-04 +-7.5167942282788154e-04 +-7.4593169491485442e-04 +-7.4116774074722911e-04 +-7.3731104999450142e-04 +-7.3429907485352529e-04 +-7.3208254764161522e-04 +-7.3062495634626100e-04 +-7.2990216453381771e-04 +-1.9822071560077876e-03 +-1.9861909039515929e-03 +-1.9943341754350510e-03 +-2.0069773559518774e-03 +-2.0245723804742100e-03 +-2.0475320268071545e-03 +-2.0759196453054587e-03 +-2.1089545090654405e-03 +-2.1444159426765243e-03 +-2.1782035950293761e-03 +-2.2044520120669225e-03 +-2.2165016337096282e-03 +-2.2085762961061022e-03 +-2.1774621825644946e-03 +-2.1233524148577152e-03 +-2.0495140537554542e-03 +-1.9611169361244017e-03 +-1.8638793792103360e-03 +-1.7630332502559974e-03 +-1.6627760807634130e-03 +-1.5661322706173157e-03 +-1.4750607721768600e-03 +-1.3906665475298819e-03 +-1.3134261121366658e-03 +-1.2433841242459104e-03 +-1.1803074581853556e-03 +-1.1237980498613018e-03 +-1.0733715383283657e-03 +-1.0285097940696502e-03 +-9.8869452491956921e-04 +-9.5342767108707249e-04 +-9.2224285185949753e-04 +-8.9471092247500833e-04 +-8.7044177576042010e-04 +-8.4908384624845005e-04 +-8.3032229306833293e-04 +-8.1387650258721007e-04 +-7.9949732192325089e-04 +-7.8696427904190788e-04 +-7.7608294142485082e-04 +-7.6668249707064124e-04 +-7.5861359746147048e-04 +-7.5174647428638639e-04 +-7.4596932474417065e-04 +-7.4118695055233933e-04 +-7.3731963086636203e-04 +-7.3430220757799206e-04 +-7.3208336176202801e-04 +-7.3062506174677961e-04 +-7.2990216583632475e-04 +-2.0242499165491908e-03 +-2.0283158218026244e-03 +-2.0366575190445923e-03 +-2.0496839648896977e-03 +-2.0679503722066585e-03 +-2.0920049412823101e-03 +-2.1220632177070134e-03 +-2.1574630150529490e-03 +-2.1959602713712500e-03 +-2.2331458671762811e-03 +-2.2624940696185460e-03 +-2.2764837871756352e-03 +-2.2686274731763450e-03 +-2.2354693524472206e-03 +-2.1774847132786149e-03 +-2.0985430019136403e-03 +-2.0044658294462257e-03 +-1.9014957770331236e-03 +-1.7952091845964387e-03 +-1.6899919829786354e-03 +-1.5889475664986508e-03 +-1.4940461541159931e-03 +-1.4063656058198994e-03 +-1.3263356398530649e-03 +-1.2539458181756399e-03 +-1.1889064338681643e-03 +-1.1307653019469611e-03 +-1.0789885170252660e-03 +-1.0330139224851397e-03 +-9.9228491680461331e-04 +-9.5627060641644847e-04 +-9.2447677101829069e-04 +-8.9645083441517587e-04 +-8.7178306015168788e-04 +-8.5010547915073816e-04 +-8.3108955142499011e-04 +-8.1444321340905083e-04 +-7.9990772342291737e-04 +-7.8725455727365835e-04 +-7.7628249979099743e-04 +-7.6681500897633672e-04 +-7.5869788532387499e-04 +-7.5179725150431500e-04 +-7.4599783128633066e-04 +-7.4120150757612060e-04 +-7.3732613517828876e-04 +-7.3430458273714974e-04 +-7.3208397912057793e-04 +-7.3062514168350102e-04 +-7.2990216682483817e-04 +-2.0445811336298088e-03 +-2.0486759802083943e-03 +-2.0570669100897091e-03 +-2.0701481353201309e-03 +-2.0884650098101638e-03 +-2.1125880200178536e-03 +-2.1428287012942274e-03 +-2.1787201305825091e-03 +-2.2182622189062451e-03 +-2.2571778061708796e-03 +-2.2887750808371307e-03 +-2.3050418273462725e-03 +-2.2988837845693230e-03 +-2.2664078341155811e-03 +-2.2079623550481089e-03 +-2.1275528235785842e-03 +-2.0312704551722219e-03 +-1.9256510283213472e-03 +-1.8165273009027707e-03 +-1.7084823837981839e-03 +-1.6047557398923430e-03 +-1.5074002241393190e-03 +-1.4175342696988945e-03 +-1.3355979181210753e-03 +-1.2615712507167847e-03 +-1.1951435475245993e-03 +-1.1358360651126894e-03 +-1.0830867840016473e-03 +-1.0363063126249883e-03 +-9.9491301747438332e-04 +-9.5835376152332780e-04 +-9.2611499802741051e-04 +-8.9772760945489895e-04 +-8.7276784020469292e-04 +-8.5085591075419696e-04 +-8.3165336225953640e-04 +-8.1485980837234327e-04 +-8.0020951852296770e-04 +-7.8746808846625368e-04 +-7.7642934326682450e-04 +-7.6691254655882144e-04 +-7.5875994485002766e-04 +-7.5183464804719116e-04 +-7.4601883119900035e-04 +-7.4121223376364743e-04 +-7.3733092877533877e-04 +-7.3430633349411329e-04 +-7.3208443424216450e-04 +-7.3062520061898415e-04 +-7.2990216755440106e-04 +-2.0529856109103043e-03 +-2.0570809040355025e-03 +-2.0654334376180917e-03 +-2.0783620223199972e-03 +-2.0963152185989060e-03 +-2.1197850249826161e-03 +-2.1490948747337813e-03 +-2.1839632507118577e-03 +-2.2227731297947209e-03 +-2.2617080137647804e-03 +-2.2943633018140210e-03 +-2.3126333225358849e-03 +-2.3089679114543173e-03 +-2.2788787395024760e-03 +-2.2222264461984370e-03 +-2.1427662064986723e-03 +-2.0465746709764652e-03 +-1.9403324448880295e-03 +-1.8300862166601127e-03 +-1.7206331917184294e-03 +-1.6153891713134171e-03 +-1.5165332745667010e-03 +-1.4252632875586771e-03 +-1.3420615466374329e-03 +-1.2669243603742972e-03 +-1.1995406255760769e-03 +-1.1394217073791510e-03 +-1.0859910471833628e-03 +-1.0386431455830191e-03 +-9.9678049454149549e-04 +-9.5983526665105164e-04 +-9.2728082576103805e-04 +-8.9863666753065561e-04 +-8.7346928128784630e-04 +-8.5139060961887181e-04 +-8.3205520740106036e-04 +-8.1515680660078501e-04 +-8.0042472637788437e-04 +-7.8762039110430351e-04 +-7.7653410346464891e-04 +-7.6698214588040859e-04 +-7.5880423716959426e-04 +-7.5186134325296440e-04 +-7.4603382442350690e-04 +-7.4121989310409295e-04 +-7.3733435225173990e-04 +-7.3430758398815483e-04 +-7.3208475934600939e-04 +-7.3062524272079544e-04 +-7.2990216807643682e-04 +-2.0560417248744671e-03 +-2.0601281436189852e-03 +-2.0684165477689075e-03 +-2.0811351503741836e-03 +-2.0986084189696026e-03 +-2.1212021676677325e-03 +-2.1491775506572016e-03 +-2.1823551863908094e-03 +-2.2194721630558532e-03 +-2.2572850877612101e-03 +-2.2899506333787169e-03 +-2.3095883464138716e-03 +-2.3083750853716304e-03 +-2.2811919678319211e-03 +-2.2272273455537454e-03 +-2.1497783722686263e-03 +-2.0547559525885516e-03 +-1.9489039793545238e-03 +-1.8384503998373834e-03 +-1.7283991405827135e-03 +-1.6223454665521447e-03 +-1.5226016269073142e-03 +-1.4304529365213492e-03 +-1.3464327237578807e-03 +-1.2705623759725582e-03 +-1.2025391057511828e-03 +-1.1418726543640926e-03 +-1.0879795453047102e-03 +-1.0402450159760620e-03 +-9.9806170223194746e-04 +-9.6085229138017671e-04 +-9.2808150381903281e-04 +-8.9926121205777503e-04 +-8.7395131731730848e-04 +-8.5175813972834802e-04 +-8.3233147108094016e-04 +-8.1536102328699062e-04 +-8.0057272640602067e-04 +-7.8772514576203826e-04 +-7.7660616796822255e-04 +-7.6703002945707635e-04 +-7.5883471357284470e-04 +-7.5187971367343556e-04 +-7.4604414318564646e-04 +-7.4122516499162028e-04 +-7.3733670881414226e-04 +-7.3430844483126289e-04 +-7.3208498316064017e-04 +-7.3062527170679567e-04 +-7.2990216843685739e-04 +-2.0570065261459039e-03 +-2.0610841870795128e-03 +-2.0693175203221463e-03 +-2.0818604983161436e-03 +-2.0989315395616454e-03 +-2.1207750084762354e-03 +-2.1475573515467739e-03 +-2.1791150854439207e-03 +-2.2144231758059250e-03 +-2.2507430517572521e-03 +-2.2828456710286354e-03 +-2.3032307186523415e-03 +-2.3039586741801419e-03 +-2.2793630592599563e-03 +-2.2279702177596208e-03 +-2.1525931280230101e-03 +-2.0589400400484030e-03 +-1.9537792777220247e-03 +-1.8434820477455829e-03 +-1.7332247042715055e-03 +-1.6267541623226107e-03 +-1.5264958517897742e-03 +-1.4338102655837230e-03 +-1.3492756276382225e-03 +-1.2729368472393207e-03 +-1.2045008343537686e-03 +-1.1434787573148561e-03 +-1.0892840420672178e-03 +-1.0412966705704242e-03 +-9.9890327490566593e-04 +-9.6152057586343918e-04 +-9.2860776275060413e-04 +-8.9967178082711629e-04 +-8.7426824684017925e-04 +-8.5199981024784840e-04 +-8.3251314548461676e-04 +-8.1549532921163426e-04 +-8.0067006756942886e-04 +-7.8779404855955099e-04 +-7.7665357167435768e-04 +-7.6706152896067223e-04 +-7.5885476317943653e-04 +-7.5189179973609557e-04 +-7.4605093233201557e-04 +-7.4122863374492852e-04 +-7.3733825942688160e-04 +-7.3430901128279018e-04 +-7.3208513043883892e-04 +-7.3062529078135705e-04 +-7.2990216867524244e-04 +-2.0572332401259182e-03 +-2.0613048631005762e-03 +-2.0695012662707729e-03 +-2.0819268926938056e-03 +-2.0987273607151408e-03 +-2.1200571082556335e-03 +-2.1459964119255755e-03 +-2.1763540302906902e-03 +-2.2102320196539836e-03 +-2.2452504118305083e-03 +-2.2766870993658271e-03 +-2.2974135509042713e-03 +-2.2994652897150550e-03 +-2.2767724394769221e-03 +-2.2273380935094070e-03 +-2.1535828855570346e-03 +-2.0610446513961681e-03 +-1.9565005604018962e-03 +-1.8464236714975438e-03 +-1.7361151800753582e-03 +-1.6294318243635615e-03 +-1.5288808399068164e-03 +-1.4358770874916568e-03 +-1.3510314877799956e-03 +-1.2744064555614593e-03 +-1.2057166174509449e-03 +-1.1444749977273670e-03 +-1.0900936441615519e-03 +-1.0419495770893883e-03 +-9.9942586483709904e-04 +-9.6193561107640196e-04 +-9.2893461638500388e-04 +-8.9992678957891365e-04 +-8.7446509808757880e-04 +-8.5214991701249878e-04 +-8.3262598694968184e-04 +-8.1557874866156901e-04 +-8.0073052720695207e-04 +-7.8783684452966450e-04 +-7.7668301424227372e-04 +-7.6708109328582782e-04 +-7.5886721592545231e-04 +-7.5189930632271046e-04 +-7.4605514901893242e-04 +-7.4123078815440714e-04 +-7.3733922249465567e-04 +-7.3430936309847744e-04 +-7.3208522191132649e-04 +-7.3062530262875663e-04 +-7.2990216882481735e-04 +-2.0572420711533379e-03 +-2.0613102008881258e-03 +-2.0694852294099860e-03 +-2.0818428227595315e-03 +-2.0984856722539458e-03 +-2.1195129250965901e-03 +-2.1449459241288092e-03 +-2.1745606276488780e-03 +-2.2075172769330294e-03 +-2.2416525253315649e-03 +-2.2725834957164005e-03 +-2.2934524553248040e-03 +-2.2963024696609408e-03 +-2.2748076348284617e-03 +-2.2266265158865082e-03 +-2.1539195501199576e-03 +-2.0621109566651111e-03 +-1.9579818939555937e-03 +-1.8480696094966859e-03 +-1.7377539763922768e-03 +-1.6309606183521163e-03 +-1.5302478411298433e-03 +-1.4370643353539740e-03 +-1.3520413541870807e-03 +-1.2752522478280770e-03 +-1.2064165533480298e-03 +-1.1450486090938733e-03 +-1.0905597926410503e-03 +-1.0423254774560176e-03 +-9.9972670499956897e-04 +-9.6217450508155860e-04 +-9.2912272852271546e-04 +-9.0007353428588489e-04 +-8.7457836202882043e-04 +-8.5223627508282536e-04 +-8.3269089877004404e-04 +-8.1562673061899224e-04 +-8.0076529960698174e-04 +-7.8786145574975147e-04 +-7.7669994473069368e-04 +-7.6709234255809965e-04 +-7.5887437558819811e-04 +-7.5190362191081207e-04 +-7.4605757306677486e-04 +-7.4123202658887615e-04 +-7.3733977607352993e-04 +-7.3430956531630673e-04 +-7.3208527448662033e-04 +-7.3062530943866094e-04 +-7.2990216891270635e-04 +-2.0572136877888918e-03 +-2.0612800774029712e-03 +-2.0694443244055577e-03 +-2.0817674930885045e-03 +-2.0983304073974134e-03 +-2.1192035606576770e-03 +-2.1443761819340047e-03 +-2.1736027609710346e-03 +-2.2060680907100222e-03 +-2.2397212954295377e-03 +-2.2703660650555645e-03 +-2.2912991802220271e-03 +-2.2945728245749768e-03 +-2.2737219639596498e-03 +-2.2262160214344450e-03 +-2.1540731845545074e-03 +-2.0626564090144525e-03 +-1.9587498176908530e-03 +-1.8489259320338014e-03 +-1.7386072561122582e-03 +-1.6317564063816862e-03 +-1.5309589118228254e-03 +-1.4376813742407557e-03 +-1.3525657385987586e-03 +-1.2756910598073555e-03 +-1.2067794045126053e-03 +-1.1453457585123028e-03 +-1.0908011166116140e-03 +-1.0425199681304981e-03 +-9.9988228005991136e-04 +-9.6229798968765364e-04 +-9.2921992485924822e-04 +-9.0014932919207198e-04 +-8.7463684505035611e-04 +-8.5228085251298996e-04 +-8.3272439692808986e-04 +-8.1565148597853511e-04 +-8.0078323568865566e-04 +-7.8787414786314885e-04 +-7.7670867411449890e-04 +-7.6709814160683782e-04 +-7.5887806577120320e-04 +-7.5190584585207684e-04 +-7.4605882205386169e-04 +-7.4123266460178342e-04 +-7.3734006122974931e-04 +-7.3430966947094379e-04 +-7.3208530156424129e-04 +-7.3062531294651131e-04 +-7.2990216896056271e-04 +-2.0571951350213196e-03 +-2.0612608121144578e-03 +-2.0694205636609024e-03 +-2.0817293346321671e-03 +-2.0982588231921802e-03 +-2.1190675689116366e-03 +-2.1441312403184380e-03 +-2.1731948654463980e-03 +-2.2054531616678857e-03 +-2.2389035398752886e-03 +-2.2694309303920592e-03 +-2.2903992788667737e-03 +-2.2938634936893448e-03 +-2.2732961857607351e-03 +-2.2260835339980340e-03 +-2.1541822930254617e-03 +-2.0629300764830878e-03 +-1.9591136751472395e-03 +-1.8493219507530448e-03 +-1.7389964840764081e-03 +-1.6321161593897578e-03 +-1.5312783123447994e-03 +-1.4379572032466076e-03 +-1.3527992680509929e-03 +-1.2758858921453130e-03 +-1.2069401147403141e-03 +-1.1454771016320127e-03 +-1.0909076032851223e-03 +-1.0426056662412358e-03 +-9.9995074729730834e-04 +-9.6235227732296437e-04 +-9.2926261660530743e-04 +-9.0018259430238023e-04 +-8.7466249420998859e-04 +-8.5230039070552431e-04 +-8.3273907069285108e-04 +-8.1566232428142375e-04 +-8.0079108456051237e-04 +-7.8787969941664451e-04 +-7.7671249071280051e-04 +-7.6710067598962663e-04 +-7.5887967788617391e-04 +-7.5190681706542790e-04 +-7.4605936731460265e-04 +-7.4123294304984739e-04 +-7.3734018564738956e-04 +-7.3430971490505729e-04 +-7.3208531337432914e-04 +-7.3062531447736358e-04 +-7.2990216898500388e-04 +-2.0571887354988291e-03 +-2.0612542041146442e-03 +-2.0694126130489641e-03 +-2.0817170822718068e-03 +-2.0982366366692515e-03 +-2.1190263978543848e-03 +-2.1440582843970457e-03 +-2.1730749879204331e-03 +-2.2052749009975588e-03 +-2.2386706527789445e-03 +-2.2691717187949940e-03 +-2.2901610824476132e-03 +-2.2936921829765453e-03 +-2.2732166330658088e-03 +-2.2260945039742964e-03 +-2.1542643786535694e-03 +-2.0630573812211767e-03 +-1.9592623978435366e-03 +-1.8494742508059286e-03 +-1.7391409355575962e-03 +-1.6322465812545904e-03 +-1.5313921999993750e-03 +-1.4380543469975162e-03 +-1.3528807338542624e-03 +-1.2759533472006441e-03 +-1.2069954175757342e-03 +-1.1455220732187914e-03 +-1.0909439129162522e-03 +-1.0426347857198854e-03 +-9.9997394322508433e-04 +-9.6237062289870575e-04 +-9.2927701202322026e-04 +-9.0019378967085462e-04 +-8.7467111182158296e-04 +-8.5230694518786487e-04 +-8.3274398651330371e-04 +-8.1566595058324475e-04 +-8.0079370754840393e-04 +-7.8788155261177962e-04 +-7.7671376341629985e-04 +-7.6710152027899064e-04 +-7.5888021443243825e-04 +-7.5190714002115158e-04 +-7.4605954848111500e-04 +-7.4123303549753731e-04 +-7.3734022692851305e-04 +-7.3430972997190046e-04 +-7.3208531728978206e-04 +-7.3062531498643368e-04 +-7.2990216899875709e-04 +-2.0571877672751026e-03 +-2.0612532076219976e-03 +-2.0694114285405235e-03 +-2.0817153038340396e-03 +-2.0982335308542530e-03 +-2.1190208759213893e-03 +-2.1440489826006380e-03 +-2.1730606377440629e-03 +-2.2052553122899618e-03 +-2.2386482198466636e-03 +-2.2691521281404600e-03 +-2.2901516224650381e-03 +-2.2936982974423952e-03 +-2.2732394495548584e-03 +-2.2261309911160089e-03 +-2.1543093206717037e-03 +-2.0631054697333282e-03 +-1.9593094739444707e-03 +-1.8495176545956825e-03 +-1.7391793220242751e-03 +-1.6322795478596816e-03 +-1.5314199251389726e-03 +-1.4380773144607862e-03 +-1.3528995504822762e-03 +-1.2759686349029865e-03 +-1.2070077565075339e-03 +-1.1455319768687740e-03 +-1.0909518215082013e-03 +-1.0426410691944002e-03 +-9.9997890857083088e-04 +-9.6237452289642126e-04 +-9.2928005387266511e-04 +-9.0019614279223585e-04 +-8.7467291457686905e-04 +-8.5230831050448527e-04 +-8.3274500650383466e-04 +-8.1566670029825053e-04 +-8.0079424800653075e-04 +-7.8788193324188008e-04 +-7.7671402402922931e-04 +-7.6710169266865189e-04 +-7.5888032368769077e-04 +-7.5190720561489567e-04 +-7.4605958518911763e-04 +-7.4123305418873433e-04 +-7.3734023525901134e-04 +-7.3430973300795169e-04 +-7.3208531807872270e-04 +-7.3062531509125348e-04 +-7.2990216900930226e-04 +-2.0571877673321273e-03 +-2.0612532080976492e-03 +-2.0694114304698847e-03 +-2.0817153137031056e-03 +-2.0982335738852671e-03 +-2.1190210220439483e-03 +-2.1440493884928046e-03 +-2.1730616012714419e-03 +-2.2052573088220035e-03 +-2.2386518460356555e-03 +-2.2691578909763616e-03 +-2.2901596525329842e-03 +-2.2937082015035623e-03 +-2.2732504305912594e-03 +-2.2261421370709648e-03 +-2.1543198663481950e-03 +-2.0631149218631739e-03 +-1.9593176090040372e-03 +-1.8495244509938464e-03 +-1.7391848803166915e-03 +-1.6322840261896107e-03 +-1.5314234966068976e-03 +-1.4380801432491807e-03 +-1.3529017809137630e-03 +-1.2759703882375033e-03 +-1.2070091318056330e-03 +-1.1455330536486502e-03 +-1.0909526629289648e-03 +-1.0426417251314637e-03 +-9.9997941831394491e-04 +-9.6237491739443169e-04 +-9.2928035754230847e-04 +-9.0019637494650627e-04 +-8.7467309053857823e-04 +-8.5230844246758349e-04 +-8.3274510419681185e-04 +-8.1566677149446341e-04 +-8.0079429891737877e-04 +-7.8788196882102681e-04 +-7.7671404820973163e-04 +-7.6710170854974553e-04 +-7.5888033368395837e-04 +-7.5190721157738084e-04 +-7.4605958850551568e-04 +-7.4123305586789939e-04 +-7.3734023600361971e-04 +-7.3430973327810907e-04 +-7.3208531814858749e-04 +-7.3062531510027502e-04 +-7.2990216900943323e-04 +-2.0571887358405297e-03 +-2.0612541984010796e-03 +-2.0694125561014805e-03 +-2.0817168881774456e-03 +-2.0982362522129171e-03 +-2.1190259890597474e-03 +-2.1440585732163597e-03 +-2.1730777432034322e-03 +-2.2052834090288678e-03 +-2.2386896001764293e-03 +-2.2692058111903625e-03 +-2.2902126993321809e-03 +-2.2937597104683580e-03 +-2.2732948448035382e-03 +-2.2261765864229760e-03 +-2.1543441018377295e-03 +-2.0631303515751573e-03 +-1.9593262813786569e-03 +-1.8495283789381933e-03 +-1.7391857266578846e-03 +-1.6322830290543631e-03 +-1.5314215130672363e-03 +-1.4380777325030156e-03 +-1.3528992875532805e-03 +-1.2759680106619266e-03 +-1.2070069731082492e-03 +-1.1455311572429118e-03 +-1.0909510364710030e-03 +-1.0426403560716442e-03 +-9.9997828371984200e-04 +-9.6237398997170670e-04 +-9.2927960919215210e-04 +-9.0019577875971449e-04 +-8.7467262181900943e-04 +-8.5230807916786668e-04 +-8.3274482701073253e-04 +-8.1566656375903831e-04 +-8.0079414641931294e-04 +-7.8788185956407718e-04 +-7.7671397217583013e-04 +-7.6710165747105228e-04 +-7.5888030083373062e-04 +-7.5190719158117455e-04 +-7.4605957717094524e-04 +-7.4123305002882646e-04 +-7.3734023337410071e-04 +-7.3430973231099889e-04 +-7.3208531789476568e-04 +-7.3062531506450155e-04 +-7.2990216899973483e-04 +-2.0571951340649392e-03 +-2.0612607322563173e-03 +-2.0694199671444109e-03 +-2.0817271676671968e-03 +-2.0982533616098697e-03 +-2.1190566725332268e-03 +-2.1441130567804575e-03 +-2.1731692033309154e-03 +-2.2054236036673129e-03 +-2.2388792894333740e-03 +-2.2694258624922775e-03 +-2.2904267456057511e-03 +-2.2939297962851712e-03 +-2.2733977206790099e-03 +-2.2262092033642797e-03 +-2.1543184830196808e-03 +-2.0630648458305981e-03 +-1.9592387353254887e-03 +-1.8494327840463370e-03 +-1.7390915212306913e-03 +-1.6321957490542589e-03 +-1.5313438500606927e-03 +-1.4380105234048097e-03 +-1.3528422736133075e-03 +-1.2759203575399341e-03 +-1.2069675996576829e-03 +-1.1454989289598975e-03 +-1.0909248703412349e-03 +-1.0426192707051547e-03 +-9.9996141747380005e-04 +-9.6236060145697862e-04 +-9.2926906891385600e-04 +-9.0018755699037873e-04 +-8.7466627554206883e-04 +-8.5230323956356712e-04 +-8.3274118816635285e-04 +-8.1566387283642640e-04 +-8.0079219527734338e-04 +-7.8788047771343676e-04 +-7.7671302089668732e-04 +-7.6710102490958705e-04 +-7.5887989790243053e-04 +-7.5190694850151539e-04 +-7.4605944051811730e-04 +-7.4123298015638247e-04 +-7.3734020211738995e-04 +-7.3430972088515652e-04 +-7.3208531492163233e-04 +-7.3062531467707578e-04 +-7.2990216898748041e-04 +-2.0572136757931046e-03 +-2.0612796903180059e-03 +-2.0694417385382947e-03 +-2.0817581793671556e-03 +-2.0983062564841459e-03 +-2.1191526034598750e-03 +-2.1442833087897580e-03 +-2.1734524981656634e-03 +-2.2058511755978232e-03 +-2.2394446690212583e-03 +-2.2700594109814711e-03 +-2.2910085789227606e-03 +-2.2943424363089677e-03 +-2.2735769854606226e-03 +-2.2261579258597629e-03 +-2.1540863154228657e-03 +-2.0627182264878782e-03 +-1.9588387787879196e-03 +-1.8490253140296894e-03 +-1.7387058804014376e-03 +-1.6318477882814736e-03 +-1.5310399488484890e-03 +-1.4377511374178129e-03 +-1.3526245571503120e-03 +-1.2757399032938155e-03 +-1.2068194998491187e-03 +-1.1453783706604041e-03 +-1.0908274344343652e-03 +-1.0425410536264582e-03 +-9.9989905348715378e-04 +-9.6231123352168320e-04 +-9.2923029650484256e-04 +-9.0015737678803801e-04 +-8.7464302338132415e-04 +-8.5228553760793922e-04 +-8.3272789879913691e-04 +-8.1565405942109594e-04 +-8.0078508928956591e-04 +-7.8787545145854823e-04 +-7.7670956495894789e-04 +-7.6709872950146956e-04 +-7.5887843736584671e-04 +-7.5190606830105534e-04 +-7.4605894616822988e-04 +-7.4123272761005357e-04 +-7.3734008923157239e-04 +-7.3430967964838449e-04 +-7.3208530419956912e-04 +-7.3062531328682437e-04 +-7.2990216896476855e-04 +-2.0572420146233116e-03 +-2.0613089178317468e-03 +-2.0694774268330482e-03 +-2.0818153763945018e-03 +-2.0984144672416046e-03 +-2.1193607031149489e-03 +-2.1446621726366028e-03 +-2.1740867041286482e-03 +-2.2068029204051947e-03 +-2.2406860590883917e-03 +-2.2714201509046101e-03 +-2.2922117504077938e-03 +-2.2951262944891871e-03 +-2.2738078121339908e-03 +-2.2258564771015042e-03 +-2.1533780759308819e-03 +-2.0617632163424889e-03 +-1.9577810231599028e-03 +-1.8479708648871465e-03 +-1.7377211043929227e-03 +-1.6309670845914049e-03 +-1.5302755844013908e-03 +-1.4371017659739729e-03 +-1.3520814415102095e-03 +-1.2752909966695250e-03 +-1.2064519014207188e-03 +-1.1450796758186649e-03 +-1.0905863886137976e-03 +-1.0423477946348324e-03 +-9.9974512677161991e-04 +-9.6218949336833069e-04 +-9.2913475914605903e-04 +-9.0008306189022470e-04 +-8.7458580268154036e-04 +-8.5224199916853285e-04 +-8.3269522966531644e-04 +-8.1562994645164037e-04 +-8.0076763652124573e-04 +-7.8786311178875455e-04 +-7.7670108385299603e-04 +-7.6709309854946334e-04 +-7.5887485576132019e-04 +-7.5190391056252377e-04 +-7.4605773469486468e-04 +-7.4123210888929350e-04 +-7.3733981274040628e-04 +-7.3430957866971365e-04 +-7.3208527794951252e-04 +-7.3062530988629462e-04 +-7.2990216891823665e-04 +-2.0572330512116659e-03 +-2.0613014101890010e-03 +-2.0694820267655634e-03 +-2.0818612583744884e-03 +-2.0985587208994824e-03 +-2.1196966736617617e-03 +-2.1453213010533588e-03 +-2.1752171681821844e-03 +-2.2084980562993590e-03 +-2.2428644505860999e-03 +-2.2737453092195920e-03 +-2.2941714008899504e-03 +-2.2962556100060883e-03 +-2.2738865053119456e-03 +-2.2249478410627920e-03 +-2.1517328295476510e-03 +-2.0596893031093371e-03 +-1.9555511808800378e-03 +-1.8457833228792476e-03 +-1.7356977332561535e-03 +-1.6291688136212124e-03 +-1.5287214863484776e-03 +-1.4357854430575845e-03 +-1.3509829303397043e-03 +-1.2743845351061596e-03 +-1.2057105658687189e-03 +-1.1444778979688901e-03 +-1.0901011415573815e-03 +-1.0419589975055028e-03 +-9.9943562255451978e-04 +-9.6194481641763885e-04 +-9.2894281817778571e-04 +-8.9993380739330944e-04 +-8.7447091367924220e-04 +-8.5215460457800977e-04 +-8.3262966870964689e-04 +-8.1558156693305617e-04 +-8.0073262718319044e-04 +-7.8783836400945931e-04 +-7.7668407785834741e-04 +-7.6708180964707255e-04 +-7.5886767663654560e-04 +-7.5189958621330879e-04 +-7.4605530714177656e-04 +-7.4123086927015689e-04 +-7.3733925885427856e-04 +-7.3430937640404936e-04 +-7.3208522537428049e-04 +-7.3062530307748427e-04 +-7.2990216883036434e-04 +-2.0570060116980047e-03 +-2.0610760983606961e-03 +-2.0692759569883737e-03 +-2.0817235273240188e-03 +-2.0985849909434767e-03 +-2.1200397342796499e-03 +-2.1461856688393724e-03 +-2.1768113199133496e-03 +-2.2109133871141616e-03 +-2.2459040356038653e-03 +-2.2768385483547039e-03 +-2.2965260543196661e-03 +-2.2971969899562221e-03 +-2.2731351620335631e-03 +-2.2226581546600259e-03 +-2.1483358607556260e-03 +-2.0556908146119714e-03 +-1.9513904529643599e-03 +-1.8417746168527484e-03 +-1.7320298362743373e-03 +-1.6259312554587338e-03 +-1.5259361366087116e-03 +-1.4334334682095144e-03 +-1.3490243200413869e-03 +-1.2727707957442152e-03 +-1.2043922489056685e-03 +-1.1434086297994769e-03 +-1.0892394618733799e-03 +-1.0412689162948260e-03 +-9.9888648383115986e-04 +-9.6151082747807830e-04 +-9.2860245208167716e-04 +-8.9966919173024807e-04 +-8.7426726203492964e-04 +-8.5199971443860939e-04 +-8.3251349170059626e-04 +-8.1549584808354497e-04 +-8.0067060578543642e-04 +-7.8779452719596817e-04 +-7.7665395808206050e-04 +-7.6706181792630490e-04 +-7.5885496443649117e-04 +-7.5189192983944858e-04 +-7.4605100952906543e-04 +-7.4122867491625670e-04 +-7.3733827845428180e-04 +-7.3430901841104736e-04 +-7.3208513232608991e-04 +-7.3062529102868796e-04 +-7.2990216867832168e-04 +-2.0560405208120240e-03 +-2.0601111836552610e-03 +-2.0683355859416113e-03 +-2.0808779511450456e-03 +-2.0979701901369368e-03 +-2.1198645838265387e-03 +-2.1467069127321932e-03 +-2.1782445061456690e-03 +-2.2132621658394400e-03 +-2.2487710879771756e-03 +-2.2793896787681300e-03 +-2.2977420263829923e-03 +-2.2963017241897704e-03 +-2.2699028494899422e-03 +-2.2174180473358155e-03 +-2.1417484635558324e-03 +-2.0484824939512630e-03 +-1.9441730900049128e-03 +-1.8349744081253663e-03 +-1.7258922453471917e-03 +-1.6205606672283651e-03 +-1.5213418765832837e-03 +-1.4295687227165914e-03 +-1.3458142266577881e-03 +-1.2701306222542912e-03 +-1.2022380736344662e-03 +-1.1416629384117020e-03 +-1.0878335634598275e-03 +-1.0401435095040510e-03 +-9.9799123524015520e-04 +-9.6080348845821104e-04 +-9.2804781781617252e-04 +-8.9923806622611185e-04 +-8.7393550913374726e-04 +-8.5174742661470767e-04 +-8.3232428222682411e-04 +-8.1535625886154086e-04 +-8.0056961736601833e-04 +-7.8772315575395427e-04 +-7.7660492451503351e-04 +-7.6702927556733958e-04 +-7.5883427360858751e-04 +-7.5187946920232175e-04 +-7.4604401583385470e-04 +-7.4122510423202371e-04 +-7.3733668324624582e-04 +-7.3430843595610014e-04 +-7.3208498094400238e-04 +-7.3062527142765156e-04 +-7.2990216843346676e-04 +-2.0529831542696075e-03 +-2.0570490470207827e-03 +-2.0652910456528816e-03 +-2.0779262142119090e-03 +-2.0952572444202428e-03 +-2.1176017464012943e-03 +-2.1451158491046438e-03 +-2.1774278955273407e-03 +-2.2130163295669514e-03 +-2.2484480753513659e-03 +-2.2779752429208421e-03 +-2.2942049064219473e-03 +-2.2900297300813017e-03 +-2.2609404405396199e-03 +-2.2063865887687419e-03 +-2.1295636653412553e-03 +-2.0360611163301652e-03 +-1.9322466686712144e-03 +-1.8240253066293599e-03 +-1.7161724431044730e-03 +-1.6121469136270901e-03 +-1.5141956468799455e-03 +-1.4235859757091504e-03 +-1.3408609858050037e-03 +-1.2660657698237595e-03 +-1.1989264931172462e-03 +-1.1389821184471631e-03 +-1.0856761245612325e-03 +-1.0384173831954648e-03 +-9.9661861978580070e-04 +-9.5971926734734960e-04 +-9.2719783470718558e-04 +-8.9857746554352139e-04 +-8.7342724063195856e-04 +-8.5136094869603721e-04 +-8.3203446457069577e-04 +-8.1514246803789602e-04 +-8.0041496219455531e-04 +-7.8761386762850891e-04 +-7.7652984914494921e-04 +-7.6697945500549649e-04 +-7.5880260028117204e-04 +-7.5186039643837554e-04 +-7.4603331198802038e-04 +-7.4121963976970867e-04 +-7.3733424217604677e-04 +-7.3430754471102196e-04 +-7.3208474931820973e-04 +-7.3062524143826645e-04 +-7.2990216806071481e-04 +-2.0445767988093630e-03 +-2.0486232262656870e-03 +-2.0568444046755075e-03 +-2.0694915118759814e-03 +-2.0869069413415754e-03 +-2.1094249623177450e-03 +-2.1371435389046772e-03 +-2.1695013918377679e-03 +-2.2046527094512318e-03 +-2.2388269490119148e-03 +-2.2661560969294840e-03 +-2.2795182940526905e-03 +-2.2724072007008667e-03 +-2.2409735910104162e-03 +-2.1851133261798542e-03 +-2.1081444485108354e-03 +-2.0155104773680165e-03 +-1.9132928814455600e-03 +-1.8070871253719953e-03 +-1.7014065010941136e-03 +-1.5995212994425851e-03 +-1.5035613666753058e-03 +-1.4147336813952944e-03 +-1.3335604657186827e-03 +-1.2600905549739047e-03 +-1.1940674117769448e-03 +-1.1350534389386914e-03 +-1.0825171355143143e-03 +-1.0358914106030571e-03 +-9.9461077899554032e-04 +-9.5813373840425832e-04 +-9.2595510715537258e-04 +-8.9761178210132119e-04 +-8.7268433898655257e-04 +-8.5079612669119791e-04 +-8.3161095498706587e-04 +-8.1483009084488609e-04 +-8.0018901565782462e-04 +-7.8745421948953997e-04 +-7.7642019204235294e-04 +-7.6690669452069273e-04 +-7.5875634850241993e-04 +-7.5183254822679319e-04 +-7.4601768501789904e-04 +-7.4121166281356833e-04 +-7.3733067906179065e-04 +-7.3430624390549465e-04 +-7.3208441127279038e-04 +-7.3062519767272166e-04 +-7.2990216751822677e-04 +-2.0242433861231016e-03 +-2.0282401953167490e-03 +-2.0363542987383563e-03 +-2.0488196172157975e-03 +-2.0659447395885212e-03 +-2.0879958534927088e-03 +-2.1149431125370654e-03 +-2.1460297400674915e-03 +-2.1792053061604581e-03 +-2.2106382753544866e-03 +-2.2347166305490183e-03 +-2.2449172334529613e-03 +-2.2354646561721786e-03 +-2.2030589559600047e-03 +-2.1477728470378965e-03 +-2.0727490006089829e-03 +-1.9830519459726912e-03 +-1.8843372122250108e-03 +-1.7818291376017370e-03 +-1.6797668107622179e-03 +-1.5812453879299679e-03 +-1.4883014895824772e-03 +-1.4021081867545571e-03 +-1.3231922975792949e-03 +-1.2516294569782465e-03 +-1.1872006536472256e-03 +-1.1295091381237905e-03 +-1.0780632093925914e-03 +-1.0323322357851364e-03 +-9.9178288091358326e-04 +-9.5590129672671351e-04 +-9.2420570443436272e-04 +-8.9625259786802597e-04 +-8.7163885774827030e-04 +-8.5000135400062793e-04 +-8.3101509840374625e-04 +-8.1439064712494880e-04 +-7.9987120230242228e-04 +-7.8722969194624430e-04 +-7.7626599392748225e-04 +-7.6680439524370501e-04 +-7.5869132961463640e-04 +-7.5179340618443890e-04 +-7.4599572368622071e-04 +-7.4120045390850585e-04 +-7.3732567291055133e-04 +-7.3430441646775944e-04 +-7.3208393640738947e-04 +-7.3062513619733915e-04 +-7.2990216675742367e-04 +-1.9821987889389599e-03 +-1.9860977482199314e-03 +-1.9939767469601445e-03 +-2.0059908717896279e-03 +-2.0223314444066582e-03 +-2.0431143454838559e-03 +-2.0681455290721190e-03 +-2.0965418526828865e-03 +-2.1262673562224680e-03 +-2.1537812835894332e-03 +-2.1741114263771448e-03 +-2.1816070961579964e-03 +-2.1712847411661631e-03 +-2.1402313234700327e-03 +-2.0883859977755708e-03 +-2.0183709941570230e-03 +-1.9345870038885351e-03 +-1.8420825241036985e-03 +-1.7456288299587455e-03 +-1.6491790498411696e-03 +-1.5556803379064015e-03 +-1.4671191455144560e-03 +-1.3846803239591023e-03 +-1.3089373832431827e-03 +-1.2400291126427885e-03 +-1.1778044510964152e-03 +-1.1219325756515832e-03 +-1.0719821141745461e-03 +-1.0274756488071126e-03 +-9.8792565204326483e-04 +-9.5285706721399705e-04 +-9.2182060495607976e-04 +-8.9439977928676656e-04 +-8.7021385194095430e-04 +-8.4891819999583060e-04 +-8.3020314197720664e-04 +-8.1379191509524677e-04 +-7.9943825671403151e-04 +-7.8692387843934289e-04 +-7.7605600959937849e-04 +-7.6666511239453826e-04 +-7.5860282206610327e-04 +-7.5174013398660088e-04 +-7.4596583992973657e-04 +-7.4118520409477699e-04 +-7.3731886305386507e-04 +-7.3430193093601136e-04 +-7.3208329060143237e-04 +-7.3062505259857290e-04 +-7.2990216572386079e-04 +-1.9091949485595026e-03 +-1.9129347930161821e-03 +-1.9204384590638442e-03 +-1.9317481701008111e-03 +-1.9468945676381310e-03 +-1.9658095735022932e-03 +-1.9881457573789401e-03 +-2.0129895527214127e-03 +-2.0385193928697787e-03 +-2.0617560376293927e-03 +-2.0786259493977143e-03 +-2.0845124815348465e-03 +-2.0752468194473231e-03 +-2.0481919757567848e-03 +-2.0029399982129711e-03 +-1.9413253355669673e-03 +-1.8668241569862235e-03 +-1.7836753892744109e-03 +-1.6960759783382134e-03 +-1.6076469645870371e-03 +-1.5211945209938290e-03 +-1.4386913705966354e-03 +-1.3613820576388405e-03 +-1.2899353824816424e-03 +-1.2245973524147038e-03 +-1.1653225816530579e-03 +-1.1118775087745024e-03 +-1.0639167201782721e-03 +-1.0210368289007489e-03 +-9.8281298623106059e-04 +-9.4882260286249201e-04 +-9.1865998571256686e-04 +-8.9194471351888838e-04 +-8.6832581820907848e-04 +-8.4748324323027544e-04 +-8.2912760282236389e-04 +-8.1299894102005875e-04 +-7.9886495790708258e-04 +-7.8651900897296382e-04 +-7.7577807200661700e-04 +-7.6648080020776793e-04 +-7.5848572942006671e-04 +-7.5166967394311546e-04 +-7.4592632384951182e-04 +-7.4116504336303659e-04 +-7.3730986201310110e-04 +-7.3429864620359019e-04 +-7.3208243725716353e-04 +-7.3062494214477065e-04 +-7.2990216435914689e-04 +-1.8021143507177819e-03 +-1.8056329689330405e-03 +-1.8126415408395717e-03 +-1.8230787732335006e-03 +-1.8368308852946928e-03 +-1.8536742740945160e-03 +-1.8731571427666180e-03 +-1.8944115141923130e-03 +-1.9159274084960670e-03 +-1.9353816995739831e-03 +-1.9496627042005061e-03 +-1.9552117706133814e-03 +-1.9486781720821405e-03 +-1.9276977715809247e-03 +-1.8914883204903181e-03 +-1.8410149476153479e-03 +-1.7786895083008749e-03 +-1.7077756869168916e-03 +-1.6317485879379875e-03 +-1.5537965993564482e-03 +-1.4765368228583336e-03 +-1.4019222887893157e-03 +-1.3312779122635649e-03 +-1.2654014867732528e-03 +-1.2046836638509198e-03 +-1.1492206309810338e-03 +-1.0989080597777353e-03 +-1.0535138286717840e-03 +-1.0127314232814310e-03 +-9.7621753067826211e-04 +-9.4361750688977928e-04 +-9.1458193622716234e-04 +-8.8877685784815523e-04 +-8.6588961394909556e-04 +-8.4563175158241177e-04 +-8.2774000098041083e-04 +-8.1197604631795301e-04 +-7.9812558094887473e-04 +-7.8599697906018098e-04 +-7.7541980296961567e-04 +-7.6624328696412900e-04 +-7.5833488483771042e-04 +-7.5157893194021026e-04 +-7.4587544839926738e-04 +-7.4113909453662943e-04 +-7.3729827974718814e-04 +-7.3429442042748354e-04 +-7.3208133962636705e-04 +-7.3062480008851370e-04 +-7.2990216260478288e-04 +-1.6665407673247888e-03 +-1.6697889909309703e-03 +-1.6762229435581129e-03 +-1.6857151405411702e-03 +-1.6980614340194951e-03 +-1.7129480079143234e-03 +-1.7298834943107230e-03 +-1.7480903726998247e-03 +-1.7663714610529797e-03 +-1.7830012885644631e-03 +-1.7957228928216563e-03 +-1.8019289805579469e-03 +-1.7990482238209112e-03 +-1.7850543768634900e-03 +-1.7589270854277532e-03 +-1.7208880505557560e-03 +-1.6723301679634488e-03 +-1.6154906734886225e-03 +-1.5530083465732088e-03 +-1.4875103090380769e-03 +-1.4213184806887949e-03 +-1.3562976821588555e-03 +-1.2938208272244016e-03 +-1.2348093055188345e-03 +-1.1798097014002118e-03 +-1.1290794883982828e-03 +-1.0826661908340731e-03 +-1.0404733114707774e-03 +-1.0023116673752287e-03 +-9.6793745879989455e-04 +-9.3707940861459643e-04 +-9.0945742727515050e-04 +-8.8479497463385816e-04 +-8.6282687885993136e-04 +-8.4330396684296593e-04 +-8.2599551260682336e-04 +-8.1069023324684011e-04 +-7.9719635077917948e-04 +-7.8534108194188703e-04 +-7.7496980452599132e-04 +-7.6594506774237126e-04 +-7.5814555696370627e-04 +-7.5146508338755683e-04 +-7.4581164186097700e-04 +-7.4110656170945375e-04 +-7.3728376331821900e-04 +-7.3428912556038008e-04 +-7.3207996459734672e-04 +-7.3062462215775503e-04 +-7.2990216040811956e-04 +-1.5143502250187185e-03 +-1.5173009307892992e-03 +-1.5231265908678610e-03 +-1.5316741789885046e-03 +-1.5427070364734954e-03 +-1.5558876163776431e-03 +-1.5707424029689941e-03 +-1.5866054957337057e-03 +-1.6025475576265942e-03 +-1.6173137954567341e-03 +-1.6293121959552641e-03 +-1.6366981343973229e-03 +-1.6375797711929365e-03 +-1.6303192826681427e-03 +-1.6138496254945614e-03 +-1.5879009368415108e-03 +-1.5530574073077501e-03 +-1.5106321993558296e-03 +-1.4624152999193547e-03 +-1.4103817127751653e-03 +-1.3564374850565323e-03 +-1.3022462353178036e-03 +-1.2491426698436219e-03 +-1.1981163175341098e-03 +-1.1498405336754633e-03 +-1.1047239213756162e-03 +-1.0629677714868706e-03 +-1.0246198527377307e-03 +-9.8962006200103048e-04 +-9.5783674286061319e-04 +-9.2909425331365932e-04 +-9.0319312087685393e-04 +-8.7992429774265944e-04 +-8.5907891547815053e-04 +-8.4045471395341779e-04 +-8.2386007545091422e-04 +-8.0911637445550038e-04 +-7.9605917106932245e-04 +-7.8453863240140272e-04 +-7.7441945702628166e-04 +-7.6558049637784993e-04 +-7.5791420760293272e-04 +-7.5132602967387736e-04 +-7.4573374421392979e-04 +-7.4106686124773239e-04 +-7.3726605546701649e-04 +-7.3428266875492346e-04 +-7.3207828826152223e-04 +-7.3062440527693791e-04 +-7.2990215773133791e-04 +-1.3589558709687889e-03 +-1.3616057517409751e-03 +-1.3668312916437701e-03 +-1.3744830987989229e-03 +-1.3843332413632937e-03 +-1.3960667438495569e-03 +-1.4092647898142790e-03 +-1.4233778492443749e-03 +-1.4376913354827172e-03 +-1.4512941042556483e-03 +-1.4630690582634637e-03 +-1.4717300007704203e-03 +-1.4759228588845312e-03 +-1.4743891621759502e-03 +-1.4661609386778128e-03 +-1.4507337695554049e-03 +-1.4281638009157251e-03 +-1.3990586627745465e-03 +-1.3644693696061563e-03 +-1.3257209529450584e-03 +-1.2842306147880724e-03 +-1.2413535112760620e-03 +-1.1982773264391480e-03 +-1.1559682521777106e-03 +-1.1151590192812737e-03 +-1.0763651086905795e-03 +-1.0399160285844268e-03 +-1.0059917720632435e-03 +-9.7465820771606645e-04 +-9.4589815011840255e-04 +-9.1963691234054105e-04 +-8.9576235624801940e-04 +-8.7414005997521146e-04 +-8.5462444164021280e-04 +-8.3706668542521520e-04 +-8.2132022265598984e-04 +-8.0724439205883932e-04 +-7.9470677428519396e-04 +-7.8358458151127125e-04 +-7.7376538846897545e-04 +-7.6514741647075663e-04 +-7.5763952446742983e-04 +-7.5116101787320799e-04 +-7.4564135384158614e-04 +-7.4101979830442798e-04 +-7.3724507327820683e-04 +-7.3427502102774286e-04 +-7.3207630335134775e-04 +-7.3062414852890535e-04 +-7.2990215456325460e-04 +-1.2115492324827808e-03 +-1.2139148007319497e-03 +-1.2185808985753198e-03 +-1.2254168306765824e-03 +-1.2342244237479483e-03 +-1.2447339208218459e-03 +-1.2565963231085289e-03 +-1.2693714493340383e-03 +-1.2825127570188545e-03 +-1.2953532312266491e-03 +-1.3071007944215291e-03 +-1.3168548086146053e-03 +-1.3236544056736152e-03 +-1.3265622690236561e-03 +-1.3247747457295403e-03 +-1.3177356638200558e-03 +-1.3052242346832383e-03 +-1.2873920138693634e-03 +-1.2647389768905613e-03 +-1.2380372972253077e-03 +-1.2082249505859718e-03 +-1.1762950790111045e-03 +-1.1432019439658032e-03 +-1.1097947017558493e-03 +-1.0767808595739633e-03 +-1.0447149158861113e-03 +-1.0140049106505582e-03 +-9.8492955654285461e-04 +-9.5766003538330841e-04 +-9.3228239229871715e-04 +-9.0881813535435580e-04 +-8.8724190721534840e-04 +-8.6749591950502456e-04 +-8.4950131268724872e-04 +-8.3316683071218305e-04 +-8.1839527310300861e-04 +-8.0508817568105155e-04 +-7.9314911925716159e-04 +-7.8248599985127618e-04 +-7.7301252861886700e-04 +-7.6464917135681161e-04 +-7.5732368859132530e-04 +-7.5097139789266469e-04 +-7.4553524923680575e-04 +-7.4096578059289024e-04 +-7.3722100307534080e-04 +-7.3426625172013065e-04 +-7.3207402815832407e-04 +-7.3062385430616326e-04 +-7.2990215093357168e-04 +-1.0795738980405379e-03 +-1.0816850256075688e-03 +-1.0858537628638436e-03 +-1.0919726527790984e-03 +-1.0998792584785086e-03 +-1.1093541385558620e-03 +-1.1201174206918452e-03 +-1.1318237748722025e-03 +-1.1440562865356527e-03 +-1.1563210466722683e-03 +-1.1680460658238260e-03 +-1.1785897450574696e-03 +-1.1872644717188182e-03 +-1.1933787721206631e-03 +-1.1962964720053494e-03 +-1.1955047025997208e-03 +-1.1906770903467555e-03 +-1.1817170719791901e-03 +-1.1687703390101240e-03 +-1.1522035741039201e-03 +-1.1325554819392417e-03 +-1.1104721519380114e-03 +-1.0866402822796084e-03 +-1.0617292520109917e-03 +-1.0363483747479838e-03 +-1.0110209639866111e-03 +-9.8617340756589609e-04 +-9.6213567672278071e-04 +-9.3914931709485061e-04 +-9.1737945835023858e-04 +-8.9692823823390696e-04 +-8.7784792451062470e-04 +-8.6015275883193000e-04 +-8.4382908498987434e-04 +-8.2884367332654817e-04 +-8.1515035401143947e-04 +-8.0269516928869393e-04 +-7.9142028660090982e-04 +-7.8126690873892100e-04 +-7.7217739264615580e-04 +-7.6409675683230963e-04 +-7.5697372511717646e-04 +-7.5076142496796746e-04 +-7.4541783338260279e-04 +-7.4090604237415328e-04 +-7.3719439932370674e-04 +-7.3425656424802566e-04 +-7.3207151575021699e-04 +-7.3062352949754077e-04 +-7.2990214692739076e-04 +-9.6691646889575053e-04 +-9.6881016584244857e-04 +-9.7255491873301646e-04 +-9.7806514858260799e-04 +-9.8521169903747347e-04 +-9.9382077382698065e-04 +-1.0036723737716232e-03 +-1.0144982566251239e-03 +-1.0259797211593208e-03 +-1.0377460367829330e-03 +-1.0493750763674312e-03 +-1.0603984638982858e-03 +-1.0703139151505075e-03 +-1.0786069202303684e-03 +-1.0847821503595593e-03 +-1.0884021344789337e-03 +-1.0891276886106694e-03 +-1.0867525800162721e-03 +-1.0812250709263656e-03 +-1.0726515589058964e-03 +-1.0612816681712790e-03 +-1.0474783204009240e-03 +-1.0316790986848313e-03 +-1.0143559356451356e-03 +-9.9597902480120853e-04 +-9.7698867171802672e-04 +-9.5777646368571019e-04 +-9.3867527826299742e-04 +-9.1995653079885234e-04 +-9.0183263602566202e-04 +-8.8446273057511465e-04 +-8.6796004577208619e-04 +-8.5239975243750433e-04 +-8.3782650823187332e-04 +-8.2426126937261185e-04 +-8.1170716901389733e-04 +-8.0015442297510890e-04 +-7.8958431743624436e-04 +-7.7997238123620925e-04 +-7.7129086334885085e-04 +-7.6351063596227049e-04 +-7.5660263369981917e-04 +-7.5053892530302217e-04 +-7.4529349880601251e-04 +-7.4084282666681347e-04 +-7.3716626434002256e-04 +-7.3424632467689879e-04 +-7.3206886128901754e-04 +-7.3062318642598447e-04 +-7.2990214269680917e-04 +-8.7486167854610494e-04 +-8.7657743436195333e-04 +-8.7997528017900734e-04 +-8.8498766976311883e-04 +-8.9151275459393390e-04 +-8.9941377191731940e-04 +-9.0851828159513065e-04 +-9.1861734474947272e-04 +-9.2946485372385416e-04 +-9.4077742899333875e-04 +-9.5223559401439275e-04 +-9.6348726417351440e-04 +-9.7415480202827981e-04 +-9.8384679788181099e-04 +-9.9217514903530567e-04 +-9.9877689021479906e-04 +-1.0033387771758856e-03 +-1.0056213000295894e-03 +-1.0054781500321197e-03 +-1.0028675619065128e-03 +-9.9785339198600674e-04 +-9.9059583870157058e-04 +-9.8133370490388920e-04 +-9.7036145031347194e-04 +-9.5800469963689067e-04 +-9.4459742862644817e-04 +-9.3046306460364109e-04 +-9.1590059455639498e-04 +-9.0117577746238586e-04 +-8.8651686773128738e-04 +-8.7211389868475464e-04 +-8.5812048825576652e-04 +-8.4465722026210994e-04 +-8.3181583503608072e-04 +-8.1966366691041664e-04 +-8.0824795310875316e-04 +-7.9759979041424422e-04 +-7.8773762840093789e-04 +-7.7867026474748942e-04 +-7.7039935625437242e-04 +-7.6292148617961269e-04 +-7.5622984101341177e-04 +-7.5031555303121575e-04 +-7.4516876268329211e-04 +-7.4077944968402017e-04 +-7.3713807521579456e-04 +-7.3423607096591368e-04 +-7.3206620431265151e-04 +-7.3062284313306727e-04 +-7.2990213846429715e-04 +-8.0313913433224045e-04 +-8.0471606075825316e-04 +-8.0784303726666668e-04 +-8.1246615203864705e-04 +-8.1850416090797028e-04 +-8.2584809556373294e-04 +-8.3436084369317037e-04 +-8.4387680144693781e-04 +-8.5420175234309957e-04 +-8.6511321145326899e-04 +-8.7636159194893549e-04 +-8.8767268559762494e-04 +-8.9875205302591575e-04 +-9.0929191870086322e-04 +-9.1898097700329534e-04 +-9.2751708978407719e-04 +-9.3462222272509658e-04 +-9.4005826352285416e-04 +-9.4364180715943472e-04 +-9.4525580449329955e-04 +-9.4485627587563787e-04 +-9.4247305106864257e-04 +-9.3820450833092389e-04 +-9.3220726562720274e-04 +-9.2468247343710996e-04 +-9.1586063819418403e-04 +-9.0598677816420030e-04 +-8.9530729793465072e-04 +-8.8405942493338652e-04 +-8.7246352572972329e-04 +-8.6071820436155460e-04 +-8.4899781586545700e-04 +-8.3745189816673133e-04 +-8.2620600304256231e-04 +-8.1536345366634802e-04 +-8.0500763810299498e-04 +-7.9520453989941281e-04 +-7.8600529298859887e-04 +-7.7744862068786593e-04 +-7.6956307520462477e-04 +-7.6236903551902744e-04 +-7.5588045007352913e-04 +-7.5010632910036334e-04 +-7.4505200225988613e-04 +-7.4072016274649168e-04 +-7.3711172086576881e-04 +-7.3422648958131726e-04 +-7.3206372257360059e-04 +-7.3062252257380649e-04 +-7.2990213451277336e-04 +-7.5076453235973790e-04 +-7.5224001058042374e-04 +-7.5516884082878872e-04 +-7.5950664801942768e-04 +-7.6518658517829791e-04 +-7.7211905430658650e-04 +-7.8019143670279400e-04 +-7.8926792146177187e-04 +-7.9918954930928768e-04 +-8.0977462673514162e-04 +-8.2081971420378669e-04 +-8.3210144714507620e-04 +-8.4337949393802265e-04 +-8.5440096377209583e-04 +-8.6490651450460594e-04 +-8.7463824711794032e-04 +-8.8334920289729387e-04 +-8.9081393452532037e-04 +-8.9683927735598537e-04 +-9.0127420201831850e-04 +-9.0401757555175514e-04 +-9.0502284055416393e-04 +-9.0429901602930181e-04 +-9.0190794057538534e-04 +-8.9795819508393536e-04 +-8.9259654361983367e-04 +-8.8599794651588490e-04 +-8.7835521547273291e-04 +-8.6986923276448185e-04 +-8.6074040951126510e-04 +-8.5116177919036752e-04 +-8.4131386620116461e-04 +-8.3136126794773775e-04 +-8.2145075423869444e-04 +-8.1171061605432593e-04 +-8.0225097444816464e-04 +-7.9316477418975859e-04 +-7.8452922133786368e-04 +-7.7640746777774894e-04 +-7.6885039081646921e-04 +-7.6189835726529819e-04 +-7.5558289654668236e-04 +-7.4992823542809766e-04 +-7.4495266823861018e-04 +-7.4066975165866392e-04 +-7.3708932340283231e-04 +-7.3421835037841641e-04 +-7.3206161513484150e-04 +-7.3062225042973424e-04 +-7.2990213115853059e-04 +-7.1661630360168697e-04 +-7.1802569705994303e-04 +-7.2082533250142149e-04 +-7.2497680608172806e-04 +-7.3042228015680411e-04 +-7.3708426126257770e-04 +-7.4486539590872490e-04 +-7.5364836026363109e-04 +-7.6329593779336932e-04 +-7.7365139865846473e-04 +-7.8453931697119951e-04 +-7.9576698547007463e-04 +-8.0712660643203905e-04 +-8.1839844235995858e-04 +-8.2935508554422225e-04 +-8.3976693670543537e-04 +-8.4940885992900936e-04 +-8.5806780747983973e-04 +-8.6555100576004662e-04 +-8.7169410253489367e-04 +-8.7636854512688339e-04 +-8.7948743402209916e-04 +-8.8100919963627277e-04 +-8.8093867367404727e-04 +-8.7932543081279833e-04 +-8.7625960099361349e-04 +-8.7186563412138527e-04 +-8.6629468868876843e-04 +-8.5971639048450146e-04 +-8.5231067127073486e-04 +-8.4426027551624296e-04 +-8.3574435220452620e-04 +-8.2693336495652341e-04 +-8.1798538645168968e-04 +-8.0904371068166452e-04 +-8.0023562624692601e-04 +-7.9167214436130231e-04 +-7.8344845967155414e-04 +-7.7564493125186287e-04 +-7.6832839595964309e-04 +-7.6155365884111902e-04 +-7.5536503951674353e-04 +-7.4979788551855536e-04 +-7.4487999117268814e-04 +-7.4063288290285637e-04 +-7.3707294873207486e-04 +-7.3421240176718586e-04 +-7.3206007529455898e-04 +-7.3062205161884353e-04 +-7.2990212870841615e-04 +-6.9978945542011289e-04 +-7.0116649672639854e-04 +-7.0390285445882364e-04 +-7.0796298755488977e-04 +-7.1329337497491379e-04 +-7.1982231627995509e-04 +-7.2745975022026847e-04 +-7.3609716031503480e-04 +-7.4560765061073772e-04 +-7.5584628843648348e-04 +-7.6665082442108035e-04 +-7.7784291277272974e-04 +-7.8922996449607330e-04 +-8.0060776788623230e-04 +-8.1176399663300308e-04 +-8.2248268691173900e-04 +-8.3254969267758491e-04 +-8.4175901978019384e-04 +-8.4991980050837669e-04 +-8.5686351878600550e-04 +-8.6245096165885819e-04 +-8.6657828974497000e-04 +-8.6918161881121680e-04 +-8.7023960273177148e-04 +-8.6977369850990021e-04 +-8.6784604710367689e-04 +-8.6455517316410245e-04 +-8.6002994205131781e-04 +-8.5442237272307557e-04 +-8.4789996875048515e-04 +-8.4063819775235952e-04 +-8.3281364173288771e-04 +-8.2459818770742768e-04 +-8.1615446188140555e-04 +-8.0763255828959237e-04 +-7.9916799161036732e-04 +-7.9088072127622548e-04 +-7.8287504924523499e-04 +-7.7524018077214482e-04 +-7.6805124766851846e-04 +-7.6137061811991423e-04 +-7.5524934862280732e-04 +-7.4972866636628438e-04 +-7.4484140069843428e-04 +-7.4061330813495071e-04 +-7.3706425588760901e-04 +-7.3420924415970286e-04 +-7.3205925800018141e-04 +-7.3062194610383610e-04 +-7.2990212740810776e-04 +-6.9978952011407380e-04 +-7.0116707971075746e-04 +-7.0390447760543403e-04 +-7.0796617817210465e-04 +-7.1329866422945975e-04 +-7.1983023255530344e-04 +-7.2747080598369084e-04 +-7.3611183148386918e-04 +-7.4562634813141280e-04 +-7.5586932287311957e-04 +-7.6667836577518707e-04 +-7.7787494938772795e-04 +-7.8926626646699761e-04 +-8.0064786149710123e-04 +-8.1180715652697888e-04 +-8.2252795157900633e-04 +-8.3259590627018975e-04 +-8.4180489944632063e-04 +-8.4996402400845260e-04 +-8.5690482305493228e-04 +-8.6248824023676788e-04 +-8.6661067640188521e-04 +-8.6920854651766966e-04 +-8.7026083102728310e-04 +-8.6978930740683224e-04 +-8.6785640078309190e-04 +-8.6456086080046617e-04 +-8.6003170543881504e-04 +-8.5442103076667714e-04 +-8.4789634759686741e-04 +-8.4063307294286499e-04 +-8.3280769593386649e-04 +-8.2459198490062618e-04 +-8.1614843677619783e-04 +-8.0762701832925912e-04 +-7.9916312828050696e-04 +-7.9087662735704222e-04 +-7.8287173899827390e-04 +-7.7523761063165268e-04 +-7.6804933566472901e-04 +-7.6136926088783414e-04 +-7.5524843538194017e-04 +-7.4972808966748694e-04 +-7.4484106402307806e-04 +-7.4061313061379538e-04 +-7.3706417450461980e-04 +-7.3420921384344392e-04 +-7.3205925000446978e-04 +-7.3062194505859387e-04 +-7.2990212739515816e-04 +-7.1661650779505275e-04 +-7.1802753712789066e-04 +-7.2083045553465676e-04 +-7.2498687585323223e-04 +-7.3043897115726206e-04 +-7.3710923589506521e-04 +-7.4490026015119003e-04 +-7.5369459459096073e-04 +-7.6335480270662865e-04 +-7.7372381797504179e-04 +-7.8462574698125837e-04 +-7.9586728362753499e-04 +-8.0723991838399067e-04 +-8.1852312936610164e-04 +-8.2948871411133763e-04 +-8.3990634735153541e-04 +-8.4955032214933804e-04 +-8.5820725436019257e-04 +-8.6568432684443848e-04 +-8.7181746097597602e-04 +-8.7647867820495376e-04 +-8.7958189696503593e-04 +-8.8108652143671477e-04 +-8.8099840827091352e-04 +-8.7936810407092847e-04 +-8.7628656949291094e-04 +-8.7187888274882399e-04 +-8.6629659884100436e-04 +-8.5970950945523305e-04 +-8.5229750755093543e-04 +-8.4424313636617806e-04 +-8.3572523104080872e-04 +-8.2691387842956214e-04 +-8.1796675547864681e-04 +-8.0902677640311206e-04 +-8.0022089066357179e-04 +-7.9165982578310434e-04 +-7.8343855449870348e-04 +-7.7563727548129243e-04 +-7.6832272176858337e-04 +-7.6154964337632111e-04 +-7.5536234447459835e-04 +-7.4979618719307544e-04 +-7.4487900139395130e-04 +-7.4063236174173961e-04 +-7.3707271007564072e-04 +-7.3421231294078216e-04 +-7.3206005188189861e-04 +-7.3062204855944802e-04 +-7.2990212867048263e-04 +-7.5076490807232633e-04 +-7.5224339625833874e-04 +-7.5517826674258636e-04 +-7.5952517333458219e-04 +-7.6521728327051707e-04 +-7.7216496386188808e-04 +-7.8025546930566973e-04 +-7.8935271976282042e-04 +-7.9929729566623024e-04 +-8.0990681075713319e-04 +-8.2097687848994383e-04 +-8.3228294222180020e-04 +-8.4358328332158079e-04 +-8.5462352473197520e-04 +-8.6514287606412842e-04 +-8.7488219210044406e-04 +-8.8359363616763345e-04 +-8.9105138917457214e-04 +-8.9706250145160833e-04 +-9.0147674858682687e-04 +-9.0419431374079808e-04 +-9.0517031835874080e-04 +-9.0441563151325943e-04 +-9.0199391222140391e-04 +-8.9801535437470054e-04 +-8.9262799711058898e-04 +-8.8600766663551238e-04 +-8.7834761891968018e-04 +-8.6984879539159915e-04 +-8.6071135121738591e-04 +-8.5112783574843478e-04 +-8.4127815034667900e-04 +-8.3132621122936469e-04 +-8.2141811460101528e-04 +-8.1168153345776621e-04 +-8.0222605711292503e-04 +-7.9314420022553599e-04 +-7.8451284364171997e-04 +-7.7639491342436839e-04 +-7.6884114925253203e-04 +-7.6189185419614936e-04 +-7.5557855237795536e-04 +-7.4992550851596287e-04 +-7.4495108408985161e-04 +-7.4066891971179163e-04 +-7.3708894322261265e-04 +-7.3421820910678952e-04 +-7.3206157794304856e-04 +-7.3062224557360485e-04 +-7.2990213109836572e-04 +-8.0313974055178170e-04 +-8.0472152357079674e-04 +-8.0785824518934143e-04 +-8.1249603566778113e-04 +-8.1855365987219169e-04 +-8.2592206217911265e-04 +-8.3446386678791577e-04 +-8.4401294114052759e-04 +-8.5437418897722219e-04 +-8.6532382979228760e-04 +-8.7661054379576135e-04 +-8.8795799619472587e-04 +-8.9906935261946646e-04 +-9.0963438277851417e-04 +-9.1933954068543200e-04 +-9.2788096208140257e-04 +-9.3497967056937938e-04 +-9.4039757660160418e-04 +-9.4395230940279740e-04 +-9.4552876108250274e-04 +-9.4508556216494168e-04 +-9.4265549710132541e-04 +-9.3833989577194474e-04 +-9.3229801540256900e-04 +-9.2473310743569398e-04 +-9.1587711946885305e-04 +-9.0597583157963084e-04 +-8.9527579342611025e-04 +-8.8401387714585010e-04 +-8.7240973478320682e-04 +-8.6066103831570887e-04 +-8.4894111869346356e-04 +-8.3739849786896529e-04 +-8.2615779164103679e-04 +-8.1532151233599376e-04 +-8.0497238475734203e-04 +-7.9517588165695650e-04 +-7.8598277106580751e-04 +-7.7743153978788082e-04 +-7.6955061312207007e-04 +-7.6236033141031891e-04 +-7.5587467172946949e-04 +-7.5010272074695983e-04 +-7.4504991506484813e-04 +-7.4071907047449368e-04 +-7.3711122313553754e-04 +-7.3422630503662144e-04 +-7.3206367406835878e-04 +-7.3062251624724330e-04 +-7.2990213443441037e-04 +-8.7486260945546094e-04 +-8.7658582294677988e-04 +-8.7999863131761288e-04 +-8.8503354309683185e-04 +-8.9158869352799796e-04 +-8.9952711805385587e-04 +-9.0867584634268263e-04 +-9.1882492568400021e-04 +-9.2972660976781813e-04 +-9.4109516573669604e-04 +-9.5260805408059555e-04 +-9.6390955713762433e-04 +-9.7461812878244219e-04 +-9.8433860962863573e-04 +-9.9267982207023805e-04 +-9.9927689938059897e-04 +-1.0038162357666612e-03 +-1.0060596366640755e-03 +-1.0058636474714090e-03 +-1.0031905068744651e-03 +-9.9810867189874296e-04 +-9.9078294204222326e-04 +-9.8145619901852401e-04 +-9.7042609247704234e-04 +-9.5802036996830975e-04 +-9.4457406039589607e-04 +-9.3041070411387853e-04 +-9.1582866784625046e-04 +-9.0109258990603140e-04 +-8.8642932405075909e-04 +-8.7202740755451546e-04 +-8.5803900586393445e-04 +-8.4458338719668453e-04 +-8.3175116671005943e-04 +-8.1960876615322386e-04 +-8.0820272228841175e-04 +-7.9756362823345717e-04 +-7.8770960277569355e-04 +-7.7864925784068019e-04 +-7.7038418096381245e-04 +-7.6291097543909300e-04 +-7.5622291244224044e-04 +-7.5031125201774709e-04 +-7.4516628712008261e-04 +-7.4077815944661627e-04 +-7.3713748921095496e-04 +-7.3423585425080504e-04 +-7.3206614746024027e-04 +-7.3062283572713311e-04 +-7.2990213837263848e-04 +-9.6691786406990230e-04 +-9.6882273780146580e-04 +-9.7258991134015454e-04 +-9.7813386793715634e-04 +-9.8532536638137771e-04 +-9.9399017227039472e-04 +-1.0039072419440471e-03 +-1.0148064168572337e-03 +-1.0263659864926673e-03 +-1.0382110180665398e-03 +-1.0499140946165677e-03 +-1.0610008373749074e-03 +-1.0709629003238794e-03 +-1.0792805113257616e-03 +-1.0854547785363630e-03 +-1.0890470883181079e-03 +-1.0897198711542864e-03 +-1.0872711019784421e-03 +-1.0816552045448283e-03 +-1.0729857366487902e-03 +-1.0615194459424483e-03 +-1.0476254528587487e-03 +-1.0317460265141124e-03 +-1.0143560328920095e-03 +-9.9592691187885742e-04 +-9.7689880411588274e-04 +-9.5766209866592121e-04 +-9.3854783131751848e-04 +-9.1982527371622718e-04 +-9.0170465927974009e-04 +-8.8434308728959992e-04 +-8.6785200358576310e-04 +-8.5230509524697245e-04 +-8.3774584653413477e-04 +-8.2419433271270558e-04 +-8.1165306563391027e-04 +-8.0011186005892777e-04 +-7.8955178080970876e-04 +-7.7994827666374208e-04 +-7.7127362329641573e-04 +-7.6349879639639765e-04 +-7.5659488555796298e-04 +-7.5053414497873938e-04 +-7.4529076152714279e-04 +-7.4084140612151164e-04 +-7.3716562139282307e-04 +-7.3424608755301944e-04 +-7.3206879920877273e-04 +-7.3062317834992209e-04 +-7.2990214259691555e-04 +-1.0795759508450849e-03 +-1.0817035231175871e-03 +-1.0859052414347566e-03 +-1.0920737022246663e-03 +-1.1000462277000851e-03 +-1.1096024727888932e-03 +-1.1204605556546575e-03 +-1.1322715881691924e-03 +-1.1446132271387079e-03 +-1.1569842193398920e-03 +-1.1688037011094421e-03 +-1.1794205710283635e-03 +-1.1881384458583126e-03 +-1.1942593881039258e-03 +-1.1971444589386900e-03 +-1.1962825069044612e-03 +-1.1913532444787545e-03 +-1.1822695434092303e-03 +-1.1691882339105886e-03 +-1.1524870280302697e-03 +-1.1327140216315431e-03 +-1.1105221041008541e-03 +-1.0866018770079281e-03 +-1.0616239574548047e-03 +-1.0361967949639168e-03 +-1.0108414223835216e-03 +-9.8598117982694558e-04 +-9.6194274738060307e-04 +-9.3896450418336013e-04 +-9.1720876055507224e-04 +-8.9677528853112157e-04 +-8.7771446866651969e-04 +-8.6003910791941261e-04 +-8.4373451483377691e-04 +-8.2876676018631731e-04 +-8.1508924600246142e-04 +-8.0264779864253001e-04 +-7.9138453038046428e-04 +-7.8124070625185669e-04 +-7.7215882738631625e-04 +-7.6408410987648893e-04 +-7.5696550584488851e-04 +-7.5075638393642431e-04 +-7.4541496126471357e-04 +-7.4090455808520491e-04 +-7.3719372982375213e-04 +-7.3425631799895732e-04 +-7.3207145141092171e-04 +-7.3062352113883739e-04 +-7.2990214682407280e-04 +-1.2115521878336109e-03 +-1.2139414302523061e-03 +-1.2186549953689424e-03 +-1.2255621944907795e-03 +-1.2344642938839077e-03 +-1.2450897615435591e-03 +-1.2570858502804366e-03 +-1.2700059477425173e-03 +-1.2832939880971915e-03 +-1.2962705354681145e-03 +-1.3081292507234386e-03 +-1.3179553697857979e-03 +-1.3247766436900548e-03 +-1.3276497133722720e-03 +-1.3257719620293168e-03 +-1.3185955435306097e-03 +-1.3059137894312930e-03 +-1.2878954082686201e-03 +-1.2650573986965653e-03 +-1.2381861634358665e-03 +-1.2082295290194093e-03 +-1.1761857257535657e-03 +-1.1430099045612776e-03 +-1.1095490019152185e-03 +-1.0765064101534425e-03 +-1.0444316829080875e-03 +-1.0137278730634855e-03 +-9.8466915858580147e-04 +-9.5742288798025528e-04 +-9.3207204783199362e-04 +-9.0863582701912232e-04 +-8.8708719654208377e-04 +-8.6736723135443959e-04 +-8.4939635845801141e-04 +-8.3308293150835685e-04 +-8.1832959885404233e-04 +-8.0503791654330261e-04 +-7.9311160400425838e-04 +-7.8245877358818145e-04 +-7.7299339970415240e-04 +-7.6463623521605688e-04 +-7.5731533427304137e-04 +-7.5096630176739877e-04 +-7.4553235912887381e-04 +-7.4096429280279665e-04 +-7.3722033413873872e-04 +-7.3426600630236544e-04 +-7.3207396415799115e-04 +-7.3062384600204187e-04 +-7.2990215083099000e-04 +-1.3589599961569333e-03 +-1.3616429209811418e-03 +-1.3669346920537953e-03 +-1.3746858028696330e-03 +-1.3846671639936570e-03 +-1.3965604950675341e-03 +-1.4099402755698509e-03 +-1.4242458050446754e-03 +-1.4387464760691425e-03 +-1.4525111310733684e-03 +-1.4644011359633464e-03 +-1.4731111653042295e-03 +-1.4772749381595336e-03 +-1.4756323193978000e-03 +-1.4672254739539457e-03 +-1.4515701084135196e-03 +-1.4287481154393346e-03 +-1.3993930954555155e-03 +-1.3645775932743073e-03 +-1.3256409969449475e-03 +-1.2840071503677857e-03 +-1.2410312811940087e-03 +-1.1978965685462261e-03 +-1.1555622114334042e-03 +-1.1147531720737084e-03 +-1.0759775481537076e-03 +-1.0395584882876745e-03 +-1.0056708904781591e-03 +-9.7437677863638518e-04 +-9.4565622367342322e-04 +-9.1943269463394170e-04 +-8.9559290570695785e-04 +-8.7400180371637179e-04 +-8.5451354440261532e-04 +-8.3697930387109556e-04 +-8.2125267382432432e-04 +-8.0719325930304832e-04 +-7.9466896863871232e-04 +-7.8355737177121022e-04 +-7.7374640956805142e-04 +-7.6513466288391410e-04 +-7.5763133333658699e-04 +-7.5115604507107860e-04 +-7.4563854518400186e-04 +-7.4101835743459600e-04 +-7.3724442728714758e-04 +-7.3427478456815831e-04 +-7.3207624179272431e-04 +-7.3062414055077038e-04 +-7.2990215446476741e-04 +-1.5143557317081236e-03 +-1.5173505457448922e-03 +-1.5232645752098876e-03 +-1.5319444351995074e-03 +-1.5431513009835794e-03 +-1.5565418563899345e-03 +-1.5716312595793762e-03 +-1.5877352645990283e-03 +-1.6038991288457058e-03 +-1.6188379097244090e-03 +-1.6309297570865876e-03 +-1.6383075300695367e-03 +-1.6390710056190256e-03 +-1.6315919129404697e-03 +-1.6148294756300706e-03 +-1.5885506583952829e-03 +-1.5533782829145774e-03 +-1.5106578680936435e-03 +-1.4622005803705631e-03 +-1.4099904147737389e-03 +-1.3559322232638636e-03 +-1.3016816859431222e-03 +-1.2485623093428505e-03 +-1.1975518654792452e-03 +-1.1493130826964954e-03 +-1.1042458628630037e-03 +-1.0625448943913109e-03 +-1.0242532591780093e-03 +-9.8930774428898291e-04 +-9.5757479238083379e-04 +-9.2887773722030720e-04 +-9.0301668814208897e-04 +-8.7978257901725641e-04 +-8.5896677343816439e-04 +-8.4036738942135395e-04 +-8.2379326328391514e-04 +-8.0906625356365162e-04 +-7.9602240538721107e-04 +-7.8451235405760920e-04 +-7.7440123900106045e-04 +-7.6556831923483486e-04 +-7.5790642309169788e-04 +-7.5132132285601503e-04 +-7.4573109505985519e-04 +-7.4106550623368275e-04 +-7.3726544946418459e-04 +-7.3428244737045649e-04 +-7.3207823071322364e-04 +-7.3062439782599245e-04 +-7.2990215763939193e-04 +-1.6665476723171228e-03 +-1.6698512013779635e-03 +-1.6763958981142299e-03 +-1.6860535131558948e-03 +-1.6986162348121146e-03 +-1.7137609571468775e-03 +-1.7309785720741498e-03 +-1.7494636134601361e-03 +-1.7679816510441711e-03 +-1.7847656136139119e-03 +-1.7975216703496001e-03 +-1.8036213984667904e-03 +-1.8004966792708990e-03 +-1.7861505453421358e-03 +-1.7596111376066721e-03 +-1.7211549941929063e-03 +-1.6722227446445107e-03 +-1.6150832847805542e-03 +-1.5523885362487267e-03 +-1.4867631759254171e-03 +-1.4205166448360311e-03 +-1.3554968659254692e-03 +-1.2930596527570310e-03 +-1.2341115455857896e-03 +-1.1791875146305994e-03 +-1.1285366830601875e-03 +-1.0822010284374090e-03 +-1.0400806858333869e-03 +-1.0019846781125627e-03 +-9.6766847927315033e-04 +-9.3686076843772087e-04 +-9.0928181933665610e-04 +-8.8465567521651273e-04 +-8.6271784682221092e-04 +-8.4321986828679737e-04 +-8.2593170224074040e-04 +-8.1064271256049291e-04 +-7.9716171543765704e-04 +-7.8531646566311678e-04 +-7.7495282339753763e-04 +-7.6593376689458787e-04 +-7.5813836032201072e-04 +-7.5146074657749277e-04 +-7.4580920802854898e-04 +-7.4110531990599030e-04 +-7.3728320909090305e-04 +-7.3428892342595673e-04 +-7.3207991211887864e-04 +-7.3062461536895591e-04 +-7.2990216032439346e-04 +-1.8021223087827715e-03 +-1.8057046626884354e-03 +-1.8128407786827971e-03 +-1.8234680472788459e-03 +-1.8374671600349206e-03 +-1.8546009959136333e-03 +-1.8743925429866115e-03 +-1.8959351517776491e-03 +-1.9176693276985964e-03 +-1.9372203793611212e-03 +-1.9514372388473511e-03 +-1.9567490914389313e-03 +-1.9498287791388279e-03 +-1.9283676760512632e-03 +-1.8916553141427373e-03 +-1.8407244396973763e-03 +-1.7780343353171212e-03 +-1.7068697052189461e-03 +-1.6307033612075418e-03 +-1.5527062419617519e-03 +-1.4754715351927010e-03 +-1.4009284112259579e-03 +-1.3303816232171542e-03 +-1.2646137864002294e-03 +-1.2040051799836907e-03 +-1.1486455674954914e-03 +-1.0984271204896115e-03 +-1.0531162148684034e-03 +-1.0124061010876283e-03 +-9.7595397164095010e-04 +-9.4340607328076160e-04 +-9.1441404062925745e-04 +-8.8864498804271878e-04 +-8.6578728355592410e-04 +-8.4555341463774718e-04 +-8.2768095333673563e-04 +-8.1193232670302836e-04 +-7.9809387819451292e-04 +-7.8597454819985004e-04 +-7.7540439073421445e-04 +-7.6623306607230318e-04 +-7.5832839597623038e-04 +-7.5157503219689097e-04 +-7.4587326497661767e-04 +-7.4113798273231989e-04 +-7.3729778437187554e-04 +-7.3429424000154427e-04 +-7.3208129283189706e-04 +-7.3062479403919012e-04 +-7.2990216253019150e-04 +-1.9092031742736512e-03 +-1.9130088927196171e-03 +-1.9206442834026093e-03 +-1.9321496790956428e-03 +-1.9475484182873151e-03 +-1.9667550313567472e-03 +-1.9893902510419725e-03 +-2.0144928058195653e-03 +-2.0401823601616706e-03 +-2.0634229730566358e-03 +-2.0801059183854918e-03 +-2.0856188048651012e-03 +-2.0758422017973033e-03 +-2.0482210700752753e-03 +-2.0024360383472661e-03 +-1.9403906967809532e-03 +-1.8655965768526717e-03 +-1.7822946595625340e-03 +-1.6946608980488223e-03 +-1.6062849484657343e-03 +-1.5199411633411597e-03 +-1.4375756202714386e-03 +-1.3604133109327526e-03 +-1.2891102253069174e-03 +-1.2239049509889419e-03 +-1.1647485295833771e-03 +-1.1114063318556624e-03 +-1.0635333653312832e-03 +-1.0207274522673966e-03 +-9.8256529238820666e-04 +-9.4862591651078006e-04 +-9.1850517716346816e-04 +-8.9182405441602284e-04 +-8.6823281288981257e-04 +-8.4741246086690797e-04 +-8.2907452286237575e-04 +-8.1295981695106304e-04 +-7.9883670016910773e-04 +-7.8649908567409094e-04 +-7.7576442514662566e-04 +-7.6647177485745274e-04 +-7.5848001341975854e-04 +-7.5166624597827205e-04 +-7.4592440811968174e-04 +-7.4116406941679446e-04 +-7.3730942863939515e-04 +-7.3429848852970430e-04 +-7.3208239639697243e-04 +-7.3062493686551749e-04 +-7.2990216429407774e-04 +-1.9822062284716264e-03 +-1.9861647601056936e-03 +-1.9941627770123241e-03 +-2.0063530877133949e-03 +-2.0229186979947036e-03 +-2.0439560454761953e-03 +-2.0692359149447714e-03 +-2.0978232755165618e-03 +-2.1276201773870736e-03 +-2.1550304670714024e-03 +-2.1750566780921183e-03 +-2.1820721565368752e-03 +-2.1711673151348847e-03 +-2.1395302128693378e-03 +-2.0871933428222200e-03 +-2.0168369899378541e-03 +-1.9328764837864382e-03 +-1.8403407804903906e-03 +-1.7439639529379187e-03 +-1.6476589605286145e-03 +-1.5543387093629839e-03 +-1.4659646524292503e-03 +-1.3837056552237468e-03 +-1.3081264163017576e-03 +-1.2393619299453261e-03 +-1.1772604956013647e-03 +-1.1214924285077607e-03 +-1.0716283511025052e-03 +-1.0271931301816780e-03 +-9.8770149389637379e-04 +-9.5268045237186481e-04 +-9.2168253020528403e-04 +-8.9429279238633242e-04 +-8.7013180595331679e-04 +-8.4885603676691139e-04 +-8.3015670782392455e-04 +-8.1375780720206498e-04 +-7.9941369666532830e-04 +-7.8690660863629271e-04 +-7.7604420837371188e-04 +-7.6665732405254133e-04 +-7.5859789865753420e-04 +-7.5173718617523770e-04 +-7.4596419488405323e-04 +-7.4118436878821891e-04 +-7.3731849175312383e-04 +-7.3430179595872691e-04 +-7.3208325564510189e-04 +-7.3062504808404385e-04 +-7.2990216566822116e-04 +-2.0242491554080359e-03 +-2.0282921568659557e-03 +-2.0364984438965570e-03 +-2.0490996147195526e-03 +-2.0663961174394708e-03 +-2.0886353036433016e-03 +-2.1157533372207472e-03 +-2.1469434300305994e-03 +-2.1800963547999683e-03 +-2.2113315333155258e-03 +-2.2350237074417563e-03 +-2.2446913779132546e-03 +-2.2346503986520666e-03 +-2.2017095445412984e-03 +-2.1460273237623355e-03 +-2.0707849312094767e-03 +-1.9810388509498636e-03 +-1.8824072168608726e-03 +-1.7800675198100288e-03 +-1.6782164554336421e-03 +-1.5799174594454226e-03 +-1.4871867782148931e-03 +-1.4011864003331104e-03 +-1.3224385818678629e-03 +-1.2510184474345985e-03 +-1.1867086946938789e-03 +-1.1291152921334797e-03 +-1.0777495391295913e-03 +-1.0320836924168962e-03 +-9.9158700661221700e-04 +-9.5574786387044009e-04 +-9.2408635699908542e-04 +-8.9616052632441798e-04 +-8.7156851916782166e-04 +-8.4994823858898093e-04 +-8.3097553860186945e-04 +-8.1436166339252840e-04 +-7.9985037930253497e-04 +-7.8721507925730576e-04 +-7.7625602615741208e-04 +-7.6679782726356424e-04 +-7.5868718344263822e-04 +-7.5179092677801643e-04 +-7.4599434152097625e-04 +-7.4119975273330310e-04 +-7.3732536147459542e-04 +-7.3430430332419212e-04 +-7.3208390711960384e-04 +-7.3062513241612097e-04 +-7.2990216671083496e-04 +-2.0445805958412698e-03 +-2.0486574192627237e-03 +-2.0569391586902717e-03 +-2.0696749273222069e-03 +-2.0872001092337978e-03 +-2.1098328096029375e-03 +-2.1376415891779816e-03 +-2.1700214003869587e-03 +-2.2050749433067010e-03 +-2.2389911394350903e-03 +-2.2658993917536877e-03 +-2.2787313243376578e-03 +-2.2710794265965234e-03 +-2.2391996850679432e-03 +-2.1830581457274543e-03 +-2.1059901244606587e-03 +-2.0134128244374077e-03 +-1.9113600166928788e-03 +-1.8053780698701356e-03 +-1.6999409896357660e-03 +-1.5982927631354902e-03 +-1.5025484440736145e-03 +-1.4139086010258128e-03 +-1.3328943483873297e-03 +-1.2595563421241647e-03 +-1.1936412048930752e-03 +-1.1347148843791797e-03 +-1.0822492949828181e-03 +-1.0356803935452684e-03 +-9.9444529641844800e-04 +-9.5800466229312923e-04 +-9.2585507452073426e-04 +-8.9753485736145957e-04 +-8.7262573521865703e-04 +-8.5075198015913990e-04 +-8.3157814510614913e-04 +-8.1480609749074676e-04 +-8.0017180640839212e-04 +-7.8744216042592392e-04 +-7.7641197683660636e-04 +-7.6690128756395264e-04 +-7.5875293872487508e-04 +-7.5183051101443139e-04 +-7.4601655024934723e-04 +-7.4121108753308384e-04 +-7.3733042368937852e-04 +-7.3430615117256231e-04 +-7.3208438727686946e-04 +-7.3062519457545009e-04 +-7.2990216748006762e-04 +-2.0529852811381607e-03 +-2.0570681946589855e-03 +-2.0653440081555012e-03 +-2.0780280994307713e-03 +-2.0954175922555732e-03 +-2.1178172509105095e-03 +-2.1453595039302290e-03 +-2.1776366952404942e-03 +-2.2130844569849535e-03 +-2.2482376480620794e-03 +-2.2773534434329329e-03 +-2.2930974031036807e-03 +-2.2884592106667536e-03 +-2.2590233227041882e-03 +-2.2042913668484207e-03 +-2.1274588234011533e-03 +-2.0340783909499334e-03 +-1.9304678145311515e-03 +-1.8224865140126275e-03 +-1.7148766908076922e-03 +-1.6110770332836753e-03 +-1.5133246777188694e-03 +-1.4228840721379897e-03 +-1.3402994081573878e-03 +-1.2656188279557925e-03 +-1.1985722235466753e-03 +-1.1387022619750769e-03 +-1.0854557684049050e-03 +-1.0382444805049000e-03 +-9.9648350008357356e-04 +-9.5961419146473926e-04 +-9.2711661410500629e-04 +-8.9851514838896931e-04 +-8.7337985884331556e-04 +-8.5132531711022946e-04 +-8.3200802294024700e-04 +-8.1512315731462233e-04 +-8.0040112776395237e-04 +-7.8760418343988298e-04 +-7.7652325787153022e-04 +-7.6697512039684715e-04 +-7.5879986872979448e-04 +-7.5185876548046775e-04 +-7.4603240401830198e-04 +-7.4121917968842863e-04 +-7.3733403802455320e-04 +-7.3430747060228860e-04 +-7.3208473014637840e-04 +-7.3062523896408620e-04 +-7.2990216803023680e-04 +-2.0560415460618743e-03 +-2.0601204086577191e-03 +-2.0683610070560705e-03 +-2.0809262398299960e-03 +-2.0980437489078073e-03 +-2.1199559669509609e-03 +-2.1467902700768203e-03 +-2.1782654824402349e-03 +-2.2131320855143161e-03 +-2.2483766956311918e-03 +-2.2786270152752438e-03 +-2.2965640268255449e-03 +-2.2947489044587250e-03 +-2.2680936518002844e-03 +-2.2155066781845627e-03 +-2.1398785721844006e-03 +-2.0467585922797843e-03 +-1.9426536877860581e-03 +-1.8336793507211669e-03 +-1.7248151296225796e-03 +-1.6196804772981058e-03 +-1.5206315401310477e-03 +-1.4290004521944194e-03 +-1.3453623721051986e-03 +-1.2697728864634317e-03 +-1.2019557739757095e-03 +-1.1414407798019024e-03 +-1.0876592046532836e-03 +-1.0400070786580433e-03 +-9.9788487212346339e-04 +-9.6072094550436629e-04 +-9.2798412818099704e-04 +-8.9918927537976652e-04 +-8.7389846175523205e-04 +-8.5171959934613741e-04 +-8.3230365332018241e-04 +-8.1534120690236940e-04 +-8.0055884258202622e-04 +-7.8771561867204960e-04 +-7.7659979782849532e-04 +-7.6702590599052420e-04 +-7.5883215124262528e-04 +-7.5187820253038069e-04 +-7.4604331093503743e-04 +-7.4122474716753039e-04 +-7.3733652485040554e-04 +-7.3430837847006229e-04 +-7.3208496607500572e-04 +-7.3062526950898917e-04 +-7.2990216840983333e-04 +-2.0570064389737052e-03 +-2.0610799383707114e-03 +-2.0692864532968779e-03 +-2.0817429126205734e-03 +-2.0986123026974861e-03 +-2.1200666527524132e-03 +-2.1461900146808413e-03 +-2.1767491384916582e-03 +-2.2107142436021388e-03 +-2.2454792156695624e-03 +-2.2761097329770481e-03 +-2.2954647847029390e-03 +-2.2958477060902528e-03 +-2.2716031128036376e-03 +-2.2210718377978461e-03 +-2.1468092704443396e-03 +-2.0543025332651027e-03 +-1.9501807973441288e-03 +-1.8407534347482191e-03 +-1.7311873318427988e-03 +-1.6252474340273063e-03 +-1.5253874114755756e-03 +-1.4329965904184658e-03 +-1.3486783474040639e-03 +-1.2724978266308142e-03 +-1.2041774686689845e-03 +-1.1432400258643098e-03 +-1.0891074155778846e-03 +-1.0411657816373258e-03 +-9.9880620447171395e-04 +-9.6144861072410047e-04 +-9.2855450194432383e-04 +-8.9963249559296839e-04 +-8.7423942279391551e-04 +-8.5197881970389177e-04 +-8.3249801244208337e-04 +-8.1548456026824022e-04 +-8.0066252974318405e-04 +-7.8778888052540811e-04 +-7.7665011881918814e-04 +-7.6705929544319362e-04 +-7.5885337613527286e-04 +-7.5189098217893406e-04 +-7.4605048229094389e-04 +-7.4122840790297455e-04 +-7.3733816002725938e-04 +-7.3430897543711804e-04 +-7.3208512121196293e-04 +-7.3062528959465408e-04 +-7.2990216866065613e-04 +-2.0572332019277648e-03 +-2.0613027609558423e-03 +-2.0694856482624800e-03 +-2.0818674861175245e-03 +-2.0985655961695184e-03 +-2.1196969670142368e-03 +-2.1452978092395833e-03 +-2.1751368651273871e-03 +-2.2083085288436628e-03 +-2.2425002404066969e-03 +-2.2731501900048303e-03 +-2.2933285613838082e-03 +-2.2952039773811196e-03 +-2.2727094381616970e-03 +-2.2237432736593528e-03 +-2.1505849490738123e-03 +-2.0586540504187920e-03 +-1.9546554339304758e-03 +-1.8450315961524150e-03 +-1.7350806139386583e-03 +-1.6286700172892391e-03 +-1.5283226387813606e-03 +-1.4354688335172637e-03 +-1.3507328278855549e-03 +-1.2741876247244295e-03 +-1.2055559096840361e-03 +-1.1443566778815216e-03 +-1.0900063293742654e-03 +-1.0418850275925864e-03 +-9.9937810035067892e-04 +-9.6190027357114113e-04 +-9.2890851389139731e-04 +-8.9990757075202824e-04 +-8.7445102024373675e-04 +-8.5213968063225479e-04 +-8.3261861732214699e-04 +-8.1557351095764858e-04 +-8.0072686526582294e-04 +-7.8783433649461815e-04 +-7.7668134017787587e-04 +-7.6708001133248417e-04 +-7.5886654453922965e-04 +-7.5189891086591522e-04 +-7.4605493146508725e-04 +-7.4123067903866563e-04 +-7.3733917449137984e-04 +-7.3430934579386267e-04 +-7.3208521745827897e-04 +-7.3062530205614967e-04 +-7.2990216881778586e-04 +-2.0572420565079914e-03 +-2.0613092903172896e-03 +-2.0694783707161275e-03 +-2.0818166357009977e-03 +-2.0984142470919474e-03 +-2.1193536785116375e-03 +-2.1446363205644683e-03 +-2.1740193085428620e-03 +-2.2066580943959058e-03 +-2.2404191855148457e-03 +-2.2709935398315343e-03 +-2.2916156395719773e-03 +-2.2943896494949855e-03 +-2.2729896150464335e-03 +-2.2250245434250232e-03 +-2.1525896350917104e-03 +-2.0610554569956943e-03 +-1.9571710666785305e-03 +-1.8474606946227861e-03 +-1.7373034707397473e-03 +-1.6306303284560717e-03 +-1.5300068465520685e-03 +-1.4368887989506906e-03 +-1.3519134501836512e-03 +-1.2751588935509277e-03 +-1.2063482520937420e-03 +-1.1449985059873938e-03 +-1.0905229490209185e-03 +-1.0422983323735034e-03 +-9.9970668387907528e-04 +-9.6215973883576479e-04 +-9.2911185331648728e-04 +-9.0006554923781281e-04 +-8.7457252813956268e-04 +-8.5223204336114808e-04 +-8.3268785899172143e-04 +-8.1562457466925373e-04 +-8.0076379513654961e-04 +-7.8786042713954285e-04 +-7.7669925924022775e-04 +-7.6709190015952907e-04 +-7.5887410142150356e-04 +-7.5190346060968001e-04 +-7.4605748442077157e-04 +-7.4123198216755916e-04 +-7.3733975654609091e-04 +-7.3430955828126252e-04 +-7.3208527267712984e-04 +-7.3062530920606206e-04 +-7.2990216890985859e-04 +-2.0572136831939910e-03 +-2.0612797540133761e-03 +-2.0694418596028837e-03 +-2.0817580573845090e-03 +-2.0983046605177872e-03 +-2.1191461696319436e-03 +-2.1442646199989340e-03 +-2.1734076433989470e-03 +-2.2057582203948243e-03 +-2.2392764006792399e-03 +-2.2697930415650634e-03 +-2.2906386881088652e-03 +-2.2938874458854177e-03 +-2.2730735227401359e-03 +-2.2256476484281921e-03 +-2.1536040450953874e-03 +-2.0622863272344583e-03 +-1.9584673087501051e-03 +-1.8487151422688719e-03 +-1.7384523322322794e-03 +-1.6316435877823097e-03 +-1.5308771582713666e-03 +-1.4376222408838046e-03 +-1.3525229552142945e-03 +-1.2756600555628673e-03 +-1.2067568831016485e-03 +-1.1453293559239896e-03 +-1.0907891406348985e-03 +-1.0425112065634728e-03 +-9.9987586229682694e-04 +-9.6229328799755942e-04 +-9.2921648442200095e-04 +-9.0014681865442452e-04 +-8.7463502159447785e-04 +-8.5227953714531667e-04 +-8.3272345695235481e-04 +-8.1565082252166494e-04 +-8.0078277478331757e-04 +-7.8787383403977303e-04 +-7.7670846576574485e-04 +-7.6709800760752411e-04 +-7.5887798298777530e-04 +-7.5190579728481985e-04 +-7.4605879542948407e-04 +-7.4123265128916527e-04 +-7.3734005538843685e-04 +-7.3430966736972550e-04 +-7.3208530102441551e-04 +-7.3062531287717918e-04 +-7.2990216895972440e-04 +-2.0571951340140403e-03 +-2.0612607302665166e-03 +-2.0694199329605537e-03 +-2.0817269172637301e-03 +-2.0982522370968739e-03 +-2.1190529301493470e-03 +-2.1441028878353688e-03 +-2.1731454854532575e-03 +-2.2053751145458779e-03 +-2.2387921180757327e-03 +-2.2692884031480136e-03 +-2.2902363432498879e-03 +-2.2936960307713022e-03 +-2.2731394543745410e-03 +-2.2259477913644295e-03 +-2.1540717041273814e-03 +-2.0628440609962626e-03 +-1.9590490019961871e-03 +-1.8492744729442828e-03 +-1.7389621887773624e-03 +-1.6320916412753284e-03 +-1.5312608898421680e-03 +-1.4379448597109236e-03 +-1.3527905303453204e-03 +-1.2758797036096844e-03 +-1.2069357257389517e-03 +-1.1454739835443989e-03 +-1.0909053843071803e-03 +-1.0426040849134315e-03 +-9.9994961948302605e-04 +-9.6235147300019507e-04 +-9.2926204365166608e-04 +-9.0018218719553828e-04 +-8.7466220615535679e-04 +-8.5230018814496029e-04 +-8.3273892946512788e-04 +-8.1566222692972803e-04 +-8.0079101843736277e-04 +-7.8787965534481467e-04 +-7.7671246203444341e-04 +-7.6710065788741040e-04 +-7.5887966689509325e-04 +-7.5190681071889533e-04 +-7.4605936388510573e-04 +-7.4123294135677083e-04 +-7.3734018491262976e-04 +-7.3430971464315058e-04 +-7.3208531330751692e-04 +-7.3062531446882906e-04 +-7.2990216898491443e-04 +-2.0571887354080449e-03 +-2.0612541939464047e-03 +-2.0694125334076567e-03 +-2.0817167777549585e-03 +-2.0982358143216504e-03 +-2.1190245938603053e-03 +-2.1440548488799818e-03 +-2.1730691266016113e-03 +-2.2052658624179726e-03 +-2.2386581197016394e-03 +-2.2691562269457474e-03 +-2.2901440689639279e-03 +-2.2936754976533242e-03 +-2.2732018494706057e-03 +-2.2260824964852968e-03 +-2.1542553098567777e-03 +-2.0630509362286561e-03 +-1.9592580526071341e-03 +-1.8494714620627109e-03 +-1.7391392368563015e-03 +-1.6322456122736956e-03 +-1.5313917006788726e-03 +-1.4380541383333481e-03 +-1.3528806969648568e-03 +-1.2759534054498194e-03 +-1.2069955229372939e-03 +-1.1455221965268906e-03 +-1.0909440371731508e-03 +-1.0426349016273645e-03 +-9.9997404625894073e-04 +-9.6237071142232496e-04 +-9.2927708608660361e-04 +-9.0019385025539233e-04 +-8.7467116037149824e-04 +-8.5230698332449490e-04 +-8.3274401586506291e-04 +-8.1566597268831393e-04 +-8.0079372380275889e-04 +-7.8788156424529853e-04 +-7.7671377148605077e-04 +-7.6710152567293906e-04 +-7.5888021787932415e-04 +-7.5190714210395459e-04 +-7.4605954965247803e-04 +-7.4123303609618246e-04 +-7.3734022719603018e-04 +-7.3430973006956106e-04 +-7.3208531731515630e-04 +-7.3062531498972348e-04 +-7.2990216899881401e-04 +-2.0571877672785339e-03 +-2.0612532075426761e-03 +-2.0694114277804679e-03 +-2.0817153011120628e-03 +-2.0982335247323801e-03 +-2.1190208663793737e-03 +-2.1440489740242861e-03 +-2.1730606434905569e-03 +-2.2052553595471149e-03 +-2.2386483498648803e-03 +-2.2691523851463991e-03 +-2.2901520326513488e-03 +-2.2936988523076232e-03 +-2.2732401070801925e-03 +-2.2261316926639524e-03 +-2.1543100105420542e-03 +-2.0631061072397313e-03 +-1.9593100363064276e-03 +-1.8495181340017256e-03 +-1.7391797207248008e-03 +-1.6322798736451876e-03 +-1.5314201880668504e-03 +-1.4380775248408464e-03 +-1.3528997178153610e-03 +-1.2759687674364739e-03 +-1.2070078611449739e-03 +-1.1455320592586925e-03 +-1.0909518862073052e-03 +-1.0426411198479941e-03 +-9.9997894808242301e-04 +-9.6237455357507239e-04 +-9.2928007755535514e-04 +-9.0019616094269182e-04 +-8.7467292836398221e-04 +-8.5230832086383829e-04 +-8.3274501418566130e-04 +-8.1566670590470843e-04 +-8.0079425202068239e-04 +-7.8788193605030014e-04 +-7.7671402593976419e-04 +-7.6710169392450972e-04 +-7.5888032447877325e-04 +-7.5190720608706030e-04 +-7.4605958545188834e-04 +-7.4123305432184541e-04 +-7.3734023531806295e-04 +-7.3430973302938550e-04 +-7.3208531808426991e-04 +-7.3062531509197567e-04 +-7.2990216900932915e-04 +-2.0571877673237872e-03 +-2.0612532078923187e-03 +-2.0694114290772340e-03 +-2.0817153080722925e-03 +-2.0982335566867363e-03 +-2.1190209780309476e-03 +-2.1440492891738805e-03 +-2.1730613989019492e-03 +-2.2052569347162628e-03 +-2.2386512231007613e-03 +-2.2691569654429890e-03 +-2.2901584294879136e-03 +-2.2937067556625733e-03 +-2.2732488816757115e-03 +-2.2261406085801795e-03 +-2.1543184535739428e-03 +-2.0631136801174434e-03 +-1.9593165577943936e-03 +-1.8495235850261107e-03 +-1.7391841805830292e-03 +-1.6322834682354853e-03 +-1.5314230556223662e-03 +-1.4380797966883261e-03 +-1.3529015095183942e-03 +-1.2759701761656081e-03 +-1.2070089663278668e-03 +-1.1455329246836214e-03 +-1.0909525625591629e-03 +-1.0426416471646879e-03 +-9.9997935791304080e-04 +-9.6237487077720891e-04 +-9.2928032174439121e-04 +-9.0019634763687146e-04 +-8.7467306987750349e-04 +-8.5230842699788711e-04 +-8.3274509276081354e-04 +-8.1566676317059567e-04 +-8.0079429297168171e-04 +-7.8788196466985695e-04 +-7.7671404539086789e-04 +-7.6710170669976052e-04 +-7.5888033252024742e-04 +-7.5190721088365094e-04 +-7.4605958811984252e-04 +-7.4123305567270462e-04 +-7.3734023591709138e-04 +-7.3430973324672228e-04 +-7.3208531814046996e-04 +-7.3062531509922193e-04 +-7.2990216900940266e-04 +-2.0571887356496898e-03 +-2.0612541866355132e-03 +-2.0694124666062732e-03 +-2.0817165408363761e-03 +-2.0982352838130281e-03 +-2.1190237700762300e-03 +-2.1440541150821407e-03 +-2.1730696447414188e-03 +-2.2052699935597637e-03 +-2.2386694417523313e-03 +-2.2691785709731249e-03 +-2.2901796980222796e-03 +-2.2937236658998874e-03 +-2.2732589077058174e-03 +-2.2261433584722522e-03 +-2.1543151470533816e-03 +-2.0631062234029323e-03 +-1.9593068173864485e-03 +-1.8495130296201344e-03 +-1.7391738041918940e-03 +-1.6322738561638844e-03 +-1.5314144939850298e-03 +-1.4380723754661821e-03 +-1.3528952019675477e-03 +-1.2759648935404433e-03 +-1.2070045927310917e-03 +-1.1455293377734136e-03 +-1.0909496449303569e-03 +-1.0426392919186259e-03 +-9.9997747078699856e-04 +-9.6237337034962150e-04 +-9.2927913864721467e-04 +-9.0019542332493024e-04 +-8.7467235526644555e-04 +-8.5230788113675141e-04 +-8.3274468161989319e-04 +-8.1566645857580075e-04 +-8.0079407169002974e-04 +-7.8788180763642783e-04 +-7.7671393706143328e-04 +-7.6710163451068430e-04 +-7.5888028643746497e-04 +-7.5190718302329152e-04 +-7.4605957242491854e-04 +-7.4123304763182947e-04 +-7.3734023231340187e-04 +-7.3430973192680849e-04 +-7.3208531779554069e-04 +-7.3062531505170580e-04 +-7.2990216899956168e-04 +-2.0571951329841106e-03 +-2.0612606449247526e-03 +-2.0694192900876469e-03 +-2.0817245466385617e-03 +-2.0982461243759807e-03 +-2.1190403159592878e-03 +-2.1440807415138690e-03 +-2.1731116140506911e-03 +-2.2053301867267193e-03 +-2.2387420189557113e-03 +-2.2692446216303432e-03 +-2.2902123135868330e-03 +-2.2937011192393371e-03 +-2.2731751045203330e-03 +-2.2260081863369288e-03 +-2.1541473568070469e-03 +-2.0629254671102213e-03 +-1.9591287744552752e-03 +-1.8493479188461605e-03 +-1.7390269594017992e-03 +-1.6321470580698842e-03 +-1.5313072954684299e-03 +-1.4379831259151217e-03 +-1.3528217343542189e-03 +-1.2759049384403491e-03 +-1.2069560021809925e-03 +-1.1454901888701865e-03 +-1.0909182731249465e-03 +-1.0426142864724266e-03 +-9.9995765212478310e-04 +-9.6235776060933176e-04 +-9.2926693149183710e-04 +-9.0018595597665392e-04 +-8.7466508397266969e-04 +-8.5230236033395450e-04 +-8.3274054659651360e-04 +-8.1566341123048424e-04 +-8.0079186892370005e-04 +-7.8788025192582929e-04 +-7.7671286880706192e-04 +-7.6710092580450982e-04 +-7.5887983595220010e-04 +-7.5190691177366882e-04 +-7.4605942019709498e-04 +-7.4123296991372505e-04 +-7.3734019759250698e-04 +-7.3430971924845110e-04 +-7.3208531449936291e-04 +-7.3062531462267648e-04 +-7.2990216898679607e-04 +-2.0572136725252417e-03 +-2.0612793608381238e-03 +-2.0694391480022122e-03 +-2.0817481349074368e-03 +-2.0982785735836795e-03 +-2.1190902708829169e-03 +-2.1441607954001624e-03 +-2.1732355782252948e-03 +-2.2055019527462234e-03 +-2.2389356975502203e-03 +-2.2693930519981382e-03 +-2.2902268216697182e-03 +-2.2935157341917346e-03 +-2.2727789497124814e-03 +-2.2254434157409609e-03 +-2.1534832580603421e-03 +-2.0622313027907498e-03 +-1.9584579844379043e-03 +-1.8487340062632660e-03 +-1.7384862102306927e-03 +-1.6316835623614754e-03 +-1.5309177180135517e-03 +-1.4376602998482169e-03 +-1.3525570193078768e-03 +-1.2756896063981327e-03 +-1.2067819596832919e-03 +-1.1453502874691362e-03 +-1.0908063845005962e-03 +-1.0425252549515177e-03 +-9.9988719194847760e-04 +-9.6230233571106014e-04 +-9.2922363745233914e-04 +-9.0015241326531225e-04 +-8.7463934574828252e-04 +-8.5228283502073365e-04 +-8.3272593401411375e-04 +-8.1565265048514832e-04 +-8.0078409617078002e-04 +-7.8787476622480446e-04 +-7.7670910450462684e-04 +-7.6709843010692883e-04 +-7.5887825057473061e-04 +-7.5190595774779251e-04 +-7.4605888509132420e-04 +-7.4123269686403564e-04 +-7.3734007566354787e-04 +-7.3430967474494193e-04 +-7.3208530293532466e-04 +-7.3062531312403998e-04 +-7.2990216896275085e-04 +-2.0572420081905966e-03 +-2.0613080321513506e-03 +-2.0694703503868947e-03 +-2.0817878476323960e-03 +-2.0983385870503362e-03 +-2.1191901016032722e-03 +-2.1443278385937232e-03 +-2.1734973142645392e-03 +-2.2058591994723199e-03 +-2.2393185273912840e-03 +-2.2696392275798200e-03 +-2.2901318393428122e-03 +-2.2929350997351406e-03 +-2.2716995177663765e-03 +-2.2239745733312957e-03 +-2.1517944855058120e-03 +-2.0604885365491880e-03 +-1.9567874016988580e-03 +-1.8472133344758378e-03 +-1.7371518992772106e-03 +-1.6305431167600482e-03 +-1.5299612265164235e-03 +-1.4368690442620781e-03 +-1.3519090806235895e-03 +-1.2751631287181492e-03 +-1.2063568255592460e-03 +-1.1450088138479069e-03 +-1.0905334634247594e-03 +-1.0423082087044979e-03 +-9.9971550283865329e-04 +-9.6216733965231776e-04 +-9.2911822724131847e-04 +-9.0007077234962934e-04 +-8.7457671949651365e-04 +-8.5223533936289197e-04 +-8.3269039802782963e-04 +-8.1562648825483800e-04 +-8.0076520310726294e-04 +-7.8786143537124573e-04 +-7.7669995892169525e-04 +-7.6709236801279920e-04 +-7.5887440048859822e-04 +-7.5190364137217689e-04 +-7.4605758610463342e-04 +-7.4123203414487094e-04 +-7.3733977977684145e-04 +-7.3430956676284308e-04 +-7.3208527488078073e-04 +-7.3062530949127434e-04 +-7.2990216891336164e-04 +-2.0572330434610866e-03 +-2.0612994723441915e-03 +-2.0694662333429585e-03 +-2.0817995417928012e-03 +-2.0983884714954808e-03 +-2.1193143743259992e-03 +-2.1445744782672797e-03 +-2.1739074179118545e-03 +-2.2064146178748878e-03 +-2.2398652894587388e-03 +-2.2698605894636956e-03 +-2.2896508478223703e-03 +-2.2915024010659196e-03 +-2.2693165461125575e-03 +-2.2208689785412242e-03 +-2.1483000330790574e-03 +-2.0569258434142345e-03 +-1.9533972263559721e-03 +-1.8441417265944917e-03 +-1.7344650069583949e-03 +-1.6282514319797240e-03 +-1.5280420292200897e-03 +-1.4352830854467982e-03 +-1.3506114051021652e-03 +-1.2741093424096950e-03 +-1.2055062796370855e-03 +-1.1443258927931919e-03 +-1.0899878024634366e-03 +-1.0418743648950345e-03 +-9.9937239063043674e-04 +-9.6189760332970214e-04 +-9.2890763844366044e-04 +-8.9990769206418474e-04 +-8.7445163720311855e-04 +-8.5214048824966784e-04 +-8.3261943891866047e-04 +-8.1557425259042829e-04 +-8.0072748515527109e-04 +-7.8783482459562611e-04 +-7.7668170461789375e-04 +-7.6708026951428400e-04 +-7.5886671741239638e-04 +-7.5189901936007116e-04 +-7.4605499439471578e-04 +-7.4123071201600741e-04 +-7.3733918952668996e-04 +-7.3430935136909305e-04 +-7.3208521892346914e-04 +-7.3062530224723271e-04 +-7.2990216882013413e-04 +-2.0570060121474264e-03 +-2.0610724233115548e-03 +-2.0692452576750939e-03 +-2.0816029056689640e-03 +-2.0982520007548741e-03 +-2.1192935288034515e-03 +-2.1447349040469420e-03 +-2.1742858362323453e-03 +-2.2069322147506209e-03 +-2.2402228483297372e-03 +-2.2695281912104596e-03 +-2.2880497206938907e-03 +-2.2882916107562763e-03 +-2.2645626960495035e-03 +-2.2149886516832189e-03 +-2.1418627073481020e-03 +-2.0504649000364205e-03 +-1.9473065917913887e-03 +-1.8386553425739176e-03 +-1.7296833584146355e-03 +-1.6241827101715134e-03 +-1.5246398636023426e-03 +-1.4324744947424822e-03 +-1.3483148809822511e-03 +-1.2722452717228924e-03 +-1.2040021816012516e-03 +-1.1431184696934326e-03 +-1.0890231959275137e-03 +-1.0411075029412582e-03 +-9.9876595034420609e-04 +-9.6142087984578525e-04 +-9.2853546815165609e-04 +-8.9961949523965901e-04 +-8.7423060000056012e-04 +-8.5197288079028608e-04 +-8.3249405570542750e-04 +-8.1548195777031050e-04 +-8.0066084502992442e-04 +-7.8778781123022782e-04 +-7.7664945652539650e-04 +-7.6705889755301405e-04 +-7.5885314609951343e-04 +-7.5189085556972397e-04 +-7.4605041696098543e-04 +-7.4122837702132792e-04 +-7.3733814714469219e-04 +-7.3430897099992188e-04 +-7.3208512011079224e-04 +-7.3062528945662245e-04 +-7.2990216865896477e-04 +-2.0560405541214491e-03 +-2.0601049793390292e-03 +-2.0682821513761914e-03 +-2.0806666606711251e-03 +-2.0973866882616535e-03 +-2.1185613746680463e-03 +-2.1441904554283207e-03 +-2.1739069662323591e-03 +-2.2065024364887466e-03 +-2.2392268945318054e-03 +-2.2672008743406494e-03 +-2.2836569874413988e-03 +-2.2814960028886282e-03 +-2.2556017919863067e-03 +-2.2045575386660170e-03 +-2.1308303739825071e-03 +-2.0396161608680903e-03 +-1.9372062511664161e-03 +-1.8296269913900295e-03 +-1.7218525926876115e-03 +-1.6175396307809102e-03 +-1.5190956040432347e-03 +-1.4279029193545330e-03 +-1.3445794773532249e-03 +-1.2692145527658256e-03 +-1.2015573026914041e-03 +-1.1411560607267998e-03 +-1.0874555059278521e-03 +-1.0398611952948938e-03 +-9.9778034329080331e-04 +-9.6064607194284134e-04 +-9.2793057120223686e-04 +-8.9915107108681715e-04 +-8.7387132854140580e-04 +-8.5170045132895462e-04 +-8.3229025796629065e-04 +-8.1533194355693124e-04 +-8.0055253164302274e-04 +-7.8771140030243776e-04 +-7.7659704545055355e-04 +-7.6702416425271857e-04 +-7.5883109122340054e-04 +-7.5187758911497064e-04 +-7.4604297880347993e-04 +-7.4122458290871171e-04 +-7.3733645345514551e-04 +-7.3430835298786802e-04 +-7.3208495956775905e-04 +-7.3062526867661095e-04 +-7.2990216839960594e-04 +-2.0529832670828289e-03 +-2.0570397211128084e-03 +-2.0652076259459551e-03 +-2.0775938633357466e-03 +-2.0943391305194192e-03 +-2.1155594479926286e-03 +-2.1412029787895815e-03 +-2.1707562739022085e-03 +-2.2027443126724096e-03 +-2.2341000379165069e-03 +-2.2597793027871265e-03 +-2.2732208696245163e-03 +-2.2679118626422311e-03 +-2.2394407811842203e-03 +-2.1868872898335367e-03 +-2.1128525046474156e-03 +-2.0223614661532335e-03 +-1.9213857111122217e-03 +-1.8156214756832178e-03 +-1.7097785650624323e-03 +-1.6073357527732926e-03 +-1.5105994525158718e-03 +-1.4209071575621941e-03 +-1.3388678742561645e-03 +-1.2645823954860595e-03 +-1.1978212249881444e-03 +-1.1381573664624306e-03 +-1.0850598543467609e-03 +-1.0379564851888997e-03 +-9.9627388975978342e-04 +-9.5946168042481924e-04 +-9.2700581231375343e-04 +-8.9843488443669384e-04 +-8.7332198750264642e-04 +-8.5128387192675572e-04 +-8.3197861344287303e-04 +-8.1510253934810757e-04 +-8.0038689629494434e-04 +-7.8759455205726651e-04 +-7.7651689969990972e-04 +-7.6697105256431962e-04 +-7.5879736775025816e-04 +-7.5185730461777163e-04 +-7.4603160631223759e-04 +-7.4121878219355513e-04 +-7.3733386412478752e-04 +-7.3430740819850583e-04 +-7.3208471414395581e-04 +-7.3062523691122191e-04 +-7.2990216800500600e-04 +-2.0445770542982127e-03 +-2.0486109624986044e-03 +-2.0567293947486996e-03 +-2.0690290268851955e-03 +-2.0856277970477790e-03 +-2.1065884881640170e-03 +-2.1317446619392466e-03 +-2.1603787972648129e-03 +-2.1907429146247421e-03 +-2.2195524266869042e-03 +-2.2418107110539248e-03 +-2.2514098776979584e-03 +-2.2425945490408788e-03 +-2.2116968857041524e-03 +-2.1582220220334293e-03 +-2.0847800037813546e-03 +-1.9960927839164930e-03 +-1.8976983341574040e-03 +-1.7948773428102982e-03 +-1.6920187402649390e-03 +-1.5923919384595150e-03 +-1.4981896386795572e-03 +-1.4107046550804094e-03 +-1.3305450613670792e-03 +-1.2578350287852647e-03 +-1.1923795944245562e-03 +-1.1337893845600998e-03 +-1.0815696710474159e-03 +-1.0351809397455009e-03 +-9.9407817895971252e-04 +-9.5773500396337035e-04 +-9.2565737253938007e-04 +-8.9739039326833649e-04 +-8.7252071008228887e-04 +-8.5067617440337344e-04 +-8.3152395536787891e-04 +-8.1476784349069514e-04 +-8.0014523085922393e-04 +-7.8742406685805783e-04 +-7.7639996594497450e-04 +-7.6689356394395050e-04 +-7.5874816791248053e-04 +-7.5182771251081938e-04 +-7.4601501633516742e-04 +-7.4121032064263664e-04 +-7.3733008722661191e-04 +-7.3430603015006983e-04 +-7.3208435618668153e-04 +-7.3062519058212901e-04 +-7.2990216743097798e-04 +-2.0242438337577970e-03 +-2.0282263801241363e-03 +-2.0362167826889991e-03 +-2.0482601534390103e-03 +-2.0643928176421861e-03 +-2.0845574271773823e-03 +-2.1084200586722040e-03 +-2.1350594192670515e-03 +-2.1625552989513312e-03 +-2.1876265583627603e-03 +-2.2056144387727233e-03 +-2.2111089592088437e-03 +-2.1992080016207333e-03 +-2.1669164527607344e-03 +-2.1139893128010556e-03 +-2.0428465929282652e-03 +-1.9577383719411819e-03 +-1.8636488275703778e-03 +-1.7653685610787215e-03 +-1.6669265416987906e-03 +-1.5713686559023800e-03 +-1.4807760170851411e-03 +-1.3964086503346429e-03 +-1.3188906599999723e-03 +-1.2483884316096953e-03 +-1.1847602094812611e-03 +-1.1276715839660099e-03 +-1.0766795047459777e-03 +-1.0312905075605344e-03 +-9.9099927257368888e-04 +-9.5531290281541655e-04 +-9.2376522343767906e-04 +-8.9592433663187589e-04 +-8.7139576911877004e-04 +-8.4982285020372239e-04 +-8.3088544013234264e-04 +-8.1429775668638614e-04 +-7.9980578758754727e-04 +-7.8718459745174066e-04 +-7.7623571722844375e-04 +-7.6678472379572513e-04 +-7.5867906494862488e-04 +-7.5178615154143571e-04 +-7.4599171775282917e-04 +-7.4119843817036023e-04 +-7.3732478368054367e-04 +-7.3430409518759584e-04 +-7.3208385358901741e-04 +-7.3062512553511393e-04 +-7.2990216662622285e-04 +-1.9821994234571838e-03 +-1.9860845770114533e-03 +-1.9938352638379448e-03 +-2.0054069218077061e-03 +-2.0207035302262613e-03 +-2.0395008476066750e-03 +-2.0612864816016421e-03 +-2.0850020390590037e-03 +-2.1087281999088102e-03 +-2.1294473558541348e-03 +-2.1431034536432462e-03 +-2.1451480710268970e-03 +-2.1315343530840078e-03 +-2.0997983411084279e-03 +-2.0497289872265022e-03 +-1.9833378522644404e-03 +-1.9042273132660692e-03 +-1.8167093796150760e-03 +-1.7250185585469281e-03 +-1.6327970859295919e-03 +-1.5428663430229886e-03 +-1.4572100685217083e-03 +-1.3770775452654994e-03 +-1.3031340369158183e-03 +-1.2356134479992542e-03 +-1.1744510468527677e-03 +-1.1193888682094063e-03 +-1.0700543566374700e-03 +-1.0260162445447001e-03 +-9.8682255519471620e-04 +-9.5202529969724099e-04 +-9.2119565594629943e-04 +-8.9393256240744674e-04 +-8.6986689794622503e-04 +-8.4866280360301532e-04 +-8.3001723284632019e-04 +-8.1365847199532703e-04 +-7.9934412584359640e-04 +-7.8685889069404259e-04 +-7.7601231797820298e-04 +-7.6663669093546629e-04 +-7.5858508298267530e-04 +-7.5172963115825199e-04 +-7.4596003548552808e-04 +-7.4118228121741920e-04 +-7.3731757283756615e-04 +-7.3430146453979305e-04 +-7.3208317032826442e-04 +-7.3062503711017793e-04 +-7.2990216553325328e-04 +-1.9091956987302783e-03 +-1.9129241686446263e-03 +-1.9203124062962451e-03 +-1.9312187651583986e-03 +-1.9454085944946976e-03 +-1.9624974672603924e-03 +-1.9818351450364927e-03 +-2.0023232779108526e-03 +-2.0222017111589212e-03 +-2.0389019576969409e-03 +-2.0491165586513779e-03 +-2.0492055301493755e-03 +-2.0359144630803187e-03 +-2.0071732931928247e-03 +-1.9626392283796520e-03 +-1.9037541256526444e-03 +-1.8333350710273597e-03 +-1.7549186796402020e-03 +-1.6721177976706278e-03 +-1.5881564060084290e-03 +-1.5056260158476354e-03 +-1.4264249681924675e-03 +-1.3518136080901313e-03 +-1.2825245410162335e-03 +-1.2188862241052645e-03 +-1.1609367658486532e-03 +-1.1085181679614043e-03 +-1.0613491539888536e-03 +-1.0190786331692172e-03 +-9.8132329623912815e-04 +-9.4769298661116059e-04 +-9.1780705639938243e-04 +-8.9130429919785691e-04 +-8.6784844340668827e-04 +-8.4713066932220148e-04 +-8.2887019953473834e-04 +-8.1281369828677737e-04 +-7.9873398464678353e-04 +-7.8642839853768412e-04 +-7.7571704168988124e-04 +-7.6644103437173503e-04 +-7.5846087319691232e-04 +-7.5165493792213268e-04 +-7.4591817046539618e-04 +-7.4116093351437034e-04 +-7.3730804628873142e-04 +-7.3429798938301157e-04 +-7.3208226778676217e-04 +-7.3062492031293245e-04 +-7.2990216409042890e-04 +-1.8021151133223222e-03 +-1.8056256760674639e-03 +-1.8125426124522648e-03 +-1.8226545811242732e-03 +-1.8356302100451232e-03 +-1.8509827969665140e-03 +-1.8679992816580261e-03 +-1.8856299582281127e-03 +-1.9023610524204761e-03 +-1.9161307405337552e-03 +-1.9243798572905532e-03 +-1.9243154809954943e-03 +-1.9133841523115847e-03 +-1.8898282984127722e-03 +-1.8531173238639453e-03 +-1.8040787689655976e-03 +-1.7446926784990633e-03 +-1.6776580158982216e-03 +-1.6059037530191352e-03 +-1.5321860913413345e-03 +-1.4588364817961239e-03 +-1.3876568134680474e-03 +-1.3199224018107531e-03 +-1.2564468770687605e-03 +-1.1976721966837946e-03 +-1.1437602439527495e-03 +-1.0946738039102079e-03 +-1.0502423714618308e-03 +-1.0102126105202916e-03 +-9.7428534060319200e-04 +-9.4214160887679844e-04 +-9.1346037307877702e-04 +-8.8792997979155722e-04 +-8.6525519443641412e-04 +-8.4516113068357614e-04 +-8.2739507987817480e-04 +-8.1172696483540105e-04 +-7.9794893138704500e-04 +-7.8587443447994648e-04 +-7.7533706186295342e-04 +-7.6618925714343775e-04 +-7.5830104682153587e-04 +-7.5155883626631579e-04 +-7.4586431253955364e-04 +-7.4113347386657905e-04 +-7.3729579374711492e-04 +-7.3429352031423962e-04 +-7.3208110721896687e-04 +-7.3062477013456086e-04 +-7.2990216223600831e-04 +-1.6665414544964562e-03 +-1.6697847281252640e-03 +-1.6761530279237507e-03 +-1.6854079142166105e-03 +-1.6971833643454951e-03 +-1.7109666369226552e-03 +-1.7260607063289417e-03 +-1.7415266172962924e-03 +-1.7561174461234014e-03 +-1.7682361103414580e-03 +-1.7759673622676727e-03 +-1.7772318401426267e-03 +-1.7700719032331250e-03 +-1.7530123205881053e-03 +-1.7253810573625182e-03 +-1.6874711664804673e-03 +-1.6404858228088949e-03 +-1.5862979779278530e-03 +-1.5271192090382619e-03 +-1.4651807897252812e-03 +-1.4024955815348026e-03 +-1.3407229013520320e-03 +-1.2811239654169889e-03 +-1.2245801193197922e-03 +-1.1716454746228131e-03 +-1.1226122125067041e-03 +-1.0775749030095475e-03 +-1.0364868512598129e-03 +-9.9920595882336681e-04 +-9.6553015105514748e-04 +-9.3522364356286739e-04 +-9.0803573180843217e-04 +-8.8371376863398052e-04 +-8.6201178331440009e-04 +-8.4269592591960940e-04 +-8.2554765876781974e-04 +-8.1036539039209003e-04 +-7.9696506416294716e-04 +-7.8518007128677673e-04 +-7.7486075032971551e-04 +-7.6587365586684112e-04 +-7.5810072101624069e-04 +-7.5143839717847207e-04 +-7.4579682503054840e-04 +-7.4109907046186372e-04 +-7.3728044522231126e-04 +-7.3428792276559541e-04 +-7.3207965376112830e-04 +-7.3062458207120843e-04 +-7.2990215991445087e-04 +-1.5143507894479905e-03 +-1.5172988614824171e-03 +-1.5230810915425452e-03 +-1.5314683770508047e-03 +-1.5421124035418831e-03 +-1.5545362266583063e-03 +-1.5681166963934683e-03 +-1.5820582576831145e-03 +-1.5953637845362416e-03 +-1.6068179171061583e-03 +-1.6150080594800047e-03 +-1.6184097382232951e-03 +-1.6155480996272982e-03 +-1.6052155887238853e-03 +-1.5866910124644419e-03 +-1.5598896899602075e-03 +-1.5253925858242597e-03 +-1.4843466274068403e-03 +-1.4382737031918094e-03 +-1.3888488498749740e-03 +-1.3377029198987881e-03 +-1.2862821805729127e-03 +-1.2357722224574086e-03 +-1.1870763055710435e-03 +-1.1408311031713999e-03 +-1.0974430722983730e-03 +-1.0571325652898767e-03 +-1.0199774119450489e-03 +-9.8595156649064573e-04 +-9.5495709222772566e-04 +-9.2684935834908585e-04 +-9.0145613864693922e-04 +-8.7859161807922839e-04 +-8.5806634891858954e-04 +-8.3969409733331522e-04 +-8.2329636894179134e-04 +-8.0870524370566779e-04 +-7.9576500782868825e-04 +-7.8433295083171425e-04 +-7.7427960040853550e-04 +-7.6548859358554079e-04 +-7.5785632657787054e-04 +-7.5129148395717508e-04 +-7.4571451711394950e-04 +-7.4105711984426813e-04 +-7.3726173307960723e-04 +-7.3428109965707668e-04 +-7.3207788231768422e-04 +-7.3062435288609234e-04 +-7.2990215708590141e-04 +-1.3589563038169531e-03 +-1.3616050137561634e-03 +-1.3668034714296741e-03 +-1.3743528899234966e-03 +-1.3839524482750776e-03 +-1.3951948803720647e-03 +-1.4075590458660992e-03 +-1.4203996673829609e-03 +-1.4329370017933645e-03 +-1.4442534764657288e-03 +-1.4533089635646868e-03 +-1.4589882284092596e-03 +-1.4601892228342612e-03 +-1.4559475919096487e-03 +-1.4455748243006770e-03 +-1.4287741508433524e-03 +-1.4056989135874901e-03 +-1.3769347493889912e-03 +-1.3434117449533985e-03 +-1.3062732498795638e-03 +-1.2667356491197523e-03 +-1.2259678065111596e-03 +-1.1850060855241042e-03 +-1.1447078840338036e-03 +-1.1057378043089758e-03 +-1.0685768018879121e-03 +-1.0335446636535297e-03 +-1.0008281370715369e-03 +-9.7050952547484250e-04 +-9.4259276830629946e-04 +-9.1702564488061172e-04 +-8.9371777798272808e-04 +-8.7255469452912886e-04 +-8.5340847005656946e-04 +-8.3614556351954542e-04 +-8.2063242538258914e-04 +-8.0673939073991482e-04 +-7.9434328261409617e-04 +-7.8332906586376966e-04 +-7.7359081716467718e-04 +-7.6503221394682045e-04 +-7.5756669487543138e-04 +-7.5111740510816981e-04 +-7.4561700937451339e-04 +-7.4100743313235790e-04 +-7.3723957506582243e-04 +-7.3427302165941614e-04 +-7.3207578541588803e-04 +-7.3062408162545805e-04 +-7.2990215373866236e-04 +-1.2115495484476316e-03 +-1.2139147474220112e-03 +-1.2185646353859727e-03 +-1.2253375879051197e-03 +-1.2339895798430466e-03 +-1.2441920994892377e-03 +-1.2555292466078390e-03 +-1.2674944465763962e-03 +-1.2794882564901239e-03 +-1.2908204660565371e-03 +-1.3007217093623919e-03 +-1.3083709736442599e-03 +-1.3129440696211779e-03 +-1.3136831070227257e-03 +-1.3099789149380527e-03 +-1.3014502823089961e-03 +-1.2880003228078302e-03 +-1.2698341643480960e-03 +-1.2474326169999372e-03 +-1.2214888912625886e-03 +-1.1928243987541899e-03 +-1.1623021238456616e-03 +-1.1307525226856114e-03 +-1.0989202659074961e-03 +-1.0674335285319053e-03 +-1.0367928848032176e-03 +-1.0073746588420481e-03 +-9.7944331693767357e-04 +-9.5316834364923093e-04 +-9.2864230723443844e-04 +-9.0589803896350520e-04 +-8.8492381945824402e-04 +-8.6567613965093308e-04 +-8.4809002242170687e-04 +-8.3208711861102130e-04 +-8.1758189118168699e-04 +-8.0448622392770134e-04 +-7.9271277153569340e-04 +-7.8217732869436459e-04 +-7.7280045082035915e-04 +-7.6450851515545313e-04 +-7.5723437197477246e-04 +-7.5091770265817918e-04 +-7.4550517442649315e-04 +-7.4095046005212464e-04 +-7.3721417400700285e-04 +-7.3426376347155483e-04 +-7.3207338260827402e-04 +-7.3062377083362524e-04 +-7.2990214990423827e-04 +-1.0795741208085949e-03 +-1.0816852558029992e-03 +-1.0858445284653766e-03 +-1.0919255107382586e-03 +-1.0997375333453682e-03 +-1.1090246198927393e-03 +-1.1194643948645793e-03 +-1.1306674147441259e-03 +-1.1421777938511761e-03 +-1.1534766665370821e-03 +-1.1639908325071387e-03 +-1.1731094945406730e-03 +-1.1802116929703283e-03 +-1.1847052639579355e-03 +-1.1860748079353090e-03 +-1.1839321050131036e-03 +-1.1780593729530538e-03 +-1.1684355042262491e-03 +-1.1552386391624450e-03 +-1.1388241323245403e-03 +-1.1196829074924491e-03 +-1.0983891393566076e-03 +-1.0755470595154586e-03 +-1.0517448232516594e-03 +-1.0275200746866406e-03 +-1.0033384933799683e-03 +-9.7958410290762158e-04 +-9.5655876482584094e-04 +-9.3448791607201340e-04 +-9.1352988869732282e-04 +-8.9378673523227354e-04 +-8.7531512405411051e-04 +-8.5813642963356214e-04 +-8.4224557007369749e-04 +-8.2761843773472565e-04 +-8.1421795064801007e-04 +-8.0199885202945930e-04 +-7.9091142929076607e-04 +-7.8090433358972509e-04 +-7.7192667119995210e-04 +-7.6392951876088743e-04 +-7.5686699193229035e-04 +-7.5069697462504237e-04 +-7.4538159560078943e-04 +-7.4088752156673129e-04 +-7.3718612106723710e-04 +-7.3425354130546413e-04 +-7.3207073016896308e-04 +-7.3062342780412287e-04 +-7.2990214567265931e-04 +-9.6691662204586454e-04 +-9.6881046392462318e-04 +-9.7254973577038382e-04 +-9.7803729931192286e-04 +-9.8512674201537906e-04 +-9.9362175800176084e-04 +-1.0032757101472521e-03 +-1.0137917459063859e-03 +-1.0248240191778088e-03 +-1.0359808274719199e-03 +-1.0468307760559763e-03 +-1.0569133066792244e-03 +-1.0657548557612504e-03 +-1.0728912790483672e-03 +-1.0778958627764412e-03 +-1.0804104107736518e-03 +-1.0801751143760978e-03 +-1.0770519619849193e-03 +-1.0710369478275099e-03 +-1.0622583575456421e-03 +-1.0509613303109002e-03 +-1.0374817136057689e-03 +-1.0222140271842993e-03 +-1.0055787255120483e-03 +-9.8799306509382589e-04 +-9.6984829116835997e-04 +-9.5149416478417079e-04 +-9.3323049127752697e-04 +-9.1530446900881261e-04 +-8.9791233192937651e-04 +-8.8120377997518155e-04 +-8.6528792168170238e-04 +-8.5023976450453750e-04 +-8.3610659505044531e-04 +-8.2291384979811435e-04 +-8.1067027239652058e-04 +-7.9937228896404086e-04 +-7.8900761851518893e-04 +-7.7955818421896427e-04 +-7.7100241407172365e-04 +-7.6331702589687938e-04 +-7.5647838809310072e-04 +-7.5046353886398364e-04 +-7.4525093576395703e-04 +-7.4082099609928628e-04 +-7.3715647803141880e-04 +-7.3424274262943231e-04 +-7.3206792876017314e-04 +-7.3062306556651165e-04 +-7.2990214120470748e-04 +-8.7486178154070639e-04 +-8.7657769870190202e-04 +-8.7997232710543315e-04 +-8.8497102466562731e-04 +-8.9146132325177200e-04 +-8.9929251858718740e-04 +-9.0827544714310472e-04 +-9.1818272915743715e-04 +-9.2874984102861359e-04 +-9.3967748167280265e-04 +-9.5063580600804982e-04 +-9.6127117503647639e-04 +-9.7121603961465716e-04 +-9.8010233486283825e-04 +-9.8757823843078902e-04 +-9.9332735397250323e-04 +-9.9708848114641192e-04 +-9.9867341779880992e-04 +-9.9798003131259931e-04 +-9.9499832899550833e-04 +-9.8980839423415119e-04 +-9.8257052186146170e-04 +-9.7350924209547811e-04 +-9.6289379082579844e-04 +-9.5101779530652687e-04 +-9.3818056436599084e-04 +-9.2467162616092222e-04 +-9.1075930997964788e-04 +-8.9668343154759432e-04 +-8.8265162516015111e-04 +-8.6883859005456730e-04 +-8.5538744217330631e-04 +-8.4241242098836966e-04 +-8.3000233103787434e-04 +-8.1822425064522765e-04 +-8.0712718512290609e-04 +-7.9674546304189429e-04 +-7.8710176701734527e-04 +-7.7820975636297277e-04 +-7.7007628231459397e-04 +-7.6270322254715214e-04 +-7.5608897530251640e-04 +-7.5022965864985594e-04 +-7.4512006030137137e-04 +-7.4075438021885167e-04 +-7.3712680347093979e-04 +-7.3423193540639276e-04 +-7.3206512576568666e-04 +-7.3062270318223434e-04 +-7.2990213673546273e-04 +-8.0313920160978293e-04 +-8.0471624961480173e-04 +-8.0784124314681074e-04 +-8.1245580587488984e-04 +-8.1847199874578928e-04 +-8.2577201943682033e-04 +-8.3420804482900088e-04 +-8.4360241724186144e-04 +-8.5374841961386133e-04 +-8.6441192808649474e-04 +-8.7533426849526667e-04 +-8.8623662265010020e-04 +-8.9682630479107734e-04 +-9.0680512180753422e-04 +-9.1587980875662697e-04 +-9.2377418493409791e-04 +-9.3024224500954452e-04 +-9.3508098236950868e-04 +-9.3814147395578670e-04 +-9.3933676257972195e-04 +-9.3864540861181137e-04 +-9.3611019566818758e-04 +-9.3183221496949918e-04 +-9.2596122905986102e-04 +-9.1868366644353165e-04 +-9.1020974677482604e-04 +-9.0076109972488940e-04 +-8.9055990784483595e-04 +-8.7982018904878597e-04 +-8.6874143851022945e-04 +-8.5750453755460687e-04 +-8.4626963376775428e-04 +-8.3517559667001988e-04 +-8.2434063440640578e-04 +-8.1386369119839654e-04 +-8.0382630759724281e-04 +-7.9429469688036371e-04 +-7.8532185905364014e-04 +-7.7694961240864602e-04 +-7.6921046909022152e-04 +-7.6212931583823475e-04 +-7.5572488547816122e-04 +-7.5001102083195104e-04 +-7.4499774248764760e-04 +-7.4069213704590624e-04 +-7.3709908445873033e-04 +-7.3422184296863409e-04 +-7.3206250871885752e-04 +-7.3062236488987352e-04 +-7.2990213256378942e-04 +-7.5076457381700456e-04 +-7.5224010826681191e-04 +-7.5516757928212319e-04 +-7.5949965914861130e-04 +-7.6516506643439612e-04 +-7.7206832855412748e-04 +-7.8008964458035218e-04 +-7.8908499352571982e-04 +-7.9888666010174590e-04 +-8.0930437121188572e-04 +-8.2012724995855356e-04 +-8.3112679465298291e-04 +-8.4206106894929664e-04 +-8.5268023260657742e-04 +-8.6273343678508918e-04 +-8.7197694594536447e-04 +-8.8018313858732389e-04 +-8.8714981173864651e-04 +-8.9270902092756187e-04 +-8.9673458890962804e-04 +-8.9914746098293996e-04 +-8.9991828693055276e-04 +-8.9906693939159675e-04 +-8.9665906738503577e-04 +-8.9280014690541775e-04 +-8.8762775414987373e-04 +-8.8130290945821722e-04 +-8.7400131940162961e-04 +-8.6590521110482051e-04 +-8.5719625443805598e-04 +-8.4804985264390852e-04 +-8.3863088807396271e-04 +-8.2909085922528727e-04 +-8.1956624558248315e-04 +-8.1017788441058993e-04 +-8.0103112906844214e-04 +-7.9221657011144286e-04 +-7.8381112768650778e-04 +-7.7587935790185078e-04 +-7.6847485093581780e-04 +-7.6164163089472922e-04 +-7.5541549492819842e-04 +-7.4982525122137072e-04 +-7.4489383236462617e-04 +-7.4063927284364608e-04 +-7.3707554776076059e-04 +-7.3421327518370953e-04 +-7.3206028743357074e-04 +-7.3062207779337667e-04 +-7.2990212902372166e-04 +-7.1661632544731981e-04 +-7.1802569457561844e-04 +-7.2082421753852746e-04 +-7.2497135570209813e-04 +-7.3040606197396119e-04 +-7.3704657925713769e-04 +-7.4479031023611008e-04 +-7.5351386966807598e-04 +-7.6307344899575677e-04 +-7.7330563585024329e-04 +-7.8402883639234187e-04 +-7.9504544413323548e-04 +-8.0614488128193107e-04 +-8.1710760285314075e-04 +-8.2771009431375684e-04 +-8.3773080666301911e-04 +-8.4695685959067929e-04 +-8.5519121296676959e-04 +-8.6225987841652679e-04 +-8.6801864313627722e-04 +-8.7235873636363342e-04 +-8.7521090695565258e-04 +-8.7654750452296213e-04 +-8.7638235231300905e-04 +-8.7476843493379433e-04 +-8.7179365541946679e-04 +-8.6757510299532135e-04 +-8.6225238630963509e-04 +-8.5598061607529527e-04 +-8.4892357333082034e-04 +-8.4124749540367353e-04 +-8.3311577760646299e-04 +-8.2468475018666616e-04 +-8.1610056676466043e-04 +-8.0749714425207883e-04 +-7.9899502928618008e-04 +-7.9070103094505673e-04 +-7.8270844874182594e-04 +-7.7509773195624744e-04 +-7.6793742464245402e-04 +-7.6128527453402659e-04 +-7.5518940933103551e-04 +-7.4968950767776940e-04 +-7.4481791290872837e-04 +-7.4060065465578065e-04 +-7.3705835659280733e-04 +-7.3420701825264263e-04 +-7.3205866547243655e-04 +-7.3062186817809027e-04 +-7.2990212643921776e-04 +-6.9978946091579124e-04 +-7.0116638039252339e-04 +-7.0390160862390274e-04 +-7.0795782690529841e-04 +-7.1327884067954618e-04 +-7.1978939322700486e-04 +-7.2739503634971093e-04 +-7.3598215338195594e-04 +-7.4541824529745376e-04 +-7.5555260054285963e-04 +-7.6621747228835277e-04 +-7.7722988157148882e-04 +-7.8839414942986712e-04 +-7.9950523320837812e-04 +-8.1035289919228950e-04 +-8.2072670348051812e-04 +-8.3042167534657144e-04 +-8.3924450561887061e-04 +-8.4701994541689989e-04 +-8.5359703220148908e-04 +-8.5885469911036274e-04 +-8.6270630900157593e-04 +-8.6510270046279147e-04 +-8.6603344251947353e-04 +-8.6552615712807838e-04 +-8.6364395978674995e-04 +-8.6048125671482742e-04 +-8.5615829006710834e-04 +-8.5081491671310839e-04 +-8.4460413088553656e-04 +-8.3768580068861297e-04 +-8.3022099879569004e-04 +-8.2236719043118716e-04 +-8.1427441891642957e-04 +-8.0608251839953853e-04 +-7.9791929609517032e-04 +-7.8989956693240688e-04 +-7.8212489103090686e-04 +-7.7468385448541414e-04 +-7.6765274055317191e-04 +-7.6109645542737155e-04 +-7.5506959510988794e-04 +-7.4961756349447141e-04 +-7.4477767397435675e-04 +-7.4058018617242515e-04 +-7.3704924509973655e-04 +-7.3420370212447976e-04 +-7.3205780587357039e-04 +-7.3062175709018577e-04 +-7.2990212506954841e-04 +-6.9978951001377192e-04 +-7.0116682283489508e-04 +-7.0390284047313300e-04 +-7.0796024834984155e-04 +-7.1328285483632887e-04 +-7.1979540110122977e-04 +-7.2740342686839854e-04 +-7.3599328773509421e-04 +-7.4543243536928964e-04 +-7.5557008203790577e-04 +-7.6623837423783791e-04 +-7.7725419514465197e-04 +-7.8842170016345920e-04 +-7.9953566160430713e-04 +-8.1038565477220765e-04 +-8.2076105653636070e-04 +-8.3045674867164002e-04 +-8.3927932560758176e-04 +-8.4705350855909247e-04 +-8.5362837988656084e-04 +-8.5888299157492205e-04 +-8.6273088880050089e-04 +-8.6512313722949066e-04 +-8.6604955374086797e-04 +-8.6553800351991256e-04 +-8.6365181774060939e-04 +-8.6048557338552040e-04 +-8.5615962844232379e-04 +-8.5081389830359759e-04 +-8.4460138269631306e-04 +-8.3768191131521703e-04 +-8.3021648634379265e-04 +-8.2236248292916106e-04 +-8.1426984628079767e-04 +-8.0607831395862657e-04 +-7.9791560517235760e-04 +-7.8989645994014771e-04 +-7.8212237879153037e-04 +-7.7468190393466393e-04 +-7.6765128948119146e-04 +-7.6109542538714667e-04 +-7.5506890202679377e-04 +-7.4961712582229069e-04 +-7.4477741846242938e-04 +-7.4058005144688518e-04 +-7.3704918333601882e-04 +-7.3420367911666547e-04 +-7.3205779980541443e-04 +-7.3062175629692622e-04 +-7.2990212505972304e-04 +-7.1661648041511394e-04 +-7.1802709105221437e-04 +-7.2082810554499914e-04 +-7.2497899792044510e-04 +-7.3041872922106031e-04 +-7.3706553317833988e-04 +-7.4481676965809109e-04 +-7.5354895817608290e-04 +-7.6311812323982071e-04 +-7.7336059697319251e-04 +-7.8409443073009129e-04 +-7.9512156355940778e-04 +-8.0623087746660741e-04 +-8.1720223217089335e-04 +-8.2781150996524366e-04 +-8.3783661084917528e-04 +-8.4706422110995491e-04 +-8.5529704526452128e-04 +-8.6236106185347641e-04 +-8.6811226569461332e-04 +-8.7244232173779642e-04 +-8.7528259961507451e-04 +-8.7660618798441291e-04 +-8.7642768799511470e-04 +-8.7480082192088206e-04 +-8.7181412328679424e-04 +-8.6758515818438728e-04 +-8.6225383619696475e-04 +-8.5597539394159151e-04 +-8.4891358299952829e-04 +-8.4123448796497588e-04 +-8.3310126595109257e-04 +-8.2466996125384994e-04 +-8.1608642715055814e-04 +-8.0748429232312363e-04 +-7.9898384602241604e-04 +-7.9069168202425299e-04 +-7.8270093142820962e-04 +-7.7509192178023536e-04 +-7.6793311834372473e-04 +-7.6128222708895979e-04 +-7.5518736399096892e-04 +-7.4968821877302409e-04 +-7.4481716173918145e-04 +-7.4060025913269903e-04 +-7.3705817547007506e-04 +-7.3420695083991597e-04 +-7.3205864770394305e-04 +-7.3062186585623164e-04 +-7.2990212641042709e-04 +-7.5076485895532658e-04 +-7.5224267774801155e-04 +-7.5517473285939584e-04 +-7.5951371850502042e-04 +-7.6518836403980490e-04 +-7.7210317055656779e-04 +-7.8013824067651354e-04 +-7.8914934932611215e-04 +-7.9896843190914218e-04 +-8.0940468960902766e-04 +-8.2024652684304809e-04 +-8.3126453724685395e-04 +-8.4221573184135683e-04 +-8.5284914241610119e-04 +-8.6291282097308603e-04 +-8.7216208612545410e-04 +-8.8036864997614818e-04 +-8.8733002731213116e-04 +-8.9287843674101754e-04 +-8.9688831188889794e-04 +-8.9928159690554500e-04 +-9.0003021575204754e-04 +-8.9915544522021129e-04 +-8.9672431598981884e-04 +-8.9284352829131319e-04 +-8.8765162607219456e-04 +-8.8131028684119614e-04 +-8.7399555434392387e-04 +-8.6588970058420979e-04 +-8.5717420115501153e-04 +-8.4802409185194723e-04 +-8.3860378215818907e-04 +-8.2906425357697747e-04 +-8.1954147436068422e-04 +-8.1015581275991711e-04 +-8.0101221857689382e-04 +-7.9220095594330765e-04 +-7.8379869819412431e-04 +-7.7586983005640869e-04 +-7.6846783726059787e-04 +-7.6163669553946510e-04 +-7.5541219802163263e-04 +-7.4982318169466674e-04 +-7.4489263011179329e-04 +-7.4063864145696790e-04 +-7.3707525923185941e-04 +-7.3421316796891032e-04 +-7.3206025920773111e-04 +-7.3062207410793333e-04 +-7.2990212897806363e-04 +-8.0313966168597264e-04 +-8.0472039548881572e-04 +-8.0785278484486658e-04 +-8.1247848535998196e-04 +-8.1850956484109580e-04 +-8.2582815471360176e-04 +-8.3428623191231222e-04 +-8.4370573753966415e-04 +-8.5387928689355621e-04 +-8.6457177292109080e-04 +-8.7552320631756266e-04 +-8.8645315501963216e-04 +-8.9706711563077328e-04 +-9.0706503199182627e-04 +-9.1615193875717337e-04 +-9.2405034505570085e-04 +-9.3051353039704161e-04 +-9.3533850527631435e-04 +-9.3837713146034587e-04 +-9.3954392503512612e-04 +-9.3881942740306154e-04 +-9.3624866474142639e-04 +-9.3193496852852413e-04 +-9.2603010448926262e-04 +-9.1872209573166453e-04 +-9.1022225571446732e-04 +-9.0075279227866921e-04 +-8.9053599804268596e-04 +-8.7978562122797825e-04 +-8.6870061467636290e-04 +-8.5746115229354649e-04 +-8.4622660441606922e-04 +-8.3513506948580641e-04 +-8.2430404529106223e-04 +-8.1383186067124347e-04 +-8.0379955280840030e-04 +-7.9427294732510611e-04 +-7.8530476653718498e-04 +-7.7693664924305243e-04 +-7.6920101127607909e-04 +-7.6212271005474531e-04 +-7.5572050013746387e-04 +-7.5000828235589000e-04 +-7.4499615845955954e-04 +-7.4069130809154341e-04 +-7.3709870671798800e-04 +-7.3422170291274533e-04 +-7.3206247190693542e-04 +-7.3062236008847412e-04 +-7.2990213250431573e-04 +-8.7486248803266865e-04 +-8.7658406502248893e-04 +-8.7999004890752103e-04 +-8.8500583916731790e-04 +-8.9151895536166348e-04 +-8.9937854008786348e-04 +-9.0839502748927918e-04 +-9.1834026845622743e-04 +-9.2894849587019297e-04 +-9.3991862275018961e-04 +-9.5091847953545554e-04 +-9.6159167003513743e-04 +-9.7156767861971023e-04 +-9.8047559445647923e-04 +-9.8796126123510027e-04 +-9.9370683915828910e-04 +-9.9745085314596380e-04 +-9.9900609906732746e-04 +-9.9827261037940189e-04 +-9.9524343329732037e-04 +-9.9000214313437244e-04 +-9.8271252698577268e-04 +-9.7360221097505238e-04 +-9.6294285215610810e-04 +-9.5102968898127204e-04 +-9.3816282954659090e-04 +-9.2463188771841579e-04 +-9.1070472193897141e-04 +-8.9662029731517811e-04 +-8.8258518504969634e-04 +-8.6877294891387453e-04 +-8.5532560246980721e-04 +-8.4235638671745227e-04 +-8.2995325225744012e-04 +-8.1818258482712432e-04 +-8.0709285814359842e-04 +-7.9671801853850837e-04 +-7.8708049759010606e-04 +-7.7819381364430985e-04 +-7.7006476537384741e-04 +-7.6269524566236683e-04 +-7.5608371702372658e-04 +-7.5022639449559244e-04 +-7.4511818153032735e-04 +-7.4075340102327061e-04 +-7.3712635873624910e-04 +-7.3423177093552452e-04 +-7.3206508261887903e-04 +-7.3062269756167530e-04 +-7.2990213666590206e-04 +-9.6691768088075930e-04 +-9.6882000511939298e-04 +-9.7257629259426734e-04 +-9.7808945227638769e-04 +-9.8521300726062242e-04 +-9.9375031922257747e-04 +-1.0034539584691986e-03 +-1.0140256182966014e-03 +-1.0251171689881220e-03 +-1.0363337191088991e-03 +-1.0472398594562242e-03 +-1.0573704760711939e-03 +-1.0662474045944814e-03 +-1.0734025065196025e-03 +-1.0784063632075626e-03 +-1.0808999106076786e-03 +-1.0806245648206740e-03 +-1.0774455074862527e-03 +-1.0713634093423713e-03 +-1.0625119908051245e-03 +-1.0511417980030309e-03 +-1.0375933835087702e-03 +-1.0222648238816180e-03 +-1.0055787999784956e-03 +-9.8795351416637654e-04 +-9.6978008633989980e-04 +-9.5140736794686084e-04 +-9.3313376632905701e-04 +-9.1520485275033462e-04 +-8.9781520557558818e-04 +-8.8111297846306771e-04 +-8.6520592485675831e-04 +-8.5016792614774268e-04 +-8.3604537842099451e-04 +-8.2286304958716094e-04 +-8.1062921178398455e-04 +-7.9933998676756538e-04 +-7.8898292556740508e-04 +-7.7953989059896187e-04 +-7.7098933012818534e-04 +-7.6330804053119611e-04 +-7.5647250782033028e-04 +-7.5045991094799605e-04 +-7.4524885836993351e-04 +-7.4081991800957080e-04 +-7.3715599008165303e-04 +-7.3424256266980232e-04 +-7.3206788164582122e-04 +-7.3062305943737246e-04 +-7.2990214112889508e-04 +-1.0795756787367386e-03 +-1.0816992940564285e-03 +-1.0858835969291031e-03 +-1.0920021998905615e-03 +-1.0998642508970521e-03 +-1.1092130878858409e-03 +-1.1197248105231333e-03 +-1.1310072753174145e-03 +-1.1426004770891888e-03 +-1.1539799768342848e-03 +-1.1645658394760529e-03 +-1.1737400557062098e-03 +-1.1808750086405445e-03 +-1.1853736274299892e-03 +-1.1867184128543195e-03 +-1.1845224472119672e-03 +-1.1785725668262568e-03 +-1.1688548253099803e-03 +-1.1555558178126082e-03 +-1.1390392709870888e-03 +-1.1198032371979197e-03 +-1.0984270526550859e-03 +-1.0755179116197831e-03 +-1.0516649087997391e-03 +-1.0274050321180215e-03 +-1.0032022298078920e-03 +-9.7943821201537098e-04 +-9.5641234223194972e-04 +-9.3434765404560108e-04 +-9.1340033971466718e-04 +-8.9367065632264299e-04 +-8.7521383998748442e-04 +-8.5805017636889991e-04 +-8.4217379791689910e-04 +-8.2756006609769836e-04 +-8.1417157403428520e-04 +-8.0196290111957114e-04 +-7.9088429290876208e-04 +-7.8088444780751126e-04 +-7.7191258152186693e-04 +-7.6391992064580856e-04 +-7.5686075410624190e-04 +-7.5069314885143224e-04 +-7.4537941587386313e-04 +-7.4088639510027060e-04 +-7.3718561296587967e-04 +-7.3425335442048572e-04 +-7.3207068134015804e-04 +-7.3062342146048025e-04 +-7.2990214559424851e-04 +-1.2115517913422150e-03 +-1.2139349572750191e-03 +-1.2186208694274368e-03 +-1.2254479084569535e-03 +-1.2341716240396729e-03 +-1.2444621576666675e-03 +-1.2559007648976241e-03 +-1.2679759911609762e-03 +-1.2800811668380867e-03 +-1.2915166555619120e-03 +-1.3015022676500251e-03 +-1.3092062682674177e-03 +-1.3137958283902301e-03 +-1.3145084689048228e-03 +-1.3107358027537154e-03 +-1.3021029366438491e-03 +-1.2885237014561130e-03 +-1.2702162455560894e-03 +-1.2476743014775806e-03 +-1.2216018813343533e-03 +-1.1928278743525125e-03 +-1.1622191269040579e-03 +-1.1306067696867570e-03 +-1.0987337877390270e-03 +-1.0672252322537754e-03 +-1.0365779239210819e-03 +-1.0071644014920521e-03 +-9.7924568942433675e-04 +-9.5298836292326934e-04 +-9.2848266899904833e-04 +-9.0575967885039301e-04 +-8.8480640447558803e-04 +-8.6557847421068644e-04 +-8.4801036951820884e-04 +-8.3202344507232360e-04 +-8.1753204913453178e-04 +-8.0444808087031894e-04 +-7.9268430018075687e-04 +-7.8215666594334994e-04 +-7.7278593337066928e-04 +-7.6449869757074158e-04 +-7.5722803165893956e-04 +-7.5091383507255708e-04 +-7.4550298104646996e-04 +-7.4094933092855753e-04 +-7.3721366633318938e-04 +-7.3426357721747388e-04 +-7.3207333403671590e-04 +-7.3062376453140554e-04 +-7.2990214982638539e-04 +-1.3589594345322759e-03 +-1.3616332224839055e-03 +-1.3668819447782822e-03 +-1.3745067276131448e-03 +-1.3842058718132033e-03 +-1.3955696037832291e-03 +-1.4080716963896917e-03 +-1.4210583961667912e-03 +-1.4337378027343736e-03 +-1.4451771552248757e-03 +-1.4543199794698558e-03 +-1.4600365197195481e-03 +-1.4612154573927778e-03 +-1.4568911690304345e-03 +-1.4463828338380335e-03 +-1.4294089575709807e-03 +-1.4061424265688850e-03 +-1.3771885932471317e-03 +-1.3434938893346065e-03 +-1.3062125628308247e-03 +-1.2665660399057282e-03 +-1.2257232375222664e-03 +-1.1847170984139483e-03 +-1.1443997115620009e-03 +-1.1054297820771706e-03 +-1.0682826612722683e-03 +-1.0332733091353268e-03 +-1.0005846061663854e-03 +-9.7029593787804392e-04 +-9.4240916155964496e-04 +-9.1687065715538173e-04 +-8.9358917655179800e-04 +-8.7244976763317639e-04 +-8.5332430687676362e-04 +-8.3607924715498484e-04 +-8.2058116067947376e-04 +-8.0670058467948878e-04 +-7.9431459087679558e-04 +-7.8330841565518977e-04 +-7.7357641356575369e-04 +-7.6502253490772572e-04 +-7.5756047840713845e-04 +-7.5111363111585205e-04 +-7.4561487780935951e-04 +-7.4100633961783743e-04 +-7.3723908480599685e-04 +-7.3427284220394006e-04 +-7.3207573869741097e-04 +-7.3062407557064070e-04 +-7.2990215366391974e-04 +-1.5143549686214505e-03 +-1.5173365155961608e-03 +-1.5231858115796514e-03 +-1.5316734820173231e-03 +-1.5424495691709601e-03 +-1.5550327515283118e-03 +-1.5687912854320310e-03 +-1.5829156954231247e-03 +-1.5963895763373868e-03 +-1.6079746865633685e-03 +-1.6162357817585610e-03 +-1.6196312922016930e-03 +-1.6166799923648778e-03 +-1.6061815708998243e-03 +-1.5874347696200068e-03 +-1.5603828639182472e-03 +-1.5256361468741996e-03 +-1.4843661112819220e-03 +-1.4381107245525064e-03 +-1.3885518478320004e-03 +-1.3373194241958258e-03 +-1.2858536927732307e-03 +-1.2353317411157179e-03 +-1.1866479043231332e-03 +-1.1404307892520203e-03 +-1.0970802487605554e-03 +-1.0568116243098041e-03 +-1.0196991888663603e-03 +-9.8571453675775820e-04 +-9.5475828884114176e-04 +-9.2668503718176885e-04 +-9.0132223834834266e-04 +-8.7848406350052159e-04 +-8.5798124107511057e-04 +-8.3962782427553413e-04 +-8.2324566333156850e-04 +-8.0866720558609134e-04 +-7.9573710535355273e-04 +-7.8431300748733348e-04 +-7.7426577425975017e-04 +-7.6547935202558848e-04 +-7.5785041870425455e-04 +-7.5128791182748158e-04 +-7.4571250660028043e-04 +-7.4105609148799136e-04 +-7.3726127316791062e-04 +-7.3428093164250568e-04 +-7.3207783864274610e-04 +-7.3062434723136988e-04 +-7.2990215701611966e-04 +-1.6665466948793076e-03 +-1.6698319412944505e-03 +-1.6762842878186119e-03 +-1.6856647147646931e-03 +-1.6976044199077383e-03 +-1.7115836136271378e-03 +-1.7268918100316725e-03 +-1.7425688486637611e-03 +-1.7573395387709353e-03 +-1.7695752230977131e-03 +-1.7773326639502678e-03 +-1.7785164496950995e-03 +-1.7711713627004996e-03 +-1.7538443884113082e-03 +-1.7259003042435770e-03 +-1.6876737962249156e-03 +-1.6404042814706890e-03 +-1.5859887486384737e-03 +-1.5266487504756634e-03 +-1.4646137010466778e-03 +-1.4018869854096449e-03 +-1.3401150909476912e-03 +-1.2805462524329830e-03 +-1.2240505439470055e-03 +-1.1711732621079948e-03 +-1.1222002508373143e-03 +-1.0772218709562305e-03 +-1.0361888722013562e-03 +-9.9895779486807064e-04 +-9.6532601345333596e-04 +-9.3505771059611666e-04 +-9.0790245761928549e-04 +-8.8360805022760682e-04 +-8.6192903579224373e-04 +-8.4263210117457052e-04 +-8.2549923132315122e-04 +-8.1032932564786635e-04 +-7.9693877846522888e-04 +-7.8516138933034838e-04 +-7.7484786289600037e-04 +-7.6586507935118406e-04 +-7.5809525929267736e-04 +-7.5143510585762600e-04 +-7.4579497793023769e-04 +-7.4109812802412563e-04 +-7.3728002460443751e-04 +-7.3428776936039898e-04 +-7.3207961393382290e-04 +-7.3062457691900977e-04 +-7.2990215985091077e-04 +-1.8021211529100978e-03 +-1.8056800863735496e-03 +-1.8126938194657353e-03 +-1.8229500123601397e-03 +-1.8361130993869109e-03 +-1.8516861219302120e-03 +-1.8689368876092577e-03 +-1.8867863450431962e-03 +-1.9036831422615961e-03 +-1.9175263139956484e-03 +-1.9257267890069585e-03 +-1.9254823958314766e-03 +-1.9142575506565383e-03 +-1.8903368141978678e-03 +-1.8532440867327618e-03 +-1.8038582490132269e-03 +-1.7441953559728400e-03 +-1.6769703276368249e-03 +-1.6051103903619904e-03 +-1.5313584935618060e-03 +-1.4580279307768215e-03 +-1.3869024775379653e-03 +-1.3192421451700021e-03 +-1.2558490440347919e-03 +-1.1971572600934090e-03 +-1.1433238020754309e-03 +-1.0943087995007486e-03 +-1.0499406076170043e-03 +-1.0099657123565668e-03 +-9.7408531716157128e-04 +-9.4198114542672008e-04 +-9.1333295215129226e-04 +-8.8782990001183169e-04 +-8.6517753302657065e-04 +-8.4510167861022651e-04 +-8.2735026700732177e-04 +-8.1169378483434806e-04 +-7.9792487131224662e-04 +-7.8585741109788506e-04 +-7.7532536510491223e-04 +-7.6618150023552130e-04 +-7.5829612225138425e-04 +-7.5155587664711655e-04 +-7.4586265548190814e-04 +-7.4113263008866313e-04 +-7.3729541779359205e-04 +-7.3429338338418715e-04 +-7.3208107170539616e-04 +-7.3062476554356683e-04 +-7.2990216217939756e-04 +-1.9092019414441710e-03 +-1.9129804048895181e-03 +-1.9204686119917058e-03 +-1.9315234819338005e-03 +-1.9459048231327068e-03 +-1.9632150128981668e-03 +-1.9827796553245304e-03 +-2.0034641993473741e-03 +-2.0234638870655370e-03 +-2.0401671881571490e-03 +-2.0502399180677006e-03 +-2.0500453030579111e-03 +-2.0363664080822299e-03 +-2.0071953780839554e-03 +-1.9622566765684010e-03 +-1.9030446589898813e-03 +-1.8324032585228783e-03 +-1.7538706440446675e-03 +-1.6710437172789236e-03 +-1.5871226286411947e-03 +-1.5046747318790720e-03 +-1.4255781423041633e-03 +-1.3510783652193020e-03 +-1.2818982846963794e-03 +-1.2183607281002122e-03 +-1.1605010937753909e-03 +-1.1081605740139496e-03 +-1.0610582126699506e-03 +-1.0188438371734167e-03 +-9.8113531372570942e-04 +-9.4754371549584933e-04 +-9.1768956772867924e-04 +-8.9121272760356535e-04 +-8.6777785909133043e-04 +-8.4707695064775322e-04 +-8.2882991571171186e-04 +-8.1278400597495143e-04 +-7.9871253909013173e-04 +-7.8641327821242653e-04 +-7.7570668472298516e-04 +-7.6643418479241995e-04 +-7.5845653517180955e-04 +-7.5165233634822879e-04 +-7.4591671656697709e-04 +-7.4116019436061965e-04 +-7.3730771738988229e-04 +-7.3429786972010092e-04 +-7.3208223677687610e-04 +-7.3062491630636773e-04 +-7.2990216404104729e-04 +-1.9822050695170279e-03 +-1.9861354341219892e-03 +-1.9939764471063959e-03 +-2.0056818179073040e-03 +-2.0211492160524861e-03 +-2.0401396468941063e-03 +-2.0621140306949725e-03 +-2.0859745967777045e-03 +-2.1097549755529511e-03 +-2.1303955029087209e-03 +-2.1438209366342448e-03 +-2.1455010802905851e-03 +-2.1314452172702071e-03 +-2.0992661396674987e-03 +-2.0488236680816338e-03 +-1.9821734414368678e-03 +-1.9029289455149876e-03 +-1.8153873461868540e-03 +-1.7237549014122720e-03 +-1.6316433506318407e-03 +-1.5418480779425757e-03 +-1.4563338489125188e-03 +-1.3763378153188387e-03 +-1.3025185552782894e-03 +-1.2351070948358538e-03 +-1.1740382183014994e-03 +-1.1190548251396833e-03 +-1.0697858742742886e-03 +-1.0258018323976068e-03 +-9.8665243490098195e-04 +-9.5189126159201038e-04 +-9.2109086711960329e-04 +-8.9385136707851079e-04 +-8.6980463099623026e-04 +-8.4861562623892426e-04 +-8.2998199271324595e-04 +-8.1363258659808879e-04 +-7.9932548656432446e-04 +-7.8684578417860431e-04 +-7.7600336171286782e-04 +-7.6663078015492419e-04 +-7.5858134647663518e-04 +-7.5172739398564066e-04 +-7.4595878701652488e-04 +-7.4118164728101789e-04 +-7.3731729104754189e-04 +-7.3430136210193560e-04 +-7.3208314379897329e-04 +-7.3062503368398056e-04 +-7.2990216549102566e-04 +-2.0242482122221602e-03 +-2.0282658151315851e-03 +-2.0363261783579896e-03 +-2.0484726515091465e-03 +-2.0647353825186121e-03 +-2.0850427297602562e-03 +-2.1090349761600318e-03 +-2.1357528742435589e-03 +-2.1632315866182829e-03 +-2.1881527421612110e-03 +-2.2058475174128486e-03 +-2.2109375245962905e-03 +-2.1985899335285443e-03 +-2.1658921675858736e-03 +-2.1126643644113134e-03 +-2.0413557806244383e-03 +-1.9562103803626124e-03 +-1.8621839448674886e-03 +-1.7640315078169238e-03 +-1.6657498575578286e-03 +-1.5703608047021294e-03 +-1.4799300009373400e-03 +-1.3957090624679286e-03 +-1.3183186332982586e-03 +-1.2479247132246023e-03 +-1.1843868446515971e-03 +-1.1273726813919806e-03 +-1.0764414506724490e-03 +-1.0311018806064178e-03 +-9.9085061791403715e-04 +-9.5519645829138819e-04 +-9.2367464735657555e-04 +-8.9585446101260186e-04 +-8.7134238725795302e-04 +-8.4978253948291569e-04 +-8.3085541713473683e-04 +-8.1427576015477099e-04 +-7.9978998445586391e-04 +-7.8717350749176319e-04 +-7.7622815242174331e-04 +-7.6677973918044600e-04 +-7.5867591830817765e-04 +-7.5178426985383158e-04 +-7.4599066879080093e-04 +-7.4119790602982058e-04 +-7.3732454732350166e-04 +-7.3430400931992967e-04 +-7.3208383136173728e-04 +-7.3062512266544729e-04 +-7.2990216659086561e-04 +-2.0445799359672173e-03 +-2.0486369124767942e-03 +-2.0568013061273683e-03 +-2.0691682259929198e-03 +-2.0858502910073612e-03 +-2.1068980175089655e-03 +-2.1321226529709509e-03 +-2.1607734588787288e-03 +-2.1910633760014752e-03 +-2.2196770445179455e-03 +-2.2416158709628771e-03 +-2.2508125527947714e-03 +-2.2415867300925197e-03 +-2.2103504357758505e-03 +-2.1566620867933114e-03 +-2.0831448392230742e-03 +-1.9945006622323364e-03 +-1.8962313143007414e-03 +-1.7935802136654234e-03 +-1.6909064711547349e-03 +-1.5914595358807026e-03 +-1.4974208841723612e-03 +-1.4100784673174653e-03 +-1.3300395199488276e-03 +-1.2574295962189544e-03 +-1.1920561322449764e-03 +-1.1335324451016758e-03 +-1.0813663989472019e-03 +-1.0350207928362866e-03 +-9.9395258957628361e-04 +-9.5763704452733257e-04 +-9.2558145503339429e-04 +-8.9733201299377623e-04 +-8.7247623410037143e-04 +-8.5064267041313200e-04 +-8.3149905506965031e-04 +-8.1474963429234600e-04 +-8.0013217030010025e-04 +-7.8741491491285409e-04 +-7.7639373120623868e-04 +-7.6688946046034518e-04 +-7.5874558014143328e-04 +-7.5182616641607833e-04 +-7.4601415512908257e-04 +-7.4120988404695256e-04 +-7.3732989341768630e-04 +-7.3430595977257780e-04 +-7.3208433797553789e-04 +-7.3062518823152687e-04 +-7.2990216740201753e-04 +-2.0529848812203778e-03 +-2.0570542527664150e-03 +-2.0652478206120550e-03 +-2.0776711868284148e-03 +-2.0944608231295734e-03 +-2.1157230011955605e-03 +-2.1413878973039267e-03 +-2.1709147411024593e-03 +-2.2027960181910272e-03 +-2.2339403305979390e-03 +-2.2593073693118345e-03 +-2.2723802834441922e-03 +-2.2667198392022779e-03 +-2.2379856867889045e-03 +-2.1852970229509446e-03 +-2.1112549534026167e-03 +-2.0208566200252821e-03 +-1.9200356171497472e-03 +-1.8144535951324036e-03 +-1.7087951523030874e-03 +-1.6065237725058331e-03 +-1.5099384390969165e-03 +-1.4203744573583091e-03 +-1.3384416740285781e-03 +-1.2642431971055682e-03 +-1.1975523590683245e-03 +-1.1379449751914063e-03 +-1.0848926197734123e-03 +-1.0378252644981851e-03 +-9.9617134368897692e-04 +-9.5938193546722412e-04 +-9.2694417179640931e-04 +-8.9838759026727186e-04 +-8.7328602819009395e-04 +-8.5125683016144479e-04 +-8.3195854618230212e-04 +-8.1508788392440853e-04 +-8.0037639697637169e-04 +-7.8758720246824851e-04 +-7.7651189740680405e-04 +-7.6696776291429881e-04 +-7.5879529470313661e-04 +-7.5185606684036524e-04 +-7.4603091722983165e-04 +-7.4121843302561718e-04 +-7.3733370918878187e-04 +-7.3430735195541491e-04 +-7.3208469959394281e-04 +-7.3062523503350074e-04 +-7.2990216798187553e-04 +-2.0560413322112175e-03 +-2.0601119804396465e-03 +-2.0683014441408029e-03 +-2.0807033082648491e-03 +-2.0974425140721973e-03 +-2.1186307280301746e-03 +-2.1442537180222433e-03 +-2.1739228859060174e-03 +-2.2064037128682388e-03 +-2.2389275698131727e-03 +-2.2666220427457464e-03 +-2.2827629226112836e-03 +-2.2803174533406133e-03 +-2.2542286564229139e-03 +-2.2031068629642814e-03 +-2.1294111890647581e-03 +-2.0383077888317968e-03 +-1.9360530962336082e-03 +-1.8286441114549127e-03 +-1.7210351243492701e-03 +-1.6168716211979936e-03 +-1.5185565048839371e-03 +-1.4274716402905639e-03 +-1.3442365509305824e-03 +-1.2689430564259568e-03 +-1.2013430573276623e-03 +-1.1409874582838197e-03 +-1.0873231801855321e-03 +-1.0397576541805093e-03 +-9.9769962142677170e-04 +-9.6058342786266358e-04 +-9.2788223542323201e-04 +-8.9911404240403125e-04 +-8.7384321229381796e-04 +-8.5167933247090729e-04 +-8.3227460213818397e-04 +-8.1532052022350470e-04 +-8.0054435437212261e-04 +-7.8770568021006826e-04 +-7.7659315467151660e-04 +-7.6702160699109237e-04 +-7.5882948050332965e-04 +-7.5187662780389238e-04 +-7.4604244383699150e-04 +-7.4122431192295780e-04 +-7.3733633324432428e-04 +-7.3430830936018355e-04 +-7.3208494828328201e-04 +-7.3062526722048721e-04 +-7.2990216838167020e-04 +-2.0570063364186808e-03 +-2.0610753375978324e-03 +-2.0692532236043257e-03 +-2.0816176176925594e-03 +-2.0982727283931188e-03 +-2.1193139579938837e-03 +-2.1447382022339121e-03 +-2.1742386447330085e-03 +-2.2067810775556972e-03 +-2.2399004351254144e-03 +-2.2689750595023730e-03 +-2.2872442688781926e-03 +-2.2872675659647403e-03 +-2.2633999397215867e-03 +-2.2137847113901667e-03 +-2.1407041017761350e-03 +-2.0494112696110680e-03 +-1.9463885334557120e-03 +-1.8378803283075388e-03 +-1.7290439519558277e-03 +-1.6236637354396296e-03 +-1.5242234188888987e-03 +-1.4321429350558842e-03 +-1.3480523122806926e-03 +-1.2720381077098485e-03 +-1.2038391788872765e-03 +-1.1429905115238510e-03 +-1.0889229823916287e-03 +-1.0410292312552929e-03 +-9.9870502417385228e-04 +-9.6137366187963266e-04 +-9.2849907750741320e-04 +-8.9959164555944286e-04 +-8.7420947205680383e-04 +-8.5195702321839701e-04 +-8.3248230808324365e-04 +-8.1547339114631709e-04 +-8.0065471590620176e-04 +-7.8778352582146755e-04 +-7.7664654280650979e-04 +-7.6705698317337974e-04 +-7.5885194069540856e-04 +-7.5189013636491693e-04 +-7.4605001682593187e-04 +-7.4122817437783663e-04 +-7.3733805726727093e-04 +-7.3430893838586254e-04 +-7.3208511167598502e-04 +-7.3062528836829576e-04 +-7.2990216864555753e-04 +-2.0572331578438954e-03 +-2.0613004974774848e-03 +-2.0694689817939201e-03 +-2.0818042681940881e-03 +-2.0983936893239144e-03 +-2.1193145969592864e-03 +-2.1445566496651231e-03 +-2.1738464735503605e-03 +-2.2062707795349945e-03 +-2.2395888780050235e-03 +-2.2694089316103979e-03 +-2.2890111837174858e-03 +-2.2907042738604965e-03 +-2.2684232210784011e-03 +-2.2199547835220178e-03 +-2.1474288620881169e-03 +-2.0561401522095602e-03 +-1.9527174130503961e-03 +-1.8435712166062171e-03 +-1.7339966558754325e-03 +-1.6278728804947880e-03 +-1.5277393322102155e-03 +-1.4350428014787170e-03 +-1.3504215953730051e-03 +-1.2739599016983860e-03 +-1.2053889068392826e-03 +-1.1442338955841868e-03 +-1.0899158469410723e-03 +-1.0418182271405298e-03 +-9.9932873548819624e-04 +-9.6186379857178528e-04 +-9.2888160400412167e-04 +-8.9988778037672986e-04 +-8.7443653954420817e-04 +-8.5212916206928895e-04 +-8.3261105172610064e-04 +-8.1556813869600175e-04 +-8.0072311228265327e-04 +-7.8783176800731206e-04 +-7.7667962691925334e-04 +-7.6707890472544043e-04 +-7.5886585823358940e-04 +-7.5189850682094738e-04 +-7.4605470928367174e-04 +-7.4123056764426357e-04 +-7.3733912550144056e-04 +-7.3430932813820828e-04 +-7.3208521291580526e-04 +-7.3062530147211522e-04 +-7.2990216881058838e-04 +-2.0572420399783413e-03 +-2.0613083148408990e-03 +-2.0694710667252697e-03 +-2.0817888033540640e-03 +-2.0983384199731846e-03 +-2.1191847704423463e-03 +-2.1443082187489640e-03 +-2.1734461658727633e-03 +-2.2057492868500202e-03 +-2.2391159890644444e-03 +-2.2693154591380744e-03 +-2.2896794315302826e-03 +-2.2923760354269830e-03 +-2.2710785607362887e-03 +-2.2233431914904242e-03 +-2.1511961124416031e-03 +-2.0599513959411015e-03 +-1.9563244873105675e-03 +-1.8468261512875909e-03 +-1.7368349451263982e-03 +-1.6302875430568907e-03 +-1.5297572739130770e-03 +-1.4367074177488227e-03 +-1.3517815874367527e-03 +-1.2750628720894904e-03 +-1.2062781632942974e-03 +-1.1449472118841722e-03 +-1.0904853174185953e-03 +-1.0422706704716919e-03 +-9.9968632750064906e-04 +-9.6214475814341963e-04 +-9.2910084339626524e-04 +-9.0005748153077468e-04 +-8.7456664509277359e-04 +-8.5222778363535268e-04 +-8.3268480422724576e-04 +-8.1562241146606945e-04 +-8.0076228777808370e-04 +-7.8785939791944568e-04 +-7.7669857417446474e-04 +-7.6709145852275960e-04 +-7.5887382800002127e-04 +-7.5190329989098135e-04 +-7.4605739616496027e-04 +-7.4123193797237324e-04 +-7.3733973712948033e-04 +-7.3430955128950541e-04 +-7.3208527087942950e-04 +-7.3062530897502801e-04 +-7.2990216890700345e-04 +-2.0572136781423184e-03 +-2.0612794091785852e-03 +-2.0694392398817032e-03 +-2.0817480423319036e-03 +-2.0982773623625440e-03 +-2.1190853880789754e-03 +-2.1441466119743692e-03 +-2.1732015367274121e-03 +-2.2054314064955871e-03 +-2.2388079940256936e-03 +-2.2691908967126186e-03 +-2.2899461009029697e-03 +-2.2931704287551570e-03 +-2.2723968572121306e-03 +-2.2250561514356518e-03 +-2.1531172492984360e-03 +-2.0619035222319776e-03 +-1.9581760654493272e-03 +-1.8484986083445454e-03 +-1.7382937855837791e-03 +-1.6315285890523793e-03 +-1.5307941718440082e-03 +-1.4375624767983886e-03 +-1.3524799108714464e-03 +-1.2756290078164889e-03 +-1.2067344381591369e-03 +-1.1453130888763867e-03 +-1.0907773223140984e-03 +-1.0425026032192448e-03 +-9.9986959153576874e-04 +-9.6228871637444712e-04 +-9.2921315509457674e-04 +-9.0014440041638231e-04 +-8.7463327297905590e-04 +-8.5227828110979510e-04 +-8.3272256297826756e-04 +-8.1565019391594972e-04 +-8.0078233963034099e-04 +-7.8787353872261830e-04 +-7.7670827029763148e-04 +-7.6709788224238983e-04 +-7.5887790573511368e-04 +-7.5190575206635600e-04 +-7.4605877069167797e-04 +-7.4123263894208292e-04 +-7.3734004997909276e-04 +-7.3430966542634190e-04 +-7.3208530052561681e-04 +-7.3062531281314978e-04 +-7.2990216895892318e-04 +-2.0571951329458266e-03 +-2.0612606434149850e-03 +-2.0694192641449545e-03 +-2.0817243566010482e-03 +-2.0982452709534471e-03 +-2.1190374757646931e-03 +-2.1440730240302208e-03 +-2.1730936139190333e-03 +-2.2052933870315350e-03 +-2.2386758622641224e-03 +-2.2691403000137562e-03 +-2.2900678120637641e-03 +-2.2935237082194271e-03 +-2.2729790991784541e-03 +-2.2258097936513196e-03 +-2.1539600696041058e-03 +-2.0627579075240270e-03 +-1.9589847807137978e-03 +-1.8492277722931241e-03 +-1.7389288055330789e-03 +-1.6320680478886273e-03 +-1.5312443347402600e-03 +-1.4379332919838817e-03 +-1.3527824650071062e-03 +-1.2758740850882398e-03 +-1.2069318122141820e-03 +-1.1454712571294201e-03 +-1.0909034846543965e-03 +-1.0426027615704490e-03 +-9.9994869831525465e-04 +-9.6235083278029454e-04 +-9.2926159983322044e-04 +-9.0018188069631590e-04 +-8.7466199560670482e-04 +-8.5230004453110250e-04 +-8.3273883240799905e-04 +-8.1566216210805851e-04 +-8.0079097578850036e-04 +-7.8787962780838461e-04 +-7.7671244467162541e-04 +-7.6710064726160916e-04 +-7.5887966063458324e-04 +-7.5190680720677201e-04 +-7.4605936203826382e-04 +-7.4123294046766813e-04 +-7.3734018453535733e-04 +-7.3430971451122714e-04 +-7.3208531327436798e-04 +-7.3062531446463222e-04 +-7.2990216898484830e-04 +-2.0571887353218105e-03 +-2.0612541832550880e-03 +-2.0694124493836727e-03 +-2.0817164570341583e-03 +-2.0982349514860302e-03 +-2.1190227112225517e-03 +-2.1440512885843688e-03 +-2.1730631053729745e-03 +-2.2052566769692312e-03 +-2.2386455503805198e-03 +-2.2691409401666240e-03 +-2.2901276126030988e-03 +-2.2936597545448207e-03 +-2.2731883310630431e-03 +-2.2260719511051404e-03 +-2.1542477604480186e-03 +-2.0630459529767794e-03 +-1.9592550367514327e-03 +-1.8494698338854128e-03 +-1.7391385218420369e-03 +-1.6322454595717468e-03 +-1.5313918685690541e-03 +-1.4380544692221759e-03 +-1.3528810930747222e-03 +-1.2759538092559151e-03 +-1.2069959028913626e-03 +-1.1455225372473596e-03 +-1.0909443329768036e-03 +-1.0426351523956010e-03 +-9.9997425486507635e-04 +-9.6237088217119226e-04 +-9.2927722379523110e-04 +-9.0019395973165318e-04 +-8.7467124613502115e-04 +-8.5230704947204458e-04 +-8.3274406601985349e-04 +-8.1566600999649717e-04 +-8.0079375095508127e-04 +-7.8788158351114992e-04 +-7.7671378475262188e-04 +-7.6710153448559203e-04 +-7.5888022348116150e-04 +-7.5190714547371555e-04 +-7.4605955154042388e-04 +-7.4123303705797723e-04 +-7.3734022762470105e-04 +-7.3430973022572238e-04 +-7.3208531735566003e-04 +-7.3062531499495475e-04 +-7.2990216899886280e-04 +-2.0571877672834575e-03 +-2.0612532074714800e-03 +-2.0694114270365105e-03 +-2.0817152985169634e-03 +-2.0982335193836530e-03 +-2.1190208598933120e-03 +-2.1440489746230424e-03 +-2.1730606720168893e-03 +-2.2052554553599955e-03 +-2.2386485697639988e-03 +-2.2691527869223298e-03 +-2.2901526465571149e-03 +-2.2936996603090680e-03 +-2.2732410468884806e-03 +-2.2261326820417725e-03 +-2.1543109737403895e-03 +-2.0631069904651477e-03 +-1.9593108106726689e-03 +-1.8495187908927060e-03 +-1.7391802648314672e-03 +-1.6322803167590513e-03 +-1.5314205446833172e-03 +-1.4380778095086015e-03 +-1.3528999437781555e-03 +-1.2759689460966148e-03 +-1.2070080019897171e-03 +-1.1455321700146570e-03 +-1.0909519730844604e-03 +-1.0426411877989875e-03 +-9.9997900104185455e-04 +-9.6237459466504214e-04 +-9.2928010925486546e-04 +-9.0019618522370337e-04 +-8.7467294679890615e-04 +-8.5230833470958565e-04 +-8.3274502444897103e-04 +-8.1566671339279779e-04 +-8.0079425738054154e-04 +-7.8788193979928954e-04 +-7.7671402848960452e-04 +-7.6710169560028588e-04 +-7.5888032553419224e-04 +-7.5190720671690424e-04 +-7.4605958580236580e-04 +-7.4123305449936465e-04 +-7.3734023539680498e-04 +-7.3430973305795965e-04 +-7.3208531809165766e-04 +-7.3062531509292305e-04 +-7.2990216900932329e-04 +-2.0571877673145320e-03 +-2.0612532076983640e-03 +-2.0694114278078982e-03 +-2.0817153028669833e-03 +-2.0982335403316814e-03 +-2.1190209349020001e-03 +-2.1440491891538170e-03 +-2.1730611902715815e-03 +-2.2052565414131605e-03 +-2.2386505575185058e-03 +-2.2691559632631655e-03 +-2.2901570904740893e-03 +-2.2937051581696805e-03 +-2.2732471571654637e-03 +-2.2261388958450591e-03 +-2.1543168618816440e-03 +-2.0631122746309410e-03 +-1.9593153632499931e-03 +-1.8495225976226449e-03 +-1.7391833803686247e-03 +-1.6322828285223801e-03 +-1.5314225488867698e-03 +-1.4380793976746123e-03 +-1.3529011965092918e-03 +-1.2759699312063675e-03 +-1.2070087749339552e-03 +-1.1455327753458965e-03 +-1.0909524462137242e-03 +-1.0426415567057847e-03 +-9.9997928777824699e-04 +-9.6237481660916906e-04 +-9.2928028012226923e-04 +-9.0019631586670955e-04 +-8.7467304583029308e-04 +-8.5230840898528561e-04 +-8.3274507944004696e-04 +-8.1566675347172430e-04 +-8.0079428604185314e-04 +-7.8788195983037635e-04 +-7.7671404210388404e-04 +-7.6710170454213976e-04 +-7.5888033116279475e-04 +-7.5190721007430724e-04 +-7.4605958766983964e-04 +-7.4123305544492924e-04 +-7.3734023581611431e-04 +-7.3430973321009598e-04 +-7.3208531813100358e-04 +-7.3062531509800730e-04 +-7.2990216900940602e-04 +-2.0571887354729739e-03 +-2.0612541766914286e-03 +-2.0694123914439993e-03 +-2.0817162481699294e-03 +-2.0982344623008999e-03 +-2.1190218709546418e-03 +-2.1440502602767695e-03 +-2.1730625632899792e-03 +-2.2052581231916074e-03 +-2.2386513868444618e-03 +-2.2691538727247339e-03 +-2.2901494111292405e-03 +-2.2936901912893938e-03 +-2.2732251475170570e-03 +-2.2261117975464709e-03 +-2.1542873547229827e-03 +-2.0630828324922283e-03 +-1.9592877704490024e-03 +-1.8494978764461119e-03 +-1.7391619368093167e-03 +-1.6322646553253322e-03 +-1.5314074031287179e-03 +-1.4380669277705615e-03 +-1.3528910218007268e-03 +-1.2759616862796700e-03 +-1.2070021308507124e-03 +-1.1455274471050048e-03 +-1.0909481927039301e-03 +-1.0426381770114283e-03 +-9.9997661606665241e-04 +-9.6237271679787352e-04 +-9.2927864091293315e-04 +-9.0019504638674407e-04 +-8.7467207193943277e-04 +-8.5230767021314286e-04 +-8.3274452648216533e-04 +-8.1566634616001791e-04 +-8.0079399170792775e-04 +-7.8788175198822661e-04 +-7.7671389938889967e-04 +-7.6710160985319980e-04 +-7.5888027096360493e-04 +-7.5190717381779957e-04 +-7.4605956731635479e-04 +-7.4123304505026863e-04 +-7.3734023117049134e-04 +-7.3430973151268576e-04 +-7.3208531768855975e-04 +-7.3062531503791843e-04 +-7.2990216899940826e-04 +-2.0571951320858470e-03 +-2.0612605724394622e-03 +-2.0694187273299649e-03 +-2.0817223630487172e-03 +-2.0982400765299880e-03 +-2.1190265962388022e-03 +-2.1440535174160123e-03 +-2.1730628590560493e-03 +-2.2052506727951544e-03 +-2.2386244989313917e-03 +-2.2690885035103027e-03 +-2.2900264203839361e-03 +-2.2935015665383699e-03 +-2.2729795312254829e-03 +-2.2258303851594666e-03 +-2.1539949602698266e-03 +-2.0628004991252277e-03 +-1.9590295194331737e-03 +-1.8492708093834202e-03 +-1.7389679182927636e-03 +-1.6321022504690239e-03 +-1.5312734514700060e-03 +-1.4379576113110056e-03 +-1.3528024992840758e-03 +-1.2758904212151049e-03 +-1.2069450277575175e-03 +-1.1454818788814254e-03 +-1.0909119725439956e-03 +-1.0426095065550060e-03 +-9.9995402722488267e-04 +-9.6235501603335251e-04 +-9.2926485980087943e-04 +-9.0018439960793610e-04 +-8.7466392252213661e-04 +-8.5230150124990223e-04 +-8.3273991835758278e-04 +-8.1566295832939662e-04 +-8.0079154816164392e-04 +-7.8788002965811085e-04 +-7.7671271887860978e-04 +-7.6710082798591523e-04 +-7.5887977473861013e-04 +-7.5190687544724692e-04 +-7.4605940008112305e-04 +-7.4123295976702961e-04 +-7.3734019310727557e-04 +-7.3430971762528802e-04 +-7.3208531408043543e-04 +-7.3062531456870392e-04 +-7.2990216898614685e-04 +-2.0572136701317678e-03 +-2.0612790904072169e-03 +-2.0694370055388978e-03 +-2.0817398025606755e-03 +-2.0982555555846705e-03 +-2.1190383209207771e-03 +-2.1440584309961562e-03 +-2.1730538317596346e-03 +-2.2052084711996450e-03 +-2.2385065665387980e-03 +-2.2688292565837859e-03 +-2.2895629408340914e-03 +-2.2928109619195546e-03 +-2.2720958747664303e-03 +-2.2248292955157601e-03 +-2.1529627306368414e-03 +-2.0618092028351592e-03 +-1.9581264470780080e-03 +-1.8484792711367737e-03 +-1.7382932804995773e-03 +-1.6315387028193388e-03 +-1.5308094402457467e-03 +-1.4375794939843977e-03 +-1.3524966940206128e-03 +-1.2756445024183982e-03 +-1.2067481664971233e-03 +-1.1453249146665732e-03 +-1.0907872998396073e-03 +-1.0425108840834368e-03 +-9.9987636902731242e-04 +-9.6229419359221662e-04 +-9.2921752766599996e-04 +-9.0014784793935188e-04 +-8.7463595551871387e-04 +-8.5228033851113218e-04 +-8.3272411565619346e-04 +-8.1565134434662340e-04 +-8.0078317410706330e-04 +-7.8787412914524890e-04 +-7.7670867588181707e-04 +-7.6709815110335945e-04 +-7.5887807633519592e-04 +-7.5190585453407282e-04 +-7.4605882802611422e-04 +-7.4123266811876212e-04 +-7.3734006297147923e-04 +-7.3430967015602892e-04 +-7.3208530175177965e-04 +-7.3062531297162056e-04 +-7.2990216896088916e-04 +-2.0572420046444970e-03 +-2.0613073137878244e-03 +-2.0694645240791325e-03 +-2.0817650792283628e-03 +-2.0982756708109208e-03 +-2.1190483683591194e-03 +-2.1440495630415299e-03 +-2.1730058173585472e-03 +-2.2050706474711916e-03 +-2.2381734149603664e-03 +-2.2681445832352797e-03 +-2.2883820903883832e-03 +-2.2910870954111419e-03 +-2.2699167611368938e-03 +-2.2223789172610350e-03 +-2.1504479984733064e-03 +-2.0594015903528991e-03 +-1.9559376356847679e-03 +-1.8465635533131016e-03 +-1.7366621938958693e-03 +-1.6301772681588302e-03 +-1.5296891497666204e-03 +-1.4366670256656007e-03 +-1.3517590216924865e-03 +-1.2750514867893323e-03 +-1.2062735831118224e-03 +-1.1449466044257841e-03 +-1.0904868805091158e-03 +-1.0422732807100611e-03 +-9.9968930372696502e-04 +-9.6214770422144733e-04 +-9.2910354462753125e-04 +-9.0005983685699953e-04 +-8.7456862296758176e-04 +-8.5222939346622166e-04 +-8.3268607801992669e-04 +-8.1562339214376713e-04 +-8.0076302185915502e-04 +-7.8785993104265987e-04 +-7.7669894848118848e-04 +-7.6709171125218282e-04 +-7.5887399087340175e-04 +-7.5190339901012469e-04 +-7.4605745224207490e-04 +-7.4123196677350020e-04 +-7.3733975005178646e-04 +-7.3430955602191410e-04 +-7.3208527211179343e-04 +-7.3062530913478075e-04 +-7.2990216890898754e-04 +-2.0572330434653380e-03 +-2.0612979234412888e-03 +-2.0694532946442697e-03 +-2.0817486426684836e-03 +-2.0982476231464547e-03 +-2.1189974495073338e-03 +-2.1439543375352233e-03 +-2.1728181680419497e-03 +-2.2046792926145383e-03 +-2.2373633396429475e-03 +-2.2666146172010443e-03 +-2.2858671642393127e-03 +-2.2875169197677514e-03 +-2.2654776333807156e-03 +-2.2174360368241090e-03 +-2.1454051324349532e-03 +-2.0545906615806967e-03 +-1.9515733044691960e-03 +-1.8427487159991562e-03 +-1.7334167084782838e-03 +-1.6274696137745480e-03 +-1.5274617227101126e-03 +-1.4348531087144448e-03 +-1.3502927298729890e-03 +-1.2738727990906187e-03 +-1.2053303225476387e-03 +-1.1441947046858057e-03 +-1.0898897962721141e-03 +-1.0418010463745010e-03 +-9.9931751557982623e-04 +-9.6185656207251622e-04 +-9.2887700997289701e-04 +-8.9988492242123531e-04 +-8.7443480777439923e-04 +-8.5212814873581735e-04 +-8.3261048666361654e-04 +-8.1556784511343952e-04 +-8.0072297645663584e-04 +-7.8783171850163483e-04 +-7.7667962034089460e-04 +-7.6707891598186049e-04 +-7.5886587389149048e-04 +-7.5189852061138211e-04 +-7.4605471909163315e-04 +-7.4123057353231469e-04 +-7.3733912845311506e-04 +-7.3430932930853459e-04 +-7.3208521323786101e-04 +-7.3062530151536773e-04 +-7.2990216881114013e-04 +-2.0570060307481242e-03 +-2.0610695404114174e-03 +-2.0692202548568870e-03 +-2.0815037338606534e-03 +-2.0979771073381982e-03 +-2.1186760504049119e-03 +-2.1435323595058275e-03 +-2.1721894711853491e-03 +-2.2036231762564713e-03 +-2.2354947774359830e-03 +-2.2634364588789194e-03 +-2.2809771107701049e-03 +-2.2808509818679312e-03 +-2.2573902670081770e-03 +-2.2085625283994295e-03 +-2.1364309945293121e-03 +-2.0460731359685856e-03 +-1.9438692829347153e-03 +-1.8360257713886958e-03 +-1.7277020969733504e-03 +-1.6227039313886306e-03 +-1.5235418003916028e-03 +-1.4316608370813762e-03 +-1.3477119742467372e-03 +-1.2717979511083770e-03 +-1.2036696413517264e-03 +-1.1428707255511372e-03 +-1.0888382718798237e-03 +-1.0409692867346474e-03 +-9.9866259978621027e-04 +-9.6134365642691524e-04 +-9.2847789093913392e-04 +-8.9957672992270097e-04 +-8.7419901846868891e-04 +-8.5194974353354654e-04 +-8.3247728234586520e-04 +-8.1546996075181240e-04 +-8.0065240855098948e-04 +-7.8778200260897272e-04 +-7.7664556081873581e-04 +-7.6705636886795767e-04 +-7.5885157088737031e-04 +-7.5188992454109488e-04 +-7.4604990321250710e-04 +-7.4122811866681577e-04 +-7.3733803323305491e-04 +-7.3430892986142877e-04 +-7.3208510950982476e-04 +-7.3062528809216595e-04 +-7.2990216864218685e-04 +-2.0560406254744230e-03 +-2.0601002293357457e-03 +-2.0682389370964716e-03 +-2.0804935548257202e-03 +-2.0969060859737003e-03 +-2.1174848718975283e-03 +-2.1421077822971258e-03 +-2.1703118725549882e-03 +-2.2008927660337020e-03 +-2.2312974219723964e-03 +-2.2570630535733486e-03 +-2.2719292323414909e-03 +-2.2691546801074567e-03 +-2.2436679183221371e-03 +-2.1938136680298213e-03 +-2.1216987442591309e-03 +-2.0321918687364413e-03 +-1.9313655314987710e-03 +-1.8251384674924337e-03 +-1.7184575891013049e-03 +-1.6149975191541029e-03 +-1.5172030564200175e-03 +-1.4264976670561422e-03 +-1.3435365525681718e-03 +-1.2684398405280680e-03 +-1.2009808792852038e-03 +-1.1407263662446270e-03 +-1.0871346466312449e-03 +-1.0396213282134327e-03 +-9.9760097014115921e-04 +-9.6051204771163256e-04 +-9.2783065330298976e-04 +-8.9907686814038072e-04 +-8.7381654050460290e-04 +-8.5166032032770020e-04 +-8.3226117082750258e-04 +-8.1531114334001465e-04 +-8.0053790742550316e-04 +-7.8770133315656356e-04 +-7.7659029477060524e-04 +-7.6701978307683110e-04 +-7.5882836239258406e-04 +-7.5187597643116080e-04 +-7.4604208900387831e-04 +-7.4122413548401188e-04 +-7.3733625619441248e-04 +-7.3430828175241646e-04 +-7.3208494121191942e-04 +-7.3062526631407522e-04 +-7.2990216837054856e-04 +-2.0529834513432791e-03 +-2.0570328065344849e-03 +-2.0651407280758423e-03 +-2.0773226813181112e-03 +-2.0935848266463316e-03 +-2.1138755081846561e-03 +-2.1379694549995892e-03 +-2.1652341048685676e-03 +-2.1942311468760834e-03 +-2.2221955580273554e-03 +-2.2446668472980535e-03 +-2.2557758750190128e-03 +-2.2495068883230597e-03 +-2.2215335380400673e-03 +-2.1706310322307173e-03 +-2.0989076178834468e-03 +-2.0109187476808304e-03 +-1.9123053118497665e-03 +-1.8085885312962558e-03 +-1.7044224161501971e-03 +-1.6033014289936309e-03 +-1.5075808975967791e-03 +-1.4186563693041228e-03 +-1.3371915554757348e-03 +-1.2633335607770987e-03 +-1.1968898083347600e-03 +-1.1374616822403697e-03 +-1.0845395468828570e-03 +-1.0375670107112317e-03 +-9.9598233402498331e-04 +-9.5924365067680121e-04 +-9.2684315521178093e-04 +-8.9831402206076499e-04 +-8.7323270826906508e-04 +-8.5121845298916294e-04 +-8.3193118322803881e-04 +-8.1506861350454367e-04 +-8.0036303866937272e-04 +-7.8757812575838812e-04 +-7.7650588304893848e-04 +-7.6696390178134367e-04 +-7.5879291330166378e-04 +-7.5185467183171335e-04 +-7.4603015352330590e-04 +-7.4121805161085608e-04 +-7.3733354200017029e-04 +-7.3430729186417423e-04 +-7.3208468416560821e-04 +-7.3062523305262889e-04 +-7.2990216795754321e-04 +-2.0445774280922818e-03 +-2.0486022542072452e-03 +-2.0566380905557278e-03 +-2.0686534378906510e-03 +-2.0845798527313773e-03 +-2.1042543484161131e-03 +-2.1272900082339435e-03 +-2.1528378610849307e-03 +-2.1792287591850808e-03 +-2.2035791968483057e-03 +-2.2216148887267270e-03 +-2.2280710287733733e-03 +-2.2178192977835936e-03 +-2.1873468927834459e-03 +-2.1358379801796139e-03 +-2.0653162028096005e-03 +-1.9799039901976950e-03 +-1.8846865820720494e-03 +-1.7846815771127590e-03 +-1.6841731457501461e-03 +-1.5864288823403893e-03 +-1.4936929975737962e-03 +-1.4073292161704478e-03 +-1.3280167537864935e-03 +-1.2559423246294968e-03 +-1.1909621532332146e-03 +-1.1327269989162181e-03 +-1.0807727667038361e-03 +-1.0345829353632580e-03 +-9.9362957783938940e-04 +-9.5739893476973561e-04 +-9.2540627431698670e-04 +-8.9720357379701094e-04 +-8.7238255689077351e-04 +-8.5057484716479089e-04 +-8.3145043048118452e-04 +-8.1471521506831606e-04 +-8.0010819784329730e-04 +-7.8739855501196697e-04 +-7.7638284746287477e-04 +-7.6688244765423983e-04 +-7.5874124050506406e-04 +-7.5182361665455163e-04 +-7.4601275551055407e-04 +-7.4120918340253822e-04 +-7.3732958568389548e-04 +-7.3430584898463800e-04 +-7.3208430949503792e-04 +-7.3062518457169966e-04 +-7.2990216735703930e-04 +-2.0242444509852623e-03 +-2.0282171436878794e-03 +-2.0361089273572691e-03 +-2.0478082862517536e-03 +-2.0631254795714271e-03 +-2.0817341186685975e-03 +-2.1030466985865600e-03 +-2.1260033215056320e-03 +-2.1487891123235007e-03 +-2.1685770527884898e-03 +-2.1814981578635881e-03 +-2.1830673301855468e-03 +-2.1691107268505191e-03 +-2.1368908511600155e-03 +-2.0859029562839432e-03 +-2.0179693474576370e-03 +-1.9366642626323673e-03 +-1.8464135095614070e-03 +-1.7516460285950429e-03 +-1.6562147901967661e-03 +-1.5631235242972680e-03 +-1.4744894089740019e-03 +-1.3916441229221014e-03 +-1.3152922561530998e-03 +-1.2456754246600137e-03 +-1.1827160032741176e-03 +-1.1261313858814466e-03 +-1.0755189864407328e-03 +-1.0304162786879867e-03 +-9.9034128091199749e-04 +-9.5481856091755304e-04 +-9.2339496013633471e-04 +-8.9564827057264369e-04 +-8.7119124085887831e-04 +-8.4967259943763602e-04 +-8.3077626203111900e-04 +-8.1421951137090984e-04 +-7.9975066858465336e-04 +-7.8714658943358773e-04 +-7.7621019174437499e-04 +-7.6676813540672167e-04 +-7.5866872031037319e-04 +-7.5178003146127723e-04 +-7.4598833775512395e-04 +-7.4119673715305622e-04 +-7.3732403319731439e-04 +-7.3430382401035404e-04 +-7.3208378368078109e-04 +-7.3062511653452134e-04 +-7.2990216651548634e-04 +-1.9822002668714771e-03 +-1.9860765165246813e-03 +-1.9937259065502884e-03 +-2.0049382622175684e-03 +-2.0193789874050957e-03 +-2.0365410195509648e-03 +-2.0556464946867728e-03 +-2.0754894179676191e-03 +-2.0942443882580207e-03 +-2.1093250406387012e-03 +-2.1174338208142444e-03 +-2.1149374315366015e-03 +-2.0985691587475383e-03 +-2.0662420048783723e-03 +-2.0176244407471254e-03 +-1.9542240135076421e-03 +-1.8789815561646795e-03 +-1.7955973930768626e-03 +-1.7078593019088950e-03 +-1.6191500367924120e-03 +-1.5321852841401699e-03 +-1.4489455231636787e-03 +-1.3707328221073897e-03 +-1.2982881743881685e-03 +-1.2319242025234142e-03 +-1.1716477339549967e-03 +-1.1172612632569618e-03 +-1.0684410867804399e-03 +-1.0247942977117033e-03 +-9.8589849008465583e-04 +-9.5132820422937265e-04 +-9.2067166397220856e-04 +-8.9354066158944150e-04 +-8.6957576275141946e-04 +-8.4844842062549593e-04 +-8.2986112787904339e-04 +-8.1354638875020516e-04 +-7.9926504089604313e-04 +-7.8680427724594506e-04 +-7.7597559292321165e-04 +-7.6661279647569590e-04 +-7.5857016673861366e-04 +-7.5172079825726475e-04 +-7.4595515325638466e-04 +-7.4117982243369700e-04 +-7.3731648737139185e-04 +-7.3430107212576166e-04 +-7.3208306912711020e-04 +-7.3062502407726930e-04 +-7.2990216537288037e-04 +-1.9091966715634099e-03 +-1.9129185219344154e-03 +-1.9202166856721352e-03 +-1.9307970013547088e-03 +-1.9442045665836378e-03 +-1.9597919306590158e-03 +-1.9766564101575926e-03 +-1.9935443335972109e-03 +-2.0087438199857628e-03 +-2.0200243831636293e-03 +-2.0247121893545274e-03 +-2.0199773548032359e-03 +-2.0033260489995043e-03 +-1.9731620797406382e-03 +-1.9292006069540478e-03 +-1.8725608352951530e-03 +-1.8055146551072549e-03 +-1.7310162232455023e-03 +-1.6521930501407168e-03 +-1.5719385219734063e-03 +-1.4926648361142999e-03 +-1.4162075772603522e-03 +-1.3438394093199847e-03 +-1.2763453337524891e-03 +-1.2141218786412477e-03 +-1.1572762423287151e-03 +-1.1057130397106459e-03 +-1.0592041928461369e-03 +-1.0174420229778082e-03 +-9.8007772742692901e-04 +-9.4674810818138125e-04 +-9.1709334750800936e-04 +-8.9076822903276119e-04 +-8.6744871786848497e-04 +-8.4683535559171264e-04 +-8.2865454029692077e-04 +-8.1265845764570124e-04 +-7.9862419854806466e-04 +-7.8635242994317344e-04 +-7.7566586362347388e-04 +-7.6640768232749700e-04 +-7.5844002282830065e-04 +-7.5164257510000956e-04 +-7.4591132935052074e-04 +-7.4115748478313355e-04 +-7.3730652251331285e-04 +-7.3429743813350546e-04 +-7.3208212554783623e-04 +-7.3062490198850432e-04 +-7.2990216386489728e-04 +-1.8021160850451227e-03 +-1.8056226886294829e-03 +-1.8124690977394237e-03 +-1.8223195200916494e-03 +-1.8346619546941111e-03 +-1.8487909914590723e-03 +-1.8637758622326488e-03 +-1.8784144799132410e-03 +-1.8911877069072043e-03 +-1.9002480483643006e-03 +-1.9034926970020300e-03 +-1.8987631656927659e-03 +-1.8841682529645324e-03 +-1.8584559487123927e-03 +-1.8213075607206143e-03 +-1.7734394441009398e-03 +-1.7164754923743289e-03 +-1.6526471348561882e-03 +-1.5844302660793475e-03 +-1.5142219205576959e-03 +-1.4441156759553450e-03 +-1.3757871183364835e-03 +-1.3104696228442038e-03 +-1.2489893438709313e-03 +-1.1918303663311020e-03 +-1.1392087898132622e-03 +-1.0911429072271955e-03 +-1.0475132430449697e-03 +-1.0081105448815643e-03 +-9.7267224538612445e-04 +-9.4090902139155831e-04 +-9.1252339940937216e-04 +-8.8722226630600168e-04 +-8.6472487614910139e-04 +-8.4476763014563604e-04 +-8.2710661118972479e-04 +-8.1151860395286548e-04 +-7.9780113134268022e-04 +-7.8577188458464706e-04 +-7.7526780961660949e-04 +-7.6614402884519746e-04 +-7.5827271731923086e-04 +-7.5154201001266052e-04 +-7.4585498744743838e-04 +-7.4112876674024960e-04 +-7.3729371164901432e-04 +-7.3429276639756650e-04 +-7.3208091255031610e-04 +-7.3062474504381682e-04 +-7.2990216192712052e-04 +-1.6665423187577379e-03 +-1.6697838481219739e-03 +-1.6761024443419331e-03 +-1.6851676499238309e-03 +-1.6964790848562081e-03 +-1.7093586881758596e-03 +-1.7229381586250955e-03 +-1.7361434689424210e-03 +-1.7476847990611714e-03 +-1.7560696539347703e-03 +-1.7596644676963738e-03 +-1.7568267022947026e-03 +-1.7461077851053273e-03 +-1.7264907754296506e-03 +-1.6975946774810309e-03 +-1.6597741187457426e-03 +-1.6140769638086710e-03 +-1.5620753536017048e-03 +-1.5056270853122812e-03 +-1.4466350219204920e-03 +-1.3868552001634097e-03 +-1.3277758272843224e-03 +-1.2705648027953060e-03 +-1.2160696687036089e-03 +-1.1648503106992682e-03 +-1.1172273523854758e-03 +-1.0733341483684198e-03 +-1.0331651610050569e-03 +-9.9661725859317703e-04 +-9.6352293251320681e-04 +-9.3367582456811303e-04 +-9.0684960891184981e-04 +-8.8281147256200369e-04 +-8.6133139295990508e-04 +-8.4218825416021220e-04 +-8.2517365256783203e-04 +-8.1009405893883702e-04 +-7.9677184330070449e-04 +-7.8504553867150622e-04 +-7.7476961684544475e-04 +-7.6581397127561946e-04 +-7.5806324372029493e-04 +-7.5141608853758490e-04 +-7.4578443762616088e-04 +-7.4109280702762468e-04 +-7.3727767078240450e-04 +-7.3428691699120856e-04 +-7.3207939383027065e-04 +-7.3062454854870866e-04 +-7.2990215950163178e-04 +-1.5143514922988188e-03 +-1.5172992626108308e-03 +-1.5230492579061297e-03 +-1.5313092907216234e-03 +-1.5416383872564321e-03 +-1.5534437883173524e-03 +-1.5659777979311119e-03 +-1.5783365666929092e-03 +-1.5894656462494524e-03 +-1.5981810338211075e-03 +-1.6032175666731274e-03 +-1.6033152315188515e-03 +-1.5973445810351468e-03 +-1.5844553015267344e-03 +-1.5642141842844438e-03 +-1.5366917420896044e-03 +-1.5024679334258919e-03 +-1.4625531930773830e-03 +-1.4182479476677360e-03 +-1.3709788299417121e-03 +-1.3221484180203726e-03 +-1.2730224074582980e-03 +-1.2246622779697337e-03 +-1.1778992762879934e-03 +-1.1333392283630532e-03 +-1.0913864589993550e-03 +-1.0522768573618163e-03 +-1.0161129873108728e-03 +-9.8289691402208374e-04 +-9.5255858058114734e-04 +-9.2497902581312370e-04 +-9.0000859629048877e-04 +-8.7748073850217058e-04 +-8.5722211597979417e-04 +-8.3905979791426642e-04 +-8.2282618929076484e-04 +-8.0836226608828549e-04 +-7.9551956951699754e-04 +-7.8416131382599223e-04 +-7.7416287806199790e-04 +-7.6541188405317249e-04 +-7.5780800946071108e-04 +-7.5126264377544803e-04 +-7.4569846428466772e-04 +-7.4104898613709972e-04 +-7.3725812384468372e-04 +-7.3427978938580825e-04 +-7.3207754332362191e-04 +-7.3062430913473141e-04 +-7.2990215654691220e-04 +-1.3589568386465627e-03 +-1.3616059876369077e-03 +-1.3667848188843531e-03 +-1.3742535906291018e-03 +-1.3836510048894325e-03 +-1.3944931410972510e-03 +-1.4061737381409435e-03 +-1.4179676533558601e-03 +-1.4290404239881644e-03 +-1.4384682680730644e-03 +-1.4452739237442317e-03 +-1.4484830627766304e-03 +-1.4472020719643879e-03 +-1.4407104109576848e-03 +-1.4285517607852617e-03 +-1.4106024345590413e-03 +-1.3870974963170102e-03 +-1.3586054582707542e-03 +-1.3259570339474156e-03 +-1.2901455064628215e-03 +-1.2522210023839843e-03 +-1.2131979030541769e-03 +-1.1739869060169207e-03 +-1.1353549094546922e-03 +-1.0979097068039413e-03 +-1.0621033247291728e-03 +-1.0282472297927180e-03 +-9.9653356114594738e-04 +-9.6705809074885442e-04 +-9.3984215999879967e-04 +-9.1485209891355699e-04 +-8.9201552463465887e-04 +-8.7123447718074547e-04 +-8.5239566064552986e-04 +-8.3537819764947199e-04 +-8.2005933922460277e-04 +-8.0631854842502142e-04 +-7.9404032461725591e-04 +-7.8311607521891924e-04 +-7.7344528287954704e-04 +-7.6493616367583788e-04 +-7.5750596762179671e-04 +-7.5108103673750650e-04 +-7.4559670729756314e-04 +-7.4099712058365674e-04 +-7.3723498933261390e-04 +-7.3427135403856549e-04 +-7.3207535340650220e-04 +-7.3062402582024647e-04 +-7.2990215305086803e-04 +-1.2115499364707893e-03 +-1.2139158392786334e-03 +-1.2185543138110702e-03 +-1.2252780947903245e-03 +-1.2338051204917825e-03 +-1.2437580933449682e-03 +-1.2546654877765801e-03 +-1.2659654079140454e-03 +-1.2770141398260259e-03 +-1.2871017009935429e-03 +-1.2954769314115183e-03 +-1.3013842169989547e-03 +-1.3041121947366171e-03 +-1.3030514842167346e-03 +-1.2977542245046047e-03 +-1.2879846499904196e-03 +-1.2737492324334987e-03 +-1.2552982640709966e-03 +-1.2330973894872745e-03 +-1.2077749418635516e-03 +-1.1800560868485271e-03 +-1.1506960905888419e-03 +-1.1204227852277425e-03 +-1.0898941107843848e-03 +-1.0596722924322403e-03 +-1.0302129892418141e-03 +-1.0018660232184672e-03 +-9.7488386185237805e-04 +-9.4943442439009802e-04 +-9.2561556105630316e-04 +-9.0346939508023302e-04 +-8.8299544473955478e-04 +-8.6416199236556224e-04 +-8.4691554065079253e-04 +-8.3118842485154366e-04 +-8.1690477137924143e-04 +-8.0398504401704772e-04 +-7.9234942608907009e-04 +-7.8192026986719778e-04 +-7.7262381616323254e-04 +-7.6439135526489683e-04 +-7.5715996954368045e-04 +-7.5087297037136180e-04 +-7.4548011825696571e-04 +-7.4093769541700610e-04 +-7.3720848397748205e-04 +-7.3426169017291475e-04 +-7.3207284469859997e-04 +-7.3062370127826009e-04 +-7.2990214904653308e-04 +-1.0795743930650992e-03 +-1.0816862357708231e-03 +-1.0858390690335173e-03 +-1.0918907395465794e-03 +-1.0996271622198408e-03 +-1.1087620332614152e-03 +-1.1189376541904871e-03 +-1.1297278563594281e-03 +-1.1406442106397865e-03 +-1.1511468426326664e-03 +-1.1606611625499153e-03 +-1.1686014966396342e-03 +-1.1744017651787830e-03 +-1.1775518629315580e-03 +-1.1776364101736500e-03 +-1.1743706169056243e-03 +-1.1676270072934483e-03 +-1.1574474488040643e-03 +-1.1440374664763149e-03 +-1.1277434918612198e-03 +-1.1090172266083106e-03 +-1.0883735004825249e-03 +-1.0663483286609671e-03 +-1.0434625696968455e-03 +-1.0201944065315227e-03 +-9.9696163733486954e-04 +-9.7411303391634410e-04 +-9.5192701524915619e-04 +-9.3061553118275510e-04 +-9.1033116088826518e-04 +-8.9117578792671619e-04 +-8.7320965057048454e-04 +-8.5645997708982773e-04 +-8.4092875102607153e-04 +-8.2659939819874342e-04 +-8.1344235307980947e-04 +-8.0141956343187455e-04 +-7.9048804625694207e-04 +-7.8060263043670071e-04 +-7.7171802387882525e-04 +-7.6379033406940168e-04 +-7.5677815642746576e-04 +-7.5064332839632148e-04 +-7.4535143091969088e-04 +-7.4087210396883696e-04 +-7.3717922959551277e-04 +-7.3425102469484751e-04 +-7.3207007615498079e-04 +-7.3062334314080149e-04 +-7.2990214462806077e-04 +-9.6691680853170183e-04 +-9.6881124738030231e-04 +-9.7254693178000712e-04 +-9.7801714313467932e-04 +-9.8506115939972819e-04 +-9.9346399478554212e-04 +-1.0029568836593533e-03 +-1.0132191721929555e-03 +-1.0238823805424951e-03 +-1.0345372382441478e-03 +-1.0447444385358678e-03 +-1.0540496446808517e-03 +-1.0620028419990140e-03 +-1.0681814158684242e-03 +-1.0722153874796949e-03 +-1.0738122401453725e-03 +-1.0727780484250089e-03 +-1.0690315479781637e-03 +-1.0626085753236004e-03 +-1.0536558713023336e-03 +-1.0424151596176337e-03 +-1.0292001016079053e-03 +-1.0143697085499451e-03 +-9.9830187520425547e-04 +-9.8137001818805899e-04 +-9.6392469855784114e-04 +-9.4628094849959427e-04 +-9.2871107615658107e-04 +-9.1144211230729947e-04 +-8.9465678467367702e-04 +-8.7849688442566908e-04 +-8.6306802745199525e-04 +-8.4844502374305329e-04 +-8.3467729035266978e-04 +-8.2179394123613018e-04 +-8.0980834537837105e-04 +-7.9872206071043492e-04 +-7.8852813008099679e-04 +-7.7921377450328264e-04 +-7.7076254580940714e-04 +-7.6315601250285842e-04 +-7.5637505438609913e-04 +-7.5040083742080070e-04 +-7.4521553301411779e-04 +-7.4080283733542901e-04 +-7.3714833747436396e-04 +-7.3423976289425019e-04 +-7.3206715301883630e-04 +-7.3062296502604399e-04 +-7.2990213996346816e-04 +-8.7486190664002542e-04 +-8.7657827571580623e-04 +-8.7997087511531517e-04 +-8.8495918242554553e-04 +-8.9142192485447771e-04 +-8.9919683155481643e-04 +-9.0808085208393132e-04 +-9.1783127510748608e-04 +-9.2816823917964142e-04 +-9.3877914239939592e-04 +-9.4932541177263714e-04 +-9.5945196295531743e-04 +-9.6879944188716250e-04 +-9.7701897624779708e-04 +-9.8378869028086066e-04 +-9.8883071560979864e-04 +-9.9192698624723987e-04 +-9.9293189679024369e-04 +-9.9178006477524533e-04 +-9.8848801266470114e-04 +-9.8314947469644014e-04 +-9.7592502142969373e-04 +-9.6702752216877574e-04 +-9.5670543387731100e-04 +-9.4522594351524060e-04 +-9.3285966135643269e-04 +-9.1986801429297209e-04 +-9.0649388737916643e-04 +-8.9295554012296054e-04 +-8.7944345241910385e-04 +-8.6611954777247716e-04 +-8.5311817443178384e-04 +-8.4054825688342663e-04 +-8.2849611854076517e-04 +-8.1702858718190935e-04 +-8.0619610453057790e-04 +-7.9603565728915697e-04 +-7.8657342354040202e-04 +-7.7782708529043577e-04 +-7.6980779727449768e-04 +-7.6252182731928551e-04 +-7.5597189801433773e-04 +-7.5015826626952662e-04 +-7.4507957902870275e-04 +-7.4073354187572293e-04 +-7.3711743387422054e-04 +-7.3422849766464936e-04 +-7.3206422919420478e-04 +-7.3062258684307489e-04 +-7.2990213529831622e-04 +-8.0313928324693461e-04 +-8.0471663923334890e-04 +-8.0784040456141875e-04 +-8.1244850348763137e-04 +-8.1844744708872870e-04 +-8.2571210565368441e-04 +-8.3408576520943556e-04 +-8.4338075243066825e-04 +-8.5337994914596769e-04 +-8.6383952680562401e-04 +-8.7449320303046088e-04 +-8.8505824631213278e-04 +-8.9524332162861729e-04 +-9.0475807450702281e-04 +-9.1332410035933583e-04 +-9.2068666472534615e-04 +-9.2662627633376940e-04 +-9.3096903528306827e-04 +-9.3359465177584428e-04 +-9.3444120110338356e-04 +-9.3350604329339086e-04 +-9.3084282810584429e-04 +-9.2655502162679543e-04 +-9.2078681445801106e-04 +-9.1371251792454181e-04 +-9.0552559272581885e-04 +-8.9642830924137481e-04 +-8.8662277387553451e-04 +-8.7630374698122345e-04 +-8.6565338972684918e-04 +-8.5483785092728437e-04 +-8.4400545628550774e-04 +-8.3328618793080593e-04 +-8.2279212643248431e-04 +-8.1261855157578849e-04 +-8.0284544435817271e-04 +-7.9353918703328069e-04 +-7.8475431126626778e-04 +-7.7653519125597651e-04 +-7.6891761675487637e-04 +-7.6193020999458820e-04 +-7.5559567146076087e-04 +-7.4993185361910011e-04 +-7.4495267054800482e-04 +-7.4066885634487629e-04 +-7.3708858728415609e-04 +-7.3421798292172557e-04 +-7.3206150032948455e-04 +-7.3062223389551819e-04 +-7.2990213094470055e-04 +-7.5076462421466998e-04 +-7.5224033368928133e-04 +-7.5516693554655910e-04 +-7.5949465549144703e-04 +-7.6514853640518654e-04 +-7.7202823401640978e-04 +-7.8000798768472458e-04 +-7.8893695850711131e-04 +-7.9864015247000395e-04 +-8.0892015401963675e-04 +-8.1955987978967859e-04 +-8.3032651803088440e-04 +-8.4097674240245820e-04 +-8.5126317781153036e-04 +-8.6094195449683362e-04 +-8.6978102562884944e-04 +-8.7756876370442046e-04 +-8.8412222092208097e-04 +-8.8929437143002660e-04 +-8.9297967687164306e-04 +-8.9511744358292849e-04 +-8.9569265928509582e-04 +-8.9473427406316442e-04 +-8.9231117348407695e-04 +-8.8852632769182381e-04 +-8.8350974926804256e-04 +-8.7741093765579320e-04 +-8.7039143658714543e-04 +-8.6261800909817350e-04 +-8.5425677642576392e-04 +-8.4546850480419437e-04 +-8.3640508217604768e-04 +-8.2720711868306852e-04 +-8.1800253429954630e-04 +-8.0890596084330125e-04 +-8.0001877670310266e-04 +-7.9142960262116734e-04 +-7.8321510804737094e-04 +-7.7544100375692606e-04 +-7.6816312322091880e-04 +-7.6142851990796052e-04 +-7.5527652886030856e-04 +-7.4973975803878791e-04 +-7.4484498816651155e-04 +-7.4061396954667417e-04 +-7.3706411114277549e-04 +-7.3420906167620721e-04 +-7.3205918514483725e-04 +-7.3062193446576625e-04 +-7.2990212725135392e-04 +-7.1661635226914105e-04 +-7.1802577101587469e-04 +-7.2082351175825903e-04 +-7.2496726677274287e-04 +-7.3039332869955257e-04 +-7.3701640524978778e-04 +-7.4472954941033175e-04 +-7.5340434547722858e-04 +-7.6289151048326907e-04 +-7.7302207759845181e-04 +-7.8360931948673394e-04 +-7.9445154230845720e-04 +-8.0533583289245359e-04 +-8.1604277210608762e-04 +-8.2635203881372484e-04 +-8.3604872680787554e-04 +-8.4493009170460271e-04 +-8.5281235007415520e-04 +-8.5953708572703903e-04 +-8.6497679447195062e-04 +-8.6903913069829013e-04 +-8.7166951000461920e-04 +-8.7285186359659192e-04 +-8.7260751301537743e-04 +-8.7099231121298096e-04 +-8.6809235009941495e-04 +-8.6401864284526089e-04 +-8.5890123909620661e-04 +-8.5288322247251548e-04 +-8.4611498230358594e-04 +-8.3874906197581734e-04 +-8.3093578290133131e-04 +-8.2281974219419577e-04 +-8.1453719540053218e-04 +-8.0621426950161718e-04 +-7.9796590756915262e-04 +-7.8989542307845051e-04 +-7.8209453512943902e-04 +-7.7464376108582922e-04 +-7.6761305599773336e-04 +-7.6106260490143825e-04 +-7.5504369189674048e-04 +-7.4959958689851155e-04 +-7.4476640603327016e-04 +-7.4057391428831803e-04 +-7.3704624911301460e-04 +-7.3420255137661655e-04 +-7.3205749569102072e-04 +-7.3062171596998055e-04 +-7.2990212455638630e-04 +-6.9978946823179874e-04 +-7.0116630881935087e-04 +-7.0390064503701537e-04 +-7.0795368469615740e-04 +-7.1326701698164890e-04 +-7.1976243679496617e-04 +-7.2734185834745740e-04 +-7.3588743519949467e-04 +-7.4526202041313354e-04 +-7.5531010723508662e-04 +-7.6585938519371105e-04 +-7.7672302640816742e-04 +-7.8770278075497092e-04 +-7.9859290608976137e-04 +-8.0918489258175830e-04 +-8.1927286227978318e-04 +-8.2865944272793811e-04 +-8.3716183567057549e-04 +-8.4461773932407503e-04 +-8.5089074656718067e-04 +-8.5587484149242865e-04 +-8.5949765903885005e-04 +-8.6172225680106282e-04 +-8.6254726711931090e-04 +-8.6200543668566647e-04 +-8.6016070089496718e-04 +-8.5710406086921605e-04 +-8.5294861582628848e-04 +-8.4782414258222506e-04 +-8.4187160643839950e-04 +-8.3523794042777684e-04 +-8.2807135526836875e-04 +-8.2051735488831545e-04 +-8.1271554550340253e-04 +-8.0479725017201602e-04 +-7.9688388159128356e-04 +-7.8908598569835402e-04 +-7.8150284635561699e-04 +-7.7422253402347082e-04 +-7.6732228500805109e-04 +-7.6086910874793227e-04 +-7.5492053533200655e-04 +-7.4952543143630879e-04 +-7.4472482834061105e-04 +-7.4055271954953173e-04 +-7.3703679725783846e-04 +-7.3419910632642569e-04 +-7.3205660167823873e-04 +-7.3062160034791177e-04 +-7.2990212313027967e-04 +-6.9978949888040555e-04 +-7.0116658500659452e-04 +-7.0390141399825446e-04 +-7.0795519624237046e-04 +-7.1326952275199403e-04 +-7.1976618711068431e-04 +-7.2734709599072756e-04 +-7.3589438563899173e-04 +-7.4527087834049921e-04 +-7.5532101978963227e-04 +-7.6587243292751341e-04 +-7.7673820381691096e-04 +-7.8771997894208786e-04 +-7.9861190065370067e-04 +-8.0920533990303726e-04 +-8.1929430685418890e-04 +-8.2868133697240902e-04 +-8.3718357182031356e-04 +-8.4463869094055747e-04 +-8.5091031523475125e-04 +-8.5589250298139050e-04 +-8.5951300292935555e-04 +-8.6173501442700058e-04 +-8.6255732453897384e-04 +-8.6201283179581853e-04 +-8.6016560623094161e-04 +-8.5710675556746130e-04 +-8.5294945133293997e-04 +-8.4782350687630345e-04 +-8.4186989092776643e-04 +-8.3523551254189058e-04 +-8.2806853843220795e-04 +-8.2051441629534374e-04 +-8.1271269110054349e-04 +-8.0479462561130197e-04 +-7.9688157758832216e-04 +-7.8908404620646542e-04 +-7.8150127812987003e-04 +-7.7422131642351690e-04 +-7.6732137920000804e-04 +-7.6086846576227417e-04 +-7.5492010268637618e-04 +-7.4952515822674422e-04 +-7.4472466884156448e-04 +-7.4055263544937347e-04 +-7.3703675870287705e-04 +-7.3419909196418773e-04 +-7.3205659789029806e-04 +-7.3062159985273691e-04 +-7.2990212312415024e-04 +-7.1661644900520096e-04 +-7.1802664274297546e-04 +-7.2082593878111353e-04 +-7.2497203729959131e-04 +-7.3040123601717508e-04 +-7.3702823692087130e-04 +-7.4474606627071950e-04 +-7.5342624891310255e-04 +-7.6291939767884572e-04 +-7.7305638624756046e-04 +-7.8365026580712641e-04 +-7.9449905883285173e-04 +-8.0538951494348162e-04 +-8.1610184340158356e-04 +-8.2641534654269292e-04 +-8.3611477419275341e-04 +-8.4499711140388341e-04 +-8.5287841532419295e-04 +-8.5960024909115620e-04 +-8.6503523810349677e-04 +-8.6909130873227098e-04 +-8.7171426409102877e-04 +-8.7288849673953345e-04 +-8.7263581383329825e-04 +-8.7101252882317232e-04 +-8.6810512721280928e-04 +-8.6402491986265297e-04 +-8.5890214427889735e-04 +-8.5287996267563112e-04 +-8.4610874598948116e-04 +-8.3874094225846693e-04 +-8.3092672419486408e-04 +-8.2281051040527457e-04 +-8.1452836894623112e-04 +-8.0620624687273727e-04 +-7.9795892658523191e-04 +-7.8988958715925904e-04 +-7.8208984256525934e-04 +-7.7464013417691149e-04 +-7.6761036786094532e-04 +-7.6106070258402160e-04 +-7.5504241512711209e-04 +-7.4959878232119532e-04 +-7.4476593712823242e-04 +-7.4057366738965505e-04 +-7.3704613605018272e-04 +-7.3420250929534981e-04 +-7.3205748459933379e-04 +-7.3062171452059643e-04 +-7.2990212453841121e-04 +-7.5076480220753002e-04 +-7.5224193764485950e-04 +-7.5517140104727700e-04 +-7.5950343180946440e-04 +-7.6516307954731895e-04 +-7.7204998356114986e-04 +-7.8003832300729305e-04 +-7.8897713159307439e-04 +-7.9869119726619343e-04 +-8.0898277631407365e-04 +-8.1963433675670821e-04 +-8.3041250212673048e-04 +-8.4107328899768962e-04 +-8.5136861815172417e-04 +-8.6105393367282750e-04 +-8.6989659826432642e-04 +-8.7768456838888955e-04 +-8.8423472001356420e-04 +-8.8940012904889347e-04 +-8.9307563844617018e-04 +-8.9520117806415108e-04 +-8.9576253103731854e-04 +-8.9478952401402315e-04 +-8.9235190508972051e-04 +-8.8855340866225957e-04 +-8.8352465144824757e-04 +-8.7741554313519349e-04 +-8.7038783793396432e-04 +-8.6260832688804967e-04 +-8.5424300994601946e-04 +-8.4545242395355294e-04 +-8.3638816165820676e-04 +-8.2719051046510389e-04 +-8.1798707121203611e-04 +-8.0889218293736628e-04 +-8.0000697211393462e-04 +-7.9141985571871487e-04 +-7.8320734913366497e-04 +-7.7543505615295110e-04 +-7.6815874504865863e-04 +-7.6142543909377407e-04 +-7.5527447082108861e-04 +-7.4973846617124159e-04 +-7.4484423768028391e-04 +-7.4061357541411945e-04 +-7.3706393103345079e-04 +-7.3420899474917157e-04 +-7.3205916752533461e-04 +-7.3062193216519408e-04 +-7.2990212722285654e-04 +-8.0313957044182423e-04 +-8.0471922722569862e-04 +-8.0784760927302374e-04 +-8.1246266077718992e-04 +-8.1847089710005371e-04 +-8.2574714718010170e-04 +-8.3413457224246505e-04 +-8.4344524852641002e-04 +-8.5346164112103378e-04 +-8.6393930776184345e-04 +-8.7461114514153656e-04 +-8.8519341433404520e-04 +-8.9539364568295737e-04 +-9.0492032170401903e-04 +-9.1349397629487971e-04 +-9.2085905705444277e-04 +-9.2679562618587790e-04 +-9.3112979438387297e-04 +-9.3374176171868528e-04 +-9.3457052315245096e-04 +-9.3361467539162580e-04 +-9.3092926816478730e-04 +-9.2661916610130182e-04 +-9.2082981034565285e-04 +-9.1373650769330543e-04 +-9.0553340166725613e-04 +-8.9642312356534028e-04 +-8.8660784848369290e-04 +-8.7628216839648766e-04 +-8.6562790589981436e-04 +-8.5481076818554633e-04 +-8.4397859574968450e-04 +-8.3326088937337340e-04 +-8.2276928618846431e-04 +-8.1259868183380154e-04 +-8.0282874308579180e-04 +-7.9352561021162158e-04 +-7.8474364153450463e-04 +-7.7652709920929871e-04 +-7.6891171286909540e-04 +-7.6192608644325838e-04 +-7.5559293398465418e-04 +-7.4993014417108674e-04 +-7.4495168174495800e-04 +-7.4066833888399865e-04 +-7.3708835148582872e-04 +-7.3421789549418370e-04 +-7.3206147735025676e-04 +-7.3062223089832205e-04 +-7.2990213090757172e-04 +-8.7486234765586190e-04 +-8.7658224978472165e-04 +-8.7998193765346947e-04 +-8.8498091479762096e-04 +-8.9145790074762104e-04 +-8.9925052908419051e-04 +-9.0815549824423494e-04 +-9.1792961668091754e-04 +-9.2829224675600197e-04 +-9.3892967180886171e-04 +-9.4950186787407247e-04 +-9.5965202948868034e-04 +-9.6901895077054453e-04 +-9.7725198275034546e-04 +-9.8402779256489994e-04 +-9.8906761058650252e-04 +-9.9215319914592172e-04 +-9.9313957572953835e-04 +-9.9196271000374231e-04 +-9.8864102151803926e-04 +-9.8327042446222802e-04 +-9.7601366958350872e-04 +-9.6708555893324638e-04 +-9.5673606097165743e-04 +-9.4523336848186532e-04 +-9.3284859066883840e-04 +-9.1984320788924330e-04 +-9.0645981122201228e-04 +-8.9291612913059565e-04 +-8.7940197783992495e-04 +-8.6607857202024698e-04 +-8.5307957175204932e-04 +-8.4051327822778888e-04 +-8.2846548179836207e-04 +-8.1700257790558422e-04 +-8.0617467643545333e-04 +-7.9601852548680642e-04 +-7.8656014643990345e-04 +-7.7781713330676600e-04 +-7.6980060801308872e-04 +-7.6251684788083247e-04 +-7.5596861562122791e-04 +-7.5015622867570574e-04 +-7.4507840623731303e-04 +-7.4073293062929045e-04 +-7.3711715625605055e-04 +-7.3422839499647169e-04 +-7.3206420226053670e-04 +-7.3062258333453768e-04 +-7.2990213525489652e-04 +-9.6691746949171956e-04 +-9.6881720331120399e-04 +-9.7256350943291606e-04 +-9.7804969875588013e-04 +-9.8511500906794535e-04 +-9.9354424708940716e-04 +-1.0030681524989403e-03 +-1.0133651638232594e-03 +-1.0240653758209148e-03 +-1.0347575274915039e-03 +-1.0449998061725781e-03 +-1.0543350312725759e-03 +-1.0623103159852479e-03 +-1.0685005520351086e-03 +-1.0725340717418843e-03 +-1.0741178162733483e-03 +-1.0730586244726546e-03 +-1.0692772252856723e-03 +-1.0628123746539088e-03 +-1.0538142063394719e-03 +-1.0425278196576238e-03 +-1.0292698133776545e-03 +-1.0144014192878174e-03 +-9.9830192203197252e-04 +-9.8134532864573671e-04 +-9.6388212184896278e-04 +-9.4622676590347388e-04 +-9.2865069616096399e-04 +-9.1137992761755040e-04 +-8.9459615445652623e-04 +-8.7844020256934831e-04 +-8.6301684193121027e-04 +-8.4840017959887887e-04 +-8.3463907673415536e-04 +-8.2176222995505204e-04 +-8.0978271391980597e-04 +-7.9870189657235365e-04 +-7.8851271590446451e-04 +-7.7920235500871231e-04 +-7.7075437837279546e-04 +-7.6315040353715593e-04 +-7.5637138372370444e-04 +-7.5039857275483596e-04 +-7.4521423623566722e-04 +-7.4080216435599088e-04 +-7.3714803287990580e-04 +-7.3423965055747012e-04 +-7.3206712360849235e-04 +-7.3062296120003113e-04 +-7.2990213991614285e-04 +-1.0795753655757400e-03 +-1.0816949989152424e-03 +-1.0858634568691261e-03 +-1.0919386114820013e-03 +-1.0997062636090337e-03 +-1.1088796815173748e-03 +-1.1191002150177127e-03 +-1.1299400102413632e-03 +-1.1409080667564575e-03 +-1.1514610312786621e-03 +-1.1610201099911505e-03 +-1.1689951269115543e-03 +-1.1748158461501051e-03 +-1.1779690985988713e-03 +-1.1780381930601813e-03 +-1.1747391518193526e-03 +-1.1679473819506123e-03 +-1.1577092214837459e-03 +-1.1442354739421095e-03 +-1.1278777978403418e-03 +-1.1090923454335586e-03 +-1.0883971689162274e-03 +-1.0663301330007199e-03 +-1.0434126825736433e-03 +-1.0201225907407829e-03 +-9.9687657467114471e-04 +-9.7402196183192448e-04 +-9.5183561165418482e-04 +-9.3052797362856785e-04 +-9.1025029113725290e-04 +-8.9110332693928388e-04 +-8.7314642524034792e-04 +-8.5640613464698105e-04 +-8.4088394828233694e-04 +-8.2656296057711804e-04 +-8.1341340319584458e-04 +-8.0139712164615585e-04 +-7.9047110680830314e-04 +-7.8059021706213536e-04 +-7.7170922862963723e-04 +-7.6378434260534903e-04 +-7.5677426256851878e-04 +-7.5064094022108871e-04 +-7.4535007026165444e-04 +-7.4087140079103137e-04 +-7.3717891242176304e-04 +-7.3425090803503582e-04 +-7.3207004567441892e-04 +-7.3062333918088912e-04 +-7.2990214457911414e-04 +-1.2115513365602716e-03 +-1.2139284549407190e-03 +-1.2185894169736942e-03 +-1.2253469605857672e-03 +-1.2339187587137924e-03 +-1.2439266732389715e-03 +-1.2548974034287377e-03 +-1.2662660075813069e-03 +-1.2773842610310203e-03 +-1.2875362974528724e-03 +-1.2959642001489442e-03 +-1.3019056612370253e-03 +-1.3046439231761680e-03 +-1.3035667394780048e-03 +-1.2982267372235426e-03 +-1.2883920940764749e-03 +-1.2740759723707312e-03 +-1.2555367934845615e-03 +-1.2332482702629790e-03 +-1.2078454799926640e-03 +-1.1800582569000398e-03 +-1.1506442781172911e-03 +-1.1203317966130063e-03 +-1.0897776997336481e-03 +-1.0595422621614023e-03 +-1.0300787994655220e-03 +-1.0017347704152455e-03 +-9.7476049382956445e-04 +-9.4932207276269881e-04 +-9.2551590841944320e-04 +-9.0338302534504042e-04 +-8.8292214992470445e-04 +-8.6410102605580567e-04 +-8.4686581848472566e-04 +-8.3114867761094791e-04 +-8.1687365826060658e-04 +-8.0396123382299499e-04 +-7.9233165330786989e-04 +-7.8190737148398212e-04 +-7.7261475388536399e-04 +-7.6438522680087574e-04 +-7.5715601170731821e-04 +-7.5087055609572378e-04 +-7.4547874907622525e-04 +-7.4093699058054867e-04 +-7.3720816707061889e-04 +-7.3426157390692887e-04 +-7.3207281437861886e-04 +-7.3062369734420377e-04 +-7.2990214899793329e-04 +-1.3589587929433032e-03 +-1.3616235964626867e-03 +-1.3668338045675864e-03 +-1.3743496213141093e-03 +-1.3838092006737575e-03 +-1.3947270571719789e-03 +-1.4064937549355761e-03 +-1.4183788609950551e-03 +-1.4295403243277985e-03 +-1.4390448821684602e-03 +-1.4459050679577175e-03 +-1.4491374869758410e-03 +-1.4478427363171394e-03 +-1.4412994811113349e-03 +-1.4290562017186491e-03 +-1.4109987469848183e-03 +-1.3873743834943496e-03 +-1.3587639336333224e-03 +-1.3260083166635275e-03 +-1.2901076203246853e-03 +-1.2521151183381310e-03 +-1.2130452246169299e-03 +-1.1738065004131667e-03 +-1.1351625289882906e-03 +-1.0977174218613861e-03 +-1.0619197068992274e-03 +-1.0280778373221160e-03 +-9.9638153831012235e-04 +-9.6692476042708185e-04 +-9.3972754536575365e-04 +-9.1475534966710750e-04 +-8.9193524688272450e-04 +-8.7116897804801331e-04 +-8.5234312303122874e-04 +-8.3533680068084389e-04 +-8.2002733804451174e-04 +-8.0629432436708423e-04 +-7.9402241426868427e-04 +-7.8310318466649027e-04 +-7.7343629167178781e-04 +-7.6493012169690194e-04 +-7.5750208709531247e-04 +-7.5107868088596845e-04 +-7.4559537670373650e-04 +-7.4099643797555746e-04 +-7.3723468329614549e-04 +-7.3427124201649906e-04 +-7.3207532424328001e-04 +-7.3062402204063129e-04 +-7.2990215300421395e-04 +-1.5143541010780020e-03 +-1.5173227675608996e-03 +-1.5231146276552868e-03 +-1.5314373242258632e-03 +-1.5418488579977511e-03 +-1.5537537380671284e-03 +-1.5663989050710206e-03 +-1.5788718212987100e-03 +-1.5901060046189656e-03 +-1.5989031683954812e-03 +-1.6039840097006705e-03 +-1.6040778389386037e-03 +-1.5980512264263033e-03 +-1.5850583769063651e-03 +-1.5646785257716872e-03 +-1.5369996406056478e-03 +-1.5026199930335568e-03 +-1.4625653572089442e-03 +-1.4181461994673544e-03 +-1.3707934129900310e-03 +-1.3219090070401573e-03 +-1.2727549123813212e-03 +-1.2243872992017575e-03 +-1.1776318418100032e-03 +-1.1330893301513354e-03 +-1.0911599661808415e-03 +-1.0520765110510711e-03 +-1.0159393083962560e-03 +-9.8274895037633934e-04 +-9.5243447976969321e-04 +-9.2487645038996928e-04 +-8.9992501086372711e-04 +-8.7741359912156341e-04 +-8.5716898870092837e-04 +-8.3901842799532361e-04 +-8.2279453712457784e-04 +-8.0833852140989109e-04 +-7.9550215185493337e-04 +-7.8414886452310461e-04 +-7.7415424731846713e-04 +-7.6540611516354054e-04 +-7.5780432156938912e-04 +-7.5126041393330345e-04 +-7.4569720925520759e-04 +-7.4104834420293906e-04 +-7.3725783675252128e-04 +-7.3427968450552974e-04 +-7.3207751606027267e-04 +-7.3062430560486349e-04 +-7.2990215650334961e-04 +-1.6665455899791530e-03 +-1.6698133201528344e-03 +-1.6761843811679352e-03 +-1.6853279536456450e-03 +-1.6967419230002731e-03 +-1.7097438296077502e-03 +-1.7234569715260932e-03 +-1.7367940863165221e-03 +-1.7484477095215268e-03 +-1.7569056344449105e-03 +-1.7605168179595345e-03 +-1.7576286958398684e-03 +-1.7467942015743356e-03 +-1.7270102607554289e-03 +-1.6979188611599353e-03 +-1.6599006272095473e-03 +-1.6140260552728629e-03 +-1.5618822959296026e-03 +-1.5053333742503395e-03 +-1.4462809903754963e-03 +-1.3864752623922554e-03 +-1.3273963861489488e-03 +-1.2702041557992646e-03 +-1.2157390763067493e-03 +-1.1645555304367070e-03 +-1.1169701858916720e-03 +-1.0731137699342337e-03 +-1.0329791499883066e-03 +-9.9646234480717201e-04 +-9.6339550207081908e-04 +-9.3357224312220707e-04 +-9.0676641440082771e-04 +-8.8274547943033679e-04 +-8.6127973910191677e-04 +-8.4214841257686409e-04 +-8.2514342251804006e-04 +-8.1007154611214367e-04 +-7.9675543488750818e-04 +-7.8503387677019754e-04 +-7.7476157207965253e-04 +-7.6580861752899309e-04 +-7.5805983433076436e-04 +-7.5141403398569322e-04 +-7.4578328460476442e-04 +-7.4109221872667842e-04 +-7.3727740821875757e-04 +-7.3428682123059255e-04 +-7.3207936896874700e-04 +-7.3062454533253805e-04 +-7.2990215946197080e-04 +-1.8021198551568514e-03 +-1.8056566533531176e-03 +-1.8125634862360561e-03 +-1.8225039384943747e-03 +-1.8349633920708177e-03 +-1.8492300360055680e-03 +-1.8643611614112890e-03 +-1.8791363648243337e-03 +-1.8920130515606003e-03 +-1.9011192895264496e-03 +-1.9043335949312950e-03 +-1.8994916968089802e-03 +-1.8847135462705226e-03 +-1.8587734367806771e-03 +-1.8213867042606796e-03 +-1.7733017645334209e-03 +-1.7161649983159458e-03 +-1.6522177976643984e-03 +-1.5839349646480263e-03 +-1.5137052565761440e-03 +-1.4436109122977238e-03 +-1.3753162079228709e-03 +-1.3100449638613837e-03 +-1.2486161430512175e-03 +-1.1915089169497238e-03 +-1.1389363426640357e-03 +-1.0909150558442299e-03 +-1.0473248698868506e-03 +-1.0079564215596758e-03 +-9.7254738334950604e-04 +-9.4080885433439740e-04 +-9.1244385878201911e-04 +-8.8715979304222119e-04 +-8.6467639724022974e-04 +-8.4473051814538437e-04 +-8.2707863748573615e-04 +-8.1149789188325171e-04 +-7.9778611223952441e-04 +-7.8576125802164013e-04 +-7.7526050811061364e-04 +-7.6613918672515302e-04 +-7.5826964323878038e-04 +-7.5154016251997976e-04 +-7.4585395305699106e-04 +-7.4112824002603959e-04 +-7.3729347696633479e-04 +-7.3429268092127791e-04 +-7.3208089038156413e-04 +-7.3062474217796419e-04 +-7.2990216189178041e-04 +-1.9092005684732711e-03 +-1.9129536264701403e-03 +-1.9203141945199676e-03 +-1.9309872161568885e-03 +-1.9445143310358396e-03 +-1.9602398529461294e-03 +-1.9772460208471120e-03 +-1.9942565670683808e-03 +-2.0095317668423563e-03 +-2.0208142590506951e-03 +-2.0254135164136538e-03 +-2.0205016490176587e-03 +-2.0036082164775300e-03 +-1.9731758681611387e-03 +-1.9289617623078860e-03 +-1.8721178878836724e-03 +-1.8049328991736572e-03 +-1.7303619202129999e-03 +-1.6515225019082575e-03 +-1.5712931483875289e-03 +-1.4920709729672177e-03 +-1.4156789328508188e-03 +-1.3433804280820333e-03 +-1.2759543920775676e-03 +-1.2137938392706186e-03 +-1.1570042768624170e-03 +-1.1054898149812091e-03 +-1.0590225759982321e-03 +-1.0172954545713750e-03 +-9.7996038194963684e-04 +-9.4665492787993435e-04 +-9.1702000700128686e-04 +-8.9071106690477369e-04 +-8.6740465674168198e-04 +-8.4680182258293850e-04 +-8.2862939378214187e-04 +-8.1263992271119509e-04 +-7.9861081151577651e-04 +-7.8634299133228404e-04 +-7.7565939845999541e-04 +-7.6640340659226683e-04 +-7.5843731488881873e-04 +-7.5164095111112143e-04 +-7.4591042177882163e-04 +-7.4115702337880843e-04 +-7.3730631720372798e-04 +-7.3429736343594417e-04 +-7.3208210619043741e-04 +-7.3062489948747542e-04 +-7.2990216383407331e-04 +-1.9822037913300910e-03 +-1.9861082632256929e-03 +-1.9938140378920536e-03 +-2.0051098619024684e-03 +-2.0196572010818454e-03 +-2.0369397848471762e-03 +-2.0561630918870624e-03 +-2.0760965476123690e-03 +-2.0948853790092319e-03 +-2.1099169616561665e-03 +-2.1178817525512508e-03 +-2.1151578240293503e-03 +-2.0985135078565266e-03 +-2.0659097301477234e-03 +-2.0170592164831555e-03 +-1.9534970387178846e-03 +-1.8781709639593216e-03 +-1.7947720438545535e-03 +-1.7070704139150038e-03 +-1.6184297856367304e-03 +-1.5315496143443188e-03 +-1.4483985349749509e-03 +-1.3702710436711881e-03 +-1.2979039613897736e-03 +-1.2316081146534973e-03 +-1.1713900294315161e-03 +-1.1170527405724882e-03 +-1.0682734900605106e-03 +-1.0246604538866806e-03 +-9.8579229498100716e-04 +-9.5124453298588802e-04 +-9.2060625119145059e-04 +-8.9348997670552789e-04 +-8.6953689361935285e-04 +-8.4841897093010951e-04 +-8.2983912980837062e-04 +-8.1353023022091202e-04 +-7.9925340563660979e-04 +-7.8679609572264095e-04 +-7.7597000212444056e-04 +-7.6660910676995325e-04 +-7.5856783428735212e-04 +-7.5171940173978042e-04 +-7.4595437392055268e-04 +-7.4117942670953480e-04 +-7.3731631146869731e-04 +-7.3430100818064738e-04 +-7.3208305256664420e-04 +-7.3062502193852158e-04 +-7.2990216534651875e-04 +-2.0242471841686975e-03 +-2.0282417603318019e-03 +-2.0361772158039586e-03 +-2.0479409348686749e-03 +-2.0633393210872410e-03 +-2.0820370641979336e-03 +-2.1034305589945688e-03 +-2.1264362153515090e-03 +-2.1492112979397578e-03 +-2.1689055410413815e-03 +-2.1816436687228120e-03 +-2.1829603011183077e-03 +-2.1687248531501811e-03 +-2.1362513646769510e-03 +-2.0850757633811053e-03 +-2.0170386150128289e-03 +-1.9357103359285497e-03 +-1.8454989994298322e-03 +-1.7508113362187539e-03 +-1.6554802244001391e-03 +-1.5624943637530474e-03 +-1.4739612810293842e-03 +-1.3912074067928763e-03 +-1.3149351719910940e-03 +-1.2453859526338027e-03 +-1.1824829344350741e-03 +-1.1259447997433219e-03 +-1.0753703844783194e-03 +-1.0302985310778063e-03 +-9.9024848551012928e-04 +-9.5474587225194364e-04 +-9.2333841946855375e-04 +-8.9560465185242006e-04 +-8.7115791810810333e-04 +-8.4964743613621604e-04 +-8.3075752067338267e-04 +-8.1420578040255543e-04 +-7.9974080374364256e-04 +-7.8713966671159995e-04 +-7.7620546954048828e-04 +-7.6676502384417932e-04 +-7.5866675607284080e-04 +-7.5177885684935594e-04 +-7.4598768295817898e-04 +-7.4119640497325562e-04 +-7.3732388565539908e-04 +-7.3430377040890589e-04 +-7.3208376980577546e-04 +-7.3062511474318082e-04 +-7.2990216649341567e-04 +-2.0445792269263362e-03 +-2.0486184530470481e-03 +-2.0566829800445770e-03 +-2.0687403307224307e-03 +-2.0847187413892696e-03 +-2.1044475685600204e-03 +-2.1275259666294743e-03 +-2.1530842288454560e-03 +-2.1794288105469076e-03 +-2.2036569922755833e-03 +-2.2214932528753116e-03 +-2.2276981211341146e-03 +-2.2171901134149311e-03 +-2.1865062980093932e-03 +-2.1348641111582681e-03 +-2.0642953800871148e-03 +-1.9789100536887279e-03 +-1.8837707588253200e-03 +-1.7838718238797544e-03 +-1.6834788027703849e-03 +-1.5858468282606217e-03 +-1.4932131048301185e-03 +-1.4069383226050268e-03 +-1.3277011742964095e-03 +-1.2556892379771175e-03 +-1.1907602361416515e-03 +-1.1325666080539570e-03 +-1.0806458770992525e-03 +-1.0344829661131211e-03 +-9.9355118064600994e-04 +-9.5733778516462467e-04 +-9.2535888404898813e-04 +-8.9716713086933461e-04 +-8.7235479349429663e-04 +-8.5055393285533658e-04 +-8.3143488688493695e-04 +-8.1470384828037049e-04 +-8.0010004500774535e-04 +-7.8739284206343779e-04 +-7.7637895553170789e-04 +-7.6687988612340505e-04 +-7.5873962513239390e-04 +-7.5182265153084932e-04 +-7.4601221791710732e-04 +-7.4120891086501019e-04 +-7.3732946470192711e-04 +-7.3430580505267013e-04 +-7.3208429812703730e-04 +-7.3062518310437535e-04 +-7.2990216733896077e-04 +-2.0529844589420986e-03 +-2.0570418776762549e-03 +-2.0651658189283152e-03 +-2.0773709492558795e-03 +-2.0936607914063860e-03 +-2.1139776040918945e-03 +-2.1380848885097568e-03 +-2.1653330271896882e-03 +-2.1942634241137217e-03 +-2.2220958590439578e-03 +-2.2443722335200676e-03 +-2.2552511157218299e-03 +-2.2487627284681552e-03 +-2.2206251459685696e-03 +-2.1696382586462552e-03 +-2.0979103057137691e-03 +-2.0099793194149201e-03 +-1.9114624999597681e-03 +-1.8078594756622563e-03 +-1.7038085207655583e-03 +-1.6027945538053692e-03 +-1.5071682649951353e-03 +-1.4183238365763978e-03 +-1.3369255050694028e-03 +-1.2631218206938938e-03 +-1.1967219726200442e-03 +-1.1373291001705382e-03 +-1.0844351532910436e-03 +-1.0374850982762724e-03 +-9.9591832129396901e-04 +-9.5919387118823592e-04 +-9.2680467713306504e-04 +-8.9828449945831288e-04 +-8.7321026126590835e-04 +-8.5120157261798558e-04 +-8.3191865657587306e-04 +-8.1505946510149327e-04 +-8.0035648464559233e-04 +-7.8757353790061854e-04 +-7.7650276045134359e-04 +-7.6696184827249655e-04 +-7.5879161923677870e-04 +-7.5185389916993819e-04 +-7.4602972337517968e-04 +-7.4121783364863262e-04 +-7.3733344528397078e-04 +-7.3430725675536991e-04 +-7.3208467508300754e-04 +-7.3062523188049337e-04 +-7.2990216794310457e-04 +-2.0560411111844434e-03 +-2.0601045996559591e-03 +-2.0682509802833291e-03 +-2.0805164314841753e-03 +-2.0969409343512689e-03 +-2.1175281647126927e-03 +-2.1421472731610520e-03 +-2.1703218102505899e-03 +-2.2008311383336352e-03 +-2.2311105684359339e-03 +-2.2567017142303028e-03 +-2.2713711017094298e-03 +-2.2684189523950902e-03 +-2.2428107163328134e-03 +-2.1929080631721098e-03 +-2.1208128033055685e-03 +-2.0313751098755438e-03 +-1.9306456731200475e-03 +-1.8245249075360282e-03 +-1.7179472896568032e-03 +-1.6145805202064422e-03 +-1.5168665297603261e-03 +-1.4262284465635250e-03 +-1.3433224854854523e-03 +-1.2682703629144886e-03 +-1.2008471398843477e-03 +-1.1406211188143740e-03 +-1.0870520444037585e-03 +-1.0395566943526711e-03 +-9.9755058084021906e-04 +-9.6047294317828566e-04 +-9.2780048049454292e-04 +-8.9905375360141958e-04 +-8.7379898940616730e-04 +-8.5164713723356379e-04 +-8.3225139793882273e-04 +-8.1530401251547334e-04 +-8.0053280290120479e-04 +-7.8769776248481939e-04 +-7.7658786601705442e-04 +-7.6701818674916567e-04 +-7.5882735692760878e-04 +-7.5187537634885447e-04 +-7.4604175506002830e-04 +-7.4122396632570527e-04 +-7.3733618115482682e-04 +-7.3430825451856814e-04 +-7.3208493416777474e-04 +-7.3062526540511492e-04 +-7.2990216835935276e-04 +-2.0570062331695506e-03 +-2.0610713596062855e-03 +-2.0692252274554820e-03 +-2.0815129175978156e-03 +-2.0979900462296036e-03 +-2.1186888030075984e-03 +-2.1435344183503451e-03 +-2.1721600124967478e-03 +-2.2035288304265376e-03 +-2.2352935132776502e-03 +-2.2630911682889792e-03 +-2.2804743075160818e-03 +-2.2802117197734104e-03 +-2.2566644134420629e-03 +-2.2078109670482745e-03 +-2.1357077360591981e-03 +-2.0454154110212067e-03 +-1.9432961908682782e-03 +-1.8355419755450939e-03 +-1.7273029543891285e-03 +-1.6223799678268004e-03 +-1.5232818404250922e-03 +-1.4314538657375841e-03 +-1.3475480697001481e-03 +-1.2716686322001751e-03 +-1.2035678895023967e-03 +-1.1427908497322651e-03 +-1.0887757152177342e-03 +-1.0409204269237039e-03 +-9.9862456763325489e-04 +-9.6131418139649982e-04 +-9.2845517468611498e-04 +-8.9955934522501684e-04 +-8.7418582970321139e-04 +-8.5193984470981492e-04 +-8.3246994908955994e-04 +-8.1546461318039937e-04 +-8.0064858254829394e-04 +-7.8777932751444119e-04 +-7.7664374197860761e-04 +-7.6705517384859578e-04 +-7.5885081843408834e-04 +-7.5188947558956615e-04 +-7.4604965343491743e-04 +-7.4122799217001911e-04 +-7.3733797712858434e-04 +-7.3430890950265020e-04 +-7.3208510424453796e-04 +-7.3062528741279587e-04 +-7.2990216863381703e-04 +-2.0572331148674271e-03 +-2.0612985633640920e-03 +-2.0694550103192775e-03 +-2.0817515930461688e-03 +-2.0982508802901518e-03 +-2.1189975884829434e-03 +-2.1439432083097177e-03 +-2.1727801244261187e-03 +-2.2045895034763217e-03 +-2.2371907930615938e-03 +-2.2663326742451465e-03 +-2.2854678590908187e-03 +-2.2870186943893555e-03 +-2.2649199812029498e-03 +-2.2168653572652614e-03 +-2.1448613113567226e-03 +-2.0541002016678327e-03 +-1.9511489387537368e-03 +-1.8423925823567962e-03 +-1.7331243467275128e-03 +-1.6272333085021020e-03 +-1.5272727686805837e-03 +-1.4347031151925212e-03 +-1.3501742441717785e-03 +-1.2737795131424101e-03 +-1.2052570544966125e-03 +-1.1441372769429995e-03 +-1.0898448792286577e-03 +-1.0417660033143594e-03 +-9.9929026458492657e-04 +-9.6183546001696438e-04 +-9.2886075840943713e-04 +-8.9987249288370035e-04 +-8.7442538331377131e-04 +-8.5212107855757457e-04 +-8.3260525109930740e-04 +-8.1556402861739726e-04 +-8.0072024676426960e-04 +-7.8782981047766998e-04 +-7.7667832337238794e-04 +-7.6707806403533327e-04 +-7.5886533756354434e-04 +-7.5189820066744065e-04 +-7.4605454111585309e-04 +-7.4123048341067992e-04 +-7.3733908848643036e-04 +-7.3430931480704647e-04 +-7.3208520948767910e-04 +-7.3062530103151443e-04 +-7.2990216880518201e-04 +-2.0572420244880018e-03 +-2.0613074902525721e-03 +-2.0694649712418929e-03 +-2.0817656758221601e-03 +-2.0982755665163279e-03 +-2.1190450404705175e-03 +-2.1440373156734090e-03 +-2.1729738887888575e-03 +-2.2050020362030087e-03 +-2.2380469833620997e-03 +-2.2679424752174537e-03 +-2.2880996806329324e-03 +-2.2907381064140946e-03 +-2.2695291363020609e-03 +-2.2219847850436223e-03 +-2.1500744718986023e-03 +-2.0590662876923088e-03 +-1.9556486680242379e-03 +-1.8463218599880764e-03 +-1.7364643401475803e-03 +-1.6300177303035651e-03 +-1.5295618356257622e-03 +-1.4365661329407398e-03 +-1.3516794361612147e-03 +-1.2749889032437859e-03 +-1.2062244794975303e-03 +-1.1449081504250429e-03 +-1.0904568261679061e-03 +-1.0422498480955028e-03 +-9.9967109151034590e-04 +-9.6213360809266368e-04 +-9.2909269305355071e-04 +-9.0005154028614245e-04 +-8.7456233418999648e-04 +-8.5222467693004821e-04 +-8.3268258618376348e-04 +-8.1562084727678820e-04 +-8.0076120201384184e-04 +-7.8785865919757186e-04 +-7.7669808407597571e-04 +-7.6709114351829579e-04 +-7.5887363350702144e-04 +-7.5190318584622475e-04 +-7.4605733367542578e-04 +-7.4123190673943567e-04 +-7.3733972342988918e-04 +-7.3430954636294430e-04 +-7.3208526961401801e-04 +-7.3062530881252313e-04 +-7.2990216890501882e-04 +-2.0572136736386744e-03 +-2.0612791205834803e-03 +-2.0694370628936733e-03 +-2.0817397447724971e-03 +-2.0982547995006965e-03 +-2.1190352729124392e-03 +-2.1440495772285838e-03 +-2.1730325819155020e-03 +-2.2051644338500699e-03 +-2.2384268496545923e-03 +-2.2687030643115695e-03 +-2.2893877052050766e-03 +-2.2925954102340652e-03 +-2.2718573592978440e-03 +-2.2245875516661534e-03 +-2.1527342553101583e-03 +-2.0616045909538690e-03 +-1.9579504636307444e-03 +-1.8483323277770983e-03 +-1.7381731625457182e-03 +-1.6314419632742915e-03 +-1.5307323185893573e-03 +-1.4375184295681040e-03 +-1.3524485603623744e-03 +-1.2756066747646689e-03 +-1.2067185019797510e-03 +-1.1453016940674030e-03 +-1.0907691582563456e-03 +-1.0424967441191228e-03 +-9.9986538226473328e-04 +-9.6228569194973048e-04 +-9.2921098423000021e-04 +-9.0014284605284339e-04 +-8.7463216469442669e-04 +-8.5227749580865523e-04 +-8.3272201134364785e-04 +-8.1564981087453874e-04 +-8.0078207761618474e-04 +-7.8787336289762083e-04 +-7.7670815514211029e-04 +-7.6709780910812447e-04 +-7.5887786107485988e-04 +-7.5190572614089425e-04 +-7.4605875661406000e-04 +-7.4123263196195898e-04 +-7.3734004693839172e-04 +-7.3430966433905094e-04 +-7.3208530024756124e-04 +-7.3062531277755336e-04 +-7.2990216895850045e-04 +-2.0571951320624872e-03 +-2.0612605714975538e-03 +-2.0694187111362154e-03 +-2.0817222444215310e-03 +-2.0982395437958300e-03 +-2.1190248232954676e-03 +-2.1440486999065368e-03 +-2.1730516227749723e-03 +-2.2052277011984896e-03 +-2.2385832017135527e-03 +-2.2690233824616563e-03 +-2.2899362176797278e-03 +-2.2933908206116617e-03 +-2.2728571780952617e-03 +-2.2257065417742444e-03 +-2.1538780493100462e-03 +-2.0626959028166103e-03 +-1.9589396337234034e-03 +-1.8491958098928519e-03 +-1.7389066473745430e-03 +-1.6320529296817033e-03 +-1.5312341492876482e-03 +-1.4379265033132378e-03 +-1.3527779860517555e-03 +-1.2758711615270576e-03 +-1.2069299275762741e-03 +-1.1454700610597471e-03 +-1.0909027410893298e-03 +-1.0426023123283144e-03 +-9.9994843795953850e-04 +-9.6235069145234812e-04 +-9.2926153160248156e-04 +-9.0018185568259803e-04 +-8.7466199466153434e-04 +-8.5230005564885744e-04 +-8.3273884830418999e-04 +-8.1566217858570285e-04 +-8.0079099063699985e-04 +-7.8787964006328342e-04 +-7.7671245411919281e-04 +-7.6710065411019358e-04 +-7.5887966529953753e-04 +-7.5190681017312216e-04 +-7.4605936377645317e-04 +-7.4123294138582572e-04 +-7.3734018495657074e-04 +-7.3430971466815630e-04 +-7.3208531331575317e-04 +-7.3062531447004749e-04 +-7.2990216898493080e-04 +-2.0571887352688386e-03 +-2.0612541745817937e-03 +-2.0694123806936208e-03 +-2.0817161958583451e-03 +-2.0982342548518948e-03 +-2.1190212099835479e-03 +-2.1440484958834987e-03 +-2.1730584811994395e-03 +-2.2052498105337329e-03 +-2.2386364730564022e-03 +-2.2691303823243201e-03 +-2.2901168976783076e-03 +-2.2936502956954000e-03 +-2.2731810912285525e-03 +-2.2260672226923997e-03 +-2.1542452897625906e-03 +-2.0630452096880754e-03 +-1.9592554472552064e-03 +-1.8494709122327971e-03 +-1.7391399123940718e-03 +-1.6322469292290199e-03 +-1.5313932795924113e-03 +-1.4380557500982374e-03 +-1.3528822145611919e-03 +-1.2759547671011254e-03 +-1.2069967063641578e-03 +-1.1455232019908067e-03 +-1.0909448768061320e-03 +-1.0426355929837074e-03 +-9.9997460858141513e-04 +-9.6237116359429377e-04 +-9.2927744559876042e-04 +-9.0019413276324093e-04 +-8.7467137958278799e-04 +-8.5230715106043582e-04 +-8.3274414220419694e-04 +-8.1566606614193735e-04 +-8.0079379149453728e-04 +-7.8788161208179870e-04 +-7.7671380431269311e-04 +-7.6710154741422491e-04 +-7.5888023166419724e-04 +-7.5190715037811329e-04 +-7.4605955427956428e-04 +-7.4123303844972224e-04 +-7.3734022824365093e-04 +-7.3430973045081262e-04 +-7.3208531741397233e-04 +-7.3062531500249299e-04 +-7.2990216899897209e-04 +-2.0571877672898938e-03 +-2.0612532074362005e-03 +-2.0694114265345513e-03 +-2.0817152969027724e-03 +-2.0982335170464054e-03 +-2.1190208611571171e-03 +-2.1440489928012951e-03 +-2.1730607365263483e-03 +-2.2052556179504084e-03 +-2.2386489012181324e-03 +-2.2691533548923350e-03 +-2.2901534805771393e-03 +-2.2937007290148590e-03 +-2.2732422664315170e-03 +-2.2261339478369421e-03 +-2.1543121927214927e-03 +-2.0631080987281360e-03 +-1.9593117757060363e-03 +-1.8495196049656138e-03 +-1.7391809360266818e-03 +-1.6322808612663272e-03 +-1.5314209814754015e-03 +-1.4380781572111876e-03 +-1.3529002191223721e-03 +-1.2759691633565703e-03 +-1.2070081729621610e-03 +-1.1455323042565586e-03 +-1.0909520782441194e-03 +-1.0426412699545301e-03 +-9.9997906500746297e-04 +-9.6237464425083920e-04 +-9.2928014747929819e-04 +-9.0019621448305753e-04 +-8.7467296900058068e-04 +-8.5230835137589352e-04 +-8.3274503679755206e-04 +-8.1566672239879166e-04 +-8.0079426382470001e-04 +-7.8788194430535737e-04 +-7.7671403155356669e-04 +-7.6710169761348896e-04 +-7.5888032680187470e-04 +-7.5190720747329127e-04 +-7.4605958622319789e-04 +-7.4123305471249441e-04 +-7.3734023549133570e-04 +-7.3430973309226467e-04 +-7.3208531810053305e-04 +-7.3062531509407490e-04 +-7.2990216900935582e-04 +-2.0571877673051242e-03 +-2.0612532075466356e-03 +-2.0694114268870502e-03 +-2.0817152989726436e-03 +-2.0982335273685066e-03 +-2.1190208987424590e-03 +-2.1440491012417115e-03 +-2.1730609998254500e-03 +-2.2052561714926882e-03 +-2.2386499165333090e-03 +-2.2691549797987046e-03 +-2.2901557564799116e-03 +-2.2937035470691337e-03 +-2.2732454004502868e-03 +-2.2261371366105388e-03 +-2.1543152156361634e-03 +-2.0631108124938048e-03 +-1.9593141144133297e-03 +-1.8495215609850332e-03 +-1.7391825372083231e-03 +-1.6322821523668271e-03 +-1.5314220118289024e-03 +-1.4380789737836253e-03 +-1.3529008632972082e-03 +-1.2759696699638071e-03 +-1.2070085704927514e-03 +-1.1455326156049098e-03 +-1.0909523216104382e-03 +-1.0426414597217071e-03 +-9.9997921251291180e-04 +-9.6237475843006961e-04 +-9.2928023538531551e-04 +-9.0019628169701708e-04 +-8.7467301995224262e-04 +-8.5230838959168712e-04 +-8.3274506509176636e-04 +-8.1566674302073548e-04 +-8.0079427857213982e-04 +-7.8788195461233215e-04 +-7.7671403855886516e-04 +-7.6710170221461432e-04 +-7.5888032969815644e-04 +-7.5190720920090476e-04 +-7.4605958718414482e-04 +-7.4123305519905398e-04 +-7.3734023570709789e-04 +-7.3430973317054548e-04 +-7.3208531812077326e-04 +-7.3062531509668046e-04 +-7.2990216900937100e-04 +-2.0571887353402693e-03 +-2.0612541707382423e-03 +-2.0694123472801283e-03 +-2.0817160745324414e-03 +-2.0982339651997505e-03 +-2.1190206927475339e-03 +-2.1440478010948676e-03 +-2.1730579110620213e-03 +-2.2052500895177584e-03 +-2.2386388041592872e-03 +-2.2691361657134271e-03 +-2.2901271038915788e-03 +-2.2936649022622440e-03 +-2.2731990311780385e-03 +-2.2260868400763418e-03 +-2.1542649270947949e-03 +-2.0630636013696788e-03 +-1.9592718406558568e-03 +-1.8494850032614953e-03 +-1.7391517098195961e-03 +-1.6322566221642291e-03 +-1.5314011381381491e-03 +-1.4380620622203046e-03 +-1.3528872514626336e-03 +-1.2759587675670119e-03 +-1.2069998723129296e-03 +-1.1455256999156195e-03 +-1.0909468418448809e-03 +-1.0426371337890984e-03 +-9.9997581206075930e-04 +-9.6237209911021881e-04 +-9.2927816850396541e-04 +-9.0019468728254229e-04 +-8.7467180111644514e-04 +-8.5230746800175439e-04 +-8.3274437736297502e-04 +-8.1566623785519370e-04 +-8.0079391449305382e-04 +-7.8788169816828343e-04 +-7.7671386289597099e-04 +-7.6710158593424477e-04 +-7.5888025593468889e-04 +-7.5190716486736294e-04 +-7.4605956234468902e-04 +-7.4123304253587814e-04 +-7.3734023005657260e-04 +-7.3430973110884636e-04 +-7.3208531758418621e-04 +-7.3062531502445145e-04 +-7.2990216899922547e-04 +-2.0571951315746374e-03 +-2.0612605313573905e-03 +-2.0694184069589539e-03 +-2.0817211110272060e-03 +-2.0982365761462950e-03 +-2.1190185651600033e-03 +-2.1440373732947208e-03 +-2.1730335293209170e-03 +-2.2052020954643576e-03 +-2.2385515266817660e-03 +-2.2689899218791059e-03 +-2.2899070101992879e-03 +-2.2933711544875952e-03 +-2.2728495081651176e-03 +-2.2257101591194209e-03 +-2.1538901895126225e-03 +-2.0627131881112582e-03 +-1.9589590829464034e-03 +-1.8492152610893417e-03 +-1.7389247705502924e-03 +-1.6320690531162691e-03 +-1.5312480488505302e-03 +-1.4379382238808350e-03 +-1.3527877134881716e-03 +-1.2758791404923620e-03 +-1.2069364134480898e-03 +-1.1454752945729810e-03 +-1.0909069369396899e-03 +-1.0426056557631832e-03 +-9.9995108557426470e-04 +-9.6235277393760257e-04 +-9.2926315717302736e-04 +-9.0018311352044189e-04 +-8.7466295805806334e-04 +-8.5230078472731628e-04 +-8.3273939230712026e-04 +-8.1566257776212459e-04 +-8.0079127778395461e-04 +-7.8787984178077801e-04 +-7.7671259183374004e-04 +-7.6710074491530083e-04 +-7.5887972265326932e-04 +-7.5190684448521341e-04 +-7.4605938291030024e-04 +-7.4123295109488534e-04 +-7.3734018926976724e-04 +-7.3430971623533075e-04 +-7.3208531372145685e-04 +-7.3062531452242389e-04 +-7.2990216898556116e-04 +-2.0572136693413710e-03 +-2.0612789425305095e-03 +-2.0694358049122459e-03 +-2.0817350881934355e-03 +-2.0982424367268575e-03 +-2.1190084978414290e-03 +-2.1439992104444342e-03 +-2.1729478012684736e-03 +-2.2050356981191859e-03 +-2.2382514830218605e-03 +-2.2684906905721869e-03 +-2.2891600073028759e-03 +-2.2923784837411533e-03 +-2.2716719725567325e-03 +-2.2244438140401114e-03 +-2.1526322234667354e-03 +-2.0615380960621083e-03 +-1.9579110623053585e-03 +-1.8483119040025224e-03 +-1.7381651080082868e-03 +-1.6314414171356574e-03 +-1.5307359520751898e-03 +-1.4375240891534632e-03 +-1.3524549241627152e-03 +-1.2756129775471441e-03 +-1.2067243353846597e-03 +-1.1453068699375875e-03 +-1.0907736189615736e-03 +-1.0425005055800746e-03 +-9.9986849875155167e-04 +-9.6228823493642508e-04 +-9.2921303010244855e-04 +-9.0014446927683134e-04 +-8.7463343427949256e-04 +-8.5227847371538868e-04 +-8.3272275200241351e-04 +-8.1565036131442327e-04 +-8.0078247790723515e-04 +-7.8787364673641174e-04 +-7.7670835048583174e-04 +-7.6709793880820902e-04 +-7.5887794348622483e-04 +-7.5190577569786020e-04 +-7.4605878437071548e-04 +-7.4123264609880920e-04 +-7.3734005323790178e-04 +-7.3430966663356003e-04 +-7.3208530084264989e-04 +-7.3062531285447599e-04 +-7.2990216895943178e-04 +-2.0572420058184264e-03 +-2.0613069363902897e-03 +-2.0694613056574198e-03 +-2.0817523178510529e-03 +-2.0982401265187407e-03 +-2.1189678015600590e-03 +-2.1438904655062957e-03 +-2.1727231670078512e-03 +-2.2046143830639900e-03 +-2.2375065507071767e-03 +-2.2672682290098738e-03 +-2.2873488269065812e-03 +-2.2899876897652569e-03 +-2.2688480147044629e-03 +-2.2214147821554156e-03 +-2.1496278642986538e-03 +-2.0587341341689459e-03 +-1.9554115290004170e-03 +-1.8461579426834738e-03 +-1.7363539933326405e-03 +-1.6299451410689652e-03 +-1.5295151324119496e-03 +-1.4365367984698701e-03 +-1.3516615460573314e-03 +-1.2749784262279706e-03 +-1.2062187170952471e-03 +-1.1449053201697743e-03 +-1.0904557648767038e-03 +-1.0422498064071005e-03 +-9.9967159414773377e-04 +-9.6213435993766259e-04 +-9.2909351649861935e-04 +-9.0005233366487441e-04 +-8.7456304429480249e-04 +-8.5222528090131866e-04 +-8.3268307961528298e-04 +-8.1562123644262003e-04 +-8.0076149882626945e-04 +-7.8785887797804606e-04 +-7.7669823952936296e-04 +-7.6709124950825435e-04 +-7.5887370236373724e-04 +-7.5190322802927954e-04 +-7.4605735767210054e-04 +-7.4123191911981950e-04 +-7.3733972900493438e-04 +-7.3430954841048764e-04 +-7.3208527014834493e-04 +-7.3062530888187910e-04 +-7.2990216890585972e-04 +-2.0572330548976692e-03 +-2.0612971512452946e-03 +-2.0694462630575588e-03 +-2.0817203732092248e-03 +-2.0981686101743174e-03 +-2.1188185102721060e-03 +-2.1436023739031889e-03 +-2.1721969979386115e-03 +-2.2036850101033612e-03 +-2.2359229060541098e-03 +-2.2647365285951896e-03 +-2.2836666448726420e-03 +-2.2851866087811512e-03 +-2.2632205738112804e-03 +-2.2154061403212620e-03 +-2.1436833633219272e-03 +-2.0531935031437381e-03 +-1.9504754298636433e-03 +-1.8419050946089290e-03 +-1.7327779500896114e-03 +-1.6269903064568977e-03 +-1.5271037859003603e-03 +-1.4345862974690779e-03 +-1.3500938124708509e-03 +-1.2737242941258191e-03 +-1.2052192340188631e-03 +-1.1441114321152424e-03 +-1.0898272636425794e-03 +-1.0417540350512913e-03 +-9.9928216630160768e-04 +-9.6183000880694454e-04 +-9.2885711308420904e-04 +-8.9987007509881496e-04 +-8.7442379583507865e-04 +-8.5212004904292623e-04 +-8.3260459337894778e-04 +-8.1556361598298472e-04 +-8.0071999350726287e-04 +-7.8782965911025919e-04 +-7.7667823576875689e-04 +-7.6707801528703176e-04 +-7.5886531171513369e-04 +-7.5189818776039672e-04 +-7.4605453514259659e-04 +-7.4123048090640211e-04 +-7.3733908756809963e-04 +-7.3430931452993209e-04 +-7.3208520942696529e-04 +-7.3062530102463257e-04 +-7.2990216880508595e-04 +-2.0570060736553146e-03 +-2.0610682037127291e-03 +-2.0692069322671347e-03 +-2.0814492035822058e-03 +-2.0978239514917495e-03 +-2.1183294131872387e-03 +-2.1428536334158967e-03 +-2.1710009724855601e-03 +-2.2017395075705801e-03 +-2.2327926749139801e-03 +-2.2599412407499405e-03 +-2.2769027676338041e-03 +-2.2765469640160397e-03 +-2.2532238354027231e-03 +-2.2048134215995143e-03 +-2.1332479651840234e-03 +-2.0434878575995921e-03 +-1.9418365316915735e-03 +-1.8344634399703845e-03 +-1.7265194120360959e-03 +-1.6218170276548203e-03 +-1.5228801275614342e-03 +-1.4311682463963725e-03 +-1.3473452854658138e-03 +-1.2715246557253135e-03 +-1.2034655734192827e-03 +-1.1427180424116918e-03 +-1.0887238345789379e-03 +-1.0408834171005792e-03 +-9.9859815144067018e-04 +-9.6129533142257626e-04 +-9.2844174173146662e-04 +-8.9954979819491319e-04 +-8.7417907370281522e-04 +-8.5193509374780851e-04 +-8.3246663683138322e-04 +-8.1546233021738456e-04 +-8.0064703216026353e-04 +-7.8777829435838569e-04 +-7.7664306982496139e-04 +-7.6705474966732678e-04 +-7.5885056094131612e-04 +-7.5188932693817765e-04 +-7.4604957312378089e-04 +-7.4122795252915691e-04 +-7.3733795992803693e-04 +-7.3430890337223892e-04 +-7.3208510268078038e-04 +-7.3062528721292081e-04 +-7.2990216863135231e-04 +-2.0560407435191376e-03 +-2.0600982467083384e-03 +-2.0682164627148425e-03 +-2.0803994673775890e-03 +-2.0966402773827594e-03 +-2.1168839203217393e-03 +-2.1409380527256023e-03 +-2.1682833651973147e-03 +-2.1977151819812576e-03 +-2.2267897929333321e-03 +-2.2512804080690833e-03 +-2.2652172042933751e-03 +-2.2620677064924669e-03 +-2.2367915792997129e-03 +-2.1876015948652946e-03 +-2.1164002813486823e-03 +-2.0278686402444386e-03 +-1.9279520742059931e-03 +-1.8225056174685872e-03 +-1.7164587792027968e-03 +-1.6134952685972379e-03 +-1.5160804911246355e-03 +-1.4256610463345245e-03 +-1.3429133623477504e-03 +-1.2679752438537776e-03 +-1.2006339741382054e-03 +-1.1404668774669183e-03 +-1.0869402402469599e-03 +-1.0394755330762318e-03 +-9.9749161510802103e-04 +-9.6043010685286474e-04 +-9.2776940145455563e-04 +-8.9903126693911286e-04 +-8.7378279313882873e-04 +-8.5163554874796254e-04 +-8.3224318141730032e-04 +-8.1529825634205967e-04 +-8.0052883226962236e-04 +-7.8769507683335374e-04 +-7.7658609399226201e-04 +-7.6701705356809250e-04 +-7.5882666051768285e-04 +-7.5187496971738596e-04 +-7.4604153309282902e-04 +-7.4122385575272319e-04 +-7.3733613279259572e-04 +-7.3430823716747915e-04 +-7.3208492971908463e-04 +-7.3062526483448056e-04 +-7.2990216835232800e-04 +-2.0529837166895363e-03 +-2.0570303541287828e-03 +-2.0651069687153355e-03 +-2.0771772767589273e-03 +-2.0931710455246682e-03 +-2.1129409594296510e-03 +-2.1361620100457143e-03 +-2.1621316327902064e-03 +-2.1894289813854917e-03 +-2.2154571375482793e-03 +-2.2360855788893822e-03 +-2.2458404596668339e-03 +-2.2389941671517180e-03 +-2.2112755863904839e-03 +-2.1612919435919447e-03 +-2.0908731245151443e-03 +-2.0043065806203686e-03 +-1.9070426750286361e-03 +-1.8045003387210936e-03 +-1.7012995612958473e-03 +-1.6009421446146143e-03 +-1.5058103017916193e-03 +-1.4173321485956220e-03 +-1.3362023744772191e-03 +-1.2625944687585425e-03 +-1.1963369860213987e-03 +-1.1370476177967486e-03 +-1.0842290272322838e-03 +-1.0373339689970439e-03 +-9.9580745068818255e-04 +-9.5911256460329318e-04 +-9.2674514619375836e-04 +-8.9824104734923308e-04 +-8.7317870063565492e-04 +-8.5117880992786139e-04 +-8.3190239500642907e-04 +-8.1504799173922498e-04 +-8.0034851754666914e-04 +-7.8756811571063247e-04 +-7.7649916228692342e-04 +-7.6695953514233019e-04 +-7.5879019080398575e-04 +-7.5185306145898127e-04 +-7.4602926430245443e-04 +-7.4121760417307156e-04 +-7.3733334462008828e-04 +-7.3430722055212963e-04 +-7.3208466578344718e-04 +-7.3062523068611023e-04 +-7.2990216792841092e-04 +-2.0445779271268394e-03 +-2.0485999299405117e-03 +-2.0565937188081465e-03 +-2.0684552597492168e-03 +-2.0840103305815850e-03 +-2.1029672271538694e-03 +-2.1248122923192849e-03 +-2.1486189867064793e-03 +-2.1727587406390769e-03 +-2.1945714313502656e-03 +-2.2101904807130483e-03 +-2.2148312888767073e-03 +-2.2037272320785243e-03 +-2.1734611074719131e-03 +-2.1230411483493849e-03 +-2.0541611009581478e-03 +-1.9706027761739820e-03 +-1.8771920949451023e-03 +-1.7787943540273667e-03 +-1.6796315936954916e-03 +-1.5829684003664474e-03 +-1.4910769623729737e-03 +-1.4053605701514491e-03 +-1.3265385345407204e-03 +-1.2548330287759158e-03 +-1.1901294240502834e-03 +-1.1321014122710465e-03 +-1.0803024562188450e-03 +-1.0342292498801697e-03 +-9.9336371110159616e-04 +-9.5719937383511092e-04 +-9.2525689756290069e-04 +-8.9709224653426094e-04 +-8.7230010000006249e-04 +-8.5051428160860419e-04 +-8.3140642413851221e-04 +-8.1468367719150130e-04 +-8.0008598088949633e-04 +-7.8738323442347413e-04 +-7.7637255795768960e-04 +-7.6687576044468712e-04 +-7.5873707013953903e-04 +-7.5182114930454600e-04 +-7.4601139280744834e-04 +-7.4120849759662659e-04 +-7.3732928310535502e-04 +-7.3430573965129029e-04 +-7.3208428130934955e-04 +-7.3062518094282663e-04 +-7.2990216731237483e-04 +-2.0242452370542491e-03 +-2.0282158687246164e-03 +-2.0360589552399131e-03 +-2.0475743598196406e-03 +-2.0624440675078765e-03 +-2.0801883328778249e-03 +-2.1000738638106186e-03 +-2.1209586690835104e-03 +-2.1410828489123171e-03 +-2.1578720641313460e-03 +-2.1679023160646313e-03 +-2.1672140348159728e-03 +-2.1520516989455064e-03 +-2.1198316409042966e-03 +-2.0699089469485427e-03 +-2.0037712351772172e-03 +-1.9246103788134962e-03 +-1.8365339628492890e-03 +-1.7437631157921827e-03 +-1.6500482101160813e-03 +-1.5583667817226038e-03 +-1.4708548479768014e-03 +-1.3888837245775725e-03 +-1.3132031156214759e-03 +-1.2440970869251106e-03 +-1.1815243606537692e-03 +-1.1252317918932007e-03 +-1.0748398730411914e-03 +-1.0299037678188610e-03 +-9.8995487007177410e-04 +-9.5452777902216930e-04 +-9.2317682822691928e-04 +-8.9548539870400569e-04 +-8.7107041326086969e-04 +-8.4958372750415902e-04 +-8.3071161109252959e-04 +-8.1417312966110874e-04 +-7.9971796475909762e-04 +-7.8712401883350544e-04 +-7.7619502205493647e-04 +-7.6675827015771096e-04 +-7.5866256445333315e-04 +-7.5177638753569159e-04 +-7.4598632431433886e-04 +-7.4119572344535218e-04 +-7.3732358579508812e-04 +-7.3430366230115961e-04 +-7.3208374198380298e-04 +-7.3062511116529132e-04 +-7.2990216644940379e-04 +-1.9822013073325317e-03 +-1.9860770469895595e-03 +-1.9936782627911934e-03 +-2.0047010887280295e-03 +-2.0186755771121668e-03 +-2.0349334795670545e-03 +-2.0525443377858235e-03 +-2.0702148342406535e-03 +-2.0861678460918900e-03 +-2.0980562798288646e-03 +-2.1030089939763625e-03 +-2.0979113801941596e-03 +-2.0799430405355267e-03 +-2.0472376528138068e-03 +-1.9994027638600823e-03 +-1.9376656296261996e-03 +-1.8645944943219746e-03 +-1.7835426774812822e-03 +-1.6980428135242591e-03 +-1.6113280715936925e-03 +-1.5260518699426325e-03 +-1.4441909734899353e-03 +-1.3670760660265883e-03 +-1.2954902519842469e-03 +-1.2297903276605477e-03 +-1.1700234871030145e-03 +-1.1160264560097903e-03 +-1.0675032701952998e-03 +-1.0240828591699305e-03 +-9.8535968691364434e-04 +-9.5092117278807267e-04 +-9.2036530396236312e-04 +-8.9331124878376804e-04 +-8.6940514194956686e-04 +-8.4832264826192666e-04 +-8.2976945688618378e-04 +-8.1348051079663827e-04 +-7.9921852054720211e-04 +-7.8677212836614945e-04 +-7.7595396000452164e-04 +-7.6659871307852641e-04 +-7.5856137043925245e-04 +-7.5171558693083859e-04 +-7.4595227159796940e-04 +-7.4117837065756779e-04 +-7.3731584627069230e-04 +-7.3430084030065123e-04 +-7.3208300932973069e-04 +-7.3062501637545583e-04 +-7.2990216527808369e-04 +-1.9091978447274502e-03 +-1.9129209529406891e-03 +-1.9201782434468313e-03 +-1.9305892890010853e-03 +-1.9435742597258404e-03 +-1.9583358544995760e-03 +-1.9738264054778368e-03 +-1.9887008786444340e-03 +-2.0012701422683992e-03 +-2.0094902275521963e-03 +-2.0110424334522821e-03 +-2.0035547375341499e-03 +-1.9849666992579618e-03 +-1.9539560839937058e-03 +-1.9102775621026554e-03 +-1.8548733389854920e-03 +-1.7897100050550281e-03 +-1.7174128446983477e-03 +-1.6408336315643817e-03 +-1.5626766555264947e-03 +-1.4852504456003754e-03 +-1.4103531457295383e-03 +-1.3392629145453749e-03 +-1.2727933876882523e-03 +-1.2113789828922517e-03 +-1.1551656508134655e-03 +-1.1040932879554312e-03 +-1.0579638922720265e-03 +-1.0164943929010044e-03 +-9.7935559113112246e-04 +-9.4619963557920266e-04 +-9.1667858855891198e-04 +-8.9045636948730412e-04 +-8.6721594694236736e-04 +-8.4666322947161662e-04 +-8.2852873611768962e-04 +-8.1256782910838616e-04 +-7.9856006141644791e-04 +-7.8630802098320085e-04 +-7.7563592939605436e-04 +-7.6638816460107095e-04 +-7.5842781553387870e-04 +-7.5163533408088509e-04 +-7.4590732101874259e-04 +-7.4115546348846892e-04 +-7.3730562920029902e-04 +-7.3429711489578328e-04 +-7.3208204212947656e-04 +-7.3062489124067547e-04 +-7.2990216373259112e-04 +-1.8021172372841422e-03 +-1.8056264388126401e-03 +-1.8124426952608286e-03 +-1.8221598393448008e-03 +-1.8341634519606514e-03 +-1.8476235926419837e-03 +-1.8614846314559011e-03 +-1.8744554733617664e-03 +-1.8850101549646584e-03 +-1.8914182570627022e-03 +-1.8918316724696358e-03 +-1.8844492969450537e-03 +-1.8677557963067083e-03 +-1.8407889874116176e-03 +-1.8033553694087902e-03 +-1.7561136446944522e-03 +-1.7004901188944839e-03 +-1.6384537041878966e-03 +-1.5722241877373583e-03 +-1.5039944127710877e-03 +-1.4357218027554199e-03 +-1.3690088182211561e-03 +-1.3050636375320369e-03 +-1.2447183530234520e-03 +-1.1884800660332386e-03 +-1.1365950147127991e-03 +-1.0891125782554712e-03 +-1.0459419874983699e-03 +-1.0068988685250828e-03 +-9.7174136893566330e-04 +-9.4019696555186114e-04 +-9.1198157404410757e-04 +-8.8681263255511577e-04 +-8.6441765463838205e-04 +-8.4453948680646433e-04 +-8.2693924028871899e-04 +-8.1139763089544878e-04 +-7.9771526719182395e-04 +-7.8571227550102362e-04 +-7.7522753536203961e-04 +-7.6611771415773682e-04 +-7.5825622808898022e-04 +-7.5153221280056034e-04 +-7.4584955616005988e-04 +-7.4112602439913629e-04 +-7.3729249835981670e-04 +-7.3429232699211426e-04 +-7.3208079907585385e-04 +-7.3062473041677950e-04 +-7.2990216174702392e-04 +-1.6665433304521001e-03 +-1.6697880691348987e-03 +-1.6760869973521245e-03 +-1.6850576388656488e-03 +-1.6961234661248016e-03 +-1.7085123579182830e-03 +-1.7212579431750616e-03 +-1.7332077851873043e-03 +-1.7430449886091969e-03 +-1.7493329310608425e-03 +-1.7505942940913869e-03 +-1.7454316219128450e-03 +-1.7326841103116857e-03 +-1.7115959197176514e-03 +-1.6819541596729455e-03 +-1.6441524230320936e-03 +-1.5991544722000850e-03 +-1.5483649254954565e-03 +-1.4934427331005974e-03 +-1.4361050696690910e-03 +-1.3779619703670975e-03 +-1.3204037292491708e-03 +-1.2645442592761598e-03 +-1.2112108986745260e-03 +-1.1609659244779405e-03 +-1.1141453979415822e-03 +-1.0709041615956482e-03 +-1.0312596685303191e-03 +-9.9513065838968077e-04 +-9.6236908860711722e-04 +-9.3278521555921717e-04 +-9.0616650804291798e-04 +-8.8229139785061888e-04 +-8.6093892014270173e-04 +-8.4189520344141308e-04 +-8.2495761901201620e-04 +-8.0993723930907282e-04 +-7.9666010846796804e-04 +-7.8496770381459246e-04 +-7.7471686769088274e-04 +-7.6577941149398934e-04 +-7.5804153522944105e-04 +-7.5140316238021625e-04 +-7.4577725811919788e-04 +-7.4108917601041979e-04 +-7.3727606207785743e-04 +-7.3428633372021076e-04 +-7.3207924307242889e-04 +-7.3062452910433937e-04 +-7.2990215926215386e-04 +-1.5143523068029338e-03 +-1.5173032518334970e-03 +-1.5230417465659650e-03 +-1.5312399534982717e-03 +-1.5414044113083419e-03 +-1.5528765234326045e-03 +-1.5648374020072935e-03 +-1.5763206454009002e-03 +-1.5862374942722480e-03 +-1.5934193467024948e-03 +-1.5966820144095177e-03 +-1.5949131126800828e-03 +-1.5871776289883102e-03 +-1.5728277515210125e-03 +-1.5515949405863997e-03 +-1.5236401790222108e-03 +-1.4895457973676221e-03 +-1.4502475879027402e-03 +-1.4069224876745406e-03 +-1.3608574999561455e-03 +-1.3133261778801833e-03 +-1.2654916316491595e-03 +-1.2183444031056740e-03 +-1.1726741853744457e-03 +-1.1290685858991573e-03 +-1.0879300726923504e-03 +-1.0495028139263121e-03 +-1.0139029899163721e-03 +-9.8114830740402611e-04 +-9.5118431105518453e-04 +-9.2390645887834542e-04 +-8.9917781325535133e-04 +-8.7684269660319577e-04 +-8.5673688820318437e-04 +-8.3869499815061562e-04 +-8.2255562068590186e-04 +-8.0816479200163007e-04 +-7.9537818690842929e-04 +-7.8406240077341129e-04 +-7.7409558555958057e-04 +-7.6536764415568916e-04 +-7.5778013534734650e-04 +-7.5124600132147213e-04 +-7.4568919865300931e-04 +-7.4104429042700151e-04 +-7.3725603982086583e-04 +-7.3427903271138407e-04 +-7.3207734753582188e-04 +-7.3062428386410608e-04 +-7.2990215623556609e-04 +-1.3589574535016623e-03 +-1.3616093564199486e-03 +-1.3667821278638911e-03 +-1.3742128909634251e-03 +-1.3835061096152436e-03 +-1.3941343267050265e-03 +-1.4054427047571997e-03 +-1.4166601513094180e-03 +-1.4269200819607135e-03 +-1.4352936802570302e-03 +-1.4408375398208032e-03 +-1.4426554440729502e-03 +-1.4399705599974142e-03 +-1.4321999194497885e-03 +-1.4190191178754090e-03 +-1.4004037617104713e-03 +-1.3766370336389733e-03 +-1.3482797469777387e-03 +-1.3161081194395159e-03 +-1.2810317600872999e-03 +-1.2440073928817507e-03 +-1.2059621534330804e-03 +-1.1677354261919314e-03 +-1.1300424719469827e-03 +-1.0934584170359631e-03 +-1.0584183958738511e-03 +-1.0252286983889957e-03 +-9.9408412567478168e-04 +-9.6508776670910441e-04 +-9.3827058374186501e-04 +-9.1360924388264543e-04 +-8.9104143948680878e-04 +-8.7047848811865232e-04 +-8.5181533495373534e-04 +-8.3493825325618536e-04 +-8.1973060529725943e-04 +-8.0607702883540096e-04 +-7.9386638284558960e-04 +-7.8299373990981761e-04 +-7.7336166311855190e-04 +-7.6488095871548624e-04 +-7.5747105490439376e-04 +-7.5106012308773251e-04 +-7.4558503010081865e-04 +-7.4099118801243405e-04 +-7.3723235086633674e-04 +-7.3427039443242734e-04 +-7.3207510479059948e-04 +-7.3062399370306126e-04 +-7.2990215265499796e-04 +-1.2115503797086762e-03 +-1.2139184753660671e-03 +-1.2185541047914918e-03 +-1.2252555243207556e-03 +-1.2337191511526432e-03 +-1.2435400044243919e-03 +-1.2542148629678151e-03 +-1.2651501025479303e-03 +-1.2756762846664071e-03 +-1.2850713148461123e-03 +-1.2925932262637867e-03 +-1.2975222584884062e-03 +-1.2992098960917828e-03 +-1.2971301676462112e-03 +-1.2909263927444045e-03 +-1.2804455843281775e-03 +-1.2657536644668018e-03 +-1.2471277381003358e-03 +-1.2250261766732669e-03 +-1.2000417493901201e-03 +-1.1728460085493372e-03 +-1.1441337674842030e-03 +-1.1145749663347857e-03 +-1.0847783957171552e-03 +-1.0552687256378587e-03 +-1.0264758774409263e-03 +-9.9873433115108662e-04 +-9.7228943691921987e-04 +-9.4730794146659315e-04 +-9.2389044751721406e-04 +-9.0208415087071072e-04 +-8.8189478981621616e-04 +-8.6329721964664599e-04 +-8.4624437192069781e-04 +-8.3067458594400772e-04 +-8.1651743366387543e-04 +-8.0369822550250040e-04 +-7.9214140666592251e-04 +-7.8177304882893052e-04 +-7.7252262323371679e-04 +-7.6432421625949353e-04 +-7.5711732233896278e-04 +-7.5084732442571320e-04 +-7.4546575033828809e-04 +-7.4093037464131569e-04 +-7.3720522019614268e-04 +-7.3426050080895250e-04 +-7.3207253609766578e-04 +-7.3062366137190615e-04 +-7.2990214855440808e-04 +-1.0795747024842364e-03 +-1.0816881919590937e-03 +-1.0858398902444026e-03 +-1.0918787683432652e-03 +-1.0995775004212205e-03 +-1.1086325887675645e-03 +-1.1186662360110828e-03 +-1.1292312649760579e-03 +-1.1398204567979516e-03 +-1.1498815146791836e-03 +-1.1588383883876776e-03 +-1.1661188675096284e-03 +-1.1711871953528443e-03 +-1.1735791145287310e-03 +-1.1729355194411812e-03 +-1.1690301626153519e-03 +-1.1617870325981133e-03 +-1.1512842803361573e-03 +-1.1377437429552022e-03 +-1.1215076492787576e-03 +-1.1030062610717778e-03 +-1.0827214067767748e-03 +-1.0611508708270555e-03 +-1.0387775993574316e-03 +-1.0160461297851417e-03 +-9.9334704793748547e-04 +-9.7100898816857982e-04 +-9.4929688282569902e-04 +-9.2841482669840799e-04 +-9.0851193770375034e-04 +-8.8968982560826138e-04 +-8.7201060228193027e-04 +-8.5550469340125697e-04 +-8.4017799422188451e-04 +-8.2601813187193663e-04 +-8.1299975299249985e-04 +-8.0108885740857397e-04 +-7.9024625811507259e-04 +-7.8043027722246691e-04 +-7.7159879674825675e-04 +-7.6371078000844761e-04 +-7.5672736938303860e-04 +-7.5061265309648727e-04 +-7.4533417968681876e-04 +-7.4086328538151749e-04 +-7.3717528734011640e-04 +-7.3424958493808578e-04 +-7.3206970196646826e-04 +-7.3062329469913544e-04 +-7.2990214403034477e-04 +-9.6691701964424540e-04 +-9.6881264321834804e-04 +-9.7254800219998103e-04 +-9.7801097288849771e-04 +-9.8503274649410638e-04 +-9.9338775578253170e-04 +-1.0027946602570357e-03 +-1.0129192203608510e-03 +-1.0233799466435854e-03 +-1.0337573287428337e-03 +-1.0436071896808459e-03 +-1.0524782492169127e-03 +-1.0599333294005141e-03 +-1.0655728672097631e-03 +-1.0690586518473024e-03 +-1.0701351705870586e-03 +-1.0686458272917273e-03 +-1.0645417249939618e-03 +-1.0578816690569235e-03 +-1.0488233663553557e-03 +-1.0376071518997064e-03 +-1.0245346270720559e-03 +-1.0099451046107336e-03 +-9.9419266593135072e-04 +-9.7762606391097687e-04 +-9.6057287158252862e-04 +-9.4332841844364627e-04 +-9.2614934544898910e-04 +-9.0925113269199858e-04 +-8.9280871619271899e-04 +-8.7695926724222462e-04 +-8.6180629465596435e-04 +-8.4742438489984946e-04 +-8.3386406947660050e-04 +-8.2115647245276785e-04 +-8.0931752776892811e-04 +-7.9835166094258461e-04 +-7.8825490441414227e-04 +-7.7901746478902249e-04 +-7.7062578930169143e-04 +-7.6306419341828501e-04 +-7.5631611621286153e-04 +-7.5036506858610686e-04 +-7.4519533417018180e-04 +-7.4079247569850944e-04 +-7.3714369189818892e-04 +-7.3423806231198414e-04 +-7.3206671026454875e-04 +-7.3062290764029387e-04 +-7.2990213925497305e-04 +-8.7486204787974467e-04 +-8.7657923772025662e-04 +-8.7997182611467125e-04 +-8.8495597429580830e-04 +-8.9140543641621475e-04 +-8.9915139489319458e-04 +-9.0798291736163034e-04 +-9.1764855805170789e-04 +-9.2785967004381130e-04 +-9.3829596187470165e-04 +-9.4861369922390800e-04 +-9.5845670537814684e-04 +-9.6746995677408757e-04 +-9.7531513394498893e-04 +-9.8168703826240948e-04 +-9.8632941391205891e-04 +-9.8904852611147315e-04 +-9.8972292475678868e-04 +-9.8830819799437895e-04 +-9.8483614617096227e-04 +-9.7940856164142995e-04 +-9.7218651949597737e-04 +-9.6337661275521208e-04 +-9.5321580539887594e-04 +-9.4195651345401789e-04 +-9.2985322009309015e-04 +-9.1715149143163654e-04 +-9.0407979692050790e-04 +-8.9084413838363518e-04 +-8.7762520271487661e-04 +-8.6457758592696921e-04 +-8.5183057544330242e-04 +-8.3948999501423801e-04 +-8.2764068196933098e-04 +-8.1634925364996276e-04 +-8.0566690997212209e-04 +-7.9563210058809450e-04 +-7.8627295242643456e-04 +-7.7760940501774933e-04 +-7.6965503799667336e-04 +-7.6241859977438072e-04 +-7.5590526125714403e-04 +-7.5011762617878766e-04 +-7.4505653228828194e-04 +-7.4072167701413178e-04 +-7.3711209860136150e-04 +-7.3422654000264355e-04 +-7.3206371860592577e-04 +-7.3062252058692795e-04 +-7.2990213447982001e-04 +-8.0313937532049595e-04 +-8.0471727353372197e-04 +-8.0784108437106472e-04 +-8.1244664629328883e-04 +-8.1843733715692389e-04 +-8.2568388299000101e-04 +-8.3402452932729353e-04 +-8.4326590706438622e-04 +-8.5318495791603674e-04 +-8.6353227487120335e-04 +-8.7403714767480146e-04 +-8.8441447345053716e-04 +-8.9437349792348842e-04 +-9.0362810647279181e-04 +-9.1190811581143261e-04 +-9.1897077098471961e-04 +-9.2461148173550369e-04 +-9.2867278670344768e-04 +-9.3105064420490090e-04 +-9.3169741314743921e-04 +-9.3062126813421022e-04 +-9.2788221933748024e-04 +-9.2358529770334157e-04 +-9.1787174718206352e-04 +-9.1090919537277005e-04 +-9.0288174797657468e-04 +-8.9398080053622374e-04 +-8.8439713320418280e-04 +-8.7431460457826782e-04 +-8.6390553322818523e-04 +-8.5332767805874486e-04 +-8.4272261158280541e-04 +-8.3221522047952968e-04 +-8.2191405438082263e-04 +-8.1191226251267807e-04 +-8.0228889507478768e-04 +-7.9311039112674566e-04 +-7.8443211958031424e-04 +-7.7629988004034067e-04 +-7.6875130348593010e-04 +-7.6181711861107151e-04 +-7.5552226855446286e-04 +-7.4988687575902157e-04 +-7.4492706099902630e-04 +-7.4065562734398958e-04 +-7.3708262198433146e-04 +-7.3421578923185714e-04 +-7.3206092723282728e-04 +-7.3062215944572247e-04 +-7.2990213002447452e-04 +-7.5076468116664469e-04 +-7.5224071774497689e-04 +-7.5516728688652436e-04 +-7.5949323495056733e-04 +-7.6514153030619262e-04 +-7.7200907510215468e-04 +-7.7996673371720949e-04 +-7.8885979688985710e-04 +-7.9850912550578457e-04 +-8.0871321819867860e-04 +-8.1925141500140879e-04 +-8.2988837980103316e-04 +-8.4037989598172342e-04 +-8.5047986757154695e-04 +-8.5994825578683087e-04 +-8.6855951964094136e-04 +-8.7611099667036835e-04 +-8.8243058420669985e-04 +-8.8738308551137711e-04 +-8.9087467822184939e-04 +-8.9285513716983681e-04 +-8.9331767419725924e-04 +-8.9229650579335392e-04 +-8.8986248319676737e-04 +-8.8611728364646489e-04 +-8.8118674500586359e-04 +-8.7521392628837436e-04 +-8.6835240697500011e-04 +-8.6076022192516609e-04 +-8.5259469266955087e-04 +-8.4400828332690484e-04 +-8.3514549683915914e-04 +-8.2614074326627584e-04 +-8.1711705818203451e-04 +-8.0818552254193887e-04 +-7.9944522992596463e-04 +-7.9098365624018143e-04 +-7.8287730478974029e-04 +-7.7519252130661893e-04 +-7.6798639561586376e-04 +-7.6130768700711420e-04 +-7.5519772792162205e-04 +-7.4969127487128754e-04 +-7.4481728664554643e-04 +-7.4059961816726172e-04 +-7.3705762427208493e-04 +-7.3420667167568604e-04 +-7.3205855988300688e-04 +-7.3062185316313246e-04 +-7.2990212624595297e-04 +-7.1661638290057431e-04 +-7.1802595372779049e-04 +-7.2082350173971563e-04 +-7.2496572150709078e-04 +-7.3038740428097652e-04 +-7.3700126059994694e-04 +-7.4469788297781283e-04 +-7.5334600557939828e-04 +-7.6279323744262958e-04 +-7.7286744967268938e-04 +-7.8337898063496174e-04 +-7.9412378294692516e-04 +-8.0488757060879720e-04 +-8.1545093595426082e-04 +-8.2559530072116828e-04 +-8.3510945463767744e-04 +-8.4379633358559270e-04 +-8.5147961453349672e-04 +-8.5800967151829796e-04 +-8.6326845643675475e-04 +-8.6717294254072584e-04 +-8.6967688982918657e-04 +-8.7077084352597833e-04 +-8.7048043718421740e-04 +-8.6886321715454770e-04 +-8.6600431549099018e-04 +-8.6201136172982013e-04 +-8.5700903749733168e-04 +-8.5113364722294658e-04 +-8.4452801499226176e-04 +-8.3733693603510830e-04 +-8.2970332527004679e-04 +-8.2176512572301990e-04 +-8.1365297369250010e-04 +-8.0548856858752411e-04 +-7.9738366360606629e-04 +-7.8943957688470891e-04 +-7.8174711833455804e-04 +-7.7438683165809608e-04 +-7.6742946083866760e-04 +-7.6093656306893591e-04 +-7.5496120365646339e-04 +-7.4954868155785752e-04 +-7.4473724602536835e-04 +-7.4055877499221818e-04 +-7.3703939415246413e-04 +-7.3420002228111430e-04 +-7.3205683336235647e-04 +-7.3062162978896217e-04 +-7.2990212349029616e-04 +-6.9978947726927947e-04 +-7.0116631261587733e-04 +-7.0390022401465289e-04 +-7.0795158764115022e-04 +-7.1326074149439189e-04 +-7.1974781537106089e-04 +-7.2731266819535466e-04 +-7.3583506227752320e-04 +-7.4517522115314717e-04 +-7.5517492267565664e-04 +-7.6565926867497259e-04 +-7.7643924402864123e-04 +-7.8731513010479729e-04 +-7.9808077119796470e-04 +-8.0852861175590644e-04 +-8.1845533416091188e-04 +-8.2766784179848284e-04 +-8.3598926214116791e-04 +-8.4326460152150463e-04 +-8.4936567667374659e-04 +-8.5419498281044182e-04 +-8.5768823253439062e-04 +-8.5981540621376379e-04 +-8.6058027900269389e-04 +-8.6001851579719482e-04 +-8.5819453646660199e-04 +-8.5519743624544724e-04 +-8.5113629222160374e-04 +-8.4613519479610831e-04 +-8.4032831707794809e-04 +-8.3385528388645058e-04 +-8.2685703586909108e-04 +-8.1947231357455772e-04 +-8.1183481977225355e-04 +-8.0407106185045364e-04 +-7.9629883290514207e-04 +-7.8862626083342111e-04 +-7.8115133824601182e-04 +-7.7396184010262471e-04 +-7.6713553800782650e-04 +-7.6074062747102792e-04 +-7.5483629486249168e-04 +-7.4947336249087603e-04 +-7.4469496189176205e-04 +-7.4053719621198003e-04 +-7.3702976202868803e-04 +-7.3419650886843860e-04 +-7.3205592108589105e-04 +-7.3062151175928662e-04 +-7.2990212203421394e-04 +-6.9978948768732925e-04 +-7.0116640649699625e-04 +-7.0390048539865826e-04 +-7.0795210144336789e-04 +-7.1326159325160407e-04 +-7.1974909017212150e-04 +-7.2731444856655679e-04 +-7.3583742486015089e-04 +-7.4517823212704826e-04 +-7.5517863205707813e-04 +-7.6566370384628440e-04 +-7.7644440312038803e-04 +-7.8732097610280957e-04 +-7.9808722782580179e-04 +-8.0853556221244618e-04 +-8.1846262361267945e-04 +-8.2767528411170285e-04 +-8.3599665072397436e-04 +-8.4327172343328293e-04 +-8.4937232849842056e-04 +-8.5420098634863412e-04 +-8.5769344827291085e-04 +-8.5981974282483089e-04 +-8.6058369775333216e-04 +-8.6002102956843503e-04 +-8.5819620390684061e-04 +-8.5519835223971498e-04 +-8.5113657623488213e-04 +-8.4613497871173634e-04 +-8.4032773394462554e-04 +-8.3385445860180852e-04 +-8.2685607837238025e-04 +-8.1947131469047377e-04 +-8.1183384950631607e-04 +-8.0407016971259157e-04 +-7.9629804973123397e-04 +-7.8862560156391288e-04 +-7.8115080517696166e-04 +-7.7396142621789733e-04 +-7.6713523010699461e-04 +-7.6074040890839855e-04 +-7.5483614779831780e-04 +-7.4947326962195070e-04 +-7.4469490767512610e-04 +-7.4053716762480617e-04 +-7.3702974892315921e-04 +-7.3419650398645869e-04 +-7.3205591979830795e-04 +-7.3062151159097443e-04 +-7.2990212203213737e-04 +-7.1661641578295396e-04 +-7.1802625004378556e-04 +-7.2082432672916131e-04 +-7.2496734309640532e-04 +-7.3039009212295936e-04 +-7.3700528240188009e-04 +-7.4470349736241892e-04 +-7.5335345096198868e-04 +-7.6280271681923551e-04 +-7.7287911182673903e-04 +-7.8339289906730449e-04 +-7.9413993472972669e-04 +-8.0490581819091158e-04 +-8.1547101546898212e-04 +-8.2561682031129582e-04 +-8.3513190552275750e-04 +-8.4381911501175912e-04 +-8.5150207155211370e-04 +-8.5803114214965228e-04 +-8.6328832274842752e-04 +-8.6719067905098666e-04 +-8.6969210278099967e-04 +-8.7078329598811062e-04 +-8.7049005729887823e-04 +-8.6887008960041053e-04 +-8.6600865874028718e-04 +-8.6201349544771553e-04 +-8.5700934520752624e-04 +-8.5113253916466701e-04 +-8.4452589515181839e-04 +-8.3733417598677172e-04 +-8.2970024604078893e-04 +-8.2176198766051301e-04 +-8.1364997341223011e-04 +-8.0548584154403811e-04 +-7.9738129063840516e-04 +-7.8943759314679734e-04 +-7.8174552324485611e-04 +-7.7438559880471268e-04 +-7.6742854709146080e-04 +-7.6093591643630089e-04 +-7.5496076965905735e-04 +-7.4954840806729431e-04 +-7.4473708663596531e-04 +-7.4055869106684458e-04 +-7.3703935572033664e-04 +-7.3420000797691813e-04 +-7.3205682959208440e-04 +-7.3062162929628477e-04 +-7.2990212348418083e-04 +-7.5076474166975156e-04 +-7.5224126295886688e-04 +-7.5516880479190734e-04 +-7.5949621818161960e-04 +-7.6514647378654837e-04 +-7.7201646817166803e-04 +-7.7997704525247478e-04 +-7.8887345246687955e-04 +-7.9852647658728453e-04 +-8.0873450470271503e-04 +-8.1927672435663942e-04 +-8.2991760748011027e-04 +-8.4041271410244885e-04 +-8.5051570890505763e-04 +-8.5998631986319461e-04 +-8.6859880527239731e-04 +-8.7615036124250836e-04 +-8.8246882519170432e-04 +-8.8741903496516235e-04 +-8.9090729781044452e-04 +-8.9288360050726958e-04 +-8.9334142527862934e-04 +-8.9231528658221160e-04 +-8.8987632885544814e-04 +-8.8612648912982030e-04 +-8.8119181063160159e-04 +-8.7521549182719913e-04 +-8.6835118374384258e-04 +-8.6075693075972554e-04 +-8.5259001317473070e-04 +-8.4400281713116097e-04 +-8.3513974522591346e-04 +-8.2613509781259134e-04 +-8.1711180198304402e-04 +-8.0818083917071504e-04 +-7.9944121732427708e-04 +-7.9098034308613214e-04 +-7.8287466739098864e-04 +-7.7519049960615813e-04 +-7.6798490739451932e-04 +-7.6130663978181098e-04 +-7.5519702835638071e-04 +-7.4969083574187080e-04 +-7.4481703154156075e-04 +-7.4059948419441025e-04 +-7.3705756304964212e-04 +-7.3420664892597139e-04 +-7.3205855389382323e-04 +-7.3062185238113300e-04 +-7.2990212623627333e-04 +-8.0313947294336971e-04 +-8.0471815323969334e-04 +-8.0784353338430096e-04 +-8.1245145861504942e-04 +-8.1844530824558574e-04 +-8.2569579424933827e-04 +-8.3404111974082695e-04 +-8.4328783049144338e-04 +-8.5321272656317226e-04 +-8.6356619233744335e-04 +-8.7407723851570937e-04 +-8.8446041978497772e-04 +-8.9442459618636124e-04 +-9.0368325776354408e-04 +-9.1196586038864113e-04 +-9.1902937105640091e-04 +-9.2466904770849073e-04 +-9.2872743257039168e-04 +-9.3110065046455074e-04 +-9.3174137291221167e-04 +-9.3065819489636424e-04 +-9.2791160248096476e-04 +-9.2360710202173959e-04 +-9.1788636256869027e-04 +-9.1091735011214882e-04 +-9.0288440246405835e-04 +-8.9397903785094096e-04 +-8.8439205977182010e-04 +-8.7430726958419270e-04 +-8.6389687076492269e-04 +-8.5331847209769930e-04 +-8.4271348116041309e-04 +-8.3220662101025369e-04 +-8.2190629054486623e-04 +-8.1190550841100722e-04 +-8.0228321799864896e-04 +-7.9310577611187811e-04 +-7.8442849274063594e-04 +-7.7629712940428038e-04 +-7.6874929664651833e-04 +-7.6181571694028350e-04 +-7.5552133803617196e-04 +-7.4988629468635318e-04 +-7.4492672488678463e-04 +-7.4065545144957477e-04 +-7.3708254183216661e-04 +-7.3421575951363339e-04 +-7.3206091942176288e-04 +-7.3062215842691536e-04 +-7.2990213001184812e-04 +-8.7486219778923108e-04 +-8.7658058857904278e-04 +-8.7997558647375266e-04 +-8.8496336152696538e-04 +-8.9141766528273432e-04 +-8.9916964767445694e-04 +-9.0800829098156358e-04 +-9.1768198620888219e-04 +-9.2790182260483697e-04 +-9.3834712978990969e-04 +-9.4867368024071947e-04 +-9.5852471220662851e-04 +-9.6754457264802501e-04 +-9.7539433816150605e-04 +-9.8176831478850044e-04 +-9.8640994032441831e-04 +-9.8912542159425689e-04 +-9.8979352020454815e-04 +-9.8837028391429000e-04 +-9.8488815794396407e-04 +-9.7944967568762420e-04 +-9.7221665335993639e-04 +-9.6339634099209691e-04 +-9.5322621637322885e-04 +-9.4195903743952275e-04 +-9.2984945695954112e-04 +-9.1714305921508155e-04 +-9.0406821371833682e-04 +-8.9083074176996208e-04 +-8.7761110466033317e-04 +-8.6456365744883880e-04 +-8.5181745363297227e-04 +-8.3947810509130681e-04 +-8.2763026795451403e-04 +-8.1634041260476387e-04 +-8.0565962616068203e-04 +-7.9562627716941330e-04 +-7.8626843929406154e-04 +-7.7760602215494554e-04 +-7.6965259423453572e-04 +-7.6241690717190468e-04 +-7.5590414551160911e-04 +-7.5011693356337190e-04 +-7.4505613363505074e-04 +-7.4072146924030369e-04 +-7.3711200423387828e-04 +-7.3422650510385939e-04 +-7.3206370945068464e-04 +-7.3062251939431640e-04 +-7.2990213446506500e-04 +-9.6691724431680797e-04 +-9.6881466774827087e-04 +-9.7255363724748592e-04 +-9.7802203914070852e-04 +-9.8505105098736301e-04 +-9.9341503502990529e-04 +-1.0028324826293375e-03 +-1.0129688457208130e-03 +-1.0234421503565489e-03 +-1.0338322095753104e-03 +-1.0436939946105151e-03 +-1.0525752585374311e-03 +-1.0600378470853016e-03 +-1.0656813495346618e-03 +-1.0691669809336551e-03 +-1.0702390441972021e-03 +-1.0687412029329710e-03 +-1.0646252377205050e-03 +-1.0579509463244715e-03 +-1.0488771890035217e-03 +-1.0376454482789749e-03 +-1.0245583240879271e-03 +-1.0099558840063268e-03 +-9.9419268191494256e-04 +-9.7761767138096717e-04 +-9.6055839879147025e-04 +-9.4331000057302789e-04 +-9.2612882098004265e-04 +-9.0922999480479345e-04 +-8.9278810673588070e-04 +-8.7693999994079008e-04 +-8.6178889568959199e-04 +-8.4740914150691711e-04 +-8.3385107993787092e-04 +-8.2114569318942027e-04 +-8.0930881515632364e-04 +-7.9834480677713543e-04 +-7.8824966485042676e-04 +-7.7901358309241198e-04 +-7.7062301303992614e-04 +-7.6306228682799669e-04 +-7.5631486848750284e-04 +-7.5036429878471821e-04 +-7.4519489337147935e-04 +-7.4079224694049994e-04 +-7.3714358836096748e-04 +-7.3423802412666010e-04 +-7.3206670026743504e-04 +-7.3062290633976116e-04 +-7.2990213923888501e-04 +-1.0795750330586116e-03 +-1.0816911707122595e-03 +-1.0858481801160459e-03 +-1.0918950408926296e-03 +-1.0996043884449775e-03 +-1.1086725796120708e-03 +-1.1187214935452243e-03 +-1.1293033802683161e-03 +-1.1399101469269670e-03 +-1.1499883142230083e-03 +-1.1589604029070329e-03 +-1.1662526721353426e-03 +-1.1713279523606901e-03 +-1.1737209445838335e-03 +-1.1730720972611731e-03 +-1.1691554389161481e-03 +-1.1618959380197578e-03 +-1.1513732652100059e-03 +-1.1378110520013144e-03 +-1.1215533041163742e-03 +-1.1030317962978837e-03 +-1.0827294524350293e-03 +-1.0611446856793503e-03 +-1.0387606414544008e-03 +-1.0160217178255880e-03 +-9.9331813312037495e-04 +-9.7097803069185558e-04 +-9.4926581273834887e-04 +-9.2838506402926691e-04 +-9.0848444841122719e-04 +-8.8966519466502530e-04 +-8.7198911075049774e-04 +-8.5548639131561872e-04 +-8.4016276491634639e-04 +-8.2600574603815344e-04 +-8.1298991238631100e-04 +-8.0108122902917544e-04 +-7.9024050008363877e-04 +-7.8042605768799563e-04 +-7.7159580708159397e-04 +-7.6370874340001829e-04 +-7.5672604578911164e-04 +-7.5061184131205007e-04 +-7.4533371717428192e-04 +-7.4086304635853357e-04 +-7.3717517952696563e-04 +-7.3424954528328583e-04 +-7.3206969160556916e-04 +-7.3062329335308912e-04 +-7.2990214401370693e-04 +-1.2115508556249707e-03 +-1.2139227636604650e-03 +-1.2185660369992239e-03 +-1.2252789330712238e-03 +-1.2337577788967356e-03 +-1.2435973079275079e-03 +-1.2542936956414991e-03 +-1.2652522825469606e-03 +-1.2758020969452816e-03 +-1.2852190443966259e-03 +-1.2927588613281949e-03 +-1.2976995118239136e-03 +-1.2993906465081746e-03 +-1.2973053194182817e-03 +-1.2910870157844181e-03 +-1.2805840888458952e-03 +-1.2658647350236012e-03 +-1.2472088227588902e-03 +-1.2250774663583131e-03 +-1.2000657277357843e-03 +-1.1728467462794310e-03 +-1.1441161548982298e-03 +-1.1145440367303417e-03 +-1.0847388244792507e-03 +-1.0552245250489898e-03 +-1.0264302631063781e-03 +-9.9868971531473635e-04 +-9.7224750142057322e-04 +-9.4726975077341201e-04 +-9.2385657354507713e-04 +-9.0205479207456285e-04 +-8.8186987547699176e-04 +-8.6327649602699070e-04 +-8.4622747041392674e-04 +-8.3066107511107004e-04 +-8.1650685773546571e-04 +-8.0369013197667397e-04 +-7.9213536536988801e-04 +-7.8176866443136514e-04 +-7.7251954279923443e-04 +-7.6432213308232186e-04 +-7.5711597699796370e-04 +-7.5084650376927760e-04 +-7.4546528492872911e-04 +-7.4093013505452431e-04 +-7.3720511247370949e-04 +-7.3426046128801878e-04 +-7.3207252579134846e-04 +-7.3062366003464631e-04 +-7.2990214853788560e-04 +-1.3589581178032311e-03 +-1.3616153419820749e-03 +-1.3667987789953240e-03 +-1.3742455335652001e-03 +-1.3835598833285307e-03 +-1.3942138392974296e-03 +-1.4055514849479380e-03 +-1.4167999296910026e-03 +-1.4270900098671292e-03 +-1.4354896863635327e-03 +-1.4410520838935060e-03 +-1.4428779036343205e-03 +-1.4401883440079805e-03 +-1.4324001662868588e-03 +-1.4191905970357124e-03 +-1.4005384841801790e-03 +-1.3767311587242321e-03 +-1.3483336190268395e-03 +-1.3161255524210193e-03 +-1.2810188812699295e-03 +-1.2439713993591486e-03 +-1.2059102532560736e-03 +-1.1676741010637108e-03 +-1.1299770765893869e-03 +-1.0933930544824997e-03 +-1.0583559797655998e-03 +-1.0251711180321310e-03 +-9.9403244980662310e-04 +-9.6504244494195030e-04 +-9.3823162390327126e-04 +-9.1357635690033951e-04 +-8.9101415152268153e-04 +-8.7045622371328913e-04 +-8.5179747642776416e-04 +-8.3492418165279742e-04 +-8.1971972750201425e-04 +-8.0606879463057874e-04 +-7.9386029478840405e-04 +-7.8298935817435356e-04 +-7.7335860684223643e-04 +-7.6487890493624224e-04 +-7.5746973584246691e-04 +-7.5105932229073294e-04 +-7.4558457780766736e-04 +-7.4099095598147613e-04 +-7.3723224683895693e-04 +-7.3427035635408684e-04 +-7.3207509487749312e-04 +-7.3062399241830619e-04 +-7.2990215263914410e-04 +-1.5143531935751160e-03 +-1.5173112415961716e-03 +-1.5230639669429431e-03 +-1.5312834744588126e-03 +-1.5414759543041555e-03 +-1.5529818814827403e-03 +-1.5649805452186958e-03 +-1.5765025908098032e-03 +-1.5864551685910182e-03 +-1.5936648212423335e-03 +-1.5969425535320790e-03 +-1.5951723508606562e-03 +-1.5874178460924516e-03 +-1.5730327626858409e-03 +-1.5517527909455224e-03 +-1.5237448475992766e-03 +-1.4895974891827469e-03 +-1.4502517230302805e-03 +-1.4068878993909436e-03 +-1.3607944698125023e-03 +-1.3132447938318064e-03 +-1.2654007015844026e-03 +-1.2182509297882110e-03 +-1.1725832771697596e-03 +-1.1289836392104240e-03 +-1.0878530824333960e-03 +-1.0494347117315542e-03 +-1.0138439527376114e-03 +-9.8109801150961999e-04 +-9.5114212670448185e-04 +-9.2387159148515615e-04 +-8.9914940096255159e-04 +-8.7681987465508895e-04 +-8.5671882924441523e-04 +-8.3868093574500369e-04 +-8.2254486152868512e-04 +-8.0815672074769339e-04 +-7.9537226632492807e-04 +-7.8405816902699457e-04 +-7.7409265181176308e-04 +-7.6536568320453705e-04 +-7.5777888176564495e-04 +-7.5124524335736702e-04 +-7.4568877204556040e-04 +-7.4104407222185019e-04 +-7.3725594223299305e-04 +-7.3427899706065875e-04 +-7.3207733826850796e-04 +-7.3062428266423536e-04 +-7.2990215622075415e-04 +-1.6665444424006290e-03 +-1.6697980872176325e-03 +-1.6761148491843999e-03 +-1.6851121290855594e-03 +-1.6962128098574674e-03 +-1.7086432753109827e-03 +-1.7214342991485508e-03 +-1.7334289461305729e-03 +-1.7433043234220619e-03 +-1.7496171079826558e-03 +-1.7508840395682535e-03 +-1.7457042529076729e-03 +-1.7329174545006848e-03 +-1.7117725178135235e-03 +-1.6820643657137850e-03 +-1.6441954294578987e-03 +-1.5991371659761265e-03 +-1.5482992965824723e-03 +-1.4933428885871255e-03 +-1.4359847209766228e-03 +-1.3778328164624389e-03 +-1.3202747453432552e-03 +-1.2644216650567377e-03 +-1.2110985216189064e-03 +-1.1608657214528038e-03 +-1.1140579811359218e-03 +-1.0708292501527274e-03 +-1.0311964394901858e-03 +-9.9507800005618112e-04 +-9.6232577248540809e-04 +-9.3275000622279418e-04 +-9.0613822864439510e-04 +-8.8226896554292130e-04 +-8.6092136203236053e-04 +-8.4188166054835446e-04 +-8.2494734326003284e-04 +-8.0992958678505471e-04 +-7.9665453094712442e-04 +-7.8496373972062141e-04 +-7.7471413312773119e-04 +-7.6577759165758982e-04 +-7.5804037631561655e-04 +-7.5140246400048774e-04 +-7.4577686618616541e-04 +-7.4108897603618828e-04 +-7.3727597282768464e-04 +-7.3428630116943467e-04 +-7.3207923462154871e-04 +-7.3062452801110947e-04 +-7.2990215924867723e-04 +-1.8021185188146890e-03 +-1.8056379840439691e-03 +-1.8124747796467067e-03 +-1.8222225266088974e-03 +-1.8342659163801834e-03 +-1.8477728330074331e-03 +-1.8616835881047620e-03 +-1.8747008609623296e-03 +-1.8852907147238300e-03 +-1.8917144227970568e-03 +-1.8921175279326189e-03 +-1.8846969579710835e-03 +-1.8679411685611671e-03 +-1.8408969180867926e-03 +-1.8033822744222641e-03 +-1.7560668403464221e-03 +-1.7003845669190203e-03 +-1.6383077532410222e-03 +-1.5720558145764897e-03 +-1.5038187796540957e-03 +-1.4355502168309508e-03 +-1.3688487416264313e-03 +-1.3049192843095137e-03 +-1.2445914926395617e-03 +-1.1883707978156697e-03 +-1.1365024038682307e-03 +-1.0890351267346728e-03 +-1.0458779556092195e-03 +-1.0068464789452318e-03 +-9.7169892590236455e-04 +-9.4016291685441382e-04 +-9.1195453668338510e-04 +-8.8679139672437931e-04 +-8.6440117575678564e-04 +-8.4452687175166853e-04 +-8.2692973151157246e-04 +-8.1139059048253195e-04 +-7.9771016192327717e-04 +-7.8570866333765876e-04 +-7.7522505344655907e-04 +-7.6611606823259195e-04 +-7.5825518315284575e-04 +-7.5153158480403793e-04 +-7.4584920455184826e-04 +-7.4112584535935373e-04 +-7.3729241858688603e-04 +-7.3429229793716072e-04 +-7.3208079154028771e-04 +-7.3062472944262081e-04 +-7.2990216173500781e-04 +-1.9091991693591058e-03 +-1.9129328856151517e-03 +-1.9202113884986968e-03 +-1.9306539465783407e-03 +-1.9436795547173450e-03 +-1.9584881127102322e-03 +-1.9740268279941969e-03 +-1.9889429860363802e-03 +-2.0015379903077775e-03 +-2.0097587355813024e-03 +-2.0112808443811885e-03 +-2.0037329700900003e-03 +-1.9850626224314403e-03 +-1.9539607713715498e-03 +-1.9101963661694065e-03 +-1.8547227587156331e-03 +-1.7895122387634381e-03 +-1.7171904189401941e-03 +-1.6406056862289849e-03 +-1.5624572706160796e-03 +-1.4850485729702310e-03 +-1.4101734445460393e-03 +-1.3391068949406757e-03 +-1.2726604972290753e-03 +-1.2112674749141367e-03 +-1.1550732039216582e-03 +-1.1040174092716954e-03 +-1.0579021570779105e-03 +-1.0164445714402649e-03 +-9.7931570315436581e-04 +-9.4616796183236000e-04 +-9.1665365874707048e-04 +-8.9043693901707957e-04 +-8.6720096975034095e-04 +-8.4665183098399908e-04 +-8.2852018835518108e-04 +-8.1256152874417458e-04 +-7.9855551091895813e-04 +-7.8630481262663377e-04 +-7.7563373176875493e-04 +-7.6638671120050970e-04 +-7.5842689505576765e-04 +-7.5163478205739632e-04 +-7.4590701251854834e-04 +-7.4115530664871647e-04 +-7.3730555941182627e-04 +-7.3429708950472250e-04 +-7.3208203554954692e-04 +-7.3062489039053325e-04 +-7.2990216372211642e-04 +-1.9822025053612621e-03 +-1.9860878382746356e-03 +-1.9937082202559110e-03 +-2.0047594186751888e-03 +-2.0187701473662269e-03 +-2.0350690282450699e-03 +-2.0527199412175346e-03 +-2.0704212138465922e-03 +-2.0863857388696608e-03 +-2.0982574953736380e-03 +-2.1031612647213946e-03 +-2.0979863018472456e-03 +-2.0799241219854668e-03 +-2.0471246956356862e-03 +-1.9992106157625941e-03 +-1.9374184963271855e-03 +-1.8643189385018487e-03 +-1.7832621085317078e-03 +-1.6977746424072786e-03 +-1.6110832352271834e-03 +-1.5258357874644707e-03 +-1.4440050378341273e-03 +-1.3669190963294137e-03 +-1.2953596492553336e-03 +-1.2296828825811865e-03 +-1.1699358880076149e-03 +-1.1159555749742211e-03 +-1.0674463007951454e-03 +-1.0240373630856141e-03 +-9.8532358918768689e-04 +-9.5089273136430956e-04 +-9.2034306894121310e-04 +-8.9329402005377406e-04 +-8.6939192961505048e-04 +-8.4831263776908032e-04 +-8.2976197933836131e-04 +-8.1347501821648325e-04 +-7.9921456550955435e-04 +-7.8676934731673005e-04 +-7.7595205958980651e-04 +-7.6659745888011039e-04 +-7.5856057759645019e-04 +-7.5171511222903284e-04 +-7.4595200668748426e-04 +-7.4117823614369693e-04 +-7.3731578647815311e-04 +-7.3430081856453767e-04 +-7.3208300370052374e-04 +-7.3062501564845361e-04 +-7.2990216526911973e-04 +-2.0242461661141471e-03 +-2.0282242363728951e-03 +-2.0360821677383547e-03 +-2.0476194495593182e-03 +-2.0625167563658115e-03 +-2.0802913102777711e-03 +-2.1002043466062381e-03 +-2.1211058207241105e-03 +-2.1412263621994740e-03 +-2.1579837284447585e-03 +-2.1679517808271759e-03 +-2.1671776510152024e-03 +-2.1519205228534032e-03 +-2.1196142497855227e-03 +-2.0696277466775242e-03 +-2.0034548395834327e-03 +-1.9242861018092222e-03 +-1.8362230884658409e-03 +-1.7434793772171232e-03 +-1.6497985100129965e-03 +-1.5581529135016460e-03 +-1.4706753244604781e-03 +-1.3887352748394306e-03 +-1.3130817350214114e-03 +-1.2439986894026104e-03 +-1.1814451358923197e-03 +-1.1251683676213721e-03 +-1.0747893603845462e-03 +-1.0298637431782908e-03 +-9.8992332717613620e-04 +-9.5450307079265558e-04 +-9.2315760900772096e-04 +-8.9547057189693572e-04 +-8.7105908624528152e-04 +-8.4957517403630944e-04 +-8.3070524056164542e-04 +-8.1416846225362621e-04 +-7.9971461151919236e-04 +-7.8712166567373532e-04 +-7.7619341689153128e-04 +-7.6675721248075051e-04 +-7.5866189677311474e-04 +-7.5177598826364734e-04 +-7.4598610173690159e-04 +-7.4119561053137529e-04 +-7.3732353564289995e-04 +-7.3430364408105125e-04 +-7.3208373726743701e-04 +-7.3062511055638321e-04 +-7.2990216644190230e-04 +-2.0445785385843269e-03 +-2.0486054362232145e-03 +-2.0566089775697436e-03 +-2.0684847962350889e-03 +-2.0840575414779526e-03 +-2.1030329065275417e-03 +-2.1248924996264029e-03 +-2.1487027329293116e-03 +-2.1728267434277305e-03 +-2.1945978763668454e-03 +-2.2101491325086579e-03 +-2.2147045235409186e-03 +-2.2035133473202349e-03 +-2.1731753555204857e-03 +-2.1227100921988313e-03 +-2.0538140857190015e-03 +-1.9702649033948652e-03 +-1.8768807782353978e-03 +-1.7785190960216384e-03 +-1.6793955685228603e-03 +-1.5827705462074110e-03 +-1.4909138360188201e-03 +-1.4052276970656901e-03 +-1.3264312625879352e-03 +-1.2547469995811680e-03 +-1.1900607885011918e-03 +-1.1320468923490458e-03 +-1.0802593240458835e-03 +-1.0341952684616174e-03 +-9.9333706243867940e-04 +-9.5717858795354961e-04 +-9.2524078873757701e-04 +-8.9707985891335196e-04 +-8.7229066271226935e-04 +-8.5050717245164348e-04 +-8.3140114058563586e-04 +-8.1467981341235842e-04 +-8.0008320959163229e-04 +-7.8738129248785390e-04 +-7.7637123501917164e-04 +-7.6687488973356088e-04 +-7.5873652104486316e-04 +-7.5182082124137432e-04 +-7.4601121006962021e-04 +-7.4120840495614613e-04 +-7.3732924198137645e-04 +-7.3430572471801312e-04 +-7.3208427744515868e-04 +-7.3062518044405579e-04 +-7.2990216730622860e-04 +-2.0529840591917291e-03 +-2.0570334375766132e-03 +-2.0651154975566410e-03 +-2.0771936839223530e-03 +-2.0931968673719137e-03 +-2.1129756638031683e-03 +-2.1362012482419638e-03 +-2.1621652586467904e-03 +-2.1894399531887125e-03 +-2.2154232472043245e-03 +-2.2359854309776895e-03 +-2.2456620771999993e-03 +-2.2387412022520630e-03 +-2.2109667931593810e-03 +-2.1609544670906262e-03 +-2.0905341069083253e-03 +-2.0039872415533707e-03 +-1.9067561804997919e-03 +-1.8042525144391290e-03 +-1.7010908838768727e-03 +-1.6007698465326905e-03 +-1.5056700392669657e-03 +-1.4172191139619305e-03 +-1.3361119386868169e-03 +-1.2625224942081482e-03 +-1.1962799354659111e-03 +-1.1370025506554947e-03 +-1.0841935419018153e-03 +-1.0373061254407457e-03 +-9.9578569157857707e-04 +-9.5909564363862014e-04 +-9.2673206678799581e-04 +-8.9823101207525278e-04 +-8.7317107048812115e-04 +-8.5117307198076422e-04 +-8.3189813696824336e-04 +-8.1504488202977616e-04 +-8.0034628971420386e-04 +-7.8756655621394888e-04 +-7.7649810085895750e-04 +-7.6695883711716659e-04 +-7.5878975092770018e-04 +-7.5185279881713734e-04 +-7.4602911808725552e-04 +-7.4121753008373576e-04 +-7.3733331174448923e-04 +-7.3430720861800830e-04 +-7.3208466269610679e-04 +-7.3062523028768079e-04 +-7.2990216792350327e-04 +-2.0560409086217918e-03 +-2.0600997322609920e-03 +-2.0682205564153786e-03 +-2.0804072435751247e-03 +-2.0966521229938626e-03 +-2.1168986363688503e-03 +-2.1409514764408792e-03 +-2.1682867432229374e-03 +-2.1976942333827420e-03 +-2.2267262770235621e-03 +-2.2511575796467808e-03 +-2.2650274805683717e-03 +-2.2618176119198006e-03 +-2.2365001920144562e-03 +-2.1872937546109561e-03 +-2.1160991264260426e-03 +-2.0275910033088224e-03 +-1.9277073772058155e-03 +-1.8222970546095071e-03 +-1.7162853174569452e-03 +-1.6133535220430569e-03 +-1.5159660989781606e-03 +-1.4255695330299800e-03 +-1.3428405968400306e-03 +-1.2679176352054589e-03 +-1.2005885136096180e-03 +-1.1404311019071777e-03 +-1.0869121622209355e-03 +-1.0394535628351178e-03 +-9.9747448685796815e-04 +-9.6041681450424385e-04 +-9.2775914516393990e-04 +-8.9902340988409117e-04 +-8.7377682719934281e-04 +-8.5163106757318537e-04 +-8.3223985943378968e-04 +-8.1529583244448439e-04 +-8.0052709714855069e-04 +-7.8769386309680172e-04 +-7.7658526841457127e-04 +-7.6701651094716872e-04 +-7.5882631874178090e-04 +-7.5187476573845737e-04 +-7.4604141957922176e-04 +-7.4122379825273046e-04 +-7.3733610728527398e-04 +-7.3430822791019932e-04 +-7.3208492732465276e-04 +-7.3062526452550929e-04 +-7.2990216834852289e-04 +-2.0570061424629981e-03 +-2.0610688220912515e-03 +-2.0692086225452752e-03 +-2.0814523253037450e-03 +-2.0978283496603180e-03 +-2.1183337480352414e-03 +-2.1428543332569143e-03 +-2.1709909589040549e-03 +-2.2017074375135048e-03 +-2.2327242609502208e-03 +-2.2598238687495842e-03 +-2.2767318530356843e-03 +-2.2763296634431139e-03 +-2.2529771002070534e-03 +-2.2045579479758421e-03 +-2.1330021128874175e-03 +-2.0432642822178506e-03 +-1.9416417253936601e-03 +-1.8342989877355778e-03 +-1.7263837354439795e-03 +-1.6217069060811113e-03 +-1.5227917621618192e-03 +-1.4310978929069620e-03 +-1.3472895712314207e-03 +-1.2714806978180023e-03 +-1.2034309860798438e-03 +-1.1426908911465142e-03 +-1.0887025704182372e-03 +-1.0408668087535660e-03 +-9.9858522361451988e-04 +-9.6128531231987903e-04 +-9.2843402006133162e-04 +-8.9954388881819519e-04 +-8.7417459060030263e-04 +-8.5193172895670164e-04 +-8.3246414412356778e-04 +-8.1546051248016632e-04 +-8.0064573163206125e-04 +-7.8777738504489823e-04 +-7.7664245156798875e-04 +-7.6705434345842769e-04 +-7.5885030516871055e-04 +-7.5188917433136038e-04 +-7.4604948821982181e-04 +-7.4122790953058931e-04 +-7.3733794085710503e-04 +-7.3430889645191935e-04 +-7.3208510089101315e-04 +-7.3062528698198987e-04 +-7.2990216862850617e-04 +-2.0572330791694925e-03 +-2.0612973687676984e-03 +-2.0694468462478088e-03 +-2.0817213760975515e-03 +-2.0981697173381884e-03 +-2.1188185575134241e-03 +-2.1435985908731829e-03 +-2.1721840661962002e-03 +-2.2036544890457949e-03 +-2.2358642540565520e-03 +-2.2646406904351982e-03 +-2.2835309126897846e-03 +-2.2850172513635800e-03 +-2.2630310159176105e-03 +-2.2152121542511872e-03 +-2.1434985072189654e-03 +-2.0530267858295610e-03 +-1.9503311795001478e-03 +-1.8417840378253929e-03 +-1.7326785707116484e-03 +-1.6269099818125644e-03 +-1.5270395568776395e-03 +-1.4345353118756850e-03 +-1.3500535369851644e-03 +-1.2736925845101971e-03 +-1.2051943288599418e-03 +-1.1440919113708385e-03 +-1.0898119955158954e-03 +-1.0417421232732976e-03 +-9.9927290318970884e-04 +-9.6182283583228954e-04 +-9.2885158888066316e-04 +-8.9986585007183185e-04 +-8.7442059228870289e-04 +-8.5211764576017743e-04 +-8.3260281371500770e-04 +-8.1556231868627966e-04 +-8.0071906563498332e-04 +-7.8782901053807896e-04 +-7.7667779490548793e-04 +-7.6707772569486066e-04 +-7.5886512940748132e-04 +-7.5189807900561756e-04 +-7.4605447464538681e-04 +-7.4123045027241891e-04 +-7.3733907398269827e-04 +-7.3430930960061494e-04 +-7.3208520815221231e-04 +-7.3062530086016354e-04 +-7.2990216880306185e-04 +-2.0572420125645426e-03 +-2.0613069963748296e-03 +-2.0694614576571655e-03 +-2.0817525206451495e-03 +-2.0982400910680614e-03 +-2.1189666703506239e-03 +-2.1438863024012033e-03 +-2.1727123138960175e-03 +-2.2045910608109081e-03 +-2.2374635742121443e-03 +-2.2671995286107100e-03 +-2.2872528303320007e-03 +-2.2898690615529376e-03 +-2.2687162533987634e-03 +-2.2212808088964949e-03 +-2.1495008953638902e-03 +-2.0586201583523956e-03 +-1.9553133033982199e-03 +-1.8460757865692615e-03 +-1.7362867391449563e-03 +-1.6298909111876004e-03 +-1.5294718559807519e-03 +-1.4365025031730491e-03 +-1.3516344934720421e-03 +-1.2749571529323304e-03 +-1.2062020258768182e-03 +-1.1448922489508493e-03 +-1.0904455488562337e-03 +-1.0422418412328951e-03 +-9.9966540348238211e-04 +-9.6212956840588371e-04 +-9.2908982785035697e-04 +-9.0004951350888341e-04 +-8.7456090662444005e-04 +-8.5222367766454106e-04 +-8.3268189267641330e-04 +-8.1562037139587421e-04 +-8.0076088022762990e-04 +-7.8785844565469078e-04 +-7.7669794570226099e-04 +-7.6709105652515209e-04 +-7.5887358088839031e-04 +-7.5190315557098703e-04 +-7.4605731736913906e-04 +-7.4123189871315041e-04 +-7.3733971995566935e-04 +-7.3430954512723019e-04 +-7.3208526929930697e-04 +-7.3062530877233858e-04 +-7.2990216890451119e-04 +-2.0572136705343828e-03 +-2.0612789527889247e-03 +-2.0694358244091370e-03 +-2.0817350685511386e-03 +-2.0982421797210585e-03 +-2.1190074617685934e-03 +-2.1439962008875644e-03 +-2.1729405780571160e-03 +-2.2050207290133846e-03 +-2.2382243857777769e-03 +-2.2684477954704831e-03 +-2.2891004414348245e-03 +-2.2923052136781465e-03 +-2.2715908966696838e-03 +-2.2243616407733430e-03 +-2.1525545604337321e-03 +-2.0614685446752818e-03 +-1.9578512422689762e-03 +-1.8482619552397730e-03 +-1.7381242777029331e-03 +-1.6314085335861514e-03 +-1.5307097370090596e-03 +-1.4375033322393141e-03 +-1.3524385626510291e-03 +-1.2756001192355598e-03 +-1.2067142518727527e-03 +-1.1452989768314763e-03 +-1.0907674523059072e-03 +-1.0424956991478731e-03 +-9.9986476415026568e-04 +-9.6228534507287740e-04 +-9.2921080586906677e-04 +-9.0014276904428414e-04 +-8.7463214570911618e-04 +-8.5227750742893202e-04 +-8.3272203670817907e-04 +-8.1564984005928450e-04 +-8.0078210518998660e-04 +-7.8787338627487225e-04 +-7.7670817347691532e-04 +-7.6709782255779987e-04 +-7.5887787031531963e-04 +-7.5190573205468540e-04 +-7.4605876009646317e-04 +-7.4123263380845817e-04 +-7.3734004778796755e-04 +-7.3430966465626638e-04 +-7.3208530033134090e-04 +-7.3062531278851042e-04 +-7.2990216895862090e-04 +-2.0571951315676417e-03 +-2.0612605310381654e-03 +-2.0694184014553529e-03 +-2.0817210707046140e-03 +-2.0982363950611828e-03 +-2.1190179625051298e-03 +-2.1440357357361442e-03 +-2.1730297099043921e-03 +-2.2051942869989868e-03 +-2.2385374890012567e-03 +-2.2689677860400037e-03 +-2.2898763486427416e-03 +-2.2933335099102618e-03 +-2.2728079180852644e-03 +-2.2256680624754234e-03 +-2.1538504493293560e-03 +-2.0626776339061946e-03 +-1.9589285291456075e-03 +-1.8491897673886661e-03 +-1.7389039434437020e-03 +-1.6320522880784601e-03 +-1.5312346893201594e-03 +-1.4379276497038390e-03 +-1.3527793809926139e-03 +-1.2758725937725755e-03 +-1.2069312806207025e-03 +-1.1454712774795945e-03 +-1.0909037989997054e-03 +-1.0426032103142023e-03 +-9.9994918568095952e-04 +-9.6235130393360025e-04 +-9.2926202585766717e-04 +-9.0018224879381326e-04 +-8.7466230274308473e-04 +-8.5230029334116371e-04 +-8.3273902857646822e-04 +-8.1566231271303633e-04 +-8.0079108827117544e-04 +-7.8787970935040568e-04 +-7.7671250183719944e-04 +-7.6710068581178426e-04 +-7.5887968545294306e-04 +-7.5190682229735661e-04 +-7.4605937056968733e-04 +-7.4123294484678348e-04 +-7.3734018649919712e-04 +-7.3430971523014935e-04 +-7.3208531346152794e-04 +-7.3062531448888843e-04 +-7.2990216898514710e-04 +-2.0571887352718245e-03 +-2.0612541700220856e-03 +-2.0694123436268293e-03 +-2.0817160567517348e-03 +-2.0982338946850068e-03 +-2.1190204680723549e-03 +-2.1440472013463381e-03 +-2.1730565234858445e-03 +-2.2052472638944280e-03 +-2.2386337346911277e-03 +-2.2691281808978770e-03 +-2.2901160519760780e-03 +-2.2936513410212168e-03 +-2.2731840556407873e-03 +-2.2260716882691505e-03 +-2.1542506284463730e-03 +-2.0630508126913993e-03 +-1.9592608534120259e-03 +-1.8494758376330759e-03 +-1.7391442233188003e-03 +-1.6322505967405591e-03 +-1.5313963372904223e-03 +-1.4380582627255398e-03 +-1.3528842577212536e-03 +-1.2759564156120302e-03 +-1.2069980284310378e-03 +-1.1455242569239157e-03 +-1.0909457147107874e-03 +-1.0426362554309969e-03 +-9.9997512967996529e-04 +-9.6237157114804515e-04 +-9.2927776219492713e-04 +-9.0019437672529722e-04 +-8.7467156577183762e-04 +-8.5230729153232038e-04 +-8.3274424673992088e-04 +-8.1566614267197281e-04 +-8.0079384643689903e-04 +-7.8788165061156087e-04 +-7.7671383057785492e-04 +-7.6710156471011543e-04 +-7.5888024257611726e-04 +-7.5190715689979698e-04 +-7.4605955791325431e-04 +-7.4123304029223786e-04 +-7.3734022906169004e-04 +-7.3430973074789844e-04 +-7.3208531749085028e-04 +-7.3062531501241008e-04 +-7.2990216899907737e-04 +-2.0571877672976922e-03 +-2.0612532074584669e-03 +-2.0694114264551648e-03 +-2.0817152969462537e-03 +-2.0982335194543781e-03 +-2.1190208736761975e-03 +-2.1440490344988845e-03 +-2.1730608455901505e-03 +-2.2052558575918349e-03 +-2.2386493535275693e-03 +-2.2691540931668247e-03 +-2.2901545294109946e-03 +-2.2937020415194687e-03 +-2.2732437380013938e-03 +-2.2261354546930421e-03 +-2.1543136285041052e-03 +-2.0631093930288482e-03 +-1.9593128949422132e-03 +-1.8495205437267744e-03 +-1.7391817063323115e-03 +-1.6322814836609639e-03 +-1.5314214790374981e-03 +-1.4380785521277536e-03 +-1.3529005310658061e-03 +-1.2759694089578657e-03 +-1.2070083658717438e-03 +-1.1455324554732135e-03 +-1.0909521965310003e-03 +-1.0426413622498501e-03 +-9.9997913678916877e-04 +-9.6237469984242522e-04 +-9.2928019029763366e-04 +-9.0019624723493687e-04 +-8.7467299383648474e-04 +-8.5230837000925791e-04 +-8.3274505059685036e-04 +-8.1566673245851782e-04 +-8.0079427102015713e-04 +-7.8788194933512195e-04 +-7.7671403497264172e-04 +-7.6710169985945691e-04 +-7.5888032821581366e-04 +-7.5190720831678224e-04 +-7.4605958669241197e-04 +-7.4123305495009081e-04 +-7.3734023559670248e-04 +-7.3430973313049332e-04 +-7.3208531811041566e-04 +-7.3062531509534288e-04 +-7.2990216900935267e-04 +-2.0571877672962619e-03 +-2.0612532074570336e-03 +-2.0694114264537262e-03 +-2.0817152969448065e-03 +-2.0982335194529192e-03 +-2.1190208736747243e-03 +-2.1440490344973935e-03 +-2.1730608455886404e-03 +-2.2052558575903049e-03 +-2.2386493535260219e-03 +-2.2691540931652709e-03 +-2.2901545294094551e-03 +-2.2937020415179712e-03 +-2.2732437379999718e-03 +-2.2261354546917215e-03 +-2.1543136285029057e-03 +-2.0631093930277753e-03 +-1.9593128949412660e-03 +-1.8495205437259452e-03 +-1.7391817063315887e-03 +-1.6322814836603361e-03 +-1.5314214790369536e-03 +-1.4380785521272811e-03 +-1.3529005310653958e-03 +-1.2759694089575096e-03 +-1.2070083658714339e-03 +-1.1455324554729444e-03 +-1.0909521965307661e-03 +-1.0426413622496463e-03 +-9.9997913678899117e-04 +-9.6237469984227137e-04 +-9.2928019029750041e-04 +-9.0019624723482173e-04 +-8.7467299383638564e-04 +-8.5230837000917290e-04 +-8.3274505059677847e-04 +-8.1566673245845711e-04 +-8.0079427102010617e-04 +-7.8788194933507999e-04 +-7.7671403497260767e-04 +-7.6710169985942992e-04 +-7.5888032821579273e-04 +-7.5190720831676641e-04 +-7.4605958669240124e-04 +-7.4123305495008365e-04 +-7.3734023559669901e-04 +-7.3430973313049288e-04 +-7.3208531811041783e-04 +-7.3062531509534906e-04 +-7.2990216900937046e-04 +-2.0571887352703920e-03 +-2.0612541700206497e-03 +-2.0694123436253878e-03 +-2.0817160567502845e-03 +-2.0982338946835457e-03 +-2.1190204680708786e-03 +-2.1440472013448441e-03 +-2.1730565234843310e-03 +-2.2052472638928950e-03 +-2.2386337346895777e-03 +-2.2691281808963205e-03 +-2.2901160519745354e-03 +-2.2936513410197171e-03 +-2.2731840556393622e-03 +-2.2260716882678278e-03 +-2.1542506284451704e-03 +-2.0630508126903233e-03 +-1.9592608534110762e-03 +-1.8494758376322439e-03 +-1.7391442233180747e-03 +-1.6322505967399285e-03 +-1.5313963372898753e-03 +-1.4380582627250651e-03 +-1.3528842577208414e-03 +-1.2759564156116718e-03 +-1.2069980284307256e-03 +-1.1455242569236440e-03 +-1.0909457147105506e-03 +-1.0426362554307911e-03 +-9.9997512967978553e-04 +-9.6237157114788913e-04 +-9.2927776219479139e-04 +-9.0019437672517991e-04 +-8.7467156577173658e-04 +-8.5230729153223375e-04 +-8.3274424673984672e-04 +-8.1566614267191014e-04 +-8.0079384643684602e-04 +-7.8788165061151707e-04 +-7.7671383057781882e-04 +-7.6710156471008627e-04 +-7.5888024257609417e-04 +-7.5190715689977909e-04 +-7.4605955791324130e-04 +-7.4123304029222886e-04 +-7.3734022906168418e-04 +-7.3430973074789573e-04 +-7.3208531749084996e-04 +-7.3062531501241366e-04 +-7.2990216899909146e-04 +-2.0571951315662088e-03 +-2.0612605310367294e-03 +-2.0694184014539117e-03 +-2.0817210707031642e-03 +-2.0982363950597218e-03 +-2.1190179625036540e-03 +-2.1440357357346506e-03 +-2.1730297099028795e-03 +-2.2051942869974542e-03 +-2.2385374889997076e-03 +-2.2689677860384485e-03 +-2.2898763486412007e-03 +-2.2933335099087630e-03 +-2.2728079180838407e-03 +-2.2256680624741015e-03 +-2.1538504493281542e-03 +-2.0626776339051200e-03 +-1.9589285291446582e-03 +-1.8491897673878347e-03 +-1.7389039434429778e-03 +-1.6320522880778311e-03 +-1.5312346893196133e-03 +-1.4379276497033650e-03 +-1.3527793809922025e-03 +-1.2758725937722178e-03 +-1.2069312806203916e-03 +-1.1454712774793237e-03 +-1.0909037989994699e-03 +-1.0426032103139971e-03 +-9.9994918568078106e-04 +-9.6235130393344521e-04 +-9.2926202585753251e-04 +-9.0018224879369704e-04 +-8.7466230274298466e-04 +-8.5230029334107805e-04 +-8.3273902857639536e-04 +-8.1566231271297464e-04 +-8.0079108827112340e-04 +-7.8787970935036286e-04 +-7.7671250183716464e-04 +-7.6710068581175629e-04 +-7.5887968545292127e-04 +-7.5190682229734002e-04 +-7.4605937056967540e-04 +-7.4123294484677556e-04 +-7.3734018649919235e-04 +-7.3430971523014751e-04 +-7.3208531346152870e-04 +-7.3062531448889266e-04 +-7.2990216898516131e-04 +-2.0572136705329417e-03 +-2.0612789527874810e-03 +-2.0694358244076885e-03 +-2.0817350685496810e-03 +-2.0982421797195896e-03 +-2.1190074617671098e-03 +-2.1439962008860634e-03 +-2.1729405780555955e-03 +-2.2050207290118442e-03 +-2.2382243857762200e-03 +-2.2684477954689202e-03 +-2.2891004414332754e-03 +-2.2923052136766407e-03 +-2.2715908966682526e-03 +-2.2243616407720142e-03 +-2.1525545604325234e-03 +-2.0614685446742006e-03 +-1.9578512422680204e-03 +-1.8482619552389358e-03 +-1.7381242777022028e-03 +-1.6314085335855169e-03 +-1.5307097370085081e-03 +-1.4375033322388351e-03 +-1.3524385626506130e-03 +-1.2756001192351979e-03 +-1.2067142518724376e-03 +-1.1452989768312018e-03 +-1.0907674523056676e-03 +-1.0424956991476645e-03 +-9.9986476415008354e-04 +-9.6228534507271910e-04 +-9.2921080586892907e-04 +-9.0014276904416476e-04 +-8.7463214570901308e-04 +-8.5227750742884333e-04 +-8.3272203670810307e-04 +-8.1564984005922010e-04 +-8.0078210518993184e-04 +-7.8787338627482660e-04 +-7.7670817347687759e-04 +-7.6709782255776919e-04 +-7.5887787031529502e-04 +-7.5190573205466610e-04 +-7.4605876009644842e-04 +-7.4123263380844755e-04 +-7.3734004778795996e-04 +-7.3430966465626182e-04 +-7.3208530033133873e-04 +-7.3062531278851161e-04 +-7.2990216895863153e-04 +-2.0572420125631076e-03 +-2.0613069963733924e-03 +-2.0694614576557227e-03 +-2.0817525206436979e-03 +-2.0982400910665982e-03 +-2.1189666703491468e-03 +-2.1438863023997088e-03 +-2.1727123138945040e-03 +-2.2045910608093750e-03 +-2.2374635742105952e-03 +-2.2671995286091566e-03 +-2.2872528303304615e-03 +-2.2898690615514423e-03 +-2.2687162533973431e-03 +-2.2212808088951765e-03 +-2.1495008953626910e-03 +-2.0586201583513231e-03 +-1.9553133033972723e-03 +-1.8460757865684310e-03 +-1.7362867391442316e-03 +-1.6298909111869704e-03 +-1.5294718559802050e-03 +-1.4365025031725742e-03 +-1.3516344934716292e-03 +-1.2749571529319713e-03 +-1.2062020258765058e-03 +-1.1448922489505770e-03 +-1.0904455488559962e-03 +-1.0422418412326883e-03 +-9.9966540348220170e-04 +-9.6212956840572683e-04 +-9.2908982785022080e-04 +-9.0004951350876545e-04 +-8.7456090662433824e-04 +-8.5222367766445346e-04 +-8.3268189267633849e-04 +-8.1562037139581078e-04 +-8.0076088022757634e-04 +-7.8785844565464622e-04 +-7.7669794570222423e-04 +-7.6709105652512238e-04 +-7.5887358088836678e-04 +-7.5190315557096871e-04 +-7.4605731736912539e-04 +-7.4123189871314076e-04 +-7.3733971995566295e-04 +-7.3430954512722650e-04 +-7.3208526929930578e-04 +-7.3062530877234053e-04 +-7.2990216890452214e-04 +-2.0572330791680539e-03 +-2.0612973687662572e-03 +-2.0694468462463620e-03 +-2.0817213760960956e-03 +-2.0981697173367213e-03 +-2.1188185575119426e-03 +-2.1435985908716845e-03 +-2.1721840661946832e-03 +-2.2036544890442593e-03 +-2.2358642540550012e-03 +-2.2646406904336435e-03 +-2.2835309126882468e-03 +-2.2850172513620868e-03 +-2.2630310159161933e-03 +-2.2152121542498718e-03 +-2.1434985072177684e-03 +-2.0530267858284894e-03 +-1.9503311794992003e-03 +-1.8417840378245618e-03 +-1.7326785707109230e-03 +-1.6269099818119338e-03 +-1.5270395568770913e-03 +-1.4345353118752084e-03 +-1.3500535369847502e-03 +-1.2736925845098365e-03 +-1.2051943288596278e-03 +-1.1440919113705646e-03 +-1.0898119955156567e-03 +-1.0417421232730895e-03 +-9.9927290318952734e-04 +-9.6182283583213135e-04 +-9.2885158888052557e-04 +-8.9986585007171269e-04 +-8.7442059228859978e-04 +-8.5211764576008863e-04 +-8.3260281371493159e-04 +-8.1556231868621504e-04 +-8.0071906563492867e-04 +-7.8782901053803332e-04 +-7.7667779490544998e-04 +-7.6707772569482987e-04 +-7.5886512940745660e-04 +-7.5189807900559826e-04 +-7.4605447464537195e-04 +-7.4123045027240807e-04 +-7.3733907398269068e-04 +-7.3430930960061006e-04 +-7.3208520815220993e-04 +-7.3062530086016409e-04 +-7.2990216880307118e-04 +-2.0570061424615691e-03 +-2.0610688220898199e-03 +-2.0692086225438384e-03 +-2.0814523253022995e-03 +-2.0978283496588613e-03 +-2.1183337480337704e-03 +-2.1428543332554268e-03 +-2.1709909589025496e-03 +-2.2017074375119822e-03 +-2.2327242609486856e-03 +-2.2598238687480481e-03 +-2.2767318530341678e-03 +-2.2763296634416442e-03 +-2.2529771002056599e-03 +-2.2045579479745498e-03 +-2.1330021128862417e-03 +-2.0432642822167985e-03 +-1.9416417253927296e-03 +-1.8342989877347617e-03 +-1.7263837354432674e-03 +-1.6217069060804916e-03 +-1.5227917621612808e-03 +-1.4310978929064945e-03 +-1.3472895712310143e-03 +-1.2714806978176489e-03 +-1.2034309860795365e-03 +-1.1426908911462467e-03 +-1.0887025704180040e-03 +-1.0408668087533630e-03 +-9.9858522361434316e-04 +-9.6128531231972584e-04 +-9.2843402006119880e-04 +-8.9954388881808049e-04 +-8.7417459060020386e-04 +-8.5193172895661707e-04 +-8.3246414412349568e-04 +-8.1546051248010550e-04 +-8.0064573163201051e-04 +-7.8777738504485627e-04 +-7.7664245156795471e-04 +-7.6705434345840037e-04 +-7.5885030516868940e-04 +-7.5188917433134455e-04 +-7.4604948821981043e-04 +-7.4122790953058183e-04 +-7.3733794085710091e-04 +-7.3430889645191794e-04 +-7.3208510089101413e-04 +-7.3062528698199366e-04 +-7.2990216862851842e-04 +-2.0560409086203607e-03 +-2.0600997322595582e-03 +-2.0682205564139392e-03 +-2.0804072435736767e-03 +-2.0966521229924037e-03 +-2.1168986363673775e-03 +-2.1409514764393904e-03 +-2.1682867432214325e-03 +-2.1976942333812219e-03 +-2.2267262770220325e-03 +-2.2511575796452547e-03 +-2.2650274805668690e-03 +-2.2618176119183469e-03 +-2.2365001920130801e-03 +-2.1872937546096793e-03 +-2.1160991264248803e-03 +-2.0275910033077812e-03 +-1.9277073772048924e-03 +-1.8222970546086961e-03 +-1.7162853174562363e-03 +-1.6133535220424393e-03 +-1.5159660989776229e-03 +-1.4255695330295118e-03 +-1.3428405968396232e-03 +-1.2679176352051044e-03 +-1.2005885136093090e-03 +-1.1404311019069080e-03 +-1.0869121622207002e-03 +-1.0394535628349127e-03 +-9.9747448685778926e-04 +-9.6041681450408816e-04 +-9.2775914516380470e-04 +-8.9902340988397397e-04 +-8.7377682719924144e-04 +-8.5163106757309864e-04 +-8.3223985943371530e-04 +-8.1529583244442118e-04 +-8.0052709714849735e-04 +-7.8769386309675738e-04 +-7.7658526841453473e-04 +-7.6701651094713912e-04 +-7.5882631874175715e-04 +-7.5187476573843905e-04 +-7.4604141957920799e-04 +-7.4122379825272049e-04 +-7.3733610728526726e-04 +-7.3430822791019552e-04 +-7.3208492732465135e-04 +-7.3062526452551027e-04 +-7.2990216834853232e-04 +-2.0529840591902984e-03 +-2.0570334375751799e-03 +-2.0651154975552021e-03 +-2.0771936839209058e-03 +-2.0931968673704557e-03 +-2.1129756638016976e-03 +-2.1362012482404789e-03 +-2.1621652586452916e-03 +-2.1894399531872020e-03 +-2.2154232472028092e-03 +-2.2359854309761834e-03 +-2.2456620771985213e-03 +-2.2387412022506375e-03 +-2.2109667931580331e-03 +-2.1609544670893759e-03 +-2.0905341069071860e-03 +-2.0039872415523480e-03 +-1.9067561804988838e-03 +-1.8042525144383293e-03 +-1.7010908838761723e-03 +-1.6007698465320790e-03 +-1.5056700392664325e-03 +-1.4172191139614661e-03 +-1.3361119386864121e-03 +-1.2625224942077954e-03 +-1.1962799354656034e-03 +-1.1370025506552263e-03 +-1.0841935419015809e-03 +-1.0373061254405412e-03 +-9.9578569157839883e-04 +-9.5909564363846488e-04 +-9.2673206678786093e-04 +-8.9823101207513591e-04 +-8.7317107048802021e-04 +-8.5117307198067759e-04 +-8.3189813696816909e-04 +-8.1504488202971317e-04 +-8.0034628971415085e-04 +-7.8756655621390476e-04 +-7.7649810085892118e-04 +-7.6695883711713699e-04 +-7.5878975092767676e-04 +-7.5185279881711923e-04 +-7.4602911808724197e-04 +-7.4121753008372590e-04 +-7.3733331174448272e-04 +-7.3430720861800451e-04 +-7.3208466269610538e-04 +-7.3062523028768187e-04 +-7.2990216792351260e-04 +-2.0445785385829244e-03 +-2.0486054362218093e-03 +-2.0566089775683333e-03 +-2.0684847962336704e-03 +-2.0840575414765240e-03 +-2.1030329065261024e-03 +-2.1248924996249518e-03 +-2.1487027329278505e-03 +-2.1728267434262629e-03 +-2.1945978763653795e-03 +-2.2101491325072068e-03 +-2.2147045235395009e-03 +-2.2035133473188723e-03 +-2.1731753555191990e-03 +-2.1227100921976383e-03 +-2.0538140857179138e-03 +-1.9702649033938864e-03 +-1.8768807782345270e-03 +-1.7785190960208697e-03 +-1.6793955685221853e-03 +-1.5827705462068205e-03 +-1.4909138360183045e-03 +-1.4052276970652402e-03 +-1.3264312625875425e-03 +-1.2547469995808254e-03 +-1.1900607885008928e-03 +-1.1320468923487848e-03 +-1.0802593240456558e-03 +-1.0341952684614188e-03 +-9.9333706243850636e-04 +-9.5717858795339901e-04 +-9.2524078873744626e-04 +-8.9707985891323910e-04 +-8.7229066271217188e-04 +-8.5050717245156000e-04 +-8.3140114058556473e-04 +-8.1467981341229825e-04 +-8.0008320959158176e-04 +-7.8738129248781227e-04 +-7.7637123501913760e-04 +-7.6687488973353377e-04 +-7.5873652104484191e-04 +-7.5182082124135839e-04 +-7.4601121006960872e-04 +-7.4120840495613832e-04 +-7.3732924198137190e-04 +-7.3430572471801128e-04 +-7.3208427744515911e-04 +-7.3062518044405861e-04 +-7.2990216730623955e-04 +-2.0242461661127698e-03 +-2.0282242363715156e-03 +-2.0360821677369700e-03 +-2.0476194495579261e-03 +-2.0625167563644107e-03 +-2.0802913102763608e-03 +-2.1002043466048187e-03 +-2.1211058207226850e-03 +-2.1412263621980476e-03 +-2.1579837284433400e-03 +-2.1679517808257777e-03 +-2.1671776510138411e-03 +-2.1519205228520974e-03 +-2.1196142497842902e-03 +-2.0696277466763801e-03 +-2.0034548395823858e-03 +-1.9242861018082770e-03 +-1.8362230884649963e-03 +-1.7434793772163738e-03 +-1.6497985100123358e-03 +-1.5581529135010655e-03 +-1.4706753244599694e-03 +-1.3887352748389850e-03 +-1.3130817350210211e-03 +-1.2439986894022688e-03 +-1.1814451358920207e-03 +-1.1251683676211106e-03 +-1.0747893603843173e-03 +-1.0298637431780907e-03 +-9.8992332717596143e-04 +-9.5450307079250304e-04 +-9.2315760900758825e-04 +-8.9547057189682047e-04 +-8.7105908624518177e-04 +-8.4957517403622357e-04 +-8.3070524056157191e-04 +-8.1416846225356365e-04 +-7.9971461151913956e-04 +-7.8712166567369119e-04 +-7.7619341689149485e-04 +-7.6675721248072081e-04 +-7.5866189677309100e-04 +-7.5177598826362880e-04 +-7.4598610173688749e-04 +-7.4119561053136488e-04 +-7.3732353564289279e-04 +-7.3430364408104659e-04 +-7.3208373726743484e-04 +-7.3062511055638332e-04 +-7.2990216644191032e-04 +-1.9822025053599732e-03 +-1.9860878382733445e-03 +-1.9937082202546152e-03 +-2.0047594186738860e-03 +-2.0187701473649167e-03 +-2.0350690282437528e-03 +-2.0527199412162119e-03 +-2.0704212138452668e-03 +-2.0863857388683390e-03 +-2.0982574953723287e-03 +-2.1031612647201096e-03 +-2.0979863018459983e-03 +-2.0799241219842724e-03 +-2.0471246956345591e-03 +-1.9992106157615459e-03 +-1.9374184963262243e-03 +-1.8643189385009775e-03 +-1.7832621085309261e-03 +-1.6977746424065828e-03 +-1.6110832352265673e-03 +-1.5258357874639277e-03 +-1.4440050378336500e-03 +-1.3669190963289948e-03 +-1.2953596492549665e-03 +-1.2296828825808651e-03 +-1.1699358880073337e-03 +-1.1159555749739752e-03 +-1.0674463007949303e-03 +-1.0240373630854265e-03 +-9.8532358918752361e-04 +-9.5089273136416764e-04 +-9.2034306894109026e-04 +-8.9329402005366813e-04 +-8.6939192961495951e-04 +-8.4831263776900291e-04 +-8.2976197933829583e-04 +-8.1347501821642839e-04 +-7.9921456550950893e-04 +-7.8676934731669308e-04 +-7.7595205958977701e-04 +-7.6659745888008751e-04 +-7.5856057759643284e-04 +-7.5171511222902080e-04 +-7.4595200668747645e-04 +-7.4117823614369281e-04 +-7.3731578647815202e-04 +-7.3430081856453930e-04 +-7.3208300370052742e-04 +-7.3062501564845957e-04 +-7.2990216526913349e-04 +-1.9091991693579054e-03 +-1.9129328856139483e-03 +-1.9202113884974892e-03 +-1.9306539465771273e-03 +-1.9436795547161248e-03 +-1.9584881127090062e-03 +-1.9740268279929670e-03 +-1.9889429860351503e-03 +-2.0015379903065528e-03 +-2.0097587355800907e-03 +-2.0112808443800007e-03 +-2.0037329700888472e-03 +-1.9850626224303344e-03 +-1.9539607713705024e-03 +-1.9101963661684279e-03 +-1.8547227587147296e-03 +-1.7895122387626130e-03 +-1.7171904189394478e-03 +-1.6406056862283149e-03 +-1.5624572706154814e-03 +-1.4850485729696993e-03 +-1.4101734445455681e-03 +-1.3391068949402589e-03 +-1.2726604972287075e-03 +-1.2112674749138123e-03 +-1.1550732039213724e-03 +-1.1040174092714437e-03 +-1.0579021570776886e-03 +-1.0164445714400700e-03 +-9.7931570315419451e-04 +-9.4616796183220994e-04 +-9.1665365874693918e-04 +-8.9043693901696497e-04 +-8.6720096975024120e-04 +-8.4665183098391245e-04 +-8.2852018835510648e-04 +-8.1256152874411051e-04 +-7.9855551091890359e-04 +-7.8630481262658759e-04 +-7.7563373176871633e-04 +-7.6638671120047772e-04 +-7.5842689505574142e-04 +-7.5163478205737507e-04 +-7.4590701251853154e-04 +-7.4115530664870314e-04 +-7.3730555941181619e-04 +-7.3429708950471502e-04 +-7.3208203554954161e-04 +-7.3062489039053011e-04 +-7.2990216372212076e-04 +-1.8021185188136512e-03 +-1.8056379840429293e-03 +-1.8124747796456635e-03 +-1.8222225266078496e-03 +-1.8342659163791298e-03 +-1.8477728330063745e-03 +-1.8616835881037001e-03 +-1.8747008609612688e-03 +-1.8852907147227742e-03 +-1.8917144227960129e-03 +-1.8921175279315949e-03 +-1.8846969579700888e-03 +-1.8679411685602111e-03 +-1.8408969180858845e-03 +-1.8033822744214117e-03 +-1.7560668403456307e-03 +-1.7003845669182930e-03 +-1.6383077532403601e-03 +-1.5720558145758917e-03 +-1.5038187796535590e-03 +-1.4355502168304716e-03 +-1.3688487416260052e-03 +-1.3049192843091360e-03 +-1.2445914926392276e-03 +-1.1883707978153748e-03 +-1.1365024038679707e-03 +-1.0890351267344443e-03 +-1.0458779556090190e-03 +-1.0068464789450562e-03 +-9.7169892590221114e-04 +-9.4016291685428024e-04 +-9.1195453668326920e-04 +-8.8679139672427924e-04 +-8.6440117575669977e-04 +-8.4452687175159513e-04 +-8.2692973151151034e-04 +-8.1139059048247991e-04 +-7.9771016192323413e-04 +-7.8570866333762385e-04 +-7.7522505344653132e-04 +-7.6611606823257048e-04 +-7.5825518315282981e-04 +-7.5153158480402687e-04 +-7.4584920455184121e-04 +-7.4112584535935037e-04 +-7.3729241858688560e-04 +-7.3429229793716278e-04 +-7.3208079154029172e-04 +-7.3062472944262699e-04 +-7.2990216173502136e-04 +-1.6665444423997193e-03 +-1.6697980872167216e-03 +-1.6761148491834851e-03 +-1.6851121290846402e-03 +-1.6962128098565437e-03 +-1.7086432753100544e-03 +-1.7214342991476192e-03 +-1.7334289461296407e-03 +-1.7433043234211332e-03 +-1.7496171079817357e-03 +-1.7508840395673480e-03 +-1.7457042529067893e-03 +-1.7329174544998304e-03 +-1.7117725178127060e-03 +-1.6820643657130107e-03 +-1.6441954294571732e-03 +-1.5991371659754528e-03 +-1.5482992965818521e-03 +-1.4933428885865589e-03 +-1.4359847209761084e-03 +-1.3778328164619747e-03 +-1.3202747453428378e-03 +-1.2644216650563639e-03 +-1.2110985216185720e-03 +-1.1608657214525059e-03 +-1.1140579811356568e-03 +-1.0708292501524920e-03 +-1.0311964394899770e-03 +-9.9507800005599616e-04 +-9.6232577248524470e-04 +-9.3275000622264988e-04 +-9.0613822864426814e-04 +-8.8226896554280973e-04 +-8.6092136203226284e-04 +-8.4188166054826924e-04 +-8.2494734325995890e-04 +-8.0992958678499064e-04 +-7.9665453094706934e-04 +-7.8496373972057436e-04 +-7.7471413312769119e-04 +-7.6577759165755599e-04 +-7.5804037631558836e-04 +-7.5140246400046422e-04 +-7.4577686618614622e-04 +-7.4108897603617223e-04 +-7.3727597282767174e-04 +-7.3428630116942426e-04 +-7.3207923462154025e-04 +-7.3062452801110308e-04 +-7.2990215924867798e-04 +-1.5143531935744006e-03 +-1.5173112415954547e-03 +-1.5230639669422236e-03 +-1.5312834744580894e-03 +-1.5414759543034284e-03 +-1.5529818814820093e-03 +-1.5649805452179622e-03 +-1.5765025908090684e-03 +-1.5864551685902852e-03 +-1.5936648212416060e-03 +-1.5969425535313614e-03 +-1.5951723508599539e-03 +-1.5874178460917698e-03 +-1.5730327626851850e-03 +-1.5517527909448977e-03 +-1.5237448475986866e-03 +-1.4895974891821950e-03 +-1.4502517230297685e-03 +-1.4068878993904728e-03 +-1.3607944698120721e-03 +-1.3132447938314156e-03 +-1.2654007015840496e-03 +-1.2182509297878937e-03 +-1.1725832771694754e-03 +-1.1289836392101705e-03 +-1.0878530824331703e-03 +-1.0494347117313541e-03 +-1.0138439527374347e-03 +-9.8109801150946451e-04 +-9.5114212670434535e-04 +-9.2387159148503699e-04 +-8.9914940096244805e-04 +-8.7681987465499940e-04 +-8.5671882924433836e-04 +-8.3868093574493831e-04 +-8.2254486152863004e-04 +-8.0815672074764742e-04 +-7.9537226632489034e-04 +-7.8405816902696432e-04 +-7.7409265181173934e-04 +-7.6536568320451906e-04 +-7.5777888176563194e-04 +-7.5124524335735856e-04 +-7.4568877204555573e-04 +-7.4104407222184889e-04 +-7.3725594223299435e-04 +-7.3427899706066232e-04 +-7.3207733826851349e-04 +-7.3062428266424295e-04 +-7.2990215622076857e-04 +-1.3589581178026259e-03 +-1.3616153419814690e-03 +-1.3667987789947158e-03 +-1.3742455335645888e-03 +-1.3835598833279159e-03 +-1.3942138392968111e-03 +-1.4055514849473164e-03 +-1.4167999296903790e-03 +-1.4270900098665054e-03 +-1.4354896863629112e-03 +-1.4410520838928900e-03 +-1.4428779036337136e-03 +-1.4401883440073868e-03 +-1.4324001662862828e-03 +-1.4191905970351586e-03 +-1.4005384841796508e-03 +-1.3767311587237320e-03 +-1.3483336190263707e-03 +-1.3161255524205826e-03 +-1.2810188812695253e-03 +-1.2439713993587774e-03 +-1.2059102532557340e-03 +-1.1676741010634018e-03 +-1.1299770765891069e-03 +-1.0933930544822466e-03 +-1.0583559797653723e-03 +-1.0251711180319267e-03 +-9.9403244980644030e-04 +-9.6504244494178724e-04 +-9.3823162390312619e-04 +-9.1357635690021070e-04 +-8.9101415152256758e-04 +-8.7045622371318852e-04 +-8.5179747642767580e-04 +-8.3492418165272012e-04 +-8.1971972750194703e-04 +-8.0606879463052030e-04 +-7.9386029478835374e-04 +-7.8298935817431030e-04 +-7.7335860684219957e-04 +-7.6487890493621090e-04 +-7.5746973584244078e-04 +-7.5105932229071104e-04 +-7.4558457780764937e-04 +-7.4099095598146117e-04 +-7.3723224683894467e-04 +-7.3427035635407676e-04 +-7.3207509487748488e-04 +-7.3062399241829968e-04 +-7.2990215263914464e-04 +-1.2115508556245188e-03 +-1.2139227636600123e-03 +-1.2185660369987692e-03 +-1.2252789330707667e-03 +-1.2337577788962756e-03 +-1.2435973079270449e-03 +-1.2542936956410336e-03 +-1.2652522825464928e-03 +-1.2758020969448130e-03 +-1.2852190443961584e-03 +-1.2927588613277300e-03 +-1.2976995118234541e-03 +-1.2993906465077231e-03 +-1.2973053194178413e-03 +-1.2910870157839913e-03 +-1.2805840888454852e-03 +-1.2658647350232103e-03 +-1.2472088227585200e-03 +-1.2250774663579657e-03 +-1.2000657277354602e-03 +-1.1728467462791311e-03 +-1.1441161548979535e-03 +-1.1145440367300891e-03 +-1.0847388244790207e-03 +-1.0552245250487814e-03 +-1.0264302631061901e-03 +-9.9868971531456765e-04 +-9.7224750142042241e-04 +-9.4726975077327790e-04 +-9.2385657354495830e-04 +-9.0205479207445822e-04 +-8.8186987547690015e-04 +-8.6327649602691090e-04 +-8.4622747041385757e-04 +-8.3066107511101073e-04 +-8.1650685773541529e-04 +-8.0369013197663147e-04 +-7.9213536536985266e-04 +-7.8176866443133630e-04 +-7.7251954279921123e-04 +-7.6432213308230386e-04 +-7.5711597699795014e-04 +-7.5084650376926816e-04 +-7.4546528492872293e-04 +-7.4093013505452116e-04 +-7.3720511247370873e-04 +-7.3426046128801997e-04 +-7.3207252579135138e-04 +-7.3062366003465097e-04 +-7.2990214853789698e-04 +-1.0795750330582488e-03 +-1.0816911707118959e-03 +-1.0858481801156808e-03 +-1.0918950408922627e-03 +-1.0996043884446082e-03 +-1.1086725796116991e-03 +-1.1187214935448500e-03 +-1.1293033802679397e-03 +-1.1399101469265890e-03 +-1.1499883142226299e-03 +-1.1589604029066554e-03 +-1.1662526721349677e-03 +-1.1713279523603197e-03 +-1.1737209445834699e-03 +-1.1730720972608186e-03 +-1.1691554389158046e-03 +-1.1618959380194276e-03 +-1.1513732652096906e-03 +-1.1378110520010158e-03 +-1.1215533041160929e-03 +-1.1030317962976211e-03 +-1.0827294524347853e-03 +-1.0611446856791252e-03 +-1.0387606414541941e-03 +-1.0160217178253991e-03 +-9.9331813312020342e-04 +-9.7097803069170054e-04 +-9.4926581273820922e-04 +-9.2838506402914179e-04 +-9.0848444841111573e-04 +-8.8966519466492631e-04 +-8.7198911075041035e-04 +-8.5548639131554206e-04 +-8.4016276491627950e-04 +-8.2600574603809544e-04 +-8.1298991238626112e-04 +-8.0108122902913283e-04 +-7.9024050008360278e-04 +-7.8042605768796560e-04 +-7.7159580708156925e-04 +-7.6370874339999823e-04 +-7.5672604578909571e-04 +-7.5061184131203771e-04 +-7.4533371717427270e-04 +-7.4086304635852696e-04 +-7.3717517952696129e-04 +-7.3424954528328334e-04 +-7.3206969160556840e-04 +-7.3062329335308988e-04 +-7.2990214401371441e-04 +-9.6691724431654115e-04 +-9.6881466774800340e-04 +-9.7255363724721726e-04 +-9.7802203914043855e-04 +-9.8505105098709109e-04 +-9.9341503502963164e-04 +-1.0028324826290619e-03 +-1.0129688457205354e-03 +-1.0234421503562698e-03 +-1.0338322095750304e-03 +-1.0436939946102349e-03 +-1.0525752585371520e-03 +-1.0600378470850247e-03 +-1.0656813495343884e-03 +-1.0691669809333867e-03 +-1.0702390441969403e-03 +-1.0687412029327173e-03 +-1.0646252377202606e-03 +-1.0579509463242381e-03 +-1.0488771890032999e-03 +-1.0376454482787659e-03 +-1.0245583240877313e-03 +-1.0099558840061444e-03 +-9.9419268191477408e-04 +-9.7761767138081213e-04 +-9.6055839879132855e-04 +-9.4331000057289898e-04 +-9.2612882097992621e-04 +-9.0922999480468861e-04 +-8.9278810673578692e-04 +-8.7693999994070692e-04 +-8.6178889568951837e-04 +-8.4740914150685249e-04 +-8.3385107993781465e-04 +-8.2114569318937158e-04 +-8.0930881515628190e-04 +-7.9834480677709997e-04 +-7.8824966485039705e-04 +-7.7901358309238747e-04 +-7.7062301303990630e-04 +-7.6306228682798108e-04 +-7.5631486848749070e-04 +-7.5036429878470921e-04 +-7.4519489337147317e-04 +-7.4079224694049625e-04 +-7.3714358836096552e-04 +-7.3423802412665999e-04 +-7.3206670026743624e-04 +-7.3062290633976387e-04 +-7.2990213923889422e-04 +-8.7486219778901001e-04 +-8.7658058857882149e-04 +-8.7997558647353051e-04 +-8.8496336152674225e-04 +-8.9141766528250978e-04 +-8.9916964767423055e-04 +-9.0800829098133524e-04 +-9.1768198620865223e-04 +-9.2790182260460549e-04 +-9.3834712978967691e-04 +-9.4867368024048582e-04 +-9.5852471220639497e-04 +-9.6754457264779244e-04 +-9.7539433816127554e-04 +-9.8176831478827319e-04 +-9.8640994032419562e-04 +-9.8912542159404005e-04 +-9.8979352020433825e-04 +-9.8837028391408834e-04 +-9.8488815794377108e-04 +-9.7944967568744097e-04 +-9.7221665335976346e-04 +-9.6339634099193482e-04 +-9.5322621637307749e-04 +-9.4195903743938246e-04 +-9.2984945695941156e-04 +-9.1714305921496262e-04 +-9.0406821371822818e-04 +-8.9083074176986321e-04 +-8.7761110466024373e-04 +-8.6456365744875835e-04 +-8.5181745363290006e-04 +-8.3947810509124240e-04 +-8.2763026795445679e-04 +-8.1634041260471313e-04 +-8.0565962616063747e-04 +-7.9562627716937427e-04 +-7.8626843929402749e-04 +-7.7760602215491605e-04 +-7.6965259423451035e-04 +-7.6241690717188289e-04 +-7.5590414551159057e-04 +-7.5011693356335596e-04 +-7.4505613363503719e-04 +-7.4072146924029230e-04 +-7.3711200423386863e-04 +-7.3422650510385115e-04 +-7.3206370945067781e-04 +-7.3062251939431087e-04 +-7.2990213446506597e-04 +-8.0313947294324286e-04 +-8.0471815323956606e-04 +-8.0784353338417335e-04 +-8.1245145861492095e-04 +-8.1844530824545640e-04 +-8.2569579424920817e-04 +-8.3404111974069576e-04 +-8.4328783049131110e-04 +-8.5321272656303923e-04 +-8.6356619233730946e-04 +-8.7407723851557493e-04 +-8.8446041978484317e-04 +-8.9442459618622680e-04 +-9.0368325776341040e-04 +-9.1196586038850853e-04 +-9.1902937105627005e-04 +-9.2466904770836236e-04 +-9.2872743257026657e-04 +-9.3110065046442942e-04 +-9.3174137291209479e-04 +-9.3065819489625257e-04 +-9.2791160248085884e-04 +-9.2360710202163984e-04 +-9.1788636256859703e-04 +-9.1091735011206219e-04 +-9.0288440246397877e-04 +-8.9397903785086831e-04 +-8.8439205977175429e-04 +-8.7430726958413372e-04 +-8.6389687076487000e-04 +-8.5331847209765290e-04 +-8.4271348116037265e-04 +-8.3220662101021877e-04 +-8.2190629054483652e-04 +-8.1190550841098239e-04 +-8.0228321799862869e-04 +-7.9310577611186196e-04 +-7.8442849274062336e-04 +-7.7629712940427138e-04 +-7.6874929664651236e-04 +-7.6181571694028025e-04 +-7.5552133803617110e-04 +-7.4988629468635448e-04 +-7.4492672488678767e-04 +-7.4065545144957954e-04 +-7.3708254183217257e-04 +-7.3421575951364054e-04 +-7.3206091942177101e-04 +-7.3062215842692468e-04 +-7.2990213001186384e-04 +-7.5076474166962742e-04 +-7.5224126295874263e-04 +-7.5516880479178277e-04 +-7.5949621818149427e-04 +-7.6514647378642217e-04 +-7.7201646817154075e-04 +-7.7997704525234642e-04 +-7.8887345246674999e-04 +-7.9852647658715367e-04 +-8.0873450470258341e-04 +-8.1927672435650693e-04 +-8.2991760747997724e-04 +-8.4041271410231582e-04 +-8.5051570890492525e-04 +-8.5998631986306342e-04 +-8.6859880527226797e-04 +-8.7615036124238162e-04 +-8.8246882519158094e-04 +-8.8741903496504266e-04 +-8.9090729781032905e-04 +-8.9288360050715878e-04 +-8.9334142527852385e-04 +-8.9231528658211153e-04 +-8.8987632885535381e-04 +-8.8612648912973161e-04 +-8.8119181063151875e-04 +-8.7521549182712215e-04 +-8.6835118374377124e-04 +-8.6075693075965973e-04 +-8.5259001317467031e-04 +-8.4400281713110567e-04 +-8.3513974522586294e-04 +-8.2613509781254548e-04 +-8.1711180198300239e-04 +-8.0818083917067731e-04 +-7.9944121732424304e-04 +-7.9098034308610135e-04 +-7.8287466739096088e-04 +-7.7519049960613309e-04 +-7.6798490739449687e-04 +-7.6130663978179070e-04 +-7.5519702835636238e-04 +-7.4969083574185410e-04 +-7.4481703154154579e-04 +-7.4059948419439637e-04 +-7.3705756304962944e-04 +-7.3420664892595979e-04 +-7.3205855389381238e-04 +-7.3062185238112324e-04 +-7.2990212623626975e-04 +-7.1661641578291515e-04 +-7.1802625004374653e-04 +-7.2082432672912207e-04 +-7.2496734309636574e-04 +-7.3039009212291968e-04 +-7.3700528240183997e-04 +-7.4470349736237848e-04 +-7.5335345096194791e-04 +-7.6280271681919442e-04 +-7.7287911182669772e-04 +-7.8339289906726307e-04 +-7.9413993472968506e-04 +-8.0490581819086995e-04 +-8.1547101546894038e-04 +-8.2561682031125419e-04 +-8.3513190552271586e-04 +-8.4381911501171781e-04 +-8.5150207155207272e-04 +-8.5803114214961216e-04 +-8.6328832274838838e-04 +-8.6719067905094882e-04 +-8.6969210278096325e-04 +-8.7078329598807604e-04 +-8.7049005729884570e-04 +-8.6887008960038039e-04 +-8.6600865874025931e-04 +-8.6201349544769027e-04 +-8.5700934520750347e-04 +-8.5113253916464684e-04 +-8.4452589515180072e-04 +-8.3733417598675643e-04 +-8.2970024604077602e-04 +-8.2176198766050249e-04 +-8.1364997341222165e-04 +-8.0548584154403172e-04 +-7.9738129063840061e-04 +-7.8943759314679441e-04 +-7.8174552324485492e-04 +-7.7438559880471300e-04 +-7.6742854709146242e-04 +-7.6093591643630371e-04 +-7.5496076965906103e-04 +-7.4954840806729897e-04 +-7.4473708663597073e-04 +-7.4055869106685087e-04 +-7.3703935572034358e-04 +-7.3420000797692550e-04 +-7.3205682959209242e-04 +-7.3062162929629366e-04 +-7.2990212348419590e-04 +-6.9978948768728588e-04 +-7.0116640649695299e-04 +-7.0390048539861478e-04 +-7.0795210144332409e-04 +-7.1326159325156005e-04 +-7.1974909017207705e-04 +-7.2731444856651201e-04 +-7.3583742486010557e-04 +-7.4517823212700250e-04 +-7.5517863205703183e-04 +-7.6566370384623778e-04 +-7.7644440312034119e-04 +-7.8732097610276263e-04 +-7.9808722782575496e-04 +-8.0853556221239999e-04 +-8.1846262361263413e-04 +-8.2767528411165851e-04 +-8.3599665072393132e-04 +-8.4327172343324141e-04 +-8.4937232849838055e-04 +-8.5420098634859584e-04 +-8.5769344827287420e-04 +-8.5981974282479598e-04 +-8.6058369775329898e-04 +-8.6002102956840348e-04 +-8.5819620390681080e-04 +-8.5519835223968690e-04 +-8.5113657623485557e-04 +-8.4613497871171130e-04 +-8.4032773394460201e-04 +-8.3385445860178619e-04 +-8.2685607837235922e-04 +-8.1947131469045393e-04 +-8.1183384950629732e-04 +-8.0407016971257379e-04 +-7.9629804973121716e-04 +-7.8862560156389683e-04 +-7.8115080517694659e-04 +-7.7396142621788291e-04 +-7.6713523010698084e-04 +-7.6074040890838543e-04 +-7.5483614779830511e-04 +-7.4947326962193856e-04 +-7.4469490767511439e-04 +-7.4053716762479467e-04 +-7.3702974892314826e-04 +-7.3419650398644785e-04 +-7.3205591979829765e-04 +-7.3062151159096489e-04 +-7.2990212203213401e-04 +-6.9978947726932186e-04 +-7.0116631261591983e-04 +-7.0390022401469550e-04 +-7.0795158764119293e-04 +-7.1326074149443515e-04 +-7.1974781537110426e-04 +-7.2731266819539857e-04 +-7.3583506227756755e-04 +-7.4517522115319194e-04 +-7.5517492267570185e-04 +-7.6565926867501835e-04 +-7.7643924402868709e-04 +-7.8731513010484315e-04 +-7.9808077119801035e-04 +-8.0852861175595154e-04 +-8.1845533416095633e-04 +-8.2766784179852610e-04 +-8.3598926214120987e-04 +-8.4326460152154507e-04 +-8.4936567667378551e-04 +-8.5419498281047901e-04 +-8.5768823253442607e-04 +-8.5981540621379751e-04 +-8.6058027900272598e-04 +-8.6001851579722518e-04 +-8.5819453646663072e-04 +-8.5519743624547435e-04 +-8.5113629222162922e-04 +-8.4613519479613227e-04 +-8.4032831707797075e-04 +-8.3385528388647183e-04 +-8.2685703586911103e-04 +-8.1947231357457659e-04 +-8.1183481977227122e-04 +-8.0407106185047034e-04 +-7.9629883290515779e-04 +-7.8862626083343608e-04 +-7.8115133824602603e-04 +-7.7396184010263816e-04 +-7.6713553800783929e-04 +-7.6074062747104017e-04 +-7.5483629486250371e-04 +-7.4947336249088763e-04 +-7.4469496189177333e-04 +-7.4053719621199109e-04 +-7.3702976202869876e-04 +-7.3419650886844944e-04 +-7.3205592108590201e-04 +-7.3062151175929801e-04 +-7.2990212203423140e-04 +-7.1661638290061226e-04 +-7.1802595372782855e-04 +-7.2082350173975401e-04 +-7.2496572150712916e-04 +-7.3038740428101533e-04 +-7.3700126059998597e-04 +-7.4469788297785208e-04 +-7.5334600557943796e-04 +-7.6279323744266948e-04 +-7.7286744967272961e-04 +-7.8337898063500207e-04 +-7.9412378294696560e-04 +-8.0488757060883764e-04 +-8.1545093595430137e-04 +-8.2559530072120893e-04 +-8.3510945463771788e-04 +-8.4379633358563281e-04 +-8.5147961453353640e-04 +-8.5800967151833699e-04 +-8.6326845643679281e-04 +-8.6717294254076249e-04 +-8.6967688982922181e-04 +-8.7077084352601161e-04 +-8.7048043718424874e-04 +-8.6886321715457676e-04 +-8.6600431549101696e-04 +-8.6201136172984441e-04 +-8.5700903749735347e-04 +-8.5113364722296577e-04 +-8.4452801499227857e-04 +-8.3733693603512251e-04 +-8.2970332527005860e-04 +-8.2176512572302944e-04 +-8.1365297369250748e-04 +-8.0548856858752953e-04 +-7.9738366360606987e-04 +-7.8943957688471075e-04 +-7.8174711833455847e-04 +-7.7438683165809499e-04 +-7.6742946083866522e-04 +-7.6093656306893244e-04 +-7.5496120365645895e-04 +-7.4954868155785209e-04 +-7.4473724602536228e-04 +-7.4055877499221146e-04 +-7.3703939415245719e-04 +-7.3420002228110704e-04 +-7.3205683336234921e-04 +-7.3062162978895524e-04 +-7.2990212349029529e-04 +-7.5076468116676775e-04 +-7.5224071774510016e-04 +-7.5516728688664807e-04 +-7.5949323495069169e-04 +-7.6514153030631774e-04 +-7.7200907510228088e-04 +-7.7996673371733677e-04 +-7.8885979688998558e-04 +-7.9850912550591424e-04 +-8.0871321819880914e-04 +-8.1925141500154008e-04 +-8.2988837980116489e-04 +-8.4037989598185526e-04 +-8.5047986757167814e-04 +-8.5994825578696098e-04 +-8.6855951964106962e-04 +-8.7611099667049401e-04 +-8.8243058420682237e-04 +-8.8738308551149572e-04 +-8.9087467822196367e-04 +-8.9285513716994632e-04 +-8.9331767419736365e-04 +-8.9229650579345280e-04 +-8.8986248319686051e-04 +-8.8611728364655239e-04 +-8.8118674500594534e-04 +-8.7521392628845036e-04 +-8.6835240697507037e-04 +-8.6076022192523092e-04 +-8.5259469266961028e-04 +-8.4400828332695916e-04 +-8.3514549683920869e-04 +-8.2614074326632083e-04 +-8.1711705818207528e-04 +-8.0818552254197551e-04 +-7.9944522992599781e-04 +-7.9098365624021135e-04 +-7.8287730478976696e-04 +-7.7519252130664300e-04 +-7.6798639561588544e-04 +-7.6130768700713371e-04 +-7.5519772792163951e-04 +-7.4969127487130359e-04 +-7.4481728664556096e-04 +-7.4059961816727506e-04 +-7.3705762427209729e-04 +-7.3420667167569775e-04 +-7.3205855988301837e-04 +-7.3062185316314417e-04 +-7.2990212624597086e-04 +-8.0313937532062150e-04 +-8.0471727353384796e-04 +-8.0784108437119114e-04 +-8.1244664629341612e-04 +-8.1843733715705194e-04 +-8.2568388299013025e-04 +-8.3402452932742363e-04 +-8.4326590706451741e-04 +-8.5318495791616891e-04 +-8.6353227487133628e-04 +-8.7403714767493471e-04 +-8.8441447345067063e-04 +-8.9437349792362156e-04 +-9.0362810647292419e-04 +-9.1190811581156391e-04 +-9.1897077098484917e-04 +-9.2461148173563087e-04 +-9.2867278670357171e-04 +-9.3105064420502103e-04 +-9.3169741314755479e-04 +-9.3062126813432070e-04 +-9.2788221933758498e-04 +-9.2358529770344012e-04 +-9.1787174718215556e-04 +-9.1090919537285537e-04 +-9.0288174797665329e-04 +-8.9398080053629519e-04 +-8.8439713320424742e-04 +-8.7431460457832572e-04 +-8.6390553322823673e-04 +-8.5332767805879008e-04 +-8.4272261158284476e-04 +-8.3221522047956351e-04 +-8.2191405438085125e-04 +-8.1191226251270193e-04 +-8.0228889507480709e-04 +-7.9311039112676094e-04 +-7.8443211958032584e-04 +-7.7629988004034891e-04 +-7.6875130348593530e-04 +-7.6181711861107390e-04 +-7.5552226855446307e-04 +-7.4988687575901962e-04 +-7.4492706099902261e-04 +-7.4065562734398449e-04 +-7.3708262198432528e-04 +-7.3421578923185010e-04 +-7.3206092723281991e-04 +-7.3062215944571531e-04 +-7.2990213002447311e-04 +-8.7486204787996444e-04 +-8.7657923772047682e-04 +-8.7997182611489200e-04 +-8.8495597429603023e-04 +-8.9140543641643821e-04 +-8.9915139489341977e-04 +-9.0798291736185715e-04 +-9.1764855805193655e-04 +-9.2785967004404169e-04 +-9.3829596187493312e-04 +-9.4861369922414024e-04 +-9.5845670537837908e-04 +-9.6746995677431883e-04 +-9.7531513394521802e-04 +-9.8168703826263543e-04 +-9.8632941391228030e-04 +-9.8904852611168869e-04 +-9.8972292475699728e-04 +-9.8830819799457974e-04 +-9.8483614617115396e-04 +-9.7940856164161188e-04 +-9.7218651949614911e-04 +-9.6337661275537308e-04 +-9.5321580539902610e-04 +-9.4195651345415710e-04 +-9.2985322009321841e-04 +-9.1715149143175429e-04 +-9.0407979692061534e-04 +-8.9084413838373265e-04 +-8.7762520271496486e-04 +-8.6457758592704858e-04 +-8.5183057544337343e-04 +-8.3948999501430143e-04 +-8.2764068196938725e-04 +-8.1634925365001241e-04 +-8.0566690997216567e-04 +-7.9563210058813266e-04 +-7.8627295242646763e-04 +-7.7760940501777785e-04 +-7.6965503799669786e-04 +-7.6241859977440175e-04 +-7.5590526125716203e-04 +-7.5011762617880294e-04 +-7.4505653228829473e-04 +-7.4072167701414273e-04 +-7.3711209860137072e-04 +-7.3422654000265190e-04 +-7.3206371860593347e-04 +-7.3062252058693565e-04 +-7.2990213447983367e-04 +-9.6691701964451092e-04 +-9.6881264321861411e-04 +-9.7254800220024828e-04 +-9.7801097288876637e-04 +-9.8503274649437700e-04 +-9.9338775578280405e-04 +-1.0027946602573100e-03 +-1.0129192203611271e-03 +-1.0233799466438629e-03 +-1.0337573287431121e-03 +-1.0436071896811245e-03 +-1.0524782492171902e-03 +-1.0599333294007893e-03 +-1.0655728672100350e-03 +-1.0690586518475691e-03 +-1.0701351705873188e-03 +-1.0686458272919797e-03 +-1.0645417249942044e-03 +-1.0578816690571555e-03 +-1.0488233663555760e-03 +-1.0376071518999142e-03 +-1.0245346270722504e-03 +-1.0099451046109147e-03 +-9.9419266593151812e-04 +-9.7762606391113061e-04 +-9.6057287158266913e-04 +-9.4332841844377410e-04 +-9.2614934544910446e-04 +-9.0925113269210212e-04 +-8.9280871619281158e-04 +-8.7695926724230670e-04 +-8.6180629465603688e-04 +-8.4742438489991299e-04 +-8.3386406947665568e-04 +-8.2115647245281545e-04 +-8.0931752776896898e-04 +-7.9835166094261909e-04 +-7.8825490441417100e-04 +-7.7901746478904613e-04 +-7.7062578930171041e-04 +-7.6306419341829997e-04 +-7.5631611621287302e-04 +-7.5036506858611521e-04 +-7.4519533417018744e-04 +-7.4079247569851280e-04 +-7.3714369189819065e-04 +-7.3423806231198447e-04 +-7.3206671026454842e-04 +-7.3062290764029354e-04 +-7.2990213925497858e-04 +-1.0795747024845981e-03 +-1.0816881919594563e-03 +-1.0858398902447663e-03 +-1.0918787683436306e-03 +-1.0995775004215885e-03 +-1.1086325887679348e-03 +-1.1186662360114555e-03 +-1.1292312649764328e-03 +-1.1398204567983281e-03 +-1.1498815146795604e-03 +-1.1588383883880538e-03 +-1.1661188675100016e-03 +-1.1711871953532132e-03 +-1.1735791145290929e-03 +-1.1729355194415342e-03 +-1.1690301626156939e-03 +-1.1617870325984420e-03 +-1.1512842803364711e-03 +-1.1377437429554993e-03 +-1.1215076492790371e-03 +-1.1030062610720389e-03 +-1.0827214067770173e-03 +-1.0611508708272793e-03 +-1.0387775993576369e-03 +-1.0160461297853292e-03 +-9.9334704793765569e-04 +-9.7100898816873367e-04 +-9.4929688282583736e-04 +-9.2841482669853181e-04 +-9.0851193770386061e-04 +-8.8968982560835928e-04 +-8.7201060228201657e-04 +-8.5550469340133265e-04 +-8.4017799422195043e-04 +-8.2601813187199377e-04 +-8.1299975299254886e-04 +-8.0108885740861572e-04 +-7.9024625811510761e-04 +-7.8043027722249608e-04 +-7.7159879674828071e-04 +-7.6371078000846691e-04 +-7.5672736938305377e-04 +-7.5061265309649898e-04 +-7.4533417968682732e-04 +-7.4086328538152367e-04 +-7.3717528734012041e-04 +-7.3424958493808839e-04 +-7.3206970196646999e-04 +-7.3062329469913696e-04 +-7.2990214403035236e-04 +-1.2115503797091266e-03 +-1.2139184753665185e-03 +-1.2185541047919450e-03 +-1.2252555243212110e-03 +-1.2337191511531016e-03 +-1.2435400044248531e-03 +-1.2542148629682791e-03 +-1.2651501025483960e-03 +-1.2756762846668735e-03 +-1.2850713148465781e-03 +-1.2925932262642494e-03 +-1.2975222584888637e-03 +-1.2992098960922325e-03 +-1.2971301676466499e-03 +-1.2909263927448295e-03 +-1.2804455843285858e-03 +-1.2657536644671912e-03 +-1.2471277381007043e-03 +-1.2250261766736130e-03 +-1.2000417493904425e-03 +-1.1728460085496358e-03 +-1.1441337674844777e-03 +-1.1145749663350373e-03 +-1.0847783957173840e-03 +-1.0552687256380660e-03 +-1.0264758774411128e-03 +-9.9873433115125402e-04 +-9.7228943691936938e-04 +-9.4730794146672607e-04 +-9.2389044751733170e-04 +-9.0208415087081404e-04 +-8.8189478981630679e-04 +-8.6329721964672470e-04 +-8.4624437192076590e-04 +-8.3067458594406605e-04 +-8.1651743366392487e-04 +-8.0369822550254192e-04 +-7.9214140666595688e-04 +-7.8177304882895838e-04 +-7.7252262323373902e-04 +-7.6432421625951077e-04 +-7.5711732233897547e-04 +-7.5084732442572209e-04 +-7.4546575033829362e-04 +-7.4093037464131851e-04 +-7.3720522019614333e-04 +-7.3426050080895153e-04 +-7.3207253609766372e-04 +-7.3062366137190398e-04 +-7.2990214855441198e-04 +-1.3589574535022655e-03 +-1.3616093564205532e-03 +-1.3667821278644980e-03 +-1.3742128909640346e-03 +-1.3835061096158566e-03 +-1.3941343267056432e-03 +-1.4054427047578194e-03 +-1.4166601513100397e-03 +-1.4269200819613354e-03 +-1.4352936802576497e-03 +-1.4408375398214173e-03 +-1.4426554440735552e-03 +-1.4399705599980059e-03 +-1.4321999194503623e-03 +-1.4190191178759610e-03 +-1.4004037617109978e-03 +-1.3766370336394716e-03 +-1.3482797469782060e-03 +-1.3161081194399508e-03 +-1.2810317600877024e-03 +-1.2440073928821204e-03 +-1.2059621534334184e-03 +-1.1677354261922391e-03 +-1.1300424719472612e-03 +-1.0934584170362144e-03 +-1.0584183958740770e-03 +-1.0252286983891987e-03 +-9.9408412567496317e-04 +-9.6508776670926639e-04 +-9.3827058374200900e-04 +-9.1360924388277315e-04 +-8.9104143948692176e-04 +-8.7047848811875185e-04 +-8.5181533495382262e-04 +-8.3493825325626179e-04 +-8.1973060529732578e-04 +-8.0607702883545853e-04 +-7.9386638284563915e-04 +-7.8299373990986000e-04 +-7.7336166311858790e-04 +-7.6488095871551671e-04 +-7.5747105490441924e-04 +-7.5106012308775387e-04 +-7.4558503010083621e-04 +-7.4099118801244858e-04 +-7.3723235086634888e-04 +-7.3427039443243775e-04 +-7.3207510479060870e-04 +-7.3062399370307036e-04 +-7.2990215265501303e-04 +-1.5143523068036468e-03 +-1.5173032518342117e-03 +-1.5230417465666828e-03 +-1.5312399534989926e-03 +-1.5414044113090668e-03 +-1.5528765234333330e-03 +-1.5648374020080249e-03 +-1.5763206454016327e-03 +-1.5862374942729790e-03 +-1.5934193467032204e-03 +-1.5966820144102331e-03 +-1.5949131126807832e-03 +-1.5871776289889900e-03 +-1.5728277515216662e-03 +-1.5515949405870227e-03 +-1.5236401790227991e-03 +-1.4895457973681725e-03 +-1.4502475879032504e-03 +-1.4069224876750101e-03 +-1.3608574999565742e-03 +-1.3133261778805725e-03 +-1.2654916316495110e-03 +-1.2183444031059897e-03 +-1.1726741853747287e-03 +-1.1290685858994093e-03 +-1.0879300726925744e-03 +-1.0495028139265105e-03 +-1.0139029899165477e-03 +-9.8114830740418050e-04 +-9.5118431105531984e-04 +-9.2390645887846339e-04 +-8.9917781325545389e-04 +-8.7684269660328424e-04 +-8.5673688820326027e-04 +-8.3869499815068013e-04 +-8.2255562068595618e-04 +-8.0816479200167507e-04 +-7.9537818690846604e-04 +-7.8406240077344078e-04 +-7.7409558555960334e-04 +-7.6536764415570629e-04 +-7.5778013534735864e-04 +-7.5124600132147983e-04 +-7.4568919865301332e-04 +-7.4104429042700249e-04 +-7.3725603982086442e-04 +-7.3427903271138060e-04 +-7.3207734753581743e-04 +-7.3062428386410131e-04 +-7.2990215623556761e-04 +-1.6665433304530071e-03 +-1.6697880691358075e-03 +-1.6760869973530370e-03 +-1.6850576388665653e-03 +-1.6961234661257228e-03 +-1.7085123579192087e-03 +-1.7212579431759906e-03 +-1.7332077851882337e-03 +-1.7430449886101233e-03 +-1.7493329310617606e-03 +-1.7505942940922901e-03 +-1.7454316219137262e-03 +-1.7326841103125377e-03 +-1.7115959197184668e-03 +-1.6819541596737179e-03 +-1.6441524230328176e-03 +-1.5991544722007570e-03 +-1.5483649254960747e-03 +-1.4934427331011622e-03 +-1.4361050696696037e-03 +-1.3779619703675600e-03 +-1.3204037292495864e-03 +-1.2645442592765319e-03 +-1.2112108986748584e-03 +-1.1609659244782367e-03 +-1.1141453979418457e-03 +-1.0709041615958824e-03 +-1.0312596685305268e-03 +-9.9513065838986443e-04 +-9.6236908860727953e-04 +-9.3278521555936018e-04 +-9.0616650804304386e-04 +-8.8229139785072914e-04 +-8.6093892014279833e-04 +-8.4189520344149710e-04 +-8.2495761901208917e-04 +-8.0993723930913592e-04 +-7.9666010846802214e-04 +-7.8496770381463864e-04 +-7.7471686769092188e-04 +-7.6577941149402230e-04 +-7.5804153522946870e-04 +-7.5140316238023913e-04 +-7.4577725811921663e-04 +-7.4108917601043540e-04 +-7.3727606207787011e-04 +-7.3428633372022161e-04 +-7.3207924307243843e-04 +-7.3062452910434891e-04 +-7.2990215926216947e-04 +-1.8021172372851772e-03 +-1.8056264388136773e-03 +-1.8124426952618692e-03 +-1.8221598393458461e-03 +-1.8341634519617022e-03 +-1.8476235926430393e-03 +-1.8614846314569597e-03 +-1.8744554733628248e-03 +-1.8850101549657116e-03 +-1.8914182570637435e-03 +-1.8918316724706571e-03 +-1.8844492969460462e-03 +-1.8677557963076620e-03 +-1.8407889874125236e-03 +-1.8033553694096407e-03 +-1.7561136446952418e-03 +-1.7004901188952092e-03 +-1.6384537041885566e-03 +-1.5722241877379544e-03 +-1.5039944127716227e-03 +-1.4357218027558972e-03 +-1.3690088182215805e-03 +-1.3050636375324129e-03 +-1.2447183530237846e-03 +-1.1884800660335319e-03 +-1.1365950147130574e-03 +-1.0891125782556983e-03 +-1.0459419874985689e-03 +-1.0068988685252571e-03 +-9.7174136893581563e-04 +-9.4019696555199374e-04 +-9.1198157404422217e-04 +-8.8681263255521465e-04 +-8.6441765463846705e-04 +-8.4453948680653654e-04 +-8.2693924028878014e-04 +-8.1139763089549974e-04 +-7.9771526719186591e-04 +-7.8571227550105756e-04 +-7.7522753536206660e-04 +-7.6611771415775742e-04 +-7.5825622808899529e-04 +-7.5153221280057074e-04 +-7.4584955616006639e-04 +-7.4112602439913933e-04 +-7.3729249835981713e-04 +-7.3429232699211253e-04 +-7.3208079907585092e-04 +-7.3062473041677646e-04 +-7.2990216174702739e-04 +-1.9091978447286473e-03 +-1.9129209529418897e-03 +-1.9201782434480361e-03 +-1.9305892890022955e-03 +-1.9435742597270569e-03 +-1.9583358545007985e-03 +-1.9738264054790637e-03 +-1.9887008786456609e-03 +-2.0012701422696213e-03 +-2.0094902275534050e-03 +-2.0110424334534673e-03 +-2.0035547375353005e-03 +-1.9849666992590650e-03 +-1.9539560839947506e-03 +-1.9102775621036318e-03 +-1.8548733389863936e-03 +-1.7897100050558510e-03 +-1.7174128446990923e-03 +-1.6408336315650502e-03 +-1.5626766555270908e-03 +-1.4852504456009054e-03 +-1.4103531457300075e-03 +-1.3392629145457899e-03 +-1.2727933876886185e-03 +-1.2113789828925746e-03 +-1.1551656508137500e-03 +-1.1040932879556819e-03 +-1.0579638922722468e-03 +-1.0164943929011981e-03 +-9.7935559113129268e-04 +-9.4619963557935163e-04 +-9.1667858855904220e-04 +-8.9045636948741763e-04 +-8.6721594694246602e-04 +-8.4666322947170194e-04 +-8.2852873611776302e-04 +-8.1256782910844904e-04 +-7.9856006141650147e-04 +-7.8630802098324617e-04 +-7.7563592939609220e-04 +-7.6638816460110229e-04 +-7.5842781553390429e-04 +-7.5163533408090569e-04 +-7.4590732101875896e-04 +-7.4115546348848182e-04 +-7.3730562920030910e-04 +-7.3429711489579141e-04 +-7.3208204212948317e-04 +-7.3062489124068209e-04 +-7.2990216373260424e-04 +-1.9822013073338180e-03 +-1.9860770469908480e-03 +-1.9936782627924866e-03 +-2.0047010887293292e-03 +-2.0186755771134739e-03 +-2.0349334795683686e-03 +-2.0525443377871432e-03 +-2.0702148342419758e-03 +-2.0861678460932088e-03 +-2.0980562798301712e-03 +-2.1030089939776454e-03 +-2.0979113801954043e-03 +-2.0799430405367184e-03 +-2.0472376528149318e-03 +-1.9994027638611284e-03 +-1.9376656296271589e-03 +-1.8645944943228437e-03 +-1.7835426774820619e-03 +-1.6980428135249532e-03 +-1.6113280715943064e-03 +-1.5260518699431738e-03 +-1.4441909734904106e-03 +-1.3670760660270055e-03 +-1.2954902519846123e-03 +-1.2297903276608675e-03 +-1.1700234871032942e-03 +-1.1160264560100349e-03 +-1.0675032701955133e-03 +-1.0240828591701167e-03 +-9.8535968691380632e-04 +-9.5092117278821318e-04 +-9.2036530396248466e-04 +-8.9331124878387288e-04 +-8.6940514194965663e-04 +-8.4832264826200298e-04 +-8.2976945688624829e-04 +-8.1348051079669216e-04 +-7.9921852054724667e-04 +-7.8677212836618556e-04 +-7.7595396000455037e-04 +-7.6659871307854853e-04 +-7.5856137043926904e-04 +-7.5171558693085019e-04 +-7.4595227159797678e-04 +-7.4117837065757169e-04 +-7.3731584627069338e-04 +-7.3430084030065026e-04 +-7.3208300932972831e-04 +-7.3062501637545345e-04 +-7.2990216527808792e-04 +-2.0242452370556239e-03 +-2.0282158687259938e-03 +-2.0360589552412952e-03 +-2.0475743598210297e-03 +-2.0624440675092743e-03 +-2.0801883328792322e-03 +-2.1000738638120350e-03 +-2.1209586690849329e-03 +-2.1410828489137400e-03 +-2.1578720641327620e-03 +-2.1679023160660268e-03 +-2.1672140348173315e-03 +-2.1520516989468092e-03 +-2.1198316409055261e-03 +-2.0699089469496845e-03 +-2.0037712351782611e-03 +-1.9246103788144390e-03 +-1.8365339628501314e-03 +-1.7437631157929297e-03 +-1.6500482101167399e-03 +-1.5583667817231825e-03 +-1.4708548479773086e-03 +-1.3888837245780163e-03 +-1.3132031156218643e-03 +-1.2440970869254503e-03 +-1.1815243606540665e-03 +-1.1252317918934609e-03 +-1.0748398730414188e-03 +-1.0299037678190598e-03 +-9.8995487007194757e-04 +-9.5452777902232065e-04 +-9.2317682822705091e-04 +-8.9548539870411975e-04 +-8.7107041326096825e-04 +-8.4958372750424370e-04 +-8.3071161109260212e-04 +-8.1417312966117054e-04 +-7.9971796475914955e-04 +-7.8712401883354870e-04 +-7.7619502205497214e-04 +-7.6675827015774002e-04 +-7.5866256445335624e-04 +-7.5177638753570969e-04 +-7.4598632431435263e-04 +-7.4119572344536248e-04 +-7.3732358579509528e-04 +-7.3430366230116471e-04 +-7.3208374198380666e-04 +-7.3062511116529522e-04 +-7.2990216644941430e-04 +-2.0445779271282393e-03 +-2.0485999299419142e-03 +-2.0565937188095546e-03 +-2.0684552597506328e-03 +-2.0840103305830109e-03 +-2.1029672271553061e-03 +-2.1248122923207334e-03 +-2.1486189867079377e-03 +-2.1727587406405414e-03 +-2.1945714313517288e-03 +-2.2101904807144963e-03 +-2.2148312888781219e-03 +-2.2037272320798843e-03 +-2.1734611074731968e-03 +-2.1230411483505757e-03 +-2.0541611009592333e-03 +-1.9706027761749582e-03 +-1.8771920949459705e-03 +-1.7787943540281330e-03 +-1.6796315936961641e-03 +-1.5829684003670359e-03 +-1.4910769623734874e-03 +-1.4053605701518971e-03 +-1.3265385345411112e-03 +-1.2548330287762569e-03 +-1.1901294240505807e-03 +-1.1321014122713060e-03 +-1.0803024562190714e-03 +-1.0342292498803671e-03 +-9.9336371110176789e-04 +-9.5719937383526021e-04 +-9.2525689756303015e-04 +-8.9709224653437272e-04 +-8.7230010000015888e-04 +-8.5051428160868648e-04 +-8.3140642413858236e-04 +-8.1468367719156050e-04 +-8.0008598088954577e-04 +-7.8738323442351500e-04 +-7.7637255795772278e-04 +-7.6687576044471358e-04 +-7.5873707013955963e-04 +-7.5182114930456140e-04 +-7.4601139280745950e-04 +-7.4120849759663407e-04 +-7.3732928310535969e-04 +-7.3430573965129278e-04 +-7.3208428130935074e-04 +-7.3062518094282804e-04 +-7.2990216731238307e-04 +-2.0529837166909639e-03 +-2.0570303541302135e-03 +-2.0651069687167719e-03 +-2.0771772767603719e-03 +-2.0931710455261232e-03 +-2.1129409594311190e-03 +-2.1361620100471962e-03 +-2.1621316327917026e-03 +-2.1894289813869992e-03 +-2.2154571375497911e-03 +-2.2360855788908858e-03 +-2.2458404596683089e-03 +-2.2389941671531405e-03 +-2.2112755863918296e-03 +-2.1612919435931924e-03 +-2.0908731245162810e-03 +-2.0043065806213890e-03 +-1.9070426750295421e-03 +-1.8045003387218909e-03 +-1.7012995612965456e-03 +-1.6009421446152238e-03 +-1.5058103017921503e-03 +-1.4173321485960848e-03 +-1.3362023744776220e-03 +-1.2625944687588936e-03 +-1.1963369860217047e-03 +-1.1370476177970158e-03 +-1.0842290272325167e-03 +-1.0373339689972471e-03 +-9.9580745068835949e-04 +-9.5911256460344692e-04 +-9.2674514619389193e-04 +-8.9824104734934876e-04 +-8.7317870063575477e-04 +-8.5117880992794694e-04 +-8.3190239500650237e-04 +-8.1504799173928689e-04 +-8.0034851754672118e-04 +-7.8756811571067573e-04 +-7.7649916228695898e-04 +-7.6695953514235903e-04 +-7.5879019080400852e-04 +-7.5185306145899883e-04 +-7.4602926430246766e-04 +-7.4121760417308132e-04 +-7.3733334462009479e-04 +-7.3430722055213419e-04 +-7.3208466578345032e-04 +-7.3062523068611370e-04 +-7.2990216792842132e-04 +-2.0560407435205662e-03 +-2.0600982467097696e-03 +-2.0682164627162792e-03 +-2.0803994673790340e-03 +-2.0966402773842157e-03 +-2.1168839203232095e-03 +-2.1409380527270877e-03 +-2.1682833651988165e-03 +-2.1977151819827746e-03 +-2.2267897929348583e-03 +-2.2512804080706064e-03 +-2.2652172042948752e-03 +-2.2620677064939176e-03 +-2.2367915793010868e-03 +-2.1876015948665687e-03 +-2.1164002813498419e-03 +-2.0278686402454777e-03 +-1.9279520742069135e-03 +-1.8225056174693960e-03 +-1.7164587792035035e-03 +-1.6134952685978538e-03 +-1.5160804911251713e-03 +-1.4256610463349905e-03 +-1.3429133623481559e-03 +-1.2679752438541306e-03 +-1.2006339741385131e-03 +-1.1404668774671863e-03 +-1.0869402402471937e-03 +-1.0394755330764356e-03 +-9.9749161510819862e-04 +-9.6043010685301913e-04 +-9.2776940145468975e-04 +-8.9903126693922886e-04 +-8.7378279313892881e-04 +-8.5163554874804852e-04 +-8.3224318141737383e-04 +-8.1529825634212190e-04 +-8.0052883226967462e-04 +-7.8769507683339722e-04 +-7.7658609399229800e-04 +-7.6701705356812145e-04 +-7.5882666051770573e-04 +-7.5187496971740385e-04 +-7.4604153309284257e-04 +-7.4122385575273295e-04 +-7.3733613279260265e-04 +-7.3430823716748393e-04 +-7.3208492971908799e-04 +-7.3062526483448447e-04 +-7.2990216835233906e-04 +-2.0570060736567410e-03 +-2.0610682037141581e-03 +-2.0692069322685688e-03 +-2.0814492035836486e-03 +-2.0978239514932036e-03 +-2.1183294131887067e-03 +-2.1428536334173812e-03 +-2.1710009724870624e-03 +-2.2017395075720997e-03 +-2.2327926749155123e-03 +-2.2599412407514736e-03 +-2.2769027676353176e-03 +-2.2765469640175060e-03 +-2.2532238354041139e-03 +-2.2048134216008041e-03 +-2.1332479651851961e-03 +-2.0434878576006421e-03 +-1.9418365316925018e-03 +-1.8344634399711985e-03 +-1.7265194120368061e-03 +-1.6218170276554376e-03 +-1.5228801275619704e-03 +-1.4311682463968383e-03 +-1.3473452854662184e-03 +-1.2715246557256652e-03 +-1.2034655734195884e-03 +-1.1427180424119581e-03 +-1.0887238345791692e-03 +-1.0408834171007808e-03 +-9.9859815144084517e-04 +-9.6129533142272838e-04 +-9.2844174173159835e-04 +-8.9954979819502703e-04 +-8.7417907370291280e-04 +-8.5193509374789200e-04 +-8.3246663683145424e-04 +-8.1546233021744441e-04 +-8.0064703216031340e-04 +-7.8777829435842679e-04 +-7.7664306982499478e-04 +-7.6705474966735335e-04 +-7.5885056094133672e-04 +-7.5188932693819315e-04 +-7.4604957312379206e-04 +-7.4122795252916428e-04 +-7.3733795992804137e-04 +-7.3430890337224130e-04 +-7.3208510268078135e-04 +-7.3062528721292244e-04 +-7.2990216863136131e-04 +-2.0572330548991047e-03 +-2.0612971512467327e-03 +-2.0694462630590029e-03 +-2.0817203732106777e-03 +-2.0981686101757815e-03 +-2.1188185102735840e-03 +-2.1436023739046842e-03 +-2.1721969979401254e-03 +-2.2036850101048943e-03 +-2.2359229060556576e-03 +-2.2647365285967409e-03 +-2.2836666448741764e-03 +-2.2851866087826409e-03 +-2.2632205738126947e-03 +-2.2154061403225744e-03 +-2.1436833633231215e-03 +-2.0531935031448071e-03 +-1.9504754298645878e-03 +-1.8419050946097575e-03 +-1.7327779500903339e-03 +-1.6269903064575263e-03 +-1.5271037859009068e-03 +-1.4345862974695523e-03 +-1.3500938124712634e-03 +-1.2737242941261780e-03 +-1.2052192340191753e-03 +-1.1441114321155146e-03 +-1.0898272636428164e-03 +-1.0417540350514984e-03 +-9.9928216630178809e-04 +-9.6183000880710131e-04 +-9.2885711308434533e-04 +-8.9987007509893303e-04 +-8.7442379583518067e-04 +-8.5212004904301384e-04 +-8.3260459337902292e-04 +-8.1556361598304847e-04 +-8.0071999350731665e-04 +-7.8782965911030397e-04 +-7.7667823576879418e-04 +-7.6707801528706201e-04 +-7.5886531171515798e-04 +-7.5189818776041559e-04 +-7.4605453514261133e-04 +-7.4123048090641295e-04 +-7.3733908756810755e-04 +-7.3430931452993806e-04 +-7.3208520942696996e-04 +-7.3062530102463766e-04 +-7.2990216880509885e-04 +-2.0572420058198580e-03 +-2.0613069363917239e-03 +-2.0694613056588596e-03 +-2.0817523178525013e-03 +-2.0982401265202009e-03 +-2.1189678015615331e-03 +-2.1438904655077871e-03 +-2.1727231670093617e-03 +-2.2046143830655200e-03 +-2.2375065507087223e-03 +-2.2672682290114246e-03 +-2.2873488269081169e-03 +-2.2899876897667492e-03 +-2.2688480147058797e-03 +-2.2214147821567306e-03 +-2.1496278642998499e-03 +-2.0587341341700158e-03 +-1.9554115290013629e-03 +-1.8461579426843021e-03 +-1.7363539933333623e-03 +-1.6299451410695925e-03 +-1.5295151324124948e-03 +-1.4365367984703432e-03 +-1.3516615460577423e-03 +-1.2749784262283282e-03 +-1.2062187170955581e-03 +-1.1449053201700453e-03 +-1.0904557648769397e-03 +-1.0422498064073060e-03 +-9.9967159414791288e-04 +-9.6213435993781817e-04 +-9.2909351649875444e-04 +-9.0005233366499129e-04 +-8.7456304429490322e-04 +-8.5222528090140529e-04 +-8.3268307961535692e-04 +-8.1562123644268270e-04 +-8.0076149882632214e-04 +-7.8785887797808987e-04 +-7.7669823952939896e-04 +-7.6709124950828352e-04 +-7.5887370236376022e-04 +-7.5190322802929743e-04 +-7.4605735767211399e-04 +-7.4123191911982936e-04 +-7.3733972900494121e-04 +-7.3430954841049252e-04 +-7.3208527014834840e-04 +-7.3062530888188333e-04 +-7.2990216890587219e-04 +-2.0572136693428086e-03 +-2.0612789425319493e-03 +-2.0694358049136918e-03 +-2.0817350881948905e-03 +-2.0982424367283238e-03 +-2.1190084978429096e-03 +-2.1439992104459321e-03 +-2.1729478012699911e-03 +-2.2050356981207233e-03 +-2.2382514830234144e-03 +-2.2684906905737468e-03 +-2.2891600073044215e-03 +-2.2923784837426560e-03 +-2.2716719725581602e-03 +-2.2244438140414367e-03 +-2.1526322234679410e-03 +-2.0615380960631868e-03 +-1.9579110623063113e-03 +-1.8483119040033575e-03 +-1.7381651080090146e-03 +-1.6314414171362901e-03 +-1.5307359520757389e-03 +-1.4375240891539402e-03 +-1.3524549241631296e-03 +-1.2756129775475043e-03 +-1.2067243353849730e-03 +-1.1453068699378607e-03 +-1.0907736189618112e-03 +-1.0425005055802819e-03 +-9.9986849875173230e-04 +-9.6228823493658196e-04 +-9.2921303010258516e-04 +-9.0014446927694951e-04 +-8.7463343427959448e-04 +-8.5227847371547650e-04 +-8.3272275200248842e-04 +-8.1565036131448691e-04 +-8.0078247790728893e-04 +-7.8787364673645662e-04 +-7.7670835048586882e-04 +-7.6709793880823905e-04 +-7.5887794348624901e-04 +-7.5190577569787895e-04 +-7.4605878437073001e-04 +-7.4123264609882004e-04 +-7.3734005323790981e-04 +-7.3430966663356578e-04 +-7.3208530084265455e-04 +-7.3062531285448152e-04 +-7.2990216895944587e-04 +-2.0571951315760673e-03 +-2.0612605313588229e-03 +-2.0694184069603924e-03 +-2.0817211110286532e-03 +-2.0982365761477535e-03 +-2.1190185651614765e-03 +-2.1440373732962113e-03 +-2.1730335293224266e-03 +-2.2052020954658872e-03 +-2.2385515266833121e-03 +-2.2689899218806585e-03 +-2.2899070102008262e-03 +-2.2933711544890906e-03 +-2.2728495081665383e-03 +-2.2257101591207397e-03 +-2.1538901895138212e-03 +-2.0627131881123298e-03 +-1.9589590829473496e-03 +-1.8492152610901703e-03 +-1.7389247705510143e-03 +-1.6320690531168960e-03 +-1.5312480488510743e-03 +-1.4379382238813071e-03 +-1.3527877134885812e-03 +-1.2758791404927179e-03 +-1.2069364134483992e-03 +-1.1454752945732501e-03 +-1.0909069369399241e-03 +-1.0426056557633870e-03 +-9.9995108557444164e-04 +-9.6235277393775642e-04 +-9.2926315717316082e-04 +-9.0018311352055692e-04 +-8.7466295805816233e-04 +-8.5230078472740107e-04 +-8.3273939230719236e-04 +-8.1566257776218541e-04 +-8.0079127778400567e-04 +-7.8787984178082008e-04 +-7.7671259183377430e-04 +-7.6710074491532815e-04 +-7.5887972265329068e-04 +-7.5190684448522968e-04 +-7.4605938291031194e-04 +-7.4123295109489347e-04 +-7.3734018926977256e-04 +-7.3430971623533378e-04 +-7.3208531372145923e-04 +-7.3062531452242703e-04 +-7.2990216898557330e-04 +-2.0571887353416987e-03 +-2.0612541707396748e-03 +-2.0694123472815669e-03 +-2.0817160745338890e-03 +-2.0982339652012095e-03 +-2.1190206927490076e-03 +-2.1440478010963586e-03 +-2.1730579110635310e-03 +-2.2052500895192880e-03 +-2.2386388041608341e-03 +-2.2691361657149805e-03 +-2.2901271038931179e-03 +-2.2936649022637407e-03 +-2.2731990311794610e-03 +-2.2260868400776619e-03 +-2.1542649270959954e-03 +-2.0630636013707522e-03 +-1.9592718406568040e-03 +-1.8494850032623252e-03 +-1.7391517098203193e-03 +-1.6322566221648569e-03 +-1.5314011381386940e-03 +-1.4380620622207775e-03 +-1.3528872514630443e-03 +-1.2759587675673690e-03 +-1.2069998723132399e-03 +-1.1455256999158897e-03 +-1.0909468418451162e-03 +-1.0426371337893031e-03 +-9.9997581206093733e-04 +-9.6237209911037374e-04 +-9.2927816850409996e-04 +-9.0019468728265819e-04 +-8.7467180111654521e-04 +-8.5230746800184015e-04 +-8.3274437736304821e-04 +-8.1566623785525572e-04 +-8.0079391449310608e-04 +-7.8788169816832647e-04 +-7.7671386289600655e-04 +-7.6710158593427317e-04 +-7.5888025593471133e-04 +-7.5190716486738028e-04 +-7.4605956234470203e-04 +-7.4123304253588746e-04 +-7.3734023005657900e-04 +-7.3430973110885059e-04 +-7.3208531758418979e-04 +-7.3062531502445633e-04 +-7.2990216899924000e-04 +-2.0571877673065510e-03 +-2.0612532075480663e-03 +-2.0694114268884865e-03 +-2.0817152989740877e-03 +-2.0982335273699629e-03 +-2.1190208987439292e-03 +-2.1440491012431986e-03 +-2.1730609998269574e-03 +-2.2052561714942147e-03 +-2.2386499165348533e-03 +-2.2691549798002555e-03 +-2.2901557564814477e-03 +-2.2937035470706273e-03 +-2.2732454004517062e-03 +-2.2261371366118559e-03 +-2.1543152156373599e-03 +-2.0631108124948751e-03 +-1.9593141144142747e-03 +-1.8495215609858600e-03 +-1.7391825372090434e-03 +-1.6322821523674525e-03 +-1.5314220118294447e-03 +-1.4380789737840961e-03 +-1.3529008632976167e-03 +-1.2759696699641617e-03 +-1.2070085704930596e-03 +-1.1455326156051778e-03 +-1.0909523216106713e-03 +-1.0426414597219096e-03 +-9.9997921251308787e-04 +-9.6237475843022238e-04 +-9.2928023538544767e-04 +-9.0019628169713114e-04 +-8.7467301995234063e-04 +-8.5230838959177103e-04 +-8.3274506509183727e-04 +-8.1566674302079544e-04 +-8.0079427857219002e-04 +-7.8788195461237324e-04 +-7.7671403855889844e-04 +-7.6710170221464078e-04 +-7.5888032969817672e-04 +-7.5190720920092027e-04 +-7.4605958718415566e-04 +-7.4123305519906136e-04 +-7.3734023570710245e-04 +-7.3430973317054787e-04 +-7.3208531812077489e-04 +-7.3062531509668393e-04 +-7.2990216900938509e-04 +-2.0571877672884644e-03 +-2.0612532074347685e-03 +-2.0694114265331128e-03 +-2.0817152969013256e-03 +-2.0982335170449469e-03 +-2.1190208611556439e-03 +-2.1440489927998046e-03 +-2.1730607365248382e-03 +-2.2052556179488793e-03 +-2.2386489012165855e-03 +-2.2691533548907816e-03 +-2.2901534805756002e-03 +-2.2937007290133623e-03 +-2.2732422664300945e-03 +-2.2261339478356220e-03 +-2.1543121927202927e-03 +-2.0631080987270635e-03 +-1.9593117757050896e-03 +-1.8495196049647851e-03 +-1.7391809360259593e-03 +-1.6322808612656999e-03 +-1.5314209814748572e-03 +-1.4380781572107156e-03 +-1.3529002191219621e-03 +-1.2759691633562145e-03 +-1.2070081729618517e-03 +-1.1455323042562893e-03 +-1.0909520782438847e-03 +-1.0426412699543262e-03 +-9.9997906500728559e-04 +-9.6237464425068524e-04 +-9.2928014747916472e-04 +-9.0019621448294261e-04 +-8.7467296900048169e-04 +-8.5230835137580863e-04 +-8.3274503679748007e-04 +-8.1566672239873073e-04 +-8.0079426382464894e-04 +-7.8788194430531519e-04 +-7.7671403155353232e-04 +-7.6710169761346164e-04 +-7.5888032680185335e-04 +-7.5190720747327501e-04 +-7.4605958622318619e-04 +-7.4123305471248606e-04 +-7.3734023549133049e-04 +-7.3430973309226131e-04 +-7.3208531810053056e-04 +-7.3062531509407046e-04 +-7.2990216900934075e-04 +-2.0571887352674061e-03 +-2.0612541745803582e-03 +-2.0694123806921797e-03 +-2.0817161958568958e-03 +-2.0982342548504338e-03 +-2.1190212099820725e-03 +-2.1440484958820056e-03 +-2.1730584811979273e-03 +-2.2052498105322007e-03 +-2.2386364730548527e-03 +-2.2691303823227640e-03 +-2.2901168976767654e-03 +-2.2936502956939003e-03 +-2.2731810912271274e-03 +-2.2260672226910769e-03 +-2.1542452897613880e-03 +-2.0630452096870003e-03 +-1.9592554472542567e-03 +-1.8494709122319655e-03 +-1.7391399123933466e-03 +-1.6322469292283902e-03 +-1.5313932795918645e-03 +-1.4380557500977627e-03 +-1.3528822145607794e-03 +-1.2759547671007672e-03 +-1.2069967063638462e-03 +-1.1455232019905353e-03 +-1.0909448768058952e-03 +-1.0426355929835018e-03 +-9.9997460858123558e-04 +-9.6237116359413775e-04 +-9.2927744559862500e-04 +-9.0019413276312362e-04 +-8.7467137958268672e-04 +-8.5230715106034908e-04 +-8.3274414220412289e-04 +-8.1566606614187458e-04 +-8.0079379149448405e-04 +-7.8788161208175457e-04 +-7.7671380431265690e-04 +-7.6710154741419553e-04 +-7.5888023166417382e-04 +-7.5190715037809497e-04 +-7.4605955427955062e-04 +-7.4123303844971194e-04 +-7.3734022824364345e-04 +-7.3430973045080731e-04 +-7.3208531741396788e-04 +-7.3062531500248714e-04 +-7.2990216899895680e-04 +-2.0571951320610547e-03 +-2.0612605714961187e-03 +-2.0694187111347743e-03 +-2.0817222444200821e-03 +-2.0982395437943689e-03 +-2.1190248232939922e-03 +-2.1440486999050440e-03 +-2.1730516227734600e-03 +-2.2052277011969583e-03 +-2.2385832017120045e-03 +-2.2690233824601016e-03 +-2.2899362176781865e-03 +-2.2933908206101633e-03 +-2.2728571780938384e-03 +-2.2257065417729226e-03 +-2.1538780493088449e-03 +-2.0626959028155361e-03 +-1.9589396337224550e-03 +-1.8491958098920209e-03 +-1.7389066473738185e-03 +-1.6320529296810743e-03 +-1.5312341492871025e-03 +-1.4379265033127645e-03 +-1.3527779860513442e-03 +-1.2758711615267000e-03 +-1.2069299275759633e-03 +-1.1454700610594767e-03 +-1.0909027410890943e-03 +-1.0426023123281095e-03 +-9.9994843795936025e-04 +-9.6235069145219330e-04 +-9.2926153160234723e-04 +-9.0018185568248169e-04 +-8.7466199466143416e-04 +-8.5230005564877157e-04 +-8.3273884830411702e-04 +-8.1566217858564127e-04 +-8.0079099063694792e-04 +-7.8787964006324048e-04 +-7.7671245411915768e-04 +-7.6710065411016517e-04 +-7.5887966529951530e-04 +-7.5190681017310503e-04 +-7.4605936377644037e-04 +-7.4123294138581661e-04 +-7.3734018495656456e-04 +-7.3430971466815229e-04 +-7.3208531331575002e-04 +-7.3062531447004337e-04 +-7.2990216898491769e-04 +-2.0572136736372345e-03 +-2.0612791205820375e-03 +-2.0694370628922248e-03 +-2.0817397447710400e-03 +-2.0982547994992280e-03 +-2.1190352729109560e-03 +-2.1440495772270833e-03 +-2.1730325819139815e-03 +-2.2051644338485299e-03 +-2.2384268496530354e-03 +-2.2687030643100065e-03 +-2.2893877052035279e-03 +-2.2925954102325599e-03 +-2.2718573592964142e-03 +-2.2245875516648255e-03 +-2.1527342553089505e-03 +-2.0616045909527883e-03 +-1.9579504636297895e-03 +-1.8483323277762611e-03 +-1.7381731625449883e-03 +-1.6314419632736572e-03 +-1.5307323185888061e-03 +-1.4375184295676252e-03 +-1.3524485603619587e-03 +-1.2756066747643072e-03 +-1.2067185019794362e-03 +-1.1453016940671287e-03 +-1.0907691582561065e-03 +-1.0424967441189145e-03 +-9.9986538226455157e-04 +-9.6228569194957230e-04 +-9.2921098422986273e-04 +-9.0014284605272402e-04 +-8.7463216469432347e-04 +-8.5227749580856654e-04 +-8.3272201134357206e-04 +-8.1564981087447433e-04 +-8.0078207761612988e-04 +-7.8787336289757508e-04 +-7.7670815514207245e-04 +-7.6709780910809357e-04 +-7.5887786107483495e-04 +-7.5190572614087451e-04 +-7.4605875661404460e-04 +-7.4123263196194727e-04 +-7.3734004693838293e-04 +-7.3430966433904443e-04 +-7.3208530024755571e-04 +-7.3062531277754707e-04 +-7.2990216895848549e-04 +-2.0572420244865676e-03 +-2.0613074902511349e-03 +-2.0694649712404509e-03 +-2.0817656758207095e-03 +-2.0982755665148655e-03 +-2.1190450404690408e-03 +-2.1440373156719154e-03 +-2.1729738887873444e-03 +-2.2050020362014752e-03 +-2.2380469833605506e-03 +-2.2679424752158994e-03 +-2.2880996806313933e-03 +-2.2907381064125988e-03 +-2.2695291363006402e-03 +-2.2219847850423039e-03 +-2.1500744718974036e-03 +-2.0590662876912363e-03 +-1.9556486680232898e-03 +-1.8463218599872456e-03 +-1.7364643401468565e-03 +-1.6300177303029356e-03 +-1.5295618356252153e-03 +-1.4365661329402651e-03 +-1.3516794361608023e-03 +-1.2749889032434270e-03 +-1.2062244794972181e-03 +-1.1449081504247708e-03 +-1.0904568261676688e-03 +-1.0422498480952959e-03 +-9.9967109151016570e-04 +-9.6213360809250690e-04 +-9.2909269305341453e-04 +-9.0005154028602438e-04 +-8.7456233418989457e-04 +-8.5222467692996060e-04 +-8.3268258618368846e-04 +-8.1562084727672477e-04 +-8.0076120201378806e-04 +-7.8785865919752719e-04 +-7.7669808407593885e-04 +-7.6709114351826587e-04 +-7.5887363350699770e-04 +-7.5190318584620588e-04 +-7.4605733367541147e-04 +-7.4123190673942504e-04 +-7.3733972342988148e-04 +-7.3430954636293866e-04 +-7.3208526961401356e-04 +-7.3062530881251803e-04 +-7.2990216890500537e-04 +-2.0572331148659890e-03 +-2.0612985633626508e-03 +-2.0694550103178312e-03 +-2.0817515930447138e-03 +-2.0982508802886851e-03 +-2.1189975884814624e-03 +-2.1439432083082193e-03 +-2.1727801244246013e-03 +-2.2045895034747852e-03 +-2.2371907930600413e-03 +-2.2663326742435900e-03 +-2.2854678590892787e-03 +-2.2870186943878606e-03 +-2.2649199812015313e-03 +-2.2168653572639451e-03 +-2.1448613113555248e-03 +-2.0541002016667611e-03 +-1.9511489387527890e-03 +-1.8423925823559655e-03 +-1.7331243467267879e-03 +-1.6272333085014714e-03 +-1.5272727686800355e-03 +-1.4347031151920450e-03 +-1.3501742441713645e-03 +-1.2737795131420500e-03 +-1.2052570544962989e-03 +-1.1441372769427258e-03 +-1.0898448792284190e-03 +-1.0417660033141512e-03 +-9.9929026458474507e-04 +-9.6183546001680619e-04 +-9.2886075840929966e-04 +-8.9987249288358108e-04 +-8.7442538331366853e-04 +-8.5212107855748588e-04 +-8.3260525109923151e-04 +-8.1556402861733264e-04 +-8.0072024676421474e-04 +-7.8782981047762423e-04 +-7.7667832337234999e-04 +-7.6707806403530216e-04 +-7.5886533756351919e-04 +-7.5189820066742081e-04 +-7.4605454111583759e-04 +-7.4123048341066821e-04 +-7.3733908848642147e-04 +-7.3430931480703986e-04 +-7.3208520948767346e-04 +-7.3062530103150836e-04 +-7.2990216880516813e-04 +-2.0570062331681221e-03 +-2.0610713596048544e-03 +-2.0692252274540448e-03 +-2.0815129175963706e-03 +-2.0979900462281468e-03 +-2.1186888030061274e-03 +-2.1435344183488572e-03 +-2.1721600124952412e-03 +-2.2035288304250123e-03 +-2.2352935132761115e-03 +-2.2630911682874392e-03 +-2.2804743075145609e-03 +-2.2802117197719372e-03 +-2.2566644134406661e-03 +-2.2078109670469800e-03 +-2.1357077360580211e-03 +-2.0454154110201533e-03 +-1.9432961908673468e-03 +-1.8355419755442773e-03 +-1.7273029543884164e-03 +-1.6223799678261809e-03 +-1.5232818404245538e-03 +-1.4314538657371168e-03 +-1.3475480696997421e-03 +-1.2716686321998219e-03 +-1.2035678895020896e-03 +-1.1427908497319977e-03 +-1.0887757152175013e-03 +-1.0409204269235012e-03 +-9.9862456763307838e-04 +-9.6131418139634652e-04 +-9.2845517468598227e-04 +-8.9955934522490202e-04 +-8.7418582970311283e-04 +-8.5193984470973046e-04 +-8.3246994908948806e-04 +-8.1546461318033866e-04 +-8.0064858254824309e-04 +-7.8777932751439923e-04 +-7.7664374197857335e-04 +-7.6705517384856835e-04 +-7.5885081843406687e-04 +-7.5188947558954989e-04 +-7.4604965343490562e-04 +-7.4122799217001076e-04 +-7.3733797712857902e-04 +-7.3430890950264705e-04 +-7.3208510424453601e-04 +-7.3062528741279348e-04 +-7.2990216863380705e-04 +-2.0560411111830127e-03 +-2.0601045996545254e-03 +-2.0682509802818897e-03 +-2.0805164314827277e-03 +-2.0969409343498100e-03 +-2.1175281647112195e-03 +-2.1421472731595619e-03 +-2.1703218102490820e-03 +-2.2008311383321108e-03 +-2.2311105684343991e-03 +-2.2567017142287697e-03 +-2.2713711017079198e-03 +-2.2684189523936300e-03 +-2.2428107163314308e-03 +-2.1929080631708287e-03 +-2.1208128033044032e-03 +-2.0313751098744999e-03 +-1.9306456731191235e-03 +-1.8245249075352164e-03 +-1.7179472896560939e-03 +-1.6145805202058240e-03 +-1.5168665297597881e-03 +-1.4262284465630572e-03 +-1.3433224854850451e-03 +-1.2682703629141340e-03 +-1.2008471398840385e-03 +-1.1406211188141045e-03 +-1.0870520444035236e-03 +-1.0395566943524660e-03 +-9.9755058084004039e-04 +-9.6047294317813008e-04 +-9.2780048049440772e-04 +-8.9905375360130248e-04 +-8.7379898940606626e-04 +-8.5164713723347683e-04 +-8.3225139793874836e-04 +-8.1530401251541013e-04 +-8.0053280290115156e-04 +-7.8769776248477493e-04 +-7.7658786601701767e-04 +-7.6701818674913586e-04 +-7.5882735692758482e-04 +-7.5187537634883572e-04 +-7.4604175506001399e-04 +-7.4122396632569465e-04 +-7.3733618115481901e-04 +-7.3430825451856251e-04 +-7.3208493416777041e-04 +-7.3062526540511026e-04 +-7.2990216835934095e-04 +-2.0529844589406688e-03 +-2.0570418776748220e-03 +-2.0651658189268771e-03 +-2.0773709492544323e-03 +-2.0936607914049275e-03 +-2.1139776040904226e-03 +-2.1380848885082693e-03 +-2.1653330271881846e-03 +-2.1942634241122047e-03 +-2.2220958590424343e-03 +-2.2443722335185510e-03 +-2.2552511157203406e-03 +-2.2487627284667197e-03 +-2.2206251459672131e-03 +-2.1696382586449976e-03 +-2.0979103057126246e-03 +-2.0099793194138936e-03 +-1.9114624999588580e-03 +-1.8078594756614553e-03 +-1.7038085207648573e-03 +-1.6027945538047573e-03 +-1.5071682649946021e-03 +-1.4183238365759333e-03 +-1.3369255050689982e-03 +-1.2631218206935410e-03 +-1.1967219726197363e-03 +-1.1373291001702697e-03 +-1.0844351532908094e-03 +-1.0374850982760682e-03 +-9.9591832129379099e-04 +-9.5919387118808088e-04 +-9.2680467713293028e-04 +-8.9828449945819622e-04 +-8.7321026126580762e-04 +-8.5120157261789906e-04 +-8.3191865657579890e-04 +-8.1505946510143027e-04 +-8.0035648464553942e-04 +-7.8757353790057430e-04 +-7.7650276045130716e-04 +-7.6696184827246706e-04 +-7.5879161923675506e-04 +-7.5185389916991975e-04 +-7.4602972337516559e-04 +-7.4121783364862221e-04 +-7.3733344528396330e-04 +-7.3430725675536449e-04 +-7.3208467508300353e-04 +-7.3062523188048914e-04 +-7.2990216794309318e-04 +-2.0445792269249341e-03 +-2.0486184530456434e-03 +-2.0566829800431662e-03 +-2.0687403307210117e-03 +-2.0847187413878410e-03 +-2.1044475685585793e-03 +-2.1275259666280197e-03 +-2.1530842288439885e-03 +-2.1794288105454313e-03 +-2.2036569922741058e-03 +-2.2214932528738475e-03 +-2.2276981211326831e-03 +-2.2171901134135545e-03 +-2.1865062980080947e-03 +-2.1348641111570655e-03 +-2.0642953800860198e-03 +-1.9789100536877439e-03 +-1.8837707588244459e-03 +-1.7838718238789833e-03 +-1.6834788027697088e-03 +-1.5858468282600304e-03 +-1.4932131048296024e-03 +-1.4069383226045767e-03 +-1.3277011742960168e-03 +-1.2556892379767749e-03 +-1.1907602361413523e-03 +-1.1325666080536962e-03 +-1.0806458770990248e-03 +-1.0344829661129225e-03 +-9.9355118064583690e-04 +-9.5733778516447418e-04 +-9.2535888404885749e-04 +-8.9716713086922164e-04 +-8.7235479349419948e-04 +-8.5055393285525310e-04 +-8.3143488688486582e-04 +-8.1470384828031021e-04 +-8.0010004500769493e-04 +-7.8739284206339594e-04 +-7.7637895553167384e-04 +-7.6687988612337773e-04 +-7.5873962513237244e-04 +-7.5182265153083305e-04 +-7.4601221791709528e-04 +-7.4120891086500173e-04 +-7.3732946470192137e-04 +-7.3430580505266688e-04 +-7.3208429812703524e-04 +-7.3062518310437318e-04 +-7.2990216733895177e-04 +-2.0242471841673206e-03 +-2.0282417603304224e-03 +-2.0361772158025743e-03 +-2.0479409348672824e-03 +-2.0633393210858393e-03 +-2.0820370641965211e-03 +-2.1034305589931459e-03 +-2.1264362153500770e-03 +-2.1492112979383218e-03 +-2.1689055410399499e-03 +-2.1816436687213990e-03 +-2.1829603011169303e-03 +-2.1687248531488596e-03 +-2.1362513646757046e-03 +-2.0850757633799496e-03 +-2.0170386150117734e-03 +-1.9357103359275980e-03 +-1.8454989994289826e-03 +-1.7508113362180015e-03 +-1.6554802243994766e-03 +-1.5624943637524656e-03 +-1.4739612810288744e-03 +-1.3912074067924302e-03 +-1.3149351719907037e-03 +-1.2453859526334612e-03 +-1.1824829344347751e-03 +-1.1259447997430604e-03 +-1.0753703844780908e-03 +-1.0302985310776064e-03 +-9.9024848550995450e-04 +-9.5474587225179109e-04 +-9.2333841946842094e-04 +-8.9560465185230481e-04 +-8.7115791810800358e-04 +-8.4964743613613028e-04 +-8.3075752067330916e-04 +-8.1420578040249266e-04 +-7.9974080374358976e-04 +-7.8713966671155561e-04 +-7.7620546954045174e-04 +-7.6676502384414940e-04 +-7.5866675607281684e-04 +-7.5177885684933707e-04 +-7.4598768295816434e-04 +-7.4119640497324456e-04 +-7.3732388565539105e-04 +-7.3430377040890004e-04 +-7.3208376980577090e-04 +-7.3062511474317616e-04 +-7.2990216649340429e-04 +-1.9822037913288021e-03 +-1.9861082632244014e-03 +-1.9938140378907578e-03 +-2.0051098619011656e-03 +-2.0196572010805348e-03 +-2.0369397848458569e-03 +-2.0561630918857362e-03 +-2.0760965476110376e-03 +-2.0948853790079013e-03 +-2.1099169616548450e-03 +-2.1178817525499506e-03 +-2.1151578240280870e-03 +-2.0985135078553162e-03 +-2.0659097301465815e-03 +-2.0170592164820947e-03 +-1.9534970387169131e-03 +-1.8781709639584428e-03 +-1.7947720438537661e-03 +-1.7070704139143041e-03 +-1.6184297856361117e-03 +-1.5315496143437741e-03 +-1.4483985349744723e-03 +-1.3702710436707686e-03 +-1.2979039613894060e-03 +-1.2316081146531758e-03 +-1.1713900294312348e-03 +-1.1170527405722423e-03 +-1.0682734900602960e-03 +-1.0246604538864930e-03 +-9.8579229498084410e-04 +-9.5124453298574621e-04 +-9.2060625119132797e-04 +-8.9348997670542208e-04 +-8.6953689361926199e-04 +-8.4841897093003199e-04 +-8.2983912980830502e-04 +-8.1353023022085705e-04 +-7.9925340563656425e-04 +-7.8679609572260387e-04 +-7.7597000212441085e-04 +-7.6660910676993016e-04 +-7.5856783428733467e-04 +-7.5171940173976795e-04 +-7.4595437392054444e-04 +-7.4117942670953003e-04 +-7.3731631146869536e-04 +-7.3430100818064770e-04 +-7.3208305256664572e-04 +-7.3062502193852320e-04 +-7.2990216534651376e-04 +-1.9092005684720704e-03 +-1.9129536264689379e-03 +-1.9203141945187607e-03 +-1.9309872161556755e-03 +-1.9445143310346195e-03 +-1.9602398529449025e-03 +-1.9772460208458795e-03 +-1.9942565670671457e-03 +-2.0095317668411238e-03 +-2.0208142590494734e-03 +-2.0254135164124538e-03 +-2.0205016490164917e-03 +-2.0036082164764098e-03 +-1.9731758681600779e-03 +-1.9289617623068952e-03 +-1.8721178878827588e-03 +-1.8049328991728241e-03 +-1.7303619202122473e-03 +-1.6515225019075829e-03 +-1.5712931483869274e-03 +-1.4920709729666841e-03 +-1.4156789328503463e-03 +-1.3433804280816159e-03 +-1.2759543920771992e-03 +-1.2137938392702938e-03 +-1.1570042768621310e-03 +-1.1054898149809572e-03 +-1.0590225759980105e-03 +-1.0172954545711801e-03 +-9.7996038194946575e-04 +-9.4665492787978430e-04 +-9.1702000700115568e-04 +-8.9071106690465898e-04 +-8.6740465674158224e-04 +-8.4680182258285209e-04 +-8.2862939378206739e-04 +-8.1263992271113112e-04 +-7.9861081151572197e-04 +-7.8634299133223786e-04 +-7.7565939845995670e-04 +-7.6640340659223463e-04 +-7.5843731488879228e-04 +-7.5164095111109996e-04 +-7.4591042177880439e-04 +-7.4115702337879455e-04 +-7.3730631720371703e-04 +-7.3429736343593528e-04 +-7.3208210619042993e-04 +-7.3062489948746794e-04 +-7.2990216383405943e-04 +-1.8021198551558138e-03 +-1.8056566533520776e-03 +-1.8125634862350129e-03 +-1.8225039384933263e-03 +-1.8349633920697634e-03 +-1.8492300360045087e-03 +-1.8643611614102256e-03 +-1.8791363648232688e-03 +-1.8920130515595389e-03 +-1.9011192895253984e-03 +-1.9043335949302618e-03 +-1.8994916968079747e-03 +-1.8847135462695553e-03 +-1.8587734367797577e-03 +-1.8213867042598164e-03 +-1.7733017645326201e-03 +-1.7161649983152109e-03 +-1.6522177976637303e-03 +-1.5839349646474240e-03 +-1.5137052565756040e-03 +-1.4436109122972424e-03 +-1.3753162079224431e-03 +-1.3100449638610051e-03 +-1.2486161430508827e-03 +-1.1915089169494285e-03 +-1.1389363426637757e-03 +-1.0909150558440013e-03 +-1.0473248698866500e-03 +-1.0079564215595002e-03 +-9.7254738334935252e-04 +-9.4080885433426393e-04 +-9.1244385878190321e-04 +-8.8715979304212112e-04 +-8.6467639724014376e-04 +-8.4473051814531108e-04 +-8.2707863748567414e-04 +-8.1149789188319967e-04 +-7.9778611223948147e-04 +-7.8576125802160533e-04 +-7.7526050811058578e-04 +-7.6613918672513144e-04 +-7.5826964323876412e-04 +-7.5154016251996849e-04 +-7.4585395305698369e-04 +-7.4112824002603558e-04 +-7.3729347696633348e-04 +-7.3429268092127867e-04 +-7.3208089038156619e-04 +-7.3062474217796636e-04 +-7.2990216189177629e-04 +-1.6665455899782433e-03 +-1.6698133201519232e-03 +-1.6761843811670214e-03 +-1.6853279536447263e-03 +-1.6967419229993491e-03 +-1.7097438296068213e-03 +-1.7234569715251604e-03 +-1.7367940863155878e-03 +-1.7484477095205948e-03 +-1.7569056344439852e-03 +-1.7605168179586224e-03 +-1.7576286958389772e-03 +-1.7467942015734733e-03 +-1.7270102607546028e-03 +-1.6979188611591528e-03 +-1.6599006272088139e-03 +-1.6140260552721824e-03 +-1.5618822959289770e-03 +-1.5053333742497685e-03 +-1.4462809903749787e-03 +-1.3864752623917885e-03 +-1.3273963861485298e-03 +-1.2702041557988895e-03 +-1.2157390763064145e-03 +-1.1645555304364086e-03 +-1.1169701858914066e-03 +-1.0731137699339982e-03 +-1.0329791499880975e-03 +-9.9646234480698682e-04 +-9.6339550207065559e-04 +-9.3357224312206276e-04 +-9.0676641440070086e-04 +-8.8274547943022533e-04 +-8.6127973910181909e-04 +-8.4214841257677887e-04 +-8.2514342251796611e-04 +-8.1007154611207970e-04 +-7.9675543488745310e-04 +-7.8503387677015049e-04 +-7.7476157207961242e-04 +-7.6580861752895916e-04 +-7.5805983433073574e-04 +-7.5141403398566948e-04 +-7.4578328460474469e-04 +-7.4109221872666194e-04 +-7.3727740821874391e-04 +-7.3428682123058084e-04 +-7.3207936896873659e-04 +-7.3062454533252786e-04 +-7.2990215946195432e-04 +-1.5143541010772868e-03 +-1.5173227675601827e-03 +-1.5231146276545675e-03 +-1.5314373242251403e-03 +-1.5418488579970241e-03 +-1.5537537380663974e-03 +-1.5663989050702864e-03 +-1.5788718212979744e-03 +-1.5901060046182307e-03 +-1.5989031683947509e-03 +-1.6039840096999493e-03 +-1.6040778389378966e-03 +-1.5980512264256162e-03 +-1.5850583769057036e-03 +-1.5646785257710564e-03 +-1.5369996406050521e-03 +-1.5026199930329998e-03 +-1.4625653572084281e-03 +-1.4181461994668798e-03 +-1.3707934129895975e-03 +-1.3219090070397644e-03 +-1.2727549123809662e-03 +-1.2243872992014388e-03 +-1.1776318418097182e-03 +-1.1330893301510813e-03 +-1.0911599661806157e-03 +-1.0520765110508710e-03 +-1.0159393083960791e-03 +-9.8274895037618365e-04 +-9.5243447976955660e-04 +-9.2487645038985013e-04 +-8.9992501086362357e-04 +-8.7741359912147396e-04 +-8.5716898870085150e-04 +-8.3901842799525823e-04 +-8.2279453712452266e-04 +-8.0833852140984523e-04 +-7.9550215185489564e-04 +-7.8414886452307425e-04 +-7.7415424731844317e-04 +-7.6540611516352254e-04 +-7.5780432156937610e-04 +-7.5126041393329488e-04 +-7.4569720925520260e-04 +-7.4104834420293710e-04 +-7.3725783675252182e-04 +-7.3427968450553234e-04 +-7.3207751606027636e-04 +-7.3062430560486729e-04 +-7.2990215650334722e-04 +-1.3589587929426980e-03 +-1.3616235964620809e-03 +-1.3668338045669784e-03 +-1.3743496213134982e-03 +-1.3838092006731430e-03 +-1.3947270571713602e-03 +-1.4064937549349542e-03 +-1.4183788609944306e-03 +-1.4295403243271736e-03 +-1.4390448821678373e-03 +-1.4459050679570993e-03 +-1.4491374869752315e-03 +-1.4478427363165426e-03 +-1.4412994811107552e-03 +-1.4290562017180914e-03 +-1.4109987469842857e-03 +-1.3873743834938461e-03 +-1.3587639336328499e-03 +-1.3260083166630877e-03 +-1.2901076203242789e-03 +-1.2521151183377576e-03 +-1.2130452246165888e-03 +-1.1738065004128567e-03 +-1.1351625289880098e-03 +-1.0977174218611328e-03 +-1.0619197068989995e-03 +-1.0280778373219115e-03 +-9.9638153830993934e-04 +-9.6692476042691856e-04 +-9.3972754536560837e-04 +-9.1475534966697870e-04 +-8.9193524688261055e-04 +-8.7116897804791280e-04 +-8.5234312303114038e-04 +-8.3533680068076659e-04 +-8.2002733804444441e-04 +-8.0629432436702579e-04 +-7.9402241426863374e-04 +-7.8310318466644690e-04 +-7.7343629167175073e-04 +-7.6493012169687061e-04 +-7.5750208709528602e-04 +-7.5107868088594633e-04 +-7.4559537670371807e-04 +-7.4099643797554196e-04 +-7.3723468329613248e-04 +-7.3427124201648779e-04 +-7.3207532424326982e-04 +-7.3062402204062131e-04 +-7.2990215300419801e-04 +-1.2115513365598197e-03 +-1.2139284549402662e-03 +-1.2185894169732397e-03 +-1.2253469605853103e-03 +-1.2339187587133329e-03 +-1.2439266732385088e-03 +-1.2548974034282722e-03 +-1.2662660075808392e-03 +-1.2773842610305515e-03 +-1.2875362974524038e-03 +-1.2959642001484782e-03 +-1.3019056612365645e-03 +-1.3046439231757148e-03 +-1.3035667394775622e-03 +-1.2982267372231137e-03 +-1.2883920940760622e-03 +-1.2740759723703376e-03 +-1.2555367934841892e-03 +-1.2332482702626293e-03 +-1.2078454799923381e-03 +-1.1800582568997381e-03 +-1.1506442781170135e-03 +-1.1203317966127523e-03 +-1.0897776997334171e-03 +-1.0595422621611933e-03 +-1.0300787994653338e-03 +-1.0017347704150764e-03 +-9.7476049382941364e-04 +-9.4932207276256458e-04 +-9.2551590841932437e-04 +-9.0338302534493568e-04 +-8.8292214992461272e-04 +-8.6410102605572565e-04 +-8.4686581848465649e-04 +-8.3114867761088860e-04 +-8.1687365826055606e-04 +-8.0396123382295249e-04 +-7.9233165330783455e-04 +-7.8190737148395328e-04 +-7.7261475388534079e-04 +-7.6438522680085763e-04 +-7.5715601170730455e-04 +-7.5087055609571413e-04 +-7.4547874907621885e-04 +-7.4093699058054498e-04 +-7.3720816707061726e-04 +-7.3426157390692908e-04 +-7.3207281437861994e-04 +-7.3062369734420507e-04 +-7.2990214899792852e-04 +-1.0795753655753770e-03 +-1.0816949989148790e-03 +-1.0858634568687612e-03 +-1.0919386114816344e-03 +-1.0997062636086646e-03 +-1.1088796815170031e-03 +-1.1191002150173382e-03 +-1.1299400102409865e-03 +-1.1409080667560793e-03 +-1.1514610312782832e-03 +-1.1610201099907726e-03 +-1.1689951269111788e-03 +-1.1748158461497341e-03 +-1.1779690985985064e-03 +-1.1780381930598255e-03 +-1.1747391518190076e-03 +-1.1679473819502806e-03 +-1.1577092214834291e-03 +-1.1442354739418094e-03 +-1.1278777978400592e-03 +-1.1090923454332949e-03 +-1.0883971689159826e-03 +-1.0663301330004940e-03 +-1.0434126825734360e-03 +-1.0201225907405936e-03 +-9.9687657467097297e-04 +-9.7402196183176933e-04 +-9.5183561165404517e-04 +-9.3052797362844263e-04 +-9.1025029113714123e-04 +-8.9110332693918500e-04 +-8.7314642524026042e-04 +-8.5640613464690440e-04 +-8.4088394828226993e-04 +-8.2656296057705993e-04 +-8.1341340319579470e-04 +-8.0139712164611324e-04 +-7.9047110680826704e-04 +-7.8059021706210522e-04 +-7.7170922862961229e-04 +-7.6378434260532875e-04 +-7.5677426256850274e-04 +-7.5064094022107614e-04 +-7.4535007026164501e-04 +-7.4087140079102433e-04 +-7.3717891242175806e-04 +-7.3425090803503235e-04 +-7.3207004567441654e-04 +-7.3062333918088673e-04 +-7.2990214457910568e-04 +-9.6691746949145317e-04 +-9.6881720331093663e-04 +-9.7256350943264783e-04 +-9.7804969875561038e-04 +-9.8511500906767386e-04 +-9.9354424708913351e-04 +-1.0030681524986647e-03 +-1.0133651638229819e-03 +-1.0240653758206357e-03 +-1.0347575274912242e-03 +-1.0449998061722980e-03 +-1.0543350312722966e-03 +-1.0623103159849707e-03 +-1.0685005520348347e-03 +-1.0725340717416152e-03 +-1.0741178162730859e-03 +-1.0730586244724002e-03 +-1.0692772252854272e-03 +-1.0628123746536744e-03 +-1.0538142063392492e-03 +-1.0425278196574141e-03 +-1.0292698133774580e-03 +-1.0144014192876348e-03 +-9.9830192203180339e-04 +-9.8134532864558124e-04 +-9.6388212184882085e-04 +-9.4622676590334486e-04 +-9.2865069616084733e-04 +-9.1137992761744545e-04 +-8.9459615445643256e-04 +-8.7844020256926504e-04 +-8.6301684193113666e-04 +-8.4840017959881414e-04 +-8.3463907673409909e-04 +-8.2176222995500347e-04 +-8.0978271391976434e-04 +-7.9870189657231820e-04 +-7.8851271590443480e-04 +-7.7920235500868781e-04 +-7.7075437837277540e-04 +-7.6315040353714021e-04 +-7.5637138372369218e-04 +-7.5039857275482685e-04 +-7.4521423623566071e-04 +-7.4080216435598654e-04 +-7.3714803287990320e-04 +-7.3423965055746904e-04 +-7.3206712360849191e-04 +-7.3062296120003070e-04 +-7.2990213991613645e-04 +-8.7486234765564116e-04 +-8.7658224978450047e-04 +-8.7998193765324764e-04 +-8.8498091479739815e-04 +-8.9145790074739661e-04 +-8.9925052908396423e-04 +-9.0815549824400693e-04 +-9.1792961668068758e-04 +-9.2829224675577049e-04 +-9.3892967180862893e-04 +-9.4950186787383871e-04 +-9.5965202948844670e-04 +-9.6901895077031175e-04 +-9.7725198275011474e-04 +-9.8402779256467226e-04 +-9.8906761058627939e-04 +-9.9215319914570423e-04 +-9.9313957572932780e-04 +-9.9196271000353978e-04 +-9.8864102151784562e-04 +-9.8327042446204414e-04 +-9.7601366958333525e-04 +-9.6708555893308375e-04 +-9.5673606097150586e-04 +-9.4523336848172481e-04 +-9.3284859066870862e-04 +-9.1984320788912426e-04 +-9.0645981122190354e-04 +-8.9291612913049688e-04 +-8.7940197783983561e-04 +-8.6607857202016653e-04 +-8.5307957175197711e-04 +-8.4051327822772437e-04 +-8.2846548179830494e-04 +-8.1700257790553359e-04 +-8.0617467643540888e-04 +-7.9601852548676728e-04 +-7.8656014643986940e-04 +-7.7781713330673640e-04 +-7.6980060801306325e-04 +-7.6251684788081057e-04 +-7.5596861562120916e-04 +-7.5015622867568958e-04 +-7.4507840623729915e-04 +-7.4073293062927863e-04 +-7.3711715625604025e-04 +-7.3422839499646248e-04 +-7.3206420226052836e-04 +-7.3062258333452901e-04 +-7.2990213525488199e-04 +-8.0313957044169770e-04 +-8.0471922722557144e-04 +-8.0784760927289612e-04 +-8.1246266077706188e-04 +-8.1847089709992458e-04 +-8.2574714717997149e-04 +-8.3413457224233386e-04 +-8.4344524852627775e-04 +-8.5346164112090075e-04 +-8.6393930776170965e-04 +-8.7461114514140233e-04 +-8.8519341433391054e-04 +-8.9539364568282304e-04 +-9.0492032170388535e-04 +-9.1349397629474712e-04 +-9.2085905705431190e-04 +-9.2679562618574942e-04 +-9.3112979438374763e-04 +-9.3374176171856385e-04 +-9.3457052315233386e-04 +-9.3361467539151391e-04 +-9.3092926816468104e-04 +-9.2661916610120186e-04 +-9.2082981034555950e-04 +-9.1373650769321869e-04 +-9.0553340166717644e-04 +-8.9642312356526753e-04 +-8.8660784848362709e-04 +-8.7628216839642878e-04 +-8.6562790589976189e-04 +-8.5481076818550014e-04 +-8.4397859574964406e-04 +-8.3326088937333859e-04 +-8.2276928618843460e-04 +-8.1259868183377671e-04 +-8.0282874308577141e-04 +-7.9352561021160532e-04 +-7.8474364153449205e-04 +-7.7652709920928971e-04 +-7.6891171286908933e-04 +-7.6192608644325502e-04 +-7.5559293398465310e-04 +-7.4993014417108783e-04 +-7.4495168174496071e-04 +-7.4066833888400277e-04 +-7.3708835148583404e-04 +-7.3421789549418988e-04 +-7.3206147735026348e-04 +-7.3062223089832845e-04 +-7.2990213090757216e-04 +-7.5076480220740609e-04 +-7.5224193764473525e-04 +-7.5517140104715242e-04 +-7.5950343180933918e-04 +-7.6516307954719285e-04 +-7.7204998356102280e-04 +-7.8003832300716468e-04 +-7.8897713159294493e-04 +-7.9869119726606278e-04 +-8.0898277631394192e-04 +-8.1963433675657582e-04 +-8.3041250212659756e-04 +-8.4107328899755670e-04 +-8.5136861815159168e-04 +-8.6105393367269609e-04 +-8.6989659826419697e-04 +-8.7768456838876259e-04 +-8.8423472001344038e-04 +-8.8940012904877355e-04 +-8.9307563844605450e-04 +-8.9520117806404017e-04 +-8.9576253103721272e-04 +-8.9478952401392297e-04 +-8.9235190508962596e-04 +-8.8855340866217077e-04 +-8.8352465144816462e-04 +-8.7741554313511630e-04 +-8.7038783793389287e-04 +-8.6260832688798397e-04 +-8.5424300994595907e-04 +-8.4545242395349753e-04 +-8.3638816165815635e-04 +-8.2719051046505792e-04 +-8.1798707121199447e-04 +-8.0889218293732845e-04 +-8.0000697211390069e-04 +-7.9141985571868419e-04 +-7.8320734913363711e-04 +-7.7543505615292605e-04 +-7.6815874504863608e-04 +-7.6142543909375358e-04 +-7.5527447082107018e-04 +-7.4973846617122468e-04 +-7.4484423768026852e-04 +-7.4061357541410524e-04 +-7.3706393103343734e-04 +-7.3420899474915900e-04 +-7.3205916752532225e-04 +-7.3062193216518140e-04 +-7.2990212722283789e-04 +-7.1661644900516226e-04 +-7.1802664274293654e-04 +-7.2082593878107428e-04 +-7.2497203729955184e-04 +-7.3040123601713551e-04 +-7.3702823692083151e-04 +-7.4474606627067917e-04 +-7.5342624891306189e-04 +-7.6291939767880485e-04 +-7.7305638624751948e-04 +-7.8365026580708510e-04 +-7.9449905883281031e-04 +-8.0538951494344010e-04 +-8.1610184340154203e-04 +-8.2641534654265139e-04 +-8.3611477419271200e-04 +-8.4499711140384221e-04 +-8.5287841532415219e-04 +-8.5960024909111619e-04 +-8.6503523810345763e-04 +-8.6909130873223325e-04 +-8.7171426409099245e-04 +-8.7288849673949898e-04 +-8.7263581383326583e-04 +-8.7101252882314207e-04 +-8.6810512721278152e-04 +-8.6402491986262771e-04 +-8.5890214427887458e-04 +-8.5287996267561096e-04 +-8.4610874598946338e-04 +-8.3874094225845164e-04 +-8.3092672419485117e-04 +-8.2281051040526405e-04 +-8.1452836894622266e-04 +-8.0620624687273098e-04 +-7.9795892658522736e-04 +-7.8988958715925633e-04 +-7.8208984256525793e-04 +-7.7464013417691171e-04 +-7.6761036786094673e-04 +-7.6106070258402431e-04 +-7.5504241512711566e-04 +-7.4959878232119987e-04 +-7.4476593712823763e-04 +-7.4057366738966091e-04 +-7.3704613605018890e-04 +-7.3420250929535642e-04 +-7.3205748459934030e-04 +-7.3062171452060239e-04 +-7.2990212453841121e-04 +-6.9978949888036229e-04 +-7.0116658500655126e-04 +-7.0390141399821109e-04 +-7.0795519624232688e-04 +-7.1326952275195001e-04 +-7.1976618711063985e-04 +-7.2734709599068278e-04 +-7.3589438563894641e-04 +-7.4527087834045335e-04 +-7.5532101978958608e-04 +-7.6587243292746689e-04 +-7.7673820381686412e-04 +-7.8771997894204102e-04 +-7.9861190065365405e-04 +-8.0920533990299108e-04 +-8.1929430685414358e-04 +-8.2868133697236478e-04 +-8.3718357182027063e-04 +-8.4463869094051594e-04 +-8.5091031523471146e-04 +-8.5589250298135234e-04 +-8.5951300292931901e-04 +-8.6173501442696578e-04 +-8.6255732453894066e-04 +-8.6201283179578709e-04 +-8.6016560623091180e-04 +-8.5710675556743300e-04 +-8.5294945133291341e-04 +-8.4782350687627841e-04 +-8.4186989092774290e-04 +-8.3523551254186836e-04 +-8.2806853843218702e-04 +-8.2051441629532400e-04 +-8.1271269110052484e-04 +-8.0479462561128430e-04 +-7.9688157758830546e-04 +-7.8908404620644948e-04 +-7.8150127812985496e-04 +-7.7422131642350248e-04 +-7.6732137919999428e-04 +-7.6086846576226095e-04 +-7.5492010268636350e-04 +-7.4952515822673186e-04 +-7.4472466884155234e-04 +-7.4055263544936154e-04 +-7.3703675870286556e-04 +-7.3419909196417602e-04 +-7.3205659789028646e-04 +-7.3062159985272444e-04 +-7.2990212312413192e-04 +-6.9978946823184124e-04 +-7.0116630881939348e-04 +-7.0390064503705809e-04 +-7.0795368469620023e-04 +-7.1326701698169205e-04 +-7.1976243679500976e-04 +-7.2734185834750153e-04 +-7.3588743519953923e-04 +-7.4526202041317843e-04 +-7.5531010723513205e-04 +-7.6585938519375680e-04 +-7.7672302640821339e-04 +-7.8770278075501700e-04 +-7.9859290608980723e-04 +-8.0918489258180362e-04 +-8.1927286227982774e-04 +-8.2865944272798159e-04 +-8.3716183567061767e-04 +-8.4461773932411580e-04 +-8.5089074656721981e-04 +-8.5587484149246605e-04 +-8.5949765903888583e-04 +-8.6172225680109676e-04 +-8.6254726711934321e-04 +-8.6200543668569704e-04 +-8.6016070089499613e-04 +-8.5710406086924327e-04 +-8.5294861582631406e-04 +-8.4782414258224924e-04 +-8.4187160643842227e-04 +-8.3523794042779820e-04 +-8.2807135526838881e-04 +-8.2051735488833431e-04 +-8.1271554550342031e-04 +-8.0479725017203283e-04 +-7.9688388159129928e-04 +-7.8908598569836898e-04 +-7.8150284635563119e-04 +-7.7422253402348426e-04 +-7.6732228500806389e-04 +-7.6086910874794442e-04 +-7.5492053533201826e-04 +-7.4952543143632006e-04 +-7.4472482834062189e-04 +-7.4055271954954235e-04 +-7.3703679725784855e-04 +-7.3419910632643566e-04 +-7.3205660167824816e-04 +-7.3062160034792056e-04 +-7.2990212313028217e-04 +-7.1661635226917910e-04 +-7.1802577101591296e-04 +-7.2082351175829741e-04 +-7.2496726677278146e-04 +-7.3039332869959150e-04 +-7.3701640524982703e-04 +-7.4472954941037133e-04 +-7.5340434547726848e-04 +-7.6289151048330919e-04 +-7.7302207759849214e-04 +-7.8360931948677438e-04 +-7.9445154230849786e-04 +-8.0533583289249435e-04 +-8.1604277210612839e-04 +-8.2635203881376560e-04 +-8.3604872680791619e-04 +-8.4493009170464315e-04 +-8.5281235007419521e-04 +-8.5953708572707828e-04 +-8.6497679447198890e-04 +-8.6903913069832711e-04 +-8.7166951000465466e-04 +-8.7285186359662543e-04 +-8.7260751301540898e-04 +-8.7099231121301013e-04 +-8.6809235009944184e-04 +-8.6401864284528528e-04 +-8.5890123909622841e-04 +-8.5288322247253467e-04 +-8.4611498230360263e-04 +-8.3874906197583165e-04 +-8.3093578290134313e-04 +-8.2281974219420553e-04 +-8.1453719540053977e-04 +-8.0621426950162260e-04 +-7.9796590756915631e-04 +-7.8989542307845236e-04 +-7.8209453512943935e-04 +-7.7464376108582803e-04 +-7.6761305599773086e-04 +-7.6106260490143467e-04 +-7.5504369189673592e-04 +-7.4959958689850602e-04 +-7.4476640603326376e-04 +-7.4057391428831098e-04 +-7.3704624911300691e-04 +-7.3420255137660820e-04 +-7.3205749569101182e-04 +-7.3062171596997090e-04 +-7.2990212455637036e-04 +-7.5076462421479315e-04 +-7.5224033368940482e-04 +-7.5516693554668302e-04 +-7.5949465549157149e-04 +-7.6514853640531188e-04 +-7.7202823401653609e-04 +-7.8000798768485197e-04 +-7.8893695850724001e-04 +-7.9864015247013372e-04 +-8.0892015401976751e-04 +-8.1955987978981032e-04 +-8.3032651803101657e-04 +-8.4097674240259026e-04 +-8.5126317781166188e-04 +-8.6094195449696405e-04 +-8.6978102562897792e-04 +-8.7756876370454645e-04 +-8.8412222092220370e-04 +-8.8929437143014565e-04 +-8.9297967687175777e-04 +-8.9511744358303853e-04 +-8.9569265928520067e-04 +-8.9473427406326373e-04 +-8.9231117348417051e-04 +-8.8852632769191163e-04 +-8.8350974926812453e-04 +-8.7741093765586942e-04 +-8.7039143658721591e-04 +-8.6261800909823844e-04 +-8.5425677642582344e-04 +-8.4546850480424890e-04 +-8.3640508217609733e-04 +-8.2720711868311363e-04 +-8.1800253429958718e-04 +-8.0890596084333790e-04 +-8.0001877670313572e-04 +-7.9142960262119715e-04 +-7.8321510804739761e-04 +-7.7544100375695024e-04 +-7.6816312322094038e-04 +-7.6142851990797992e-04 +-7.5527652886032601e-04 +-7.4973975803880352e-04 +-7.4484498816652553e-04 +-7.4061396954668718e-04 +-7.3706411114278720e-04 +-7.3420906167621805e-04 +-7.3205918514484733e-04 +-7.3062193446577525e-04 +-7.2990212725135653e-04 +-8.0313928324706059e-04 +-8.0471663923347510e-04 +-8.0784040456154539e-04 +-8.1244850348775877e-04 +-8.1844744708885696e-04 +-8.2571210565381375e-04 +-8.3408576520956589e-04 +-8.4338075243079965e-04 +-8.5337994914609996e-04 +-8.6383952680575715e-04 +-8.7449320303059446e-04 +-8.8505824631226646e-04 +-8.9524332162875075e-04 +-9.0475807450715573e-04 +-9.1332410035946745e-04 +-9.2068666472547604e-04 +-9.2662627633389690e-04 +-9.3096903528319273e-04 +-9.3359465177596484e-04 +-9.3444120110349957e-04 +-9.3350604329350178e-04 +-9.3084282810594957e-04 +-9.2655502162689442e-04 +-9.2078681445810354e-04 +-9.1371251792462757e-04 +-9.0552559272589757e-04 +-8.9642830924144647e-04 +-8.8662277387559945e-04 +-8.7630374698128156e-04 +-8.6565338972690090e-04 +-8.5483785092732979e-04 +-8.4400545628554721e-04 +-8.3328618793083987e-04 +-8.2279212643251304e-04 +-8.1261855157581235e-04 +-8.0284544435819212e-04 +-7.9353918703329598e-04 +-7.8475431126627938e-04 +-7.7653519125598475e-04 +-7.6891761675488158e-04 +-7.6193020999459058e-04 +-7.5559567146076098e-04 +-7.4993185361909795e-04 +-7.4495267054800081e-04 +-7.4066885634487066e-04 +-7.3708858728414937e-04 +-7.3421798292171755e-04 +-7.3206150032947555e-04 +-7.3062223389550800e-04 +-7.2990213094468396e-04 +-8.7486190664024519e-04 +-8.7657827571602654e-04 +-8.7997087511553613e-04 +-8.8495918242576768e-04 +-8.9142192485470138e-04 +-8.9919683155504184e-04 +-9.0808085208415846e-04 +-9.1783127510771485e-04 +-9.2816823917987192e-04 +-9.3877914239962783e-04 +-9.4932541177286992e-04 +-9.5945196295555010e-04 +-9.6879944188739419e-04 +-9.7701897624802672e-04 +-9.8378869028108726e-04 +-9.8883071561002068e-04 +-9.9192698624745649e-04 +-9.9293189679045316e-04 +-9.9178006477544699e-04 +-9.8848801266489370e-04 +-9.8314947469662294e-04 +-9.7592502142986623e-04 +-9.6702752216893740e-04 +-9.5670543387746181e-04 +-9.4522594351538014e-04 +-9.3285966135656139e-04 +-9.1986801429309027e-04 +-9.0649388737927431e-04 +-8.9295554012305833e-04 +-8.7944345241919232e-04 +-8.6611954777255674e-04 +-8.5311817443185518e-04 +-8.4054825688349006e-04 +-8.2849611854082144e-04 +-8.1702858718195911e-04 +-8.0619610453062148e-04 +-7.9603565728919514e-04 +-7.8657342354043519e-04 +-7.7782708529046439e-04 +-7.6980779727452240e-04 +-7.6252182731930643e-04 +-7.5597189801435551e-04 +-7.5015826626954158e-04 +-7.4507957902871533e-04 +-7.4073354187573356e-04 +-7.3711743387422932e-04 +-7.3422849766465663e-04 +-7.3206422919421085e-04 +-7.3062258684307966e-04 +-7.2990213529831437e-04 +-9.6691680853196735e-04 +-9.6881124738056870e-04 +-9.7254693178027449e-04 +-9.7801714313494820e-04 +-9.8506115939999881e-04 +-9.9346399478581469e-04 +-1.0029568836596281e-03 +-1.0132191721932322e-03 +-1.0238823805427731e-03 +-1.0345372382444267e-03 +-1.0447444385361469e-03 +-1.0540496446811299e-03 +-1.0620028419992900e-03 +-1.0681814158686970e-03 +-1.0722153874799627e-03 +-1.0738122401456338e-03 +-1.0727780484252622e-03 +-1.0690315479784077e-03 +-1.0626085753238335e-03 +-1.0536558713025550e-03 +-1.0424151596178423e-03 +-1.0292001016081007e-03 +-1.0143697085501270e-03 +-9.9830187520442331e-04 +-9.8137001818821338e-04 +-9.6392469855798230e-04 +-9.4628094849972231e-04 +-9.2871107615669676e-04 +-9.1144211230740344e-04 +-8.9465678467376972e-04 +-8.7849688442575148e-04 +-8.6306802745206789e-04 +-8.4844502374311682e-04 +-8.3467729035272508e-04 +-8.2179394123617778e-04 +-8.0980834537841182e-04 +-7.9872206071046939e-04 +-7.8852813008102552e-04 +-7.7921377450330628e-04 +-7.7076254580942612e-04 +-7.6315601250287316e-04 +-7.5637505438611030e-04 +-7.5040083742080861e-04 +-7.4521553301412310e-04 +-7.4080283733543193e-04 +-7.3714833747436505e-04 +-7.3423976289424954e-04 +-7.3206715301883435e-04 +-7.3062296502604052e-04 +-7.2990213996345808e-04 +-1.0795743930654611e-03 +-1.0816862357711857e-03 +-1.0858390690338814e-03 +-1.0918907395469453e-03 +-1.0996271622202088e-03 +-1.1087620332617858e-03 +-1.1189376541908603e-03 +-1.1297278563598035e-03 +-1.1406442106401634e-03 +-1.1511468426330437e-03 +-1.1606611625502919e-03 +-1.1686014966400084e-03 +-1.1744017651791529e-03 +-1.1775518629319214e-03 +-1.1776364101740047e-03 +-1.1743706169059680e-03 +-1.1676270072937787e-03 +-1.1574474488043798e-03 +-1.1440374664766137e-03 +-1.1277434918615010e-03 +-1.1090172266085732e-03 +-1.0883735004827686e-03 +-1.0663483286611920e-03 +-1.0434625696970517e-03 +-1.0201944065317109e-03 +-9.9696163733504041e-04 +-9.7411303391649860e-04 +-9.5192701524929497e-04 +-9.3061553118287924e-04 +-9.1033116088837576e-04 +-8.9117578792681420e-04 +-8.7320965057057095e-04 +-8.5645997708990341e-04 +-8.4092875102613756e-04 +-8.2659939819880056e-04 +-8.1344235307985848e-04 +-8.0141956343191629e-04 +-7.9048804625697709e-04 +-7.8060263043672987e-04 +-7.7171802387884922e-04 +-7.6379033406942087e-04 +-7.5677815642748083e-04 +-7.5064332839633286e-04 +-7.4535143091969912e-04 +-7.4087210396884271e-04 +-7.3717922959551613e-04 +-7.3425102469484914e-04 +-7.3207007615498079e-04 +-7.3062334314079986e-04 +-7.2990214462805242e-04 +-1.2115499364712403e-03 +-1.2139158392790851e-03 +-1.2185543138115234e-03 +-1.2252780947907803e-03 +-1.2338051204922409e-03 +-1.2437580933454297e-03 +-1.2546654877770441e-03 +-1.2659654079145118e-03 +-1.2770141398264932e-03 +-1.2871017009940097e-03 +-1.2954769314119825e-03 +-1.3013842169994139e-03 +-1.3041121947370688e-03 +-1.3030514842171756e-03 +-1.2977542245050321e-03 +-1.2879846499908307e-03 +-1.2737492324338907e-03 +-1.2552982640713676e-03 +-1.2330973894876230e-03 +-1.2077749418638762e-03 +-1.1800560868488277e-03 +-1.1506960905891183e-03 +-1.1204227852279951e-03 +-1.0898941107846147e-03 +-1.0596722924324483e-03 +-1.0302129892420017e-03 +-1.0018660232186353e-03 +-9.7488386185252799e-04 +-9.4943442439023138e-04 +-9.2561556105642091e-04 +-9.0346939508033656e-04 +-8.8299544473964553e-04 +-8.6416199236564106e-04 +-8.4691554065086062e-04 +-8.3118842485160199e-04 +-8.1690477137929098e-04 +-8.0398504401708935e-04 +-7.9234942608910446e-04 +-7.8192026986722565e-04 +-7.7262381616325477e-04 +-7.6439135526491385e-04 +-7.5715996954369292e-04 +-7.5087297037137047e-04 +-7.4548011825697081e-04 +-7.4093769541700837e-04 +-7.3720848397748194e-04 +-7.3426169017291258e-04 +-7.3207284469859640e-04 +-7.3062370127825456e-04 +-7.2990214904652072e-04 +-1.3589568386471664e-03 +-1.3616059876375122e-03 +-1.3667848188849601e-03 +-1.3742535906297118e-03 +-1.3836510048900461e-03 +-1.3944931410978679e-03 +-1.4061737381415639e-03 +-1.4179676533564826e-03 +-1.4290404239887873e-03 +-1.4384682680736859e-03 +-1.4452739237448481e-03 +-1.4484830627772382e-03 +-1.4472020719649829e-03 +-1.4407104109582624e-03 +-1.4285517607858182e-03 +-1.4106024345595721e-03 +-1.3870974963175124e-03 +-1.3586054582712251e-03 +-1.3259570339478539e-03 +-1.2901455064632267e-03 +-1.2522210023843564e-03 +-1.2131979030545169e-03 +-1.1739869060172297e-03 +-1.1353549094549719e-03 +-1.0979097068041937e-03 +-1.0621033247293998e-03 +-1.0282472297929216e-03 +-9.9653356114612931e-04 +-9.6705809074901661e-04 +-9.3984215999894398e-04 +-9.1485209891368471e-04 +-8.9201552463477184e-04 +-8.7123447718084500e-04 +-8.5239566064561725e-04 +-8.3537819764954832e-04 +-8.2005933922466923e-04 +-8.0631854842507899e-04 +-7.9404032461730524e-04 +-7.8311607521896153e-04 +-7.7344528287958292e-04 +-7.6493616367586824e-04 +-7.5750596762182208e-04 +-7.5108103673752742e-04 +-7.4559670729758027e-04 +-7.4099712058367084e-04 +-7.3723498933262529e-04 +-7.3427135403857471e-04 +-7.3207535340650957e-04 +-7.3062402582025189e-04 +-7.2990215305086673e-04 +-1.5143514922995318e-03 +-1.5172992626115455e-03 +-1.5230492579068474e-03 +-1.5313092907223446e-03 +-1.5416383872571575e-03 +-1.5534437883180817e-03 +-1.5659777979318442e-03 +-1.5783365666936430e-03 +-1.5894656462501855e-03 +-1.5981810338218357e-03 +-1.6032175666738464e-03 +-1.6033152315195565e-03 +-1.5973445810358322e-03 +-1.5844553015273942e-03 +-1.5642141842850728e-03 +-1.5366917420901983e-03 +-1.5024679334264472e-03 +-1.4625531930778978e-03 +-1.4182479476682092e-03 +-1.3709788299421438e-03 +-1.3221484180207645e-03 +-1.2730224074586512e-03 +-1.2246622779700511e-03 +-1.1778992762882775e-03 +-1.1333392283633065e-03 +-1.0913864589995798e-03 +-1.0522768573620156e-03 +-1.0161129873110485e-03 +-9.8289691402223835e-04 +-9.5255858058128275e-04 +-9.2497902581324188e-04 +-9.0000859629059133e-04 +-8.7748073850225906e-04 +-8.5722211597987017e-04 +-8.3905979791433082e-04 +-8.2282618929081926e-04 +-8.0836226608833038e-04 +-7.9551956951703429e-04 +-7.8416131382602161e-04 +-7.7416287806202078e-04 +-7.6541188405318962e-04 +-7.5780800946072312e-04 +-7.5126264377545562e-04 +-7.4569846428467130e-04 +-7.4104898613710016e-04 +-7.3725812384468155e-04 +-7.3427978938580369e-04 +-7.3207754332361541e-04 +-7.3062430913472295e-04 +-7.2990215654689669e-04 +-1.6665423187586454e-03 +-1.6697838481228829e-03 +-1.6761024443428449e-03 +-1.6851676499247475e-03 +-1.6964790848571301e-03 +-1.7093586881767864e-03 +-1.7229381586260262e-03 +-1.7361434689433530e-03 +-1.7476847990621012e-03 +-1.7560696539356932e-03 +-1.7596644676972834e-03 +-1.7568267022955914e-03 +-1.7461077851061877e-03 +-1.7264907754304746e-03 +-1.6975946774818115e-03 +-1.6597741187464742e-03 +-1.6140769638093499e-03 +-1.5620753536023291e-03 +-1.5056270853128506e-03 +-1.4466350219210081e-03 +-1.3868552001638750e-03 +-1.3277758272847403e-03 +-1.2705648027956800e-03 +-1.2160696687039427e-03 +-1.1648503106995655e-03 +-1.1172273523857399e-03 +-1.0733341483686544e-03 +-1.0331651610052648e-03 +-9.9661725859336134e-04 +-9.6352293251336944e-04 +-9.3367582456825636e-04 +-9.0684960891197590e-04 +-8.8281147256211417e-04 +-8.6133139296000179e-04 +-8.4218825416029633e-04 +-8.2517365256790500e-04 +-8.1009405893890001e-04 +-7.9677184330075870e-04 +-7.8504553867155241e-04 +-7.7476961684548389e-04 +-7.6581397127565231e-04 +-7.5806324372032236e-04 +-7.5141608853760756e-04 +-7.4578443762617931e-04 +-7.4109280702763965e-04 +-7.3727767078241642e-04 +-7.3428691699121821e-04 +-7.3207939383027824e-04 +-7.3062454854871408e-04 +-7.2990215950163016e-04 +-1.8021160850461581e-03 +-1.8056226886305202e-03 +-1.8124690977404650e-03 +-1.8223195200926952e-03 +-1.8346619546951630e-03 +-1.8487909914601292e-03 +-1.8637758622337098e-03 +-1.8784144799143031e-03 +-1.8911877069082632e-03 +-1.9002480483653495e-03 +-1.9034926970030604e-03 +-1.8987631656937690e-03 +-1.8841682529654976e-03 +-1.8584559487133101e-03 +-1.8213075607214759e-03 +-1.7734394441017390e-03 +-1.7164754923750622e-03 +-1.6526471348568550e-03 +-1.5844302660799488e-03 +-1.5142219205582343e-03 +-1.4441156759558253e-03 +-1.3757871183369100e-03 +-1.3104696228445816e-03 +-1.2489893438712648e-03 +-1.1918303663313963e-03 +-1.1392087898135211e-03 +-1.0911429072274230e-03 +-1.0475132430451692e-03 +-1.0081105448817389e-03 +-9.7267224538627678e-04 +-9.4090902139169091e-04 +-9.1252339940948719e-04 +-8.8722226630610088e-04 +-8.6472487614918639e-04 +-8.4476763014570836e-04 +-8.2710661118978583e-04 +-8.1151860395291655e-04 +-7.9780113134272229e-04 +-7.8577188458468100e-04 +-7.7526780961663638e-04 +-7.6614402884521795e-04 +-7.5827271731924604e-04 +-7.5154201001267071e-04 +-7.4585498744744445e-04 +-7.4112876674025210e-04 +-7.3729371164901378e-04 +-7.3429276639756346e-04 +-7.3208091255031122e-04 +-7.3062474504380977e-04 +-7.2990216192710621e-04 +-1.9091966715646079e-03 +-1.9129185219356160e-03 +-1.9202166856733397e-03 +-1.9307970013559194e-03 +-1.9442045665848554e-03 +-1.9597919306602405e-03 +-1.9766564101588230e-03 +-1.9935443335984434e-03 +-2.0087438199869923e-03 +-2.0200243831648480e-03 +-2.0247121893557257e-03 +-2.0199773548044003e-03 +-2.0033260490006227e-03 +-1.9731620797416968e-03 +-1.9292006069550371e-03 +-1.8725608352960655e-03 +-1.8055146551080867e-03 +-1.7310162232462537e-03 +-1.6521930501413903e-03 +-1.5719385219740065e-03 +-1.4926648361148324e-03 +-1.4162075772608236e-03 +-1.3438394093204010e-03 +-1.2763453337528564e-03 +-1.2141218786415715e-03 +-1.1572762423290000e-03 +-1.1057130397108968e-03 +-1.0592041928463576e-03 +-1.0174420229780022e-03 +-9.8007772742709901e-04 +-9.4674810818153033e-04 +-9.1709334750813968e-04 +-8.9076822903287481e-04 +-8.6744871786858374e-04 +-8.4683535559179819e-04 +-8.2865454029699439e-04 +-8.1265845764576434e-04 +-7.9862419854811822e-04 +-7.8635242994321865e-04 +-7.7566586362351161e-04 +-7.6640768232752834e-04 +-7.5844002282832602e-04 +-7.5164257510002995e-04 +-7.4591132935053668e-04 +-7.4115748478314580e-04 +-7.3730652251332196e-04 +-7.3429743813351218e-04 +-7.3208212554784068e-04 +-7.3062490198850659e-04 +-7.2990216386489197e-04 +-1.9822002668727634e-03 +-1.9860765165259702e-03 +-1.9937259065515821e-03 +-2.0049382622188690e-03 +-2.0193789874064041e-03 +-2.0365410195522810e-03 +-2.0556464946880969e-03 +-2.0754894179689475e-03 +-2.0942443882593486e-03 +-2.1093250406400200e-03 +-2.1174338208155416e-03 +-2.1149374315378622e-03 +-2.0985691587487466e-03 +-2.0662420048795124e-03 +-2.0176244407481845e-03 +-1.9542240135086123e-03 +-1.8789815561655572e-03 +-1.7955973930776487e-03 +-1.7078593019095936e-03 +-1.6191500367930291e-03 +-1.5321852841407135e-03 +-1.4489455231641562e-03 +-1.3707328221078082e-03 +-1.2982881743885347e-03 +-1.2319242025237347e-03 +-1.1716477339552768e-03 +-1.1172612632572067e-03 +-1.0684410867806537e-03 +-1.0247942977118897e-03 +-9.8589849008481824e-04 +-9.5132820422951349e-04 +-9.2067166397233043e-04 +-8.9354066158954645e-04 +-8.6957576275150945e-04 +-8.4844842062557248e-04 +-8.2986112787910801e-04 +-8.1354638875025915e-04 +-7.9926504089608780e-04 +-7.8680427724598116e-04 +-7.7597559292324038e-04 +-7.6661279647571802e-04 +-7.5857016673862993e-04 +-7.5172079825727592e-04 +-7.4595515325639160e-04 +-7.4117982243370026e-04 +-7.3731648737139195e-04 +-7.3430107212575928e-04 +-7.3208306912710553e-04 +-7.3062502407726247e-04 +-7.2990216537286595e-04 +-2.0242444509866371e-03 +-2.0282171436892568e-03 +-2.0361089273586521e-03 +-2.0478082862531439e-03 +-2.0631254795728266e-03 +-2.0817341186700074e-03 +-2.1030466985879808e-03 +-2.1260033215070614e-03 +-2.1487891123249340e-03 +-2.1685770527899184e-03 +-2.1814981578649993e-03 +-2.1830673301869224e-03 +-2.1691107268518388e-03 +-2.1368908511612606e-03 +-2.0859029562850977e-03 +-2.0179693474586917e-03 +-1.9366642626333179e-03 +-1.8464135095622551e-03 +-1.7516460285957939e-03 +-1.6562147901974275e-03 +-1.5631235242978484e-03 +-1.4744894089745103e-03 +-1.3916441229225463e-03 +-1.3152922561534891e-03 +-1.2456754246603539e-03 +-1.1827160032744153e-03 +-1.1261313858817071e-03 +-1.0755189864409605e-03 +-1.0304162786881857e-03 +-9.9034128091217140e-04 +-9.5481856091770461e-04 +-9.2339496013646655e-04 +-8.9564827057275797e-04 +-8.7119124085897697e-04 +-8.4967259943772102e-04 +-8.3077626203119164e-04 +-8.1421951137097142e-04 +-7.9975066858470529e-04 +-7.8714658943363110e-04 +-7.7621019174441066e-04 +-7.6676813540675051e-04 +-7.5866872031039596e-04 +-7.5178003146129490e-04 +-7.4598833775513717e-04 +-7.4119673715306576e-04 +-7.3732403319732079e-04 +-7.3430382401035773e-04 +-7.3208378368078239e-04 +-7.3062511653452036e-04 +-7.2990216651547756e-04 +-2.0445774280936813e-03 +-2.0486022542086477e-03 +-2.0566380905571360e-03 +-2.0686534378920674e-03 +-2.0845798527328041e-03 +-2.1042543484175520e-03 +-2.1272900082353959e-03 +-2.1528378610863961e-03 +-2.1792287591865548e-03 +-2.2035791968497806e-03 +-2.2216148887281889e-03 +-2.2280710287748032e-03 +-2.2178192977849683e-03 +-2.1873468927847426e-03 +-2.1358379801808152e-03 +-2.0653162028106947e-03 +-1.9799039901986777e-03 +-1.8846865820729224e-03 +-1.7846815771135284e-03 +-1.6841731457508209e-03 +-1.5864288823409793e-03 +-1.4936929975743109e-03 +-1.4073292161708971e-03 +-1.3280167537868851e-03 +-1.2559423246298383e-03 +-1.1909621532335125e-03 +-1.1327269989164779e-03 +-1.0807727667040627e-03 +-1.0345829353634556e-03 +-9.9362957783956135e-04 +-9.5739893476988502e-04 +-9.2540627431711637e-04 +-8.9720357379712294e-04 +-8.7238255689086990e-04 +-8.5057484716487351e-04 +-8.3145043048125477e-04 +-8.1471521506837515e-04 +-8.0010819784334674e-04 +-7.8739855501200762e-04 +-7.7638284746290795e-04 +-7.6688244765426618e-04 +-7.5874124050508433e-04 +-7.5182361665456681e-04 +-7.4601275551056481e-04 +-7.4120918340254505e-04 +-7.3732958568389917e-04 +-7.3430584898463898e-04 +-7.3208430949503662e-04 +-7.3062518457169586e-04 +-7.2990216735702770e-04 +-2.0529834513447077e-03 +-2.0570328065359160e-03 +-2.0651407280772791e-03 +-2.0773226813195563e-03 +-2.0935848266477879e-03 +-2.1138755081861259e-03 +-2.1379694550010746e-03 +-2.1652341048700690e-03 +-2.1942311468775982e-03 +-2.2221955580288767e-03 +-2.2446668472995679e-03 +-2.2557758750205003e-03 +-2.2495068883244943e-03 +-2.2215335380414230e-03 +-2.1706310322319733e-03 +-2.0989076178845900e-03 +-2.0109187476818557e-03 +-1.9123053118506755e-03 +-1.8085885312970555e-03 +-1.7044224161508969e-03 +-1.6033014289942413e-03 +-1.5075808975973110e-03 +-1.4186563693045862e-03 +-1.3371915554761381e-03 +-1.2633335607774502e-03 +-1.1968898083350669e-03 +-1.1374616822406368e-03 +-1.0845395468830901e-03 +-1.0375670107114349e-03 +-9.9598233402516047e-04 +-9.5924365067695516e-04 +-9.2684315521191472e-04 +-8.9831402206088078e-04 +-8.7323270826916472e-04 +-8.5121845298924870e-04 +-8.3193118322811188e-04 +-8.1506861350460558e-04 +-8.0036303866942477e-04 +-7.8757812575843127e-04 +-7.7650588304897393e-04 +-7.6696390178137240e-04 +-7.5879291330168634e-04 +-7.5185467183173059e-04 +-7.4603015352331880e-04 +-7.4121805161086497e-04 +-7.3733354200017592e-04 +-7.3430729186417716e-04 +-7.3208468416560864e-04 +-7.3062523305262683e-04 +-7.2990216795753313e-04 +-2.0560406254758524e-03 +-2.0601002293371773e-03 +-2.0682389370979093e-03 +-2.0804935548271656e-03 +-2.0969060859751575e-03 +-2.1174848718989998e-03 +-2.1421077822986138e-03 +-2.1703118725564935e-03 +-2.2008927660352243e-03 +-2.2312974219739299e-03 +-2.2570630535748795e-03 +-2.2719292323429997e-03 +-2.2691546801089156e-03 +-2.2436679183235179e-03 +-2.1938136680311011e-03 +-2.1216987442602949e-03 +-2.0321918687374835e-03 +-1.9313655314996936e-03 +-1.8251384674932438e-03 +-1.7184575891020129e-03 +-1.6149975191547194e-03 +-1.5172030564205542e-03 +-1.4264976670566086e-03 +-1.3435365525685777e-03 +-1.2684398405284217e-03 +-1.2009808792855117e-03 +-1.1407263662448954e-03 +-1.0871346466314788e-03 +-1.0396213282136367e-03 +-9.9760097014133702e-04 +-9.6051204771178706e-04 +-9.2783065330312388e-04 +-8.9907686814049684e-04 +-8.7381654050470319e-04 +-8.5166032032778607e-04 +-8.3226117082757598e-04 +-8.1531114334007677e-04 +-8.0053790742555552e-04 +-7.8770133315660693e-04 +-7.7659029477064091e-04 +-7.6701978307685984e-04 +-7.5882836239260672e-04 +-7.5187597643117826e-04 +-7.4604208900389121e-04 +-7.4122413548402088e-04 +-7.3733625619441822e-04 +-7.3430828175241960e-04 +-7.3208494121191996e-04 +-7.3062526631407316e-04 +-7.2990216837053837e-04 +-2.0570060307495506e-03 +-2.0610695404128464e-03 +-2.0692202548583216e-03 +-2.0815037338620967e-03 +-2.0979771073396532e-03 +-2.1186760504063812e-03 +-2.1435323595073138e-03 +-2.1721894711868536e-03 +-2.2036231762579944e-03 +-2.2354947774375199e-03 +-2.2634364588804577e-03 +-2.2809771107716241e-03 +-2.2808509818694031e-03 +-2.2573902670095722e-03 +-2.2085625284007232e-03 +-2.1364309945304878e-03 +-2.0460731359696377e-03 +-1.9438692829356449e-03 +-1.8360257713895107e-03 +-1.7277020969740614e-03 +-1.6227039313892486e-03 +-1.5235418003921397e-03 +-1.4316608370818424e-03 +-1.3477119742471425e-03 +-1.2717979511087290e-03 +-1.2036696413520326e-03 +-1.1428707255514037e-03 +-1.0888382718800555e-03 +-1.0409692867348489e-03 +-9.9866259978638569e-04 +-9.6134365642706724e-04 +-9.2847789093926565e-04 +-8.9957672992281459e-04 +-8.7419901846878670e-04 +-8.5194974353363013e-04 +-8.3247728234593621e-04 +-8.1546996075187214e-04 +-8.0065240855103925e-04 +-7.8778200260901381e-04 +-7.7664556081876888e-04 +-7.6705636886798402e-04 +-7.5885157088739069e-04 +-7.5188992454110985e-04 +-7.4604990321251751e-04 +-7.4122811866682238e-04 +-7.3733803323305816e-04 +-7.3430892986142953e-04 +-7.3208510950982281e-04 +-7.3062528809216128e-04 +-7.2990216864217373e-04 +-2.0572330434667735e-03 +-2.0612979234427282e-03 +-2.0694532946457147e-03 +-2.0817486426699368e-03 +-2.0982476231479197e-03 +-2.1189974495088131e-03 +-2.1439543375367199e-03 +-2.1728181680434654e-03 +-2.2046792926160735e-03 +-2.2373633396444983e-03 +-2.2666146172025986e-03 +-2.2858671642408505e-03 +-2.2875169197692441e-03 +-2.2654776333821329e-03 +-2.2174360368254244e-03 +-2.1454051324361488e-03 +-2.0545906615817675e-03 +-1.9515733044701421e-03 +-1.8427487159999856e-03 +-1.7334167084790074e-03 +-1.6274696137751770e-03 +-1.5274617227106590e-03 +-1.4348531087149197e-03 +-1.3502927298734018e-03 +-1.2738727990909777e-03 +-1.2053303225479516e-03 +-1.1441947046860782e-03 +-1.0898897962723516e-03 +-1.0418010463747079e-03 +-9.9931751558000664e-04 +-9.6185656207267310e-04 +-9.2887700997303329e-04 +-8.9988492242135348e-04 +-8.7443480777450126e-04 +-8.5212814873590495e-04 +-8.3261048666369156e-04 +-8.1556784511350306e-04 +-8.0072297645668940e-04 +-7.8783171850167950e-04 +-7.7667962034093157e-04 +-7.6707891598189052e-04 +-7.5886587389151455e-04 +-7.5189852061140054e-04 +-7.4605471909164713e-04 +-7.4123057353232477e-04 +-7.3733912845312200e-04 +-7.3430932930853849e-04 +-7.3208521323786242e-04 +-7.3062530151536621e-04 +-7.2990216881113005e-04 +-2.0572420046459290e-03 +-2.0613073137892590e-03 +-2.0694645240805732e-03 +-2.0817650792298117e-03 +-2.0982756708123819e-03 +-2.1190483683605947e-03 +-2.1440495630430222e-03 +-2.1730058173600590e-03 +-2.2050706474727230e-03 +-2.2381734149619138e-03 +-2.2681445832368327e-03 +-2.2883820903899206e-03 +-2.2910870954126359e-03 +-2.2699167611383128e-03 +-2.2223789172623517e-03 +-2.1504479984745038e-03 +-2.0594015903539699e-03 +-1.9559376356857137e-03 +-1.8465635533139303e-03 +-1.7366621938965919e-03 +-1.6301772681594584e-03 +-1.5296891497671653e-03 +-1.4366670256660743e-03 +-1.3517590216928978e-03 +-1.2750514867896899e-03 +-1.2062735831121336e-03 +-1.1449466044260552e-03 +-1.0904868805093519e-03 +-1.0422732807102667e-03 +-9.9968930372714413e-04 +-9.6214770422160302e-04 +-9.2910354462766623e-04 +-9.0005983685711652e-04 +-8.7456862296768259e-04 +-8.5222939346630839e-04 +-8.3268607802000052e-04 +-8.1562339214382969e-04 +-8.0076302185920760e-04 +-7.8785993104270357e-04 +-7.7669894848122437e-04 +-7.6709171125221177e-04 +-7.5887399087342440e-04 +-7.5190339901014215e-04 +-7.4605745224208769e-04 +-7.4123196677350919e-04 +-7.3733975005179210e-04 +-7.3430955602191692e-04 +-7.3208527211179365e-04 +-7.3062530913477804e-04 +-7.2990216890897561e-04 +-2.0572136701332059e-03 +-2.0612790904086576e-03 +-2.0694370055403450e-03 +-2.0817398025621305e-03 +-2.0982555555861373e-03 +-2.1190383209222586e-03 +-2.1440584309976546e-03 +-2.1730538317611525e-03 +-2.2052084712011828e-03 +-2.2385065665403532e-03 +-2.2688292565853476e-03 +-2.2895629408356379e-03 +-2.2928109619210582e-03 +-2.2720958747678597e-03 +-2.2248292955170867e-03 +-2.1529627306380483e-03 +-2.0618092028362382e-03 +-1.9581264470789617e-03 +-1.8484792711376092e-03 +-1.7382932805003054e-03 +-1.6315387028199714e-03 +-1.5308094402462962e-03 +-1.4375794939848750e-03 +-1.3524966940210272e-03 +-1.2756445024187588e-03 +-1.2067481664974370e-03 +-1.1453249146668463e-03 +-1.0907872998398456e-03 +-1.0425108840836444e-03 +-9.9987636902749283e-04 +-9.6229419359237394e-04 +-9.2921752766613646e-04 +-9.0014784793946995e-04 +-8.7463595551881578e-04 +-8.5228033851121989e-04 +-8.3272411565626838e-04 +-8.1565134434668693e-04 +-8.0078317410711697e-04 +-7.8787412914529357e-04 +-7.7670867588185383e-04 +-7.6709815110338937e-04 +-7.5887807633521966e-04 +-7.5190585453409114e-04 +-7.4605882802612799e-04 +-7.4123266811877198e-04 +-7.3734006297148584e-04 +-7.3430967015603249e-04 +-7.3208530175178084e-04 +-7.3062531297161850e-04 +-7.2990216896087767e-04 +-2.0571951320872777e-03 +-2.0612605724408951e-03 +-2.0694187273314034e-03 +-2.0817223630501644e-03 +-2.0982400765314469e-03 +-2.1190265962402763e-03 +-2.1440535174175029e-03 +-2.1730628590575585e-03 +-2.2052506727966840e-03 +-2.2386244989329386e-03 +-2.2690885035118562e-03 +-2.2900264203854753e-03 +-2.2935015665398652e-03 +-2.2729795312269045e-03 +-2.2258303851607859e-03 +-2.1539949602710261e-03 +-2.0628004991263002e-03 +-1.9590295194341209e-03 +-1.8492708093842494e-03 +-1.7389679182934863e-03 +-1.6321022504696512e-03 +-1.5312734514705503e-03 +-1.4379576113114779e-03 +-1.3528024992844855e-03 +-1.2758904212154612e-03 +-1.2069450277578271e-03 +-1.1454818788816947e-03 +-1.0909119725442298e-03 +-1.0426095065552096e-03 +-9.9995402722505983e-04 +-9.6235501603350647e-04 +-9.2926485980101279e-04 +-9.0018439960805113e-04 +-8.7466392252223549e-04 +-8.5230150124998691e-04 +-8.3273991835765499e-04 +-8.1566295832945744e-04 +-8.0079154816169466e-04 +-7.8788002965815280e-04 +-7.7671271887864383e-04 +-7.6710082798594256e-04 +-7.5887977473863128e-04 +-7.5190687544726274e-04 +-7.4605940008113411e-04 +-7.4123295976703677e-04 +-7.3734019310727936e-04 +-7.3430971762528878e-04 +-7.3208531408043380e-04 +-7.3062531456869883e-04 +-7.2990216898613188e-04 +-2.0571887354744046e-03 +-2.0612541766928624e-03 +-2.0694123914454382e-03 +-2.0817162481713771e-03 +-2.0982344623023592e-03 +-2.1190218709561158e-03 +-2.1440502602782610e-03 +-2.1730625632914898e-03 +-2.2052581231931374e-03 +-2.2386513868460096e-03 +-2.2691538727262878e-03 +-2.2901494111307805e-03 +-2.2936901912908908e-03 +-2.2732251475184794e-03 +-2.2261117975477915e-03 +-2.1542873547241831e-03 +-2.0630828324933021e-03 +-1.9592877704499505e-03 +-1.8494978764469420e-03 +-1.7391619368100403e-03 +-1.6322646553259604e-03 +-1.5314074031292631e-03 +-1.4380669277710345e-03 +-1.3528910218011377e-03 +-1.2759616862800275e-03 +-1.2070021308510231e-03 +-1.1455274471052752e-03 +-1.0909481927041653e-03 +-1.0426381770116335e-03 +-9.9997661606683066e-04 +-9.6237271679802856e-04 +-9.2927864091306780e-04 +-9.0019504638686029e-04 +-8.7467207193953284e-04 +-8.5230767021322873e-04 +-8.3274452648223862e-04 +-8.1566634616007971e-04 +-8.0079399170797979e-04 +-7.8788175198826955e-04 +-7.7671389938893491e-04 +-7.6710160985322799e-04 +-7.5888027096362694e-04 +-7.5190717381781638e-04 +-7.4605956731636715e-04 +-7.4123304505027687e-04 +-7.3734023117049644e-04 +-7.3430973151268771e-04 +-7.3208531768855899e-04 +-7.3062531503791420e-04 +-7.2990216899939330e-04 +-2.0571877673159597e-03 +-2.0612532076997947e-03 +-2.0694114278093346e-03 +-2.0817153028684283e-03 +-2.0982335403331377e-03 +-2.1190209349034707e-03 +-2.1440491891553054e-03 +-2.1730611902730894e-03 +-2.2052565414146879e-03 +-2.2386505575200510e-03 +-2.2691559632647173e-03 +-2.2901570904756258e-03 +-2.2937051581711754e-03 +-2.2732471571668836e-03 +-2.2261388958463766e-03 +-2.1543168618828414e-03 +-2.0631122746320118e-03 +-1.9593153632509385e-03 +-1.8495225976234726e-03 +-1.7391833803693457e-03 +-1.6322828285230059e-03 +-1.5314225488873125e-03 +-1.4380793976750833e-03 +-1.3529011965097003e-03 +-1.2759699312067223e-03 +-1.2070087749342633e-03 +-1.1455327753461648e-03 +-1.0909524462139576e-03 +-1.0426415567059875e-03 +-9.9997928777842329e-04 +-9.6237481660932194e-04 +-9.2928028012240161e-04 +-9.0019631586682382e-04 +-8.7467304583039131e-04 +-8.5230840898536941e-04 +-8.3274507944011776e-04 +-8.1566675347178393e-04 +-8.0079428604190313e-04 +-7.8788195983041712e-04 +-7.7671404210391710e-04 +-7.6710170454216589e-04 +-7.5888033116281448e-04 +-7.5190721007432210e-04 +-7.4605958766984950e-04 +-7.4123305544493542e-04 +-7.3734023581611702e-04 +-7.3430973321009577e-04 +-7.3208531813100065e-04 +-7.3062531509800026e-04 +-7.2990216900938715e-04 +-2.0571877672820316e-03 +-2.0612532074700514e-03 +-2.0694114270350759e-03 +-2.0817152985155205e-03 +-2.0982335193821980e-03 +-2.1190208598918427e-03 +-2.1440489746215553e-03 +-2.1730606720153835e-03 +-2.2052554553584698e-03 +-2.2386485697624566e-03 +-2.2691527869207807e-03 +-2.2901526465555792e-03 +-2.2936996603075757e-03 +-2.2732410468870629e-03 +-2.2261326820404567e-03 +-2.1543109737391934e-03 +-2.0631069904640796e-03 +-1.9593108106717261e-03 +-1.8495187908918805e-03 +-1.7391802648307479e-03 +-1.6322803167584266e-03 +-1.5314205446827758e-03 +-1.4380778095081320e-03 +-1.3528999437777481e-03 +-1.2759689460962614e-03 +-1.2070080019894100e-03 +-1.1455321700143900e-03 +-1.0909519730842282e-03 +-1.0426411877987856e-03 +-9.9997900104167913e-04 +-9.6237459466489014e-04 +-9.2928010925473394e-04 +-9.0019618522359040e-04 +-8.7467294679880868e-04 +-8.5230833470950260e-04 +-8.3274502444890066e-04 +-8.1566671339273870e-04 +-8.0079425738049232e-04 +-7.8788193979924931e-04 +-7.7671402848957210e-04 +-7.6710169560026051e-04 +-7.5888032553417294e-04 +-7.5190720671688982e-04 +-7.4605958580235658e-04 +-7.4123305449935923e-04 +-7.3734023539680303e-04 +-7.3430973305796052e-04 +-7.3208531809166124e-04 +-7.3062531509293074e-04 +-7.2990216900934281e-04 +-2.0571887353203820e-03 +-2.0612541832536560e-03 +-2.0694124493822351e-03 +-2.0817164570327124e-03 +-2.0982349514845730e-03 +-2.1190227112210802e-03 +-2.1440512885828795e-03 +-2.1730631053714653e-03 +-2.2052566769677024e-03 +-2.2386455503789742e-03 +-2.2691409401650723e-03 +-2.2901276126015609e-03 +-2.2936597545433258e-03 +-2.2731883310616223e-03 +-2.2260719511038216e-03 +-2.1542477604468199e-03 +-2.0630459529757078e-03 +-1.9592550367504868e-03 +-1.8494698338845841e-03 +-1.7391385218413153e-03 +-1.6322454595711195e-03 +-1.5313918685685101e-03 +-1.4380544692217041e-03 +-1.3528810930743124e-03 +-1.2759538092555593e-03 +-1.2069959028910531e-03 +-1.1455225372470903e-03 +-1.0909443329765692e-03 +-1.0426351523953972e-03 +-9.9997425486489876e-04 +-9.6237088217103819e-04 +-9.2927722379509774e-04 +-9.0019395973153793e-04 +-8.7467124613492173e-04 +-8.5230704947195947e-04 +-8.3274406601978118e-04 +-8.1566600999643591e-04 +-8.0079375095502999e-04 +-7.8788158351110775e-04 +-7.7671378475258751e-04 +-7.6710153448556460e-04 +-7.5888022348114014e-04 +-7.5190714547369939e-04 +-7.4605955154041239e-04 +-7.4123303705796964e-04 +-7.3734022762469661e-04 +-7.3430973022572108e-04 +-7.3208531735566133e-04 +-7.3062531499495974e-04 +-7.2990216899887841e-04 +-2.0571951329443985e-03 +-2.0612606434135539e-03 +-2.0694192641435172e-03 +-2.0817243565996028e-03 +-2.0982452709519899e-03 +-2.1190374757632216e-03 +-2.1440730240287319e-03 +-2.1730936139175254e-03 +-2.2052933870300071e-03 +-2.2386758622625776e-03 +-2.2691403000122054e-03 +-2.2900678120622267e-03 +-2.2935237082179331e-03 +-2.2729790991770347e-03 +-2.2258097936500025e-03 +-2.1539600696029080e-03 +-2.0627579075229562e-03 +-1.9589847807128529e-03 +-1.8492277722922967e-03 +-1.7389288055323585e-03 +-1.6320680478880017e-03 +-1.5312443347397170e-03 +-1.4379332919834109e-03 +-1.3527824650066977e-03 +-1.2758740850878848e-03 +-1.2069318122138737e-03 +-1.1454712571291519e-03 +-1.0909034846541632e-03 +-1.0426027615702460e-03 +-9.9994869831507836e-04 +-9.6235083278014167e-04 +-9.2926159983308773e-04 +-9.0018188069620152e-04 +-8.7466199560660648e-04 +-8.5230004453101869e-04 +-8.3273883240792782e-04 +-8.1566216210799856e-04 +-8.0079097578845027e-04 +-7.8787962780834341e-04 +-7.7671244467159212e-04 +-7.6710064726158282e-04 +-7.5887966063456296e-04 +-7.5190680720675694e-04 +-7.4605936203825363e-04 +-7.4123294046766152e-04 +-7.3734018453535408e-04 +-7.3430971451122692e-04 +-7.3208531327437025e-04 +-7.3062531446463797e-04 +-7.2990216898486413e-04 +-2.0572136781408820e-03 +-2.0612794091771458e-03 +-2.0694392398802586e-03 +-2.0817480423304504e-03 +-2.0982773623610795e-03 +-2.1190853880774956e-03 +-2.1441466119728725e-03 +-2.1732015367258960e-03 +-2.2054314064940505e-03 +-2.2388079940241401e-03 +-2.2691908967110599e-03 +-2.2899461009014241e-03 +-2.2931704287536552e-03 +-2.2723968572107033e-03 +-2.2250561514343273e-03 +-2.1531172492972313e-03 +-2.0619035222309004e-03 +-1.9581760654483757e-03 +-1.8484986083437116e-03 +-1.7382937855830527e-03 +-1.6315285890517478e-03 +-1.5307941718434601e-03 +-1.4375624767979129e-03 +-1.3524799108710333e-03 +-1.2756290078161294e-03 +-1.2067344381588244e-03 +-1.1453130888761146e-03 +-1.0907773223138616e-03 +-1.0425026032190381e-03 +-9.9986959153558898e-04 +-9.6228871637429078e-04 +-9.2921315509444089e-04 +-9.0014440041626478e-04 +-8.7463327297895453e-04 +-8.5227828110970804e-04 +-8.3272256297819340e-04 +-8.1565019391588705e-04 +-8.0078233963028786e-04 +-7.8787353872257450e-04 +-7.7670827029759548e-04 +-7.6709788224236066e-04 +-7.5887790573509069e-04 +-7.5190575206633844e-04 +-7.4605877069166475e-04 +-7.4123263894207371e-04 +-7.3734004997908691e-04 +-7.3430966542633886e-04 +-7.3208530052561627e-04 +-7.3062531281315249e-04 +-7.2990216895893532e-04 +-2.0572420399769106e-03 +-2.0613083148394652e-03 +-2.0694710667238311e-03 +-2.0817888033526168e-03 +-2.0983384199717257e-03 +-2.1191847704408731e-03 +-2.1443082187474730e-03 +-2.1734461658712532e-03 +-2.2057492868484902e-03 +-2.2391159890628974e-03 +-2.2693154591365218e-03 +-2.2896794315287457e-03 +-2.2923760354254903e-03 +-2.2710785607348710e-03 +-2.2233431914891084e-03 +-2.1511961124404070e-03 +-2.0599513959400320e-03 +-1.9563244873096225e-03 +-1.8468261512867635e-03 +-1.7368349451256770e-03 +-1.6302875430562640e-03 +-1.5297572739125329e-03 +-1.4367074177483504e-03 +-1.3517815874363427e-03 +-1.2750628720891337e-03 +-1.2062781632939874e-03 +-1.1449472118839022e-03 +-1.0904853174183600e-03 +-1.0422706704714872e-03 +-9.9968632750047082e-04 +-9.6214475814326481e-04 +-9.2910084339613069e-04 +-9.0005748153065845e-04 +-8.7456664509267363e-04 +-8.5222778363526681e-04 +-8.3268480422717280e-04 +-8.1562241146600765e-04 +-8.0076228777803187e-04 +-7.8785939791940274e-04 +-7.7669857417442972e-04 +-7.6709145852273141e-04 +-7.5887382799999926e-04 +-7.5190329989096466e-04 +-7.4605739616494802e-04 +-7.4123193797236489e-04 +-7.3733973712947524e-04 +-7.3430955128950335e-04 +-7.3208527087942994e-04 +-7.3062530897503137e-04 +-7.2990216890701581e-04 +-2.0572331578424612e-03 +-2.0613004974760476e-03 +-2.0694689817924777e-03 +-2.0818042681926365e-03 +-2.0983936893224516e-03 +-2.1193145969578085e-03 +-2.1445566496636273e-03 +-2.1738464735488452e-03 +-2.2062707795334592e-03 +-2.2395888780034718e-03 +-2.2694089316088414e-03 +-2.2890111837159458e-03 +-2.2907042738590021e-03 +-2.2684232210769830e-03 +-2.2199547835207024e-03 +-2.1474288620869212e-03 +-2.0561401522084907e-03 +-1.9527174130494511e-03 +-1.8435712166053890e-03 +-1.7339966558747105e-03 +-1.6278728804941600e-03 +-1.5277393322096701e-03 +-1.4350428014782435e-03 +-1.3504215953725933e-03 +-1.2739599016980279e-03 +-1.2053889068389713e-03 +-1.1442338955839153e-03 +-1.0899158469408357e-03 +-1.0418182271403236e-03 +-9.9932873548801669e-04 +-9.6186379857162926e-04 +-9.2888160400398615e-04 +-8.9988778037661244e-04 +-8.7443653954410701e-04 +-8.5212916206920211e-04 +-8.3261105172602638e-04 +-8.1556813869593876e-04 +-8.0072311228260025e-04 +-7.8783176800726793e-04 +-7.7667962691921712e-04 +-7.6707890472541126e-04 +-7.5886585823356631e-04 +-7.5189850682092960e-04 +-7.4605470928365829e-04 +-7.4123056764425414e-04 +-7.3733912550143438e-04 +-7.3430932813820502e-04 +-7.3208521291580450e-04 +-7.3062530147211728e-04 +-7.2990216881059923e-04 +-2.0570063364172566e-03 +-2.0610753375964047e-03 +-2.0692532236028923e-03 +-2.0816176176911179e-03 +-2.0982727283916655e-03 +-2.1193139579924153e-03 +-2.1447382022324263e-03 +-2.1742386447315023e-03 +-2.2067810775541711e-03 +-2.2399004351238727e-03 +-2.2689750595008286e-03 +-2.2872442688766674e-03 +-2.2872675659632627e-03 +-2.2633999397201872e-03 +-2.2137847113888704e-03 +-2.1407041017749576e-03 +-2.0494112696100159e-03 +-1.9463885334547826e-03 +-1.8378803283067245e-03 +-1.7290439519551176e-03 +-1.6236637354390122e-03 +-1.5242234188883631e-03 +-1.4321429350554191e-03 +-1.3480523122802886e-03 +-1.2720381077094979e-03 +-1.2038391788869716e-03 +-1.1429905115235856e-03 +-1.0889229823913980e-03 +-1.0410292312550923e-03 +-9.9870502417367772e-04 +-9.6137366187948141e-04 +-9.2849907750728222e-04 +-8.9959164555932967e-04 +-8.7420947205670691e-04 +-8.5195702321831418e-04 +-8.3248230808317340e-04 +-8.1547339114625833e-04 +-8.0065471590615265e-04 +-7.8778352582142711e-04 +-7.7664654280647748e-04 +-7.6705698317335415e-04 +-7.5885194069538905e-04 +-7.5189013636490262e-04 +-7.4605001682592211e-04 +-7.4122817437783067e-04 +-7.3733805726726833e-04 +-7.3430893838586275e-04 +-7.3208511167598763e-04 +-7.3062528836830086e-04 +-7.2990216864557140e-04 +-2.0560413322097903e-03 +-2.0601119804382162e-03 +-2.0683014441393675e-03 +-2.0807033082634050e-03 +-2.0974425140707405e-03 +-2.1186307280287035e-03 +-2.1442537180207544e-03 +-2.1739228859045082e-03 +-2.2064037128667097e-03 +-2.2389275698116301e-03 +-2.2666220427442038e-03 +-2.2827629226097631e-03 +-2.2803174533391440e-03 +-2.2542286564215240e-03 +-2.2031068629629956e-03 +-2.1294111890635902e-03 +-2.0383077888307516e-03 +-1.9360530962326842e-03 +-1.8286441114541024e-03 +-1.7210351243485624e-03 +-1.6168716211973776e-03 +-1.5185565048834015e-03 +-1.4274716402900979e-03 +-1.3442365509301775e-03 +-1.2689430564256044e-03 +-1.2013430573273554e-03 +-1.1409874582835522e-03 +-1.0873231801852990e-03 +-1.0397576541803064e-03 +-9.9769962142659497e-04 +-9.6058342786250984e-04 +-9.2788223542309854e-04 +-8.9911404240391578e-04 +-8.7384321229371854e-04 +-8.5167933247082207e-04 +-8.3227460213811122e-04 +-8.1532052022344323e-04 +-8.0054435437207111e-04 +-7.8770568021002544e-04 +-7.7659315467148158e-04 +-7.6702160699106440e-04 +-7.5882948050330764e-04 +-7.5187662780387568e-04 +-7.4604244383697936e-04 +-7.4122431192294956e-04 +-7.3733633324431908e-04 +-7.3430830936018117e-04 +-7.3208494828328212e-04 +-7.3062526722048992e-04 +-7.2990216838168126e-04 +-2.0529848812189510e-03 +-2.0570542527649860e-03 +-2.0652478206106203e-03 +-2.0776711868269711e-03 +-2.0944608231281176e-03 +-2.1157230011940899e-03 +-2.1413878973024375e-03 +-2.1709147411009514e-03 +-2.2027960181895010e-03 +-2.2339403305964025e-03 +-2.2593073693103023e-03 +-2.2723802834426865e-03 +-2.2667198392008264e-03 +-2.2379856867875345e-03 +-2.1852970229496774e-03 +-2.1112549534014662e-03 +-2.0208566200242521e-03 +-1.9200356171488358e-03 +-1.8144535951316026e-03 +-1.7087951523023872e-03 +-1.6065237725052227e-03 +-1.5099384390963851e-03 +-1.4203744573578468e-03 +-1.3384416740281756e-03 +-1.2642431971052177e-03 +-1.1975523590680190e-03 +-1.1379449751911400e-03 +-1.0848926197731801e-03 +-1.0378252644979828e-03 +-9.9617134368880085e-04 +-9.5938193546707103e-04 +-9.2694417179627650e-04 +-8.9838759026715693e-04 +-8.7328602818999496e-04 +-8.5125683016135979e-04 +-8.3195854618222970e-04 +-8.1508788392434717e-04 +-8.0037639697632041e-04 +-7.8758720246820601e-04 +-7.7651189740676925e-04 +-7.6696776291427084e-04 +-7.5879529470311482e-04 +-7.5185606684034865e-04 +-7.4603091722981972e-04 +-7.4121843302560894e-04 +-7.3733370918877700e-04 +-7.3430735195541253e-04 +-7.3208469959394303e-04 +-7.3062523503350334e-04 +-7.2990216798188626e-04 +-2.0445799359658187e-03 +-2.0486369124753925e-03 +-2.0568013061259614e-03 +-2.0691682259915043e-03 +-2.0858502910059340e-03 +-2.1068980175075244e-03 +-2.1321226529694933e-03 +-2.1607734588772543e-03 +-2.1910633759999868e-03 +-2.2196770445164506e-03 +-2.2416158709613917e-03 +-2.2508125527933177e-03 +-2.2415867300911228e-03 +-2.2103504357745343e-03 +-2.1566620867920949e-03 +-2.0831448392219691e-03 +-1.9945006622313463e-03 +-1.8962313142998639e-03 +-1.7935802136646512e-03 +-1.6909064711540585e-03 +-1.5914595358801121e-03 +-1.4974208841718462e-03 +-1.4100784673170168e-03 +-1.3300395199484368e-03 +-1.2574295962186138e-03 +-1.1920561322446793e-03 +-1.1335324451014169e-03 +-1.0813663989469760e-03 +-1.0350207928360900e-03 +-9.9395258957611231e-04 +-9.5763704452718392e-04 +-9.2558145503326549e-04 +-8.9733201299366488e-04 +-8.7247623410027569e-04 +-8.5064267041305025e-04 +-8.3149905506958103e-04 +-8.1474963429228756e-04 +-8.0013217030005157e-04 +-7.8741491491281397e-04 +-7.7639373120620627e-04 +-7.6688946046031960e-04 +-7.5874558014141366e-04 +-7.5182616641606391e-04 +-7.4601415512907260e-04 +-7.4120988404694649e-04 +-7.3732989341768326e-04 +-7.3430595977257748e-04 +-7.3208433797554006e-04 +-7.3062518823153132e-04 +-7.2990216740203000e-04 +-2.0242482122207871e-03 +-2.0282658151302090e-03 +-2.0363261783566083e-03 +-2.0484726515077574e-03 +-2.0647353825172122e-03 +-2.0850427297588433e-03 +-2.1090349761586050e-03 +-2.1357528742421182e-03 +-2.1632315866168331e-03 +-2.1881527421597604e-03 +-2.2058475174114123e-03 +-2.2109375245948880e-03 +-2.1985899335271982e-03 +-2.1658921675846050e-03 +-2.1126643644101394e-03 +-2.0413557806233697e-03 +-1.9562103803616522e-03 +-1.8621839448666334e-03 +-1.7640315078161688e-03 +-1.6657498575571646e-03 +-1.5703608047015476e-03 +-1.4799300009368313e-03 +-1.3957090624674836e-03 +-1.3183186332978701e-03 +-1.2479247132242627e-03 +-1.1843868446513002e-03 +-1.1273726813917210e-03 +-1.0764414506722222e-03 +-1.0311018806062199e-03 +-9.9085061791386432e-04 +-9.5519645829123749e-04 +-9.2367464735644469e-04 +-8.9585446101248824e-04 +-8.7134238725785490e-04 +-8.4978253948283155e-04 +-8.3085541713466494e-04 +-8.1427576015471017e-04 +-7.9978998445581274e-04 +-7.8717350749172047e-04 +-7.7622815242170840e-04 +-7.6677973918041781e-04 +-7.5867591830815553e-04 +-7.5178426985381456e-04 +-7.4599066879078846e-04 +-7.4119790602981169e-04 +-7.3732454732349602e-04 +-7.3430400931992663e-04 +-7.3208383136173663e-04 +-7.3062512266544881e-04 +-7.2990216659087515e-04 +-1.9822050695157425e-03 +-1.9861354341207016e-03 +-1.9939764471051044e-03 +-2.0056818179060051e-03 +-2.0211492160511777e-03 +-2.0401396468927866e-03 +-2.0621140306936424e-03 +-2.0859745967763653e-03 +-2.1097549755516071e-03 +-2.1303955029073809e-03 +-2.1438209366329221e-03 +-2.1455010802892962e-03 +-2.1314452172689715e-03 +-2.0992661396663339e-03 +-2.0488236680805535e-03 +-1.9821734414358812e-03 +-1.9029289455140977e-03 +-1.8153873461860593e-03 +-1.7237549014115677e-03 +-1.6316433506312197e-03 +-1.5418480779420300e-03 +-1.4563338489120407e-03 +-1.3763378153184200e-03 +-1.3025185552779234e-03 +-1.2351070948355338e-03 +-1.1740382183012196e-03 +-1.1190548251394389e-03 +-1.0697858742740756e-03 +-1.0258018323974212e-03 +-9.8665243490082062e-04 +-9.5189126159187041e-04 +-9.2109086711948240e-04 +-8.9385136707840649e-04 +-8.6980463099614114e-04 +-8.4861562623884848e-04 +-8.2998199271318209e-04 +-8.1363258659803556e-04 +-7.9932548656428066e-04 +-7.8684578417856886e-04 +-7.7600336171283985e-04 +-7.6663078015490294e-04 +-7.5858134647661956e-04 +-7.5172739398563025e-04 +-7.4595878701651859e-04 +-7.4118164728101540e-04 +-7.3731729104754254e-04 +-7.3430136210193874e-04 +-7.3208314379897849e-04 +-7.3062503368398805e-04 +-7.2990216549104084e-04 +-1.9092019414429743e-03 +-1.9129804048883192e-03 +-1.9204686119905022e-03 +-1.9315234819325907e-03 +-1.9459048231314886e-03 +-1.9632150128969404e-03 +-1.9827796553232952e-03 +-2.0034641993461333e-03 +-2.0234638870642945e-03 +-2.0401671881559130e-03 +-2.0502399180664811e-03 +-2.0500453030567224e-03 +-2.0363664080810871e-03 +-2.0071953780828734e-03 +-1.9622566765673914e-03 +-1.9030446589889520e-03 +-1.8324032585220330e-03 +-1.7538706440439064e-03 +-1.6710437172782434e-03 +-1.5871226286405902e-03 +-1.5046747318785366e-03 +-1.4255781423036906e-03 +-1.3510783652188848e-03 +-1.2818982846960121e-03 +-1.2183607280998889e-03 +-1.1605010937751062e-03 +-1.1081605740136992e-03 +-1.0610582126697305e-03 +-1.0188438371732235e-03 +-9.8113531372554007e-04 +-9.4754371549570101e-04 +-9.1768956772854979e-04 +-8.9121272760345237e-04 +-8.6777785909123253e-04 +-8.4707695064766854e-04 +-8.2882991571163901e-04 +-8.1278400597488919e-04 +-7.9871253909007882e-04 +-7.8641327821238208e-04 +-7.7570668472294808e-04 +-7.6643418479238937e-04 +-7.5845653517178483e-04 +-7.5165233634820916e-04 +-7.4591671656696181e-04 +-7.4116019436060794e-04 +-7.3730771738987383e-04 +-7.3429786972009485e-04 +-7.3208223677687231e-04 +-7.3062491630636610e-04 +-7.2990216404105303e-04 +-1.8021211529090635e-03 +-1.8056800863725129e-03 +-1.8126938194646951e-03 +-1.8229500123590945e-03 +-1.8361130993858592e-03 +-1.8516861219291538e-03 +-1.8689368876081934e-03 +-1.8867863450421284e-03 +-1.9036831422605284e-03 +-1.9175263139945870e-03 +-1.9257267890059118e-03 +-1.9254823958304548e-03 +-1.9142575506555534e-03 +-1.8903368141969311e-03 +-1.8532440867318827e-03 +-1.8038582490124124e-03 +-1.7441953559720943e-03 +-1.6769703276361487e-03 +-1.6051103903613824e-03 +-1.5313584935612626e-03 +-1.4580279307763381e-03 +-1.3869024775375368e-03 +-1.3192421451696233e-03 +-1.2558490440344578e-03 +-1.1971572600931147e-03 +-1.1433238020751722e-03 +-1.0943087995005216e-03 +-1.0499406076168053e-03 +-1.0099657123563929e-03 +-9.7408531716141971e-04 +-9.4198114542658824e-04 +-9.1333295215117810e-04 +-8.8782990001173314e-04 +-8.6517753302648630e-04 +-8.4510167861015484e-04 +-8.2735026700726138e-04 +-8.1169378483429775e-04 +-7.9792487131220542e-04 +-7.8585741109785166e-04 +-7.7532536510488599e-04 +-7.6618150023550146e-04 +-7.5829612225136993e-04 +-7.5155587664710712e-04 +-7.4586265548190272e-04 +-7.4113263008866129e-04 +-7.3729541779359313e-04 +-7.3429338338419062e-04 +-7.3208107170540169e-04 +-7.3062476554357453e-04 +-7.2990216217941274e-04 +-1.6665466948784012e-03 +-1.6698319412935426e-03 +-1.6762842878177006e-03 +-1.6856647147637772e-03 +-1.6976044199068167e-03 +-1.7115836136262106e-03 +-1.7268918100307401e-03 +-1.7425688486628259e-03 +-1.7573395387699997e-03 +-1.7695752230967822e-03 +-1.7773326639493477e-03 +-1.7785164496941978e-03 +-1.7711713626996251e-03 +-1.7538443884104696e-03 +-1.7259003042427823e-03 +-1.6876737962241712e-03 +-1.6404042814699993e-03 +-1.5859887486378405e-03 +-1.5266487504750870e-03 +-1.4646137010461567e-03 +-1.4018869854091761e-03 +-1.3401150909472710e-03 +-1.2805462524326074e-03 +-1.2240505439466709e-03 +-1.1711732621076973e-03 +-1.1222002508370500e-03 +-1.0772218709559961e-03 +-1.0361888722011487e-03 +-9.9895779486788719e-04 +-9.6532601345317420e-04 +-9.3505771059597398e-04 +-9.0790245761916016e-04 +-8.8360805022749699e-04 +-8.6192903579214778e-04 +-8.4263210117448703e-04 +-8.2549923132307879e-04 +-8.1032932564780390e-04 +-7.9693877846517553e-04 +-7.8516138933030295e-04 +-7.7484786289596188e-04 +-7.6586507935115175e-04 +-7.5809525929265058e-04 +-7.5143510585760410e-04 +-7.4579497793021991e-04 +-7.4109812802411132e-04 +-7.3728002460442612e-04 +-7.3428776936039009e-04 +-7.3207961393381607e-04 +-7.3062457691900500e-04 +-7.2990215985091315e-04 +-1.5143549686207380e-03 +-1.5173365155954472e-03 +-1.5231858115789347e-03 +-1.5316734820166030e-03 +-1.5424495691702357e-03 +-1.5550327515275828e-03 +-1.5687912854312981e-03 +-1.5829156954223894e-03 +-1.5963895763366511e-03 +-1.6079746865626360e-03 +-1.6162357817578359e-03 +-1.6196312922009805e-03 +-1.6166799923641837e-03 +-1.6061815708991551e-03 +-1.5874347696193680e-03 +-1.5603828639176439e-03 +-1.5256361468736362e-03 +-1.4843661112814003e-03 +-1.4381107245520276e-03 +-1.3885518478315639e-03 +-1.3373194241954307e-03 +-1.2858536927728751e-03 +-1.2353317411153990e-03 +-1.1866479043228485e-03 +-1.1404307892517668e-03 +-1.0970802487603303e-03 +-1.0568116243096053e-03 +-1.0196991888661851e-03 +-9.8571453675760424e-04 +-9.5475828884100688e-04 +-9.2668503718165132e-04 +-9.0132223834824064e-04 +-8.7848406350043366e-04 +-8.5798124107503543e-04 +-8.3962782427547027e-04 +-8.2324566333151494e-04 +-8.0866720558604699e-04 +-7.9573710535351663e-04 +-7.8431300748730464e-04 +-7.7426577425972784e-04 +-7.6547935202557211e-04 +-7.5785041870424328e-04 +-7.5128791182747464e-04 +-7.4571250660027729e-04 +-7.4105609148799147e-04 +-7.3726127316791354e-04 +-7.3428093164251088e-04 +-7.3207783864275315e-04 +-7.3062434723137888e-04 +-7.2990215701613582e-04 +-1.3589594345316733e-03 +-1.3616332224833021e-03 +-1.3668819447776768e-03 +-1.3745067276125361e-03 +-1.3842058718125910e-03 +-1.3955696037826128e-03 +-1.4080716963890717e-03 +-1.4210583961661682e-03 +-1.4337378027337491e-03 +-1.4451771552242520e-03 +-1.4543199794692361e-03 +-1.4600365197189359e-03 +-1.4612154573921774e-03 +-1.4568911690298508e-03 +-1.4463828338374710e-03 +-1.4294089575704436e-03 +-1.4061424265683770e-03 +-1.3771885932466555e-03 +-1.3434938893341637e-03 +-1.3062125628304161e-03 +-1.2665660399053535e-03 +-1.2257232375219246e-03 +-1.1847170984136380e-03 +-1.1443997115617203e-03 +-1.1054297820769178e-03 +-1.0682826612720413e-03 +-1.0332733091351234e-03 +-1.0005846061662041e-03 +-9.7029593787788227e-04 +-9.4240916155950130e-04 +-9.1687065715525455e-04 +-8.9358917655168579e-04 +-8.7244976763307740e-04 +-8.5332430687667688e-04 +-8.3607924715490916e-04 +-8.2058116067940806e-04 +-8.0670058467943197e-04 +-7.9431459087674669e-04 +-7.8330841565514803e-04 +-7.7357641356571834e-04 +-7.6502253490769601e-04 +-7.5756047840711373e-04 +-7.5111363111583166e-04 +-7.4561487780934281e-04 +-7.4100633961782399e-04 +-7.3723908480598612e-04 +-7.3427284220393149e-04 +-7.3207573869740424e-04 +-7.3062407557063583e-04 +-7.2990215366392180e-04 +-1.2115517913417655e-03 +-1.2139349572745687e-03 +-1.2186208694269845e-03 +-1.2254479084564990e-03 +-1.2341716240392153e-03 +-1.2444621576662069e-03 +-1.2559007648971605e-03 +-1.2679759911605100e-03 +-1.2800811668376194e-03 +-1.2915166555614445e-03 +-1.3015022676495594e-03 +-1.3092062682669562e-03 +-1.3137958283897758e-03 +-1.3145084689043785e-03 +-1.3107358027532846e-03 +-1.3021029366434345e-03 +-1.2885237014557173e-03 +-1.2702162455557149e-03 +-1.2476743014772293e-03 +-1.2216018813340263e-03 +-1.1928278743522100e-03 +-1.1622191269037802e-03 +-1.1306067696865030e-03 +-1.0987337877387965e-03 +-1.0672252322535673e-03 +-1.0365779239208945e-03 +-1.0071644014918843e-03 +-9.7924568942418734e-04 +-9.5298836292313674e-04 +-9.2848266899893102e-04 +-9.0575967885028990e-04 +-8.8480640447549793e-04 +-8.6557847421060827e-04 +-8.4801036951814130e-04 +-8.3202344507226592e-04 +-8.1753204913448288e-04 +-8.0444808087027806e-04 +-7.9268430018072315e-04 +-7.8215666594332262e-04 +-7.7278593337064781e-04 +-7.6449869757072521e-04 +-7.5722803165892774e-04 +-7.5091383507254917e-04 +-7.4550298104646541e-04 +-7.4094933092855590e-04 +-7.3721366633319014e-04 +-7.3426357721747659e-04 +-7.3207333403672024e-04 +-7.3062376453141161e-04 +-7.2990214982639830e-04 +-1.0795756787363778e-03 +-1.0816992940560672e-03 +-1.0858835969287403e-03 +-1.0920021998901967e-03 +-1.0998642508966850e-03 +-1.1092130878854714e-03 +-1.1197248105227608e-03 +-1.1310072753170396e-03 +-1.1426004770888122e-03 +-1.1539799768339072e-03 +-1.1645658394756756e-03 +-1.1737400557058346e-03 +-1.1808750086401733e-03 +-1.1853736274296243e-03 +-1.1867184128539631e-03 +-1.1845224472116216e-03 +-1.1785725668259242e-03 +-1.1688548253096626e-03 +-1.1555558178123074e-03 +-1.1390392709868060e-03 +-1.1198032371976556e-03 +-1.0984270526548411e-03 +-1.0755179116195574e-03 +-1.0516649087995325e-03 +-1.0274050321178330e-03 +-1.0032022298077214e-03 +-9.7943821201521681e-04 +-9.5641234223181138e-04 +-9.3434765404547737e-04 +-9.1340033971455713e-04 +-8.9367065632254552e-04 +-8.7521383998739855e-04 +-8.5805017636882478e-04 +-8.4217379791683361e-04 +-8.2756006609764187e-04 +-8.1417157403423695e-04 +-8.0196290111953015e-04 +-7.9088429290872760e-04 +-7.8088444780748264e-04 +-7.7191258152184373e-04 +-7.6391992064578991e-04 +-7.5686075410622748e-04 +-7.5069314885142140e-04 +-7.4537941587385554e-04 +-7.4088639510026550e-04 +-7.3718561296587696e-04 +-7.3425335442048496e-04 +-7.3207068134015891e-04 +-7.3062342146048241e-04 +-7.2990214559425740e-04 +-9.6691768088049421e-04 +-9.6882000511912757e-04 +-9.7257629259400085e-04 +-9.7808945227611968e-04 +-9.8521300726035288e-04 +-9.9375031922230555e-04 +-1.0034539584689247e-03 +-1.0140256182963256e-03 +-1.0251171689878446e-03 +-1.0363337191086207e-03 +-1.0472398594559454e-03 +-1.0573704760709159e-03 +-1.0662474045942053e-03 +-1.0734025065193297e-03 +-1.0784063632072944e-03 +-1.0808999106074167e-03 +-1.0806245648204197e-03 +-1.0774455074860079e-03 +-1.0713634093421371e-03 +-1.0625119908049022e-03 +-1.0511417980028214e-03 +-1.0375933835085741e-03 +-1.0222648238814359e-03 +-1.0055787999783273e-03 +-9.8795351416622215e-04 +-9.6978008633975897e-04 +-9.5140736794673312e-04 +-9.3313376632894176e-04 +-9.1520485275023119e-04 +-8.9781520557549602e-04 +-8.8111297846298596e-04 +-8.6520592485668621e-04 +-8.5016792614767969e-04 +-8.3604537842093976e-04 +-8.2286304958711378e-04 +-8.1062921178394443e-04 +-7.9933998676753166e-04 +-7.8898292556737689e-04 +-7.7953989059893899e-04 +-7.7098933012816713e-04 +-7.6330804053118190e-04 +-7.5647250782031976e-04 +-7.5045991094798879e-04 +-7.4524885836992885e-04 +-7.4081991800956841e-04 +-7.3715599008165270e-04 +-7.3424256266980373e-04 +-7.3206788164582393e-04 +-7.3062305943737669e-04 +-7.2990214112890581e-04 +-8.7486248803244932e-04 +-8.7658406502226960e-04 +-8.7999004890730072e-04 +-8.8500583916709650e-04 +-8.9151895536144056e-04 +-8.9937854008763883e-04 +-9.0839502748905258e-04 +-9.1834026845599910e-04 +-9.2894849586996290e-04 +-9.3991862274995814e-04 +-9.5091847953522309e-04 +-9.6159167003490498e-04 +-9.7156767861947876e-04 +-9.8047559445624938e-04 +-9.8796126123487367e-04 +-9.9370683915806684e-04 +-9.9745085314574696e-04 +-9.9900609906711756e-04 +-9.9827261037920001e-04 +-9.9524343329712760e-04 +-9.9000214313418942e-04 +-9.8271252698560007e-04 +-9.7360221097489051e-04 +-9.6294285215595739e-04 +-9.5102968898113239e-04 +-9.3816282954646243e-04 +-9.2463188771829794e-04 +-9.1070472193886408e-04 +-8.9662029731508075e-04 +-8.8258518504960831e-04 +-8.6877294891379560e-04 +-8.5532560246973652e-04 +-8.4235638671738939e-04 +-8.2995325225738450e-04 +-8.1818258482707520e-04 +-8.0709285814355549e-04 +-7.9671801853847097e-04 +-7.8708049759007364e-04 +-7.7819381364428199e-04 +-7.7006476537382366e-04 +-7.6269524566234645e-04 +-7.5608371702370956e-04 +-7.5022639449557802e-04 +-7.4511818153031543e-04 +-7.4075340102326053e-04 +-7.3712635873624107e-04 +-7.3423177093551780e-04 +-7.3206508261887372e-04 +-7.3062269756167129e-04 +-7.2990213666590455e-04 +-8.0313966168584763e-04 +-8.0472039548869028e-04 +-8.0785278484474070e-04 +-8.1247848535985511e-04 +-8.1850956484096830e-04 +-8.2582815471347317e-04 +-8.3428623191218255e-04 +-8.4370573753953361e-04 +-8.5387928689342459e-04 +-8.6457177292095842e-04 +-8.7552320631742973e-04 +-8.8645315501949891e-04 +-8.9706711563064035e-04 +-9.0706503199169378e-04 +-9.1615193875704218e-04 +-9.2405034505557129e-04 +-9.3051353039691443e-04 +-9.3533850527619021e-04 +-9.3837713146022552e-04 +-9.3954392503501022e-04 +-9.3881942740295073e-04 +-9.3624866474132122e-04 +-9.3193496852842525e-04 +-9.2603010448917035e-04 +-9.1872209573157920e-04 +-9.1022225571438893e-04 +-9.0075279227859776e-04 +-8.9053599804262155e-04 +-8.7978562122792057e-04 +-8.6870061467631183e-04 +-8.5746115229350160e-04 +-8.4622660441603041e-04 +-8.3513506948577323e-04 +-8.2430404529103415e-04 +-8.1383186067122027e-04 +-8.0379955280838165e-04 +-7.9427294732509147e-04 +-7.8530476653717403e-04 +-7.7693664924304495e-04 +-7.6920101127607454e-04 +-7.6212271005474358e-04 +-7.5572050013746441e-04 +-7.5000828235589282e-04 +-7.4499615845956409e-04 +-7.4069130809154970e-04 +-7.3709870671799548e-04 +-7.3422170291275401e-04 +-7.3206247190694517e-04 +-7.3062236008848496e-04 +-7.2990213250433296e-04 +-7.5076485895520407e-04 +-7.5224267774788903e-04 +-7.5517473285927267e-04 +-7.5951371850489660e-04 +-7.6518836403968022e-04 +-7.7210317055644202e-04 +-7.8013824067638669e-04 +-7.8914934932598410e-04 +-7.9896843190901295e-04 +-8.0940468960889744e-04 +-8.2024652684291690e-04 +-8.3126453724672233e-04 +-8.4221573184122521e-04 +-8.5284914241597011e-04 +-8.6291282097295593e-04 +-8.7216208612532584e-04 +-8.8036864997602230e-04 +-8.8733002731200853e-04 +-8.9287843674089871e-04 +-8.9688831188878344e-04 +-8.9928159690543527e-04 +-9.0003021575194302e-04 +-8.9915544522011241e-04 +-8.9672431598972560e-04 +-8.9284352829122580e-04 +-8.8765162607211303e-04 +-8.8131028684112047e-04 +-8.7399555434385394e-04 +-8.6588970058414539e-04 +-8.5717420115495255e-04 +-8.4802409185189345e-04 +-8.3860378215814006e-04 +-8.2906425357693312e-04 +-8.1954147436064410e-04 +-8.1015581275988089e-04 +-8.0101221857686140e-04 +-7.9220095594327849e-04 +-7.8379869819409818e-04 +-7.7586983005638517e-04 +-7.6846783726057695e-04 +-7.6163669553944635e-04 +-7.5541219802161593e-04 +-7.4982318169465167e-04 +-7.4489263011177974e-04 +-7.4063864145695554e-04 +-7.3707525923184835e-04 +-7.3421316796890013e-04 +-7.3206025920772178e-04 +-7.3062207410792498e-04 +-7.2990212897806168e-04 +-7.1661648041507675e-04 +-7.1802709105217696e-04 +-7.2082810554496141e-04 +-7.2497899792040715e-04 +-7.3041872922102193e-04 +-7.3706553317830139e-04 +-7.4481676965805206e-04 +-7.5354895817604365e-04 +-7.6311812323978125e-04 +-7.7336059697315294e-04 +-7.8409443073005150e-04 +-7.9512156355936788e-04 +-8.0623087746656741e-04 +-8.1720223217085313e-04 +-8.2781150996520355e-04 +-8.3783661084913539e-04 +-8.4706422110991523e-04 +-8.5529704526448203e-04 +-8.6236106185343781e-04 +-8.6811226569457570e-04 +-8.7244232173775999e-04 +-8.7528259961503960e-04 +-8.7660618798437984e-04 +-8.7642768799508369e-04 +-8.7480082192085333e-04 +-8.7181412328676800e-04 +-8.6758515818436365e-04 +-8.6225383619694361e-04 +-8.5597539394157275e-04 +-8.4891358299951224e-04 +-8.4123448796496233e-04 +-8.3310126595108130e-04 +-8.2466996125384105e-04 +-8.1608642715055130e-04 +-8.0748429232311886e-04 +-7.9898384602241311e-04 +-7.9069168202425179e-04 +-7.8270093142820995e-04 +-7.7509192178023721e-04 +-7.6793311834372788e-04 +-7.6128222708896401e-04 +-7.5518736399097423e-04 +-7.4968821877303027e-04 +-7.4481716173918839e-04 +-7.4060025913270672e-04 +-7.3705817547008330e-04 +-7.3420695083992497e-04 +-7.3205864770395260e-04 +-7.3062186585624205e-04 +-7.2990212641044368e-04 +-6.9978951001372996e-04 +-7.0116682283485313e-04 +-7.0390284047309093e-04 +-7.0796024834979927e-04 +-7.1328285483628615e-04 +-7.1979540110118684e-04 +-7.2740342686835506e-04 +-7.3599328773505019e-04 +-7.4543243536924529e-04 +-7.5557008203786088e-04 +-7.6623837423779259e-04 +-7.7725419514460643e-04 +-7.8842170016341377e-04 +-7.9953566160426192e-04 +-8.1038565477216298e-04 +-8.2076105653631690e-04 +-8.3045674867159719e-04 +-8.3927932560754035e-04 +-8.4705350855905246e-04 +-8.5362837988652257e-04 +-8.5888299157488529e-04 +-8.6273088880046587e-04 +-8.6512313722945738e-04 +-8.6604955374083652e-04 +-8.6553800351988274e-04 +-8.6365181774058131e-04 +-8.6048557338549395e-04 +-8.5615962844229896e-04 +-8.5081389830357417e-04 +-8.4460138269629105e-04 +-8.3768191131519643e-04 +-8.3021648634377335e-04 +-8.2236248292914284e-04 +-8.1426984628078065e-04 +-8.0607831395861041e-04 +-7.9791560517234253e-04 +-7.8989645994013340e-04 +-7.8212237879151693e-04 +-7.7468190393465113e-04 +-7.6765128948117932e-04 +-7.6109542538713496e-04 +-7.5506890202678271e-04 +-7.4961712582227995e-04 +-7.4477741846241908e-04 +-7.4058005144687520e-04 +-7.3704918333600950e-04 +-7.3420367911665625e-04 +-7.3205779980540576e-04 +-7.3062175629691820e-04 +-7.2990212505972120e-04 +-6.9978946091583504e-04 +-7.0116638039256730e-04 +-7.0390160862394675e-04 +-7.0795782690534254e-04 +-7.1327884067959074e-04 +-7.1978939322704964e-04 +-7.2739503634975636e-04 +-7.3598215338200191e-04 +-7.4541824529750016e-04 +-7.5555260054290657e-04 +-7.6621747228839993e-04 +-7.7722988157153641e-04 +-7.8839414942991483e-04 +-7.9950523320842549e-04 +-8.1035289919233644e-04 +-8.2072670348056430e-04 +-8.3042167534661654e-04 +-8.3924450561891431e-04 +-8.4701994541694250e-04 +-8.5359703220152985e-04 +-8.5885469911040199e-04 +-8.6270630900161334e-04 +-8.6510270046282714e-04 +-8.6603344251950736e-04 +-8.6552615712811058e-04 +-8.6364395978678053e-04 +-8.6048125671485626e-04 +-8.5615829006713566e-04 +-8.5081491671313420e-04 +-8.4460413088556095e-04 +-8.3768580068863607e-04 +-8.3022099879571161e-04 +-8.2236719043120765e-04 +-8.1427441891644898e-04 +-8.0608251839955685e-04 +-7.9791929609518777e-04 +-7.8989956693242336e-04 +-7.8212489103092258e-04 +-7.7468385448542921e-04 +-7.6765274055318623e-04 +-7.6109645542738564e-04 +-7.5506959510990128e-04 +-7.4961756349448464e-04 +-7.4477767397436933e-04 +-7.4058018617243772e-04 +-7.3704924509974880e-04 +-7.3420370212449212e-04 +-7.3205780587358297e-04 +-7.3062175709019868e-04 +-7.2990212506956738e-04 +-7.1661632544735927e-04 +-7.1802569457565790e-04 +-7.2082421753856725e-04 +-7.2497135570213814e-04 +-7.3040606197400130e-04 +-7.3704657925717824e-04 +-7.4479031023615085e-04 +-7.5351386966811718e-04 +-7.6307344899579830e-04 +-7.7330563585028503e-04 +-7.8402883639238372e-04 +-7.9504544413327755e-04 +-8.0614488128197335e-04 +-8.1710760285318303e-04 +-8.2771009431379923e-04 +-8.3773080666306129e-04 +-8.4695685959072136e-04 +-8.5519121296681112e-04 +-8.6225987841656777e-04 +-8.6801864313631723e-04 +-8.7235873636367213e-04 +-8.7521090695568977e-04 +-8.7654750452299758e-04 +-8.7638235231304233e-04 +-8.7476843493382533e-04 +-8.7179365541949542e-04 +-8.6757510299534759e-04 +-8.6225238630965872e-04 +-8.5598061607531620e-04 +-8.4892357333083888e-04 +-8.4124749540368958e-04 +-8.3311577760647665e-04 +-8.2468475018667743e-04 +-8.1610056676466964e-04 +-8.0749714425208587e-04 +-7.9899502928618539e-04 +-7.9070103094506009e-04 +-7.8270844874182789e-04 +-7.7509773195624787e-04 +-7.6793742464245315e-04 +-7.6128527453402464e-04 +-7.5518940933103269e-04 +-7.4968950767776549e-04 +-7.4481791290872382e-04 +-7.4060065465577545e-04 +-7.3705835659280169e-04 +-7.3420701825263667e-04 +-7.3205866547243080e-04 +-7.3062186817808485e-04 +-7.2990212643921841e-04 +-7.5076457381712924e-04 +-7.5224010826693691e-04 +-7.5516757928224853e-04 +-7.5949965914873729e-04 +-7.6516506643452297e-04 +-7.7206832855425530e-04 +-7.8008964458048120e-04 +-7.8908499352585014e-04 +-7.9888666010187730e-04 +-8.0930437121201821e-04 +-8.2012724995868681e-04 +-8.3112679465311692e-04 +-8.4206106894943076e-04 +-8.5268023260671110e-04 +-8.6273343678522167e-04 +-8.7197694594549511e-04 +-8.8018313858745194e-04 +-8.8714981173877141e-04 +-8.9270902092768308e-04 +-8.9673458890974502e-04 +-8.9914746098305207e-04 +-8.9991828693065977e-04 +-8.9906693939169823e-04 +-8.9665906738513150e-04 +-8.9280014690550752e-04 +-8.8762775414995775e-04 +-8.8130290945829539e-04 +-8.7400131940170193e-04 +-8.6590521110488730e-04 +-8.5719625443811723e-04 +-8.4804985264396468e-04 +-8.3863088807401400e-04 +-8.2909085922533399e-04 +-8.1956624558252554e-04 +-8.1017788441062832e-04 +-8.0103112906847694e-04 +-7.9221657011147430e-04 +-7.8381112768653618e-04 +-7.7587935790187647e-04 +-7.6847485093584100e-04 +-7.6164163089475025e-04 +-7.5541549492821739e-04 +-7.4982525122138817e-04 +-7.4489383236464222e-04 +-7.4063927284366104e-04 +-7.3707554776077447e-04 +-7.3421327518372298e-04 +-7.3206028743358386e-04 +-7.3062207779339000e-04 +-7.2990212902374106e-04 +-8.0313920160991021e-04 +-8.0471624961492955e-04 +-8.0784124314693900e-04 +-8.1245580587501896e-04 +-8.1847199874591906e-04 +-8.2577201943695086e-04 +-8.3420804482913272e-04 +-8.4360241724199458e-04 +-8.5374841961399534e-04 +-8.6441192808662951e-04 +-8.7533426849540177e-04 +-8.8623662265023551e-04 +-8.9682630479121254e-04 +-9.0680512180766888e-04 +-9.1587980875676043e-04 +-9.2377418493422997e-04 +-9.3024224500967408e-04 +-9.3508098236963532e-04 +-9.3814147395590965e-04 +-9.3933676257984024e-04 +-9.3864540861192467e-04 +-9.3611019566829513e-04 +-9.3183221496960056e-04 +-9.2596122905995578e-04 +-9.1868366644361947e-04 +-9.1020974677490671e-04 +-9.0076109972496313e-04 +-8.9055990784490285e-04 +-8.7982018904884604e-04 +-8.6874143851028280e-04 +-8.5750453755465404e-04 +-8.4626963376779548e-04 +-8.3517559667005544e-04 +-8.2434063440643625e-04 +-8.1386369119842213e-04 +-8.0382630759726385e-04 +-7.9429469688038052e-04 +-7.8532185905365326e-04 +-7.7694961240865577e-04 +-7.6921046909022824e-04 +-7.6212931583823876e-04 +-7.5572488547816295e-04 +-7.5001102083195061e-04 +-7.4499774248764554e-04 +-7.4069213704590266e-04 +-7.3709908445872567e-04 +-7.3422184296862856e-04 +-7.3206250871885167e-04 +-7.3062236488986778e-04 +-7.2990213256378985e-04 +-8.7486178154092789e-04 +-8.7657769870212385e-04 +-8.7997232710565574e-04 +-8.8497102466585109e-04 +-8.9146132325199740e-04 +-8.9929251858741465e-04 +-9.0827544714333392e-04 +-9.1818272915766808e-04 +-9.2874984102884626e-04 +-9.3967748167303672e-04 +-9.5063580600828444e-04 +-9.6127117503671145e-04 +-9.7121603961489134e-04 +-9.8010233486307049e-04 +-9.8757823843101823e-04 +-9.9332735397272831e-04 +-9.9708848114663136e-04 +-9.9867341779902243e-04 +-9.9798003131280379e-04 +-9.9499832899570370e-04 +-9.8980839423433681e-04 +-9.8257052186163690e-04 +-9.7350924209564248e-04 +-9.6289379082595153e-04 +-9.5101779530666901e-04 +-9.3818056436612181e-04 +-9.2467162616104257e-04 +-9.1075930997975782e-04 +-8.9668343154769440e-04 +-8.8265162516024142e-04 +-8.6883859005464873e-04 +-8.5538744217337928e-04 +-8.4241242098843493e-04 +-8.3000233103793224e-04 +-8.1822425064527915e-04 +-8.0712718512295130e-04 +-7.9674546304193397e-04 +-7.8710176701738007e-04 +-7.7820975636300302e-04 +-7.7007628231462032e-04 +-7.6270322254717480e-04 +-7.5608897530253581e-04 +-7.5022965864987275e-04 +-7.4512006030138579e-04 +-7.4075438021886425e-04 +-7.3712680347095075e-04 +-7.3423193540640274e-04 +-7.3206512576569588e-04 +-7.3062270318224366e-04 +-7.2990213673547780e-04 +-9.6691662204613190e-04 +-9.6881046392489109e-04 +-9.7254973577065281e-04 +-9.7803729931219370e-04 +-9.8512674201565163e-04 +-9.9362175800203536e-04 +-1.0032757101475285e-03 +-1.0137917459066643e-03 +-1.0248240191780887e-03 +-1.0359808274722009e-03 +-1.0468307760562578e-03 +-1.0569133066795052e-03 +-1.0657548557615293e-03 +-1.0728912790486430e-03 +-1.0778958627767122e-03 +-1.0804104107739164e-03 +-1.0801751143763548e-03 +-1.0770519619851670e-03 +-1.0710369478277467e-03 +-1.0622583575458670e-03 +-1.0509613303111124e-03 +-1.0374817136059675e-03 +-1.0222140271844843e-03 +-1.0055787255122191e-03 +-9.8799306509398288e-04 +-9.6984829116850341e-04 +-9.5149416478430111e-04 +-9.3323049127764482e-04 +-9.1530446900891843e-04 +-8.9791233192947106e-04 +-8.8120377997526580e-04 +-8.6528792168177686e-04 +-8.5023976450460288e-04 +-8.3610659505050245e-04 +-8.2291384979816379e-04 +-8.1067027239656309e-04 +-7.9937228896407697e-04 +-7.8900761851521928e-04 +-7.7955818421898942e-04 +-7.7100241407174414e-04 +-7.6331702589689586e-04 +-7.5647838809311363e-04 +-7.5046353886399351e-04 +-7.4525093576396418e-04 +-7.4082099609929127e-04 +-7.3715647803142205e-04 +-7.3424274262943415e-04 +-7.3206792876017422e-04 +-7.3062306556651274e-04 +-7.2990214120471442e-04 +-1.0795741208089588e-03 +-1.0816852558033639e-03 +-1.0858445284657426e-03 +-1.0919255107386264e-03 +-1.0997375333457382e-03 +-1.1090246198931118e-03 +-1.1194643948649547e-03 +-1.1306674147445034e-03 +-1.1421777938515553e-03 +-1.1534766665374624e-03 +-1.1639908325075186e-03 +-1.1731094945410510e-03 +-1.1802116929707023e-03 +-1.1847052639583032e-03 +-1.1860748079356685e-03 +-1.1839321050134523e-03 +-1.1780593729533893e-03 +-1.1684355042265698e-03 +-1.1552386391627488e-03 +-1.1388241323248261e-03 +-1.1196829074927163e-03 +-1.0983891393568552e-03 +-1.0755470595156873e-03 +-1.0517448232518689e-03 +-1.0275200746868317e-03 +-1.0033384933801417e-03 +-9.7958410290777836e-04 +-9.5655876482598199e-04 +-9.3448791607213982e-04 +-9.1352988869743536e-04 +-8.9378673523237350e-04 +-8.7531512405419876e-04 +-8.5813642963363966e-04 +-8.4224557007376525e-04 +-8.2761843773478453e-04 +-8.1421795064806060e-04 +-8.0199885202950278e-04 +-7.9091142929080271e-04 +-7.8090433358975588e-04 +-7.7192667119997769e-04 +-7.6392951876090836e-04 +-7.5686699193230705e-04 +-7.5069697462505571e-04 +-7.4538159560079962e-04 +-7.4088752156673899e-04 +-7.3718612106724274e-04 +-7.3425354130546825e-04 +-7.3207073016896634e-04 +-7.3062342780412591e-04 +-7.2990214567266842e-04 +-1.2115495484480844e-03 +-1.2139147474224650e-03 +-1.2185646353864280e-03 +-1.2253375879055777e-03 +-1.2339895798435074e-03 +-1.2441920994897015e-03 +-1.2555292466083058e-03 +-1.2674944465768654e-03 +-1.2794882564905947e-03 +-1.2908204660570077e-03 +-1.3007217093628607e-03 +-1.3083709736447244e-03 +-1.3129440696216352e-03 +-1.3136831070231728e-03 +-1.3099789149384868e-03 +-1.3014502823094139e-03 +-1.2880003228082290e-03 +-1.2698341643484735e-03 +-1.2474326170002917e-03 +-1.2214888912629189e-03 +-1.1928243987544952e-03 +-1.1623021238459424e-03 +-1.1307525226858680e-03 +-1.0989202659077296e-03 +-1.0674335285321165e-03 +-1.0367928848034075e-03 +-1.0073746588422185e-03 +-9.7944331693782579e-04 +-9.5316834364936624e-04 +-9.2864230723455825e-04 +-9.0589803896361069e-04 +-8.8492381945833650e-04 +-8.6567613965101375e-04 +-8.4809002242177680e-04 +-8.3208711861108137e-04 +-8.1758189118173816e-04 +-8.0448622392774449e-04 +-7.9271277153572940e-04 +-7.8217732869439397e-04 +-7.7280045082038311e-04 +-7.6450851515547189e-04 +-7.5723437197478677e-04 +-7.5091770265818970e-04 +-7.4550517442650030e-04 +-7.4095046005212897e-04 +-7.3721417400700513e-04 +-7.3426376347155526e-04 +-7.3207338260827359e-04 +-7.3062377083362470e-04 +-7.2990214990424369e-04 +-1.3589563038175594e-03 +-1.3616050137567708e-03 +-1.3668034714302835e-03 +-1.3743528899241089e-03 +-1.3839524482756936e-03 +-1.3951948803726849e-03 +-1.4075590458667228e-03 +-1.4203996673835873e-03 +-1.4329370017939925e-03 +-1.4442534764663557e-03 +-1.4533089635653097e-03 +-1.4589882284098753e-03 +-1.4601892228348649e-03 +-1.4559475919102359e-03 +-1.4455748243012430e-03 +-1.4287741508438928e-03 +-1.4056989135880016e-03 +-1.3769347493894706e-03 +-1.3434117449538448e-03 +-1.3062732498799758e-03 +-1.2667356491201304e-03 +-1.2259678065115048e-03 +-1.1850060855244176e-03 +-1.1447078840340873e-03 +-1.1057378043092315e-03 +-1.0685768018881417e-03 +-1.0335446636537359e-03 +-1.0008281370717212e-03 +-9.7050952547500687e-04 +-9.4259276830644561e-04 +-9.1702564488074160e-04 +-8.9371777798284290e-04 +-8.7255469452923013e-04 +-8.5340847005665858e-04 +-8.3614556351962359e-04 +-8.2063242538265723e-04 +-8.0673939073997402e-04 +-7.9434328261414723e-04 +-7.8332906586381357e-04 +-7.7359081716471480e-04 +-7.6503221394685255e-04 +-7.5756669487545849e-04 +-7.5111740510819258e-04 +-7.4561700937453247e-04 +-7.4100743313237406e-04 +-7.3723957506583620e-04 +-7.3427302165942796e-04 +-7.3207578541589877e-04 +-7.3062408162546846e-04 +-7.2990215373867906e-04 +-1.5143507894487067e-03 +-1.5172988614831349e-03 +-1.5230810915432655e-03 +-1.5314683770515289e-03 +-1.5421124035426116e-03 +-1.5545362266590392e-03 +-1.5681166963942049e-03 +-1.5820582576838538e-03 +-1.5953637845369808e-03 +-1.6068179171068945e-03 +-1.6150080594807337e-03 +-1.6184097382240113e-03 +-1.6155480996279958e-03 +-1.6052155887245584e-03 +-1.5866910124650842e-03 +-1.5598896899608145e-03 +-1.5253925858248270e-03 +-1.4843466274073660e-03 +-1.4382737031922918e-03 +-1.3888488498754140e-03 +-1.3377029198991866e-03 +-1.2862821805732720e-03 +-1.2357722224577306e-03 +-1.1870763055713315e-03 +-1.1408311031716565e-03 +-1.0974430722986009e-03 +-1.0571325652900783e-03 +-1.0199774119452271e-03 +-9.8595156649080250e-04 +-9.5495709222786314e-04 +-9.2684935834920588e-04 +-9.0145613864704374e-04 +-8.7859161807931870e-04 +-8.5806634891866717e-04 +-8.3969409733338147e-04 +-8.2329636894184729e-04 +-8.0870524370571441e-04 +-7.9576500782872663e-04 +-7.8433295083174537e-04 +-7.7427960040856011e-04 +-7.6548859358555954e-04 +-7.5785632657788431e-04 +-7.5129148395718440e-04 +-7.4571451711395525e-04 +-7.4105711984427062e-04 +-7.3726173307960734e-04 +-7.3428109965707473e-04 +-7.3207788231768119e-04 +-7.3062435288608920e-04 +-7.2990215708590444e-04 +-1.6665414544973667e-03 +-1.6697847281261762e-03 +-1.6761530279246664e-03 +-1.6854079142175308e-03 +-1.6971833643464208e-03 +-1.7109666369235865e-03 +-1.7260607063298782e-03 +-1.7415266172972317e-03 +-1.7561174461243408e-03 +-1.7682361103423928e-03 +-1.7759673622685965e-03 +-1.7772318401435320e-03 +-1.7700719032340034e-03 +-1.7530123205889479e-03 +-1.7253810573633168e-03 +-1.6874711664812158e-03 +-1.6404858228095888e-03 +-1.5862979779284901e-03 +-1.5271192090388424e-03 +-1.4651807897258064e-03 +-1.4024955815352756e-03 +-1.3407229013524559e-03 +-1.2811239654173679e-03 +-1.2245801193201300e-03 +-1.1716454746231138e-03 +-1.1226122125069713e-03 +-1.0775749030097848e-03 +-1.0364868512600235e-03 +-9.9920595882355308e-04 +-9.6553015105531196e-04 +-9.3522364356301256e-04 +-9.0803573180856000e-04 +-8.8371376863409263e-04 +-8.6201178331449854e-04 +-8.4269592591969527e-04 +-8.2554765876789444e-04 +-8.1036539039215465e-04 +-7.9696506416300288e-04 +-7.8518007128682455e-04 +-7.7486075032975627e-04 +-7.6587365586687571e-04 +-7.5810072101626974e-04 +-7.5143839717849658e-04 +-7.4579682503056867e-04 +-7.4109907046188085e-04 +-7.3728044522232547e-04 +-7.3428792276560766e-04 +-7.3207965376113925e-04 +-7.3062458207121927e-04 +-7.2990215991446811e-04 +-1.8021151133233604e-03 +-1.8056256760685043e-03 +-1.8125426124533095e-03 +-1.8226545811253229e-03 +-1.8356302100461792e-03 +-1.8509827969675765e-03 +-1.8679992816590942e-03 +-1.8856299582291848e-03 +-1.9023610524215478e-03 +-1.9161307405348204e-03 +-1.9243798572916035e-03 +-1.9243154809965195e-03 +-1.9133841523125735e-03 +-1.8898282984137133e-03 +-1.8531173238648289e-03 +-1.8040787689664166e-03 +-1.7446926784998136e-03 +-1.6776580158989023e-03 +-1.6059037530197478e-03 +-1.5321860913418822e-03 +-1.4588364817966113e-03 +-1.3876568134684798e-03 +-1.3199224018111356e-03 +-1.2564468770690982e-03 +-1.1976721966840921e-03 +-1.1437602439530112e-03 +-1.0946738039104378e-03 +-1.0502423714620326e-03 +-1.0102126105204683e-03 +-9.7428534060334639e-04 +-9.4214160887693278e-04 +-9.1346037307889368e-04 +-8.8792997979165805e-04 +-8.6525519443650086e-04 +-8.4516113068365019e-04 +-8.2739507987823768e-04 +-8.1172696483545364e-04 +-7.9794893138708859e-04 +-7.8587443447998204e-04 +-7.7533706186298193e-04 +-7.6618925714345997e-04 +-7.5830104682155278e-04 +-7.5155883626632782e-04 +-7.4586431253956167e-04 +-7.4113347386658361e-04 +-7.3729579374711676e-04 +-7.3429352031423951e-04 +-7.3208110721896546e-04 +-7.3062477013455935e-04 +-7.2990216223601319e-04 +-1.9091956987314796e-03 +-1.9129241686458311e-03 +-1.9203124062974538e-03 +-1.9312187651596136e-03 +-1.9454085944959208e-03 +-1.9624974672616236e-03 +-1.9818351450377318e-03 +-2.0023232779120973e-03 +-2.0222017111601676e-03 +-2.0389019576981813e-03 +-2.0491165586526017e-03 +-2.0492055301505685e-03 +-2.0359144630814662e-03 +-2.0071732931939120e-03 +-1.9626392283806668e-03 +-1.9037541256535788e-03 +-1.8333350710282097e-03 +-1.7549186796409681e-03 +-1.6721177976713132e-03 +-1.5881564060090383e-03 +-1.5056260158481753e-03 +-1.4264249681929446e-03 +-1.3518136080905522e-03 +-1.2825245410166045e-03 +-1.2188862241055915e-03 +-1.1609367658489411e-03 +-1.1085181679616576e-03 +-1.0613491539890765e-03 +-1.0190786331694133e-03 +-9.8132329623930033e-04 +-9.4769298661131151e-04 +-9.1780705639951459e-04 +-8.9130429919797238e-04 +-8.6784844340678867e-04 +-8.4713066932228865e-04 +-8.2887019953481358e-04 +-8.1281369828684210e-04 +-7.9873398464683871e-04 +-7.8642839853773107e-04 +-7.7571704168992060e-04 +-7.6644103437176778e-04 +-7.5846087319693942e-04 +-7.5165493792215502e-04 +-7.4591817046541417e-04 +-7.4116093351438486e-04 +-7.3730804628874291e-04 +-7.3429798938302122e-04 +-7.3208226778677041e-04 +-7.3062492031294047e-04 +-7.2990216409044343e-04 +-1.9821994234584740e-03 +-1.9860845770127461e-03 +-1.9938352638392428e-03 +-2.0054069218090110e-03 +-2.0207035302275754e-03 +-2.0395008476079991e-03 +-2.0612864816029770e-03 +-2.0850020390603468e-03 +-2.1087281999101581e-03 +-2.1294473558554792e-03 +-2.1431034536445737e-03 +-2.1451480710281906e-03 +-2.1315343530852490e-03 +-2.0997983411095984e-03 +-2.0497289872275881e-03 +-1.9833378522654327e-03 +-1.9042273132669643e-03 +-1.8167093796158762e-03 +-1.7250185585476379e-03 +-1.6327970859302179e-03 +-1.5428663430235386e-03 +-1.4572100685221908e-03 +-1.3770775452659220e-03 +-1.3031340369161883e-03 +-1.2356134479995777e-03 +-1.1744510468530509e-03 +-1.1193888682096535e-03 +-1.0700543566376862e-03 +-1.0260162445448887e-03 +-9.8682255519488035e-04 +-9.5202529969738356e-04 +-9.2119565594642313e-04 +-8.9393256240755342e-04 +-8.6986689794631665e-04 +-8.4866280360309349e-04 +-8.3001723284638644e-04 +-8.1365847199538265e-04 +-7.9934412584364270e-04 +-7.8685889069408032e-04 +-7.7601231797823334e-04 +-7.6663669093549004e-04 +-7.5858508298269340e-04 +-7.5172963115826511e-04 +-7.4596003548553697e-04 +-7.4118228121742462e-04 +-7.3731757283756875e-04 +-7.3430146453979349e-04 +-7.3208317032826356e-04 +-7.3062503711017696e-04 +-7.2990216553325891e-04 +-2.0242438337591752e-03 +-2.0282263801255180e-03 +-2.0362167826903860e-03 +-2.0482601534404050e-03 +-2.0643928176435913e-03 +-2.0845574271788000e-03 +-2.1084200586736356e-03 +-2.1350594192684966e-03 +-2.1625552989527862e-03 +-2.1876265583642162e-03 +-2.2056144387741653e-03 +-2.2111089592102518e-03 +-2.1992080016220855e-03 +-2.1669164527620094e-03 +-2.1139893128022361e-03 +-2.0428465929293402e-03 +-1.9577383719421482e-03 +-1.8636488275712382e-03 +-1.7653685610794819e-03 +-1.6669265416994596e-03 +-1.5713686559029663e-03 +-1.4807760170856543e-03 +-1.3964086503350918e-03 +-1.3188906600003648e-03 +-1.2483884316100387e-03 +-1.1847602094815614e-03 +-1.1276715839662727e-03 +-1.0766795047462076e-03 +-1.0312905075607352e-03 +-9.9099927257386452e-04 +-9.5531290281556974e-04 +-9.2376522343781263e-04 +-8.9592433663199201e-04 +-8.7139576911887055e-04 +-8.4982285020380891e-04 +-8.3088544013241680e-04 +-8.1429775668644935e-04 +-7.9980578758760093e-04 +-7.8718459745178554e-04 +-7.7623571722848094e-04 +-7.6678472379575571e-04 +-7.5867906494864949e-04 +-7.5178615154145533e-04 +-7.4599171775284446e-04 +-7.4119843817037204e-04 +-7.3732478368055245e-04 +-7.3430409518760245e-04 +-7.3208385358902262e-04 +-7.3062512553511924e-04 +-7.2990216662623488e-04 +-2.0445770542996166e-03 +-2.0486109625000109e-03 +-2.0567293947501121e-03 +-2.0690290268866166e-03 +-2.0856277970492110e-03 +-2.1065884881654629e-03 +-2.1317446619407094e-03 +-2.1603787972662926e-03 +-2.1907429146262362e-03 +-2.2195524266884043e-03 +-2.2418107110554158e-03 +-2.2514098776994186e-03 +-2.2425945490422831e-03 +-2.2116968857054759e-03 +-2.1582220220346528e-03 +-2.0847800037824666e-03 +-1.9960927839174892e-03 +-1.8976983341582874e-03 +-1.7948773428110760e-03 +-1.6920187402656203e-03 +-1.5923919384601103e-03 +-1.4981896386800763e-03 +-1.4107046550808622e-03 +-1.3305450613674739e-03 +-1.2578350287856088e-03 +-1.1923795944248565e-03 +-1.1337893845603621e-03 +-1.0815696710476446e-03 +-1.0351809397457004e-03 +-9.9407817895988643e-04 +-9.5773500396352171e-04 +-9.2565737253951159e-04 +-8.9739039326845033e-04 +-8.7252071008238699e-04 +-8.5067617440345768e-04 +-8.3152395536795069e-04 +-8.1476784349075596e-04 +-8.0014523085927499e-04 +-7.8742406685810011e-04 +-7.7639996594500930e-04 +-7.6689356394397847e-04 +-7.5874816791250265e-04 +-7.5182771251083641e-04 +-7.4601501633518011e-04 +-7.4121032064264575e-04 +-7.3733008722661809e-04 +-7.3430603015007384e-04 +-7.3208435618668413e-04 +-7.3062519058213183e-04 +-7.2990216743098785e-04 +-2.0529832670842605e-03 +-2.0570397211142431e-03 +-2.0652076259473958e-03 +-2.0775938633371960e-03 +-2.0943391305208807e-03 +-2.1155594479941048e-03 +-2.1412029787910760e-03 +-2.1707562739037220e-03 +-2.2027443126739414e-03 +-2.2341000379180495e-03 +-2.2597793027886652e-03 +-2.2732208696260286e-03 +-2.2679118626436896e-03 +-2.2394407811855976e-03 +-2.1868872898348104e-03 +-2.1128525046485726e-03 +-2.0223614661542696e-03 +-1.9213857111131391e-03 +-1.8156214756840242e-03 +-1.7097785650631375e-03 +-1.6073357527739078e-03 +-1.5105994525164076e-03 +-1.4209071575626607e-03 +-1.3388678742565709e-03 +-1.2645823954864134e-03 +-1.1978212249884532e-03 +-1.1381573664627001e-03 +-1.0850598543469961e-03 +-1.0379564851891049e-03 +-9.9627388975996253e-04 +-9.5946168042497515e-04 +-9.2700581231388907e-04 +-8.9843488443681137e-04 +-8.7332198750274780e-04 +-8.5128387192684311e-04 +-8.3197861344294773e-04 +-8.1510253934817122e-04 +-8.0038689629499812e-04 +-7.8759455205731129e-04 +-7.7651689969994680e-04 +-7.6697105256434998e-04 +-7.5879736775028245e-04 +-7.5185730461779083e-04 +-7.4603160631225233e-04 +-7.4121878219356630e-04 +-7.3733386412479565e-04 +-7.3430740819851190e-04 +-7.3208471414396047e-04 +-7.3062523691122679e-04 +-7.2990216800501815e-04 +-2.0560405541228820e-03 +-2.0601049793404647e-03 +-2.0682821513776325e-03 +-2.0806666606725749e-03 +-2.0973866882631150e-03 +-2.1185613746695230e-03 +-2.1441904554298161e-03 +-2.1739069662338744e-03 +-2.2065024364902818e-03 +-2.2392268945333541e-03 +-2.2672008743421989e-03 +-2.2836569874429263e-03 +-2.2814960028901049e-03 +-2.2556017919877032e-03 +-2.2045575386673102e-03 +-2.1308303739836819e-03 +-2.0396161608691411e-03 +-1.9372062511673457e-03 +-1.8296269913908455e-03 +-1.7218525926883238e-03 +-1.6175396307815306e-03 +-1.5190956040437745e-03 +-1.4279029193550029e-03 +-1.3445794773536339e-03 +-1.2692145527661814e-03 +-1.2015573026917144e-03 +-1.1411560607270704e-03 +-1.0874555059280882e-03 +-1.0398611952950998e-03 +-9.9778034329098286e-04 +-9.6064607194299768e-04 +-9.2793057120237282e-04 +-8.9915107108693500e-04 +-8.7387132854150772e-04 +-8.5170045132904233e-04 +-8.3229025796636568e-04 +-8.1533194355699510e-04 +-8.0055253164307684e-04 +-7.8771140030248297e-04 +-7.7659704545059095e-04 +-7.6702416425274904e-04 +-7.5883109122342526e-04 +-7.5187758911499005e-04 +-7.4604297880349478e-04 +-7.4122458290872310e-04 +-7.3733645345515385e-04 +-7.3430835298787431e-04 +-7.3208495956776404e-04 +-7.3062526867661616e-04 +-7.2990216839961862e-04 +-2.0570060121488563e-03 +-2.0610724233129881e-03 +-2.0692452576765324e-03 +-2.0816029056704112e-03 +-2.0982520007563330e-03 +-2.1192935288049260e-03 +-2.1447349040484343e-03 +-2.1742858362338571e-03 +-2.2069322147521536e-03 +-2.2402228483312850e-03 +-2.2695281912120109e-03 +-2.2880497206954229e-03 +-2.2882916107577612e-03 +-2.2645626960509100e-03 +-2.2149886516845221e-03 +-2.1418627073492859e-03 +-2.0504649000374791e-03 +-1.9473065917923239e-03 +-1.8386553425747373e-03 +-1.7296833584153502e-03 +-1.6241827101721351e-03 +-1.5246398636028825e-03 +-1.4324744947429510e-03 +-1.3483148809826588e-03 +-1.2722452717232470e-03 +-1.2040021816015602e-03 +-1.1431184696937013e-03 +-1.0890231959277477e-03 +-1.0411075029414618e-03 +-9.9876595034438347e-04 +-9.6142087984593899e-04 +-9.2853546815178977e-04 +-8.9961949523977448e-04 +-8.7423060000065965e-04 +-8.5197288079037140e-04 +-8.3249405570550025e-04 +-8.1548195777037175e-04 +-8.0066084502997603e-04 +-7.8778781123027054e-04 +-7.7664945652543141e-04 +-7.6705889755304213e-04 +-7.5885314609953555e-04 +-7.5189085556974099e-04 +-7.4605041696099790e-04 +-7.4122837702133681e-04 +-7.3733814714469815e-04 +-7.3430897099992579e-04 +-7.3208512011079473e-04 +-7.3062528945662538e-04 +-7.2990216865897540e-04 +-2.0572330434625260e-03 +-2.0612994723456348e-03 +-2.0694662333444074e-03 +-2.0817995417942584e-03 +-2.0983884714969496e-03 +-2.1193143743274828e-03 +-2.1445744782687811e-03 +-2.1739074179133759e-03 +-2.2064146178764296e-03 +-2.2398652894602970e-03 +-2.2698605894652586e-03 +-2.2896508478239177e-03 +-2.2915024010674218e-03 +-2.2693165461139825e-03 +-2.2208689785425460e-03 +-2.1483000330802591e-03 +-2.0569258434153096e-03 +-1.9533972263569223e-03 +-1.8441417265953250e-03 +-1.7344650069591218e-03 +-1.6282514319803563e-03 +-1.5280420292206394e-03 +-1.4352830854472759e-03 +-1.3506114051025806e-03 +-1.2741093424100567e-03 +-1.2055062796374003e-03 +-1.1443258927934664e-03 +-1.0899878024636762e-03 +-1.0418743648952435e-03 +-9.9937239063061910e-04 +-9.6189760332986087e-04 +-9.2890763844379867e-04 +-8.9990769206430466e-04 +-8.7445163720322231e-04 +-8.5214048824975728e-04 +-8.3261943891873723e-04 +-8.1557425259049356e-04 +-8.0072748515532650e-04 +-7.8783482459567251e-04 +-7.7668170461793235e-04 +-7.6708026951431577e-04 +-7.5886671741242219e-04 +-7.5189901936009165e-04 +-7.4605499439473193e-04 +-7.4123071201601977e-04 +-7.3733918952669961e-04 +-7.3430935136910053e-04 +-7.3208521892347521e-04 +-7.3062530224723933e-04 +-7.2990216882014866e-04 +-2.0572420081920320e-03 +-2.0613080321527887e-03 +-2.0694703503883389e-03 +-2.0817878476338488e-03 +-2.0983385870518008e-03 +-2.1191901016047511e-03 +-2.1443278385952199e-03 +-2.1734973142660554e-03 +-2.2058591994738564e-03 +-2.2393185273928374e-03 +-2.2696392275813795e-03 +-2.2901318393443565e-03 +-2.2929350997366411e-03 +-2.2716995177678011e-03 +-2.2239745733326180e-03 +-2.1517944855070142e-03 +-2.0604885365502631e-03 +-1.9567874016998082e-03 +-1.8472133344766704e-03 +-1.7371518992779363e-03 +-1.6305431167606796e-03 +-1.5299612265169715e-03 +-1.4368690442625545e-03 +-1.3519090806240034e-03 +-1.2751631287185093e-03 +-1.2063568255595595e-03 +-1.1450088138481801e-03 +-1.0905334634249975e-03 +-1.0423082087047055e-03 +-9.9971550283883413e-04 +-9.6216733965247530e-04 +-9.2911822724145530e-04 +-9.0007077234974806e-04 +-8.7457671949661621e-04 +-8.5223533936298012e-04 +-8.3269039802790531e-04 +-8.1562648825490218e-04 +-8.0076520310731725e-04 +-7.8786143537129115e-04 +-7.7669995892173287e-04 +-7.6709236801282999e-04 +-7.5887440048862283e-04 +-7.5190364137219629e-04 +-7.4605758610464849e-04 +-7.4123203414488232e-04 +-7.3733977977685002e-04 +-7.3430956676284937e-04 +-7.3208527488078583e-04 +-7.3062530949128020e-04 +-7.2990216891337552e-04 +-2.0572136725266832e-03 +-2.0612793608395684e-03 +-2.0694391480036625e-03 +-2.0817481349088957e-03 +-2.0982785735851497e-03 +-2.1190902708844023e-03 +-2.1441607954016655e-03 +-2.1732355782268170e-03 +-2.2055019527477660e-03 +-2.2389356975517798e-03 +-2.2693930519997038e-03 +-2.2902268216712699e-03 +-2.2935157341932430e-03 +-2.2727789497139152e-03 +-2.2254434157422923e-03 +-2.1534832580615529e-03 +-2.0622313027918331e-03 +-1.9584579844388614e-03 +-1.8487340062641048e-03 +-1.7384862102314241e-03 +-1.6316835623621112e-03 +-1.5309177180141038e-03 +-1.4376602998486965e-03 +-1.3525570193082938e-03 +-1.2756896063984956e-03 +-1.2067819596836076e-03 +-1.1453502874694114e-03 +-1.0908063845008365e-03 +-1.0425252549517271e-03 +-9.9988719194866018e-04 +-9.6230233571121908e-04 +-9.2922363745247738e-04 +-9.0015241326543228e-04 +-8.7463934574838638e-04 +-8.5228283502082288e-04 +-8.3272593401419062e-04 +-8.1565265048521348e-04 +-8.0078409617083542e-04 +-7.8787476622485097e-04 +-7.7670910450466555e-04 +-7.6709843010696048e-04 +-7.5887825057475641e-04 +-7.5190595774781289e-04 +-7.4605888509134024e-04 +-7.4123269686404789e-04 +-7.3734007566355752e-04 +-7.3430967474494941e-04 +-7.3208530293533095e-04 +-7.3062531312404703e-04 +-7.2990216896276646e-04 +-2.0571951329855448e-03 +-2.0612606449261889e-03 +-2.0694192900890893e-03 +-2.0817245466400133e-03 +-2.0982461243774435e-03 +-2.1190403159607653e-03 +-2.1440807415153635e-03 +-2.1731116140522055e-03 +-2.2053301867282537e-03 +-2.2387420189572621e-03 +-2.2692446216319010e-03 +-2.2902123135883769e-03 +-2.2937011192408377e-03 +-2.2731751045217590e-03 +-2.2260081863382524e-03 +-2.1541473568082500e-03 +-2.0629254671112973e-03 +-1.9591287744562254e-03 +-1.8493479188469932e-03 +-1.7390269594025252e-03 +-1.6321470580705146e-03 +-1.5313072954689767e-03 +-1.4379831259155966e-03 +-1.3528217343546313e-03 +-1.2759049384407073e-03 +-1.2069560021813045e-03 +-1.1454901888704582e-03 +-1.0909182731251830e-03 +-1.0426142864726326e-03 +-9.9995765212496199e-04 +-9.6235776060948745e-04 +-9.2926693149197209e-04 +-9.0018595597677069e-04 +-8.7466508397277031e-04 +-8.5230236033404069e-04 +-8.3274054659658744e-04 +-8.1566341123054669e-04 +-8.0079186892375253e-04 +-7.8788025192587298e-04 +-7.7671286880709759e-04 +-7.6710092580453877e-04 +-7.5887983595222320e-04 +-7.5190691177368671e-04 +-7.4605942019710821e-04 +-7.4123296991373470e-04 +-7.3734019759251392e-04 +-7.3430971924845587e-04 +-7.3208531449936670e-04 +-7.3062531462268114e-04 +-7.2990216898680973e-04 +-2.0571887356511244e-03 +-2.0612541866369509e-03 +-2.0694124666077161e-03 +-2.0817165408378280e-03 +-2.0982352838144914e-03 +-2.1190237700777080e-03 +-2.1440541150836365e-03 +-2.1730696447429328e-03 +-2.2052699935612981e-03 +-2.2386694417538826e-03 +-2.2691785709746831e-03 +-2.2901796980238239e-03 +-2.2937236659013888e-03 +-2.2732589077072442e-03 +-2.2261433584735771e-03 +-2.1543151470545859e-03 +-2.0631062234040096e-03 +-1.9593068173874000e-03 +-1.8495130296209679e-03 +-1.7391738041926210e-03 +-1.6322738561645159e-03 +-1.5314144939855780e-03 +-1.4380723754666583e-03 +-1.3528952019679612e-03 +-1.2759648935408026e-03 +-1.2070045927314046e-03 +-1.1455293377736859e-03 +-1.0909496449305943e-03 +-1.0426392919188330e-03 +-9.9997747078717876e-04 +-9.6237337034977828e-04 +-9.2927913864735096e-04 +-9.0019542332504809e-04 +-8.7467235526654747e-04 +-8.5230788113683890e-04 +-8.3274468161996821e-04 +-8.1566645857586418e-04 +-8.0079407169008363e-04 +-7.8788180763647261e-04 +-7.7671393706147014e-04 +-7.6710163451071444e-04 +-7.5888028643748915e-04 +-7.5190718302331038e-04 +-7.4605957242493306e-04 +-7.4123304763184031e-04 +-7.3734023231341000e-04 +-7.3430973192681456e-04 +-7.3208531779554557e-04 +-7.3062531505171220e-04 +-7.2990216899957762e-04 +-2.0571877673252179e-03 +-2.0612532078937533e-03 +-2.0694114290786738e-03 +-2.0817153080737415e-03 +-2.0982335566881965e-03 +-2.1190209780324225e-03 +-2.1440492891753723e-03 +-2.1730613989034606e-03 +-2.2052569347177941e-03 +-2.2386512231023100e-03 +-2.2691569654445438e-03 +-2.2901584294894545e-03 +-2.2937067556640716e-03 +-2.2732488816771361e-03 +-2.2261406085815013e-03 +-2.1543184535751441e-03 +-2.0631136801185176e-03 +-1.9593165577953425e-03 +-1.8495235850269417e-03 +-1.7391841805837532e-03 +-1.6322834682361139e-03 +-1.5314230556229119e-03 +-1.4380797966887997e-03 +-1.3529015095188051e-03 +-1.2759701761659650e-03 +-1.2070089663281773e-03 +-1.1455329246838916e-03 +-1.0909525625593982e-03 +-1.0426416471648926e-03 +-9.9997935791321904e-04 +-9.6237487077736363e-04 +-9.2928032174452533e-04 +-9.0019634763698758e-04 +-8.7467306987760356e-04 +-8.5230842699797265e-04 +-8.3274509276088618e-04 +-8.1566676317065714e-04 +-8.0079429297173343e-04 +-7.8788196466989988e-04 +-7.7671404539090291e-04 +-7.6710170669978860e-04 +-7.5888033252026932e-04 +-7.5190721088366796e-04 +-7.4605958811985477e-04 +-7.4123305567271351e-04 +-7.3734023591709734e-04 +-7.3430973324672630e-04 +-7.3208531814047311e-04 +-7.3062531509922703e-04 +-7.2990216900941838e-04 +-2.0571877672771023e-03 +-2.0612532075412414e-03 +-2.0694114277790272e-03 +-2.0817153011106130e-03 +-2.0982335247309194e-03 +-2.1190208663778983e-03 +-2.1440489740227925e-03 +-2.1730606434890447e-03 +-2.2052553595455827e-03 +-2.2386483498633312e-03 +-2.2691523851448431e-03 +-2.2901520326498066e-03 +-2.2936988523061244e-03 +-2.2732401070787675e-03 +-2.2261316926626301e-03 +-2.1543100105408516e-03 +-2.0631061072386562e-03 +-1.9593100363054783e-03 +-1.8495181340008947e-03 +-1.7391797207240765e-03 +-1.6322798736445581e-03 +-1.5314201880663049e-03 +-1.4380775248403726e-03 +-1.3528997178149497e-03 +-1.2759687674361163e-03 +-1.2070078611446629e-03 +-1.1455320592584218e-03 +-1.0909518862070699e-03 +-1.0426411198477892e-03 +-9.9997894808224476e-04 +-9.6237455357491757e-04 +-9.2928007755522070e-04 +-9.0019616094257602e-04 +-8.7467292836388203e-04 +-8.5230832086375264e-04 +-8.3274501418558844e-04 +-8.1566670590464674e-04 +-8.0079425202063035e-04 +-7.8788193605025731e-04 +-7.7671402593972917e-04 +-7.6710169392448153e-04 +-7.5888032447875091e-04 +-7.5190720608704295e-04 +-7.4605958545187554e-04 +-7.4123305432183630e-04 +-7.3734023531805677e-04 +-7.3430973302938117e-04 +-7.3208531808426644e-04 +-7.3062531509197057e-04 +-7.2990216900931332e-04 +-2.0571887354066099e-03 +-2.0612541939449666e-03 +-2.0694125334062129e-03 +-2.0817167777535065e-03 +-2.0982358143201863e-03 +-2.1190245938588273e-03 +-2.1440548488784860e-03 +-2.1730691266000969e-03 +-2.2052658624164370e-03 +-2.2386581197000868e-03 +-2.2691562269441887e-03 +-2.2901440689623827e-03 +-2.2936754976518223e-03 +-2.2732018494691785e-03 +-2.2260824964839719e-03 +-2.1542553098555725e-03 +-2.0630509362275784e-03 +-1.9592580526061817e-03 +-1.8494714620618763e-03 +-1.7391392368555747e-03 +-1.6322456122730635e-03 +-1.5313917006783242e-03 +-1.4380541383328721e-03 +-1.3528806969644429e-03 +-1.2759534054494596e-03 +-1.2069955229369810e-03 +-1.1455221965266178e-03 +-1.0909440371729129e-03 +-1.0426349016271574e-03 +-9.9997404625876032e-04 +-9.6237071142216807e-04 +-9.2927708608646733e-04 +-9.0019385025527415e-04 +-8.7467116037139611e-04 +-8.5230698332440719e-04 +-8.3274401586498788e-04 +-8.1566597268824986e-04 +-8.0079372380270500e-04 +-7.8788156424525353e-04 +-7.7671377148601358e-04 +-7.6710152567290881e-04 +-7.5888021787929975e-04 +-7.5190714210393562e-04 +-7.4605954965246328e-04 +-7.4123303609617162e-04 +-7.3734022719602172e-04 +-7.3430973006955477e-04 +-7.3208531731515109e-04 +-7.3062531498971697e-04 +-7.2990216899879775e-04 +-2.0571951340126056e-03 +-2.0612607302650785e-03 +-2.0694199329591104e-03 +-2.0817269172622786e-03 +-2.0982522370954107e-03 +-2.1190529301478695e-03 +-2.1441028878338734e-03 +-2.1731454854517431e-03 +-2.2053751145443426e-03 +-2.2387921180741809e-03 +-2.2692884031464554e-03 +-2.2902363432483436e-03 +-2.2936960307698012e-03 +-2.2731394543731142e-03 +-2.2259477913631051e-03 +-2.1540717041261775e-03 +-2.0628440609951858e-03 +-1.9590490019952360e-03 +-1.8492744729434493e-03 +-1.7389621887766366e-03 +-1.6320916412746976e-03 +-1.5312608898416207e-03 +-1.4379448597104485e-03 +-1.3527905303449079e-03 +-1.2758797036093257e-03 +-1.2069357257386394e-03 +-1.1454739835441272e-03 +-1.0909053843069438e-03 +-1.0426040849132252e-03 +-9.9994961948284672e-04 +-9.6235147300003916e-04 +-9.2926204365153067e-04 +-9.0018218719542108e-04 +-8.7466220615525585e-04 +-8.5230018814487366e-04 +-8.3273892946505394e-04 +-8.1566222692966526e-04 +-8.0079101843730997e-04 +-7.8787965534477086e-04 +-7.7671246203440741e-04 +-7.6710065788738113e-04 +-7.5887966689507016e-04 +-7.5190681071887733e-04 +-7.4605936388509239e-04 +-7.4123294135676086e-04 +-7.3734018491262271e-04 +-7.3430971464314571e-04 +-7.3208531330751301e-04 +-7.3062531446882397e-04 +-7.2990216898490034e-04 +-2.0572136831925486e-03 +-2.0612797540119306e-03 +-2.0694418596014330e-03 +-2.0817580573830497e-03 +-2.0983046605163162e-03 +-2.1191461696304578e-03 +-2.1442646199974309e-03 +-2.1734076433974239e-03 +-2.2057582203932808e-03 +-2.2392764006776795e-03 +-2.2697930415634966e-03 +-2.2906386881073127e-03 +-2.2938874458839080e-03 +-2.2730735227387017e-03 +-2.2256476484268607e-03 +-2.1536040450941762e-03 +-2.0622863272333749e-03 +-1.9584673087491475e-03 +-1.8487151422680325e-03 +-1.7384523322315480e-03 +-1.6316435877816735e-03 +-1.5308771582708139e-03 +-1.4376222408833243e-03 +-1.3525229552138773e-03 +-1.2756600555625041e-03 +-1.2067568831013323e-03 +-1.1453293559237137e-03 +-1.0907891406346580e-03 +-1.0425112065632633e-03 +-9.9987586229664392e-04 +-9.6229328799739993e-04 +-9.2921648442186239e-04 +-9.0014681865430417e-04 +-8.7463502159437388e-04 +-8.5227953714522690e-04 +-8.3272345695227783e-04 +-8.1565082252159935e-04 +-8.0078277478326184e-04 +-7.8787383403972641e-04 +-7.7670846576570593e-04 +-7.6709800760749213e-04 +-7.5887798298774950e-04 +-7.5190579728479914e-04 +-7.4605879542946781e-04 +-7.4123265128915280e-04 +-7.3734005538842731e-04 +-7.3430966736971813e-04 +-7.3208530102440890e-04 +-7.3062531287717181e-04 +-7.2990216895970868e-04 +-2.0572420565065546e-03 +-2.0613092903158507e-03 +-2.0694783707146825e-03 +-2.0818166356995440e-03 +-2.0984142470904825e-03 +-2.1193536785101574e-03 +-2.1446363205629708e-03 +-2.1740193085413445e-03 +-2.2066580943943680e-03 +-2.2404191855132905e-03 +-2.2709935398299722e-03 +-2.2916156395704299e-03 +-2.2943896494934828e-03 +-2.2729896150450067e-03 +-2.2250245434236996e-03 +-2.1525896350905070e-03 +-2.0610554569946184e-03 +-1.9571710666775799e-03 +-1.8474606946219528e-03 +-1.7373034707390208e-03 +-1.6306303284554400e-03 +-1.5300068465515196e-03 +-1.4368887989502140e-03 +-1.3519134501832370e-03 +-1.2751588935505673e-03 +-1.2063482520934283e-03 +-1.1449985059871204e-03 +-1.0905229490206798e-03 +-1.0422983323732954e-03 +-9.9970668387889378e-04 +-9.6215973883560704e-04 +-9.2911185331634991e-04 +-9.0006554923769365e-04 +-8.7457252813945979e-04 +-8.5223204336105961e-04 +-8.3268785899164564e-04 +-8.1562457466918922e-04 +-8.0076379513649518e-04 +-7.8786042713949720e-04 +-7.7669925924019002e-04 +-7.6709190015949817e-04 +-7.5887410142147862e-04 +-7.5190346060966028e-04 +-7.4605748442075639e-04 +-7.4123198216754756e-04 +-7.3733975654608245e-04 +-7.3430955828125612e-04 +-7.3208527267712442e-04 +-7.3062530920605610e-04 +-7.2990216890984449e-04 +-2.0572332019263245e-03 +-2.0613027609543990e-03 +-2.0694856482610310e-03 +-2.0818674861160665e-03 +-2.0985655961680487e-03 +-2.1196969670127519e-03 +-2.1452978092380802e-03 +-2.1751368651258631e-03 +-2.2083085288421172e-03 +-2.2425002404051343e-03 +-2.2731501900032616e-03 +-2.2933285613822552e-03 +-2.2952039773796126e-03 +-2.2727094381602675e-03 +-2.2237432736580270e-03 +-2.1505849490726079e-03 +-2.0586540504177147e-03 +-1.9546554339295238e-03 +-1.8450315961515804e-03 +-1.7350806139379306e-03 +-1.6286700172886061e-03 +-1.5283226387808107e-03 +-1.4354688335167858e-03 +-1.3507328278851392e-03 +-1.2741876247240676e-03 +-1.2055559096837206e-03 +-1.1443566778812466e-03 +-1.0900063293740256e-03 +-1.0418850275923772e-03 +-9.9937810035049613e-04 +-9.6190027357098196e-04 +-9.2890851389125896e-04 +-8.9990757075190800e-04 +-8.7445102024363266e-04 +-8.5213968063216523e-04 +-8.3261861732207012e-04 +-8.1557351095758288e-04 +-8.0072686526576743e-04 +-7.8783433649457142e-04 +-7.7668134017783695e-04 +-7.6708001133245218e-04 +-7.5886654453920374e-04 +-7.5189891086589451e-04 +-7.4605493146507088e-04 +-7.4123067903865305e-04 +-7.3733917449137008e-04 +-7.3430934579385519e-04 +-7.3208521745827247e-04 +-7.3062530205614284e-04 +-7.2990216881777122e-04 +-2.0570064389722744e-03 +-2.0610799383692785e-03 +-2.0692864532954381e-03 +-2.0817429126191249e-03 +-2.0986123026960259e-03 +-2.1200666527509374e-03 +-2.1461900146793459e-03 +-2.1767491384901416e-03 +-2.2107142436006001e-03 +-2.2454792156680059e-03 +-2.2761097329754873e-03 +-2.2954647847013964e-03 +-2.2958477060887588e-03 +-2.2716031128022229e-03 +-2.2210718377965364e-03 +-2.1468092704431509e-03 +-2.0543025332640410e-03 +-1.9501807973431912e-03 +-1.8407534347473977e-03 +-1.7311873318420830e-03 +-1.6252474340266840e-03 +-1.5253874114750350e-03 +-1.4329965904179964e-03 +-1.3486783474036563e-03 +-1.2724978266304594e-03 +-1.2041774686686760e-03 +-1.1432400258640412e-03 +-1.0891074155776504e-03 +-1.0411657816371219e-03 +-9.9880620447153636e-04 +-9.6144861072394630e-04 +-9.2855450194419026e-04 +-8.9963249559285260e-04 +-8.7423942279381565e-04 +-8.5197881970380622e-04 +-8.3249801244201040e-04 +-8.1548456026817864e-04 +-8.0066252974313244e-04 +-7.8778888052536517e-04 +-7.7665011881915302e-04 +-7.6705929544316543e-04 +-7.5885337613525053e-04 +-7.5189098217891693e-04 +-7.4605048229093121e-04 +-7.4122840790296555e-04 +-7.3733816002725320e-04 +-7.3430897543711403e-04 +-7.3208512121196022e-04 +-7.3062528959465082e-04 +-7.2990216866064539e-04 +-2.0560415460604419e-03 +-2.0601204086562832e-03 +-2.0683610070546285e-03 +-2.0809262398285449e-03 +-2.0980437489063436e-03 +-2.1199559669494812e-03 +-2.1467902700753206e-03 +-2.1782654824387118e-03 +-2.2131320855127705e-03 +-2.2483766956296288e-03 +-2.2786270152736782e-03 +-2.2965640268240006e-03 +-2.2947489044572327e-03 +-2.2680936517988745e-03 +-2.2155066781832590e-03 +-2.1398785721832179e-03 +-2.0467585922787279e-03 +-1.9426536877851243e-03 +-1.8336793507203485e-03 +-1.7248151296218655e-03 +-1.6196804772974839e-03 +-1.5206315401305069e-03 +-1.4290004521939491e-03 +-1.3453623721047894e-03 +-1.2697728864630754e-03 +-1.2019557739753987e-03 +-1.1414407798016313e-03 +-1.0876592046530475e-03 +-1.0400070786578371e-03 +-9.9788487212328363e-04 +-9.6072094550420973e-04 +-9.2798412818086097e-04 +-8.9918927537964823e-04 +-8.7389846175512981e-04 +-8.5171959934604937e-04 +-8.3230365332010695e-04 +-8.1534120690230521e-04 +-8.0055884258197201e-04 +-7.8771561867200417e-04 +-7.7659979782845792e-04 +-7.6702590599049352e-04 +-7.5883215124260045e-04 +-7.5187820253036117e-04 +-7.4604331093502225e-04 +-7.4122474716751890e-04 +-7.3733652485039687e-04 +-7.3430837847005589e-04 +-7.3208496607500052e-04 +-7.3062526950898364e-04 +-7.2990216840982064e-04 +-2.0529852811367283e-03 +-2.0570681946575501e-03 +-2.0653440081540597e-03 +-2.0780280994293207e-03 +-2.0954175922541099e-03 +-2.1178172509090294e-03 +-2.1453595039287281e-03 +-2.1776366952389698e-03 +-2.2130844569834066e-03 +-2.2482376480605164e-03 +-2.2773534434313704e-03 +-2.2930974031021437e-03 +-2.2884592106652722e-03 +-2.2590233227027918e-03 +-2.2042913668471309e-03 +-2.1274588233999845e-03 +-2.0340783909488886e-03 +-1.9304678145302282e-03 +-1.8224865140118172e-03 +-1.7148766908069843e-03 +-1.6110770332830584e-03 +-1.5133246777183325e-03 +-1.4228840721375224e-03 +-1.3402994081569810e-03 +-1.2656188279554380e-03 +-1.1985722235463661e-03 +-1.1387022619748070e-03 +-1.0854557684046695e-03 +-1.0382444805046944e-03 +-9.9648350008339423e-04 +-9.5961419146458303e-04 +-9.2711661410487054e-04 +-8.9851514838885157e-04 +-8.7337985884321386e-04 +-8.5132531711014185e-04 +-8.3200802294017197e-04 +-8.1512315731455847e-04 +-8.0040112776389848e-04 +-7.8760418343983788e-04 +-7.7652325787149292e-04 +-7.6697512039681658e-04 +-7.5879986872976987e-04 +-7.5185876548044834e-04 +-7.4603240401828713e-04 +-7.4121917968841713e-04 +-7.3733403802454475e-04 +-7.3430747060228220e-04 +-7.3208473014637363e-04 +-7.3062523896408088e-04 +-7.2990216803022455e-04 +-2.0445805958398647e-03 +-2.0486574192613155e-03 +-2.0569391586888579e-03 +-2.0696749273207845e-03 +-2.0872001092323627e-03 +-2.1098328096014860e-03 +-2.1376415891765097e-03 +-2.1700214003854646e-03 +-2.2050749433051866e-03 +-2.2389911394335642e-03 +-2.2658993917521668e-03 +-2.2787313243361660e-03 +-2.2710794265950896e-03 +-2.2391996850665940e-03 +-2.1830581457262101e-03 +-2.1059901244595311e-03 +-2.0134128244364002e-03 +-1.9113600166919870e-03 +-1.8053780698693521e-03 +-1.6999409896350807e-03 +-1.5982927631348926e-03 +-1.5025484440730937e-03 +-1.4139086010253590e-03 +-1.3328943483869342e-03 +-1.2595563421238199e-03 +-1.1936412048927745e-03 +-1.1347148843789171e-03 +-1.0822492949825889e-03 +-1.0356803935450687e-03 +-9.9444529641827388e-04 +-9.5800466229297755e-04 +-9.2585507452060253e-04 +-8.9753485736134551e-04 +-8.7262573521855870e-04 +-8.5075198015905555e-04 +-8.3157814510607703e-04 +-8.1480609749068561e-04 +-8.0017180640834073e-04 +-7.8744216042588141e-04 +-7.7641197683657134e-04 +-7.6690128756392434e-04 +-7.5875293872485275e-04 +-7.5183051101441426e-04 +-7.4601655024933444e-04 +-7.4121108753307473e-04 +-7.3733042368937212e-04 +-7.3430615117255819e-04 +-7.3208438727686664e-04 +-7.3062519457544705e-04 +-7.2990216748005765e-04 +-2.0242491554066564e-03 +-2.0282921568645740e-03 +-2.0364984438951696e-03 +-2.0490996147181561e-03 +-2.0663961174380626e-03 +-2.0886353036418778e-03 +-2.1157533372193047e-03 +-2.1469434300291378e-03 +-2.1800963547984908e-03 +-2.2113315333140409e-03 +-2.2350237074402804e-03 +-2.2446913779118100e-03 +-2.2346503986506797e-03 +-2.2017095445399930e-03 +-2.1460273237611299e-03 +-2.0707849312083812e-03 +-1.9810388509488817e-03 +-1.8824072168600013e-03 +-1.7800675198092607e-03 +-1.6782164554329684e-03 +-1.5799174594448328e-03 +-1.4871867782143776e-03 +-1.4011864003326600e-03 +-1.3224385818674691e-03 +-1.2510184474342544e-03 +-1.1867086946935779e-03 +-1.1291152921332163e-03 +-1.0777495391293612e-03 +-1.0320836924166950e-03 +-9.9158700661204115e-04 +-9.5574786387028657e-04 +-9.2408635699895163e-04 +-8.9616052632430165e-04 +-8.7156851916772094e-04 +-8.4994823858889419e-04 +-8.3097553860179496e-04 +-8.1436166339246487e-04 +-7.9985037930248130e-04 +-7.8721507925726066e-04 +-7.7625602615737457e-04 +-7.6679782726353344e-04 +-7.5868718344261350e-04 +-7.5179092677799659e-04 +-7.4599434152096097e-04 +-7.4119975273329128e-04 +-7.3732536147458653e-04 +-7.3430430332418529e-04 +-7.3208390711959842e-04 +-7.3062513241611545e-04 +-7.2990216671082282e-04 +-1.9822062284703358e-03 +-1.9861647601044008e-03 +-1.9941627770110261e-03 +-2.0063530877120887e-03 +-2.0229186979933873e-03 +-2.0439560454748660e-03 +-2.0692359149434270e-03 +-2.0978232755152026e-03 +-2.1276201773857040e-03 +-2.1550304670700303e-03 +-2.1750566780907579e-03 +-2.1820721565355460e-03 +-2.1711673151336083e-03 +-2.1395302128681347e-03 +-2.0871933428211063e-03 +-2.0168369899368392e-03 +-1.9328764837855258e-03 +-1.8403407804895781e-03 +-1.7439639529372004e-03 +-1.6476589605279822e-03 +-1.5543387093624294e-03 +-1.4659646524287648e-03 +-1.3837056552233218e-03 +-1.3081264163013861e-03 +-1.2393619299450015e-03 +-1.1772604956010809e-03 +-1.1214924285075127e-03 +-1.0716283511022888e-03 +-1.0271931301814891e-03 +-9.8770149389620942e-04 +-9.5268045237172192e-04 +-9.2168253020516011e-04 +-8.9429279238622541e-04 +-8.7013180595322485e-04 +-8.4885603676683301e-04 +-8.3015670782385798e-04 +-8.1375780720200914e-04 +-7.9941369666528190e-04 +-7.8690660863625487e-04 +-7.7604420837368130e-04 +-7.6665732405251737e-04 +-7.5859789865751598e-04 +-7.5173718617522437e-04 +-7.4596419488404413e-04 +-7.4118436878821349e-04 +-7.3731849175312102e-04 +-7.3430179595872626e-04 +-7.3208325564510254e-04 +-7.3062504808404450e-04 +-7.2990216566821530e-04 +-1.9092031742724486e-03 +-1.9130088927184121e-03 +-1.9206442834014002e-03 +-1.9321496790944265e-03 +-1.9475484182860897e-03 +-1.9667550313555112e-03 +-1.9893902510407248e-03 +-2.0144928058183072e-03 +-2.0401823601604060e-03 +-2.0634229730553716e-03 +-2.0801059183842394e-03 +-2.0856188048638761e-03 +-2.0758422017961237e-03 +-2.0482210700741572e-03 +-2.0024360383462244e-03 +-1.9403906967799961e-03 +-1.8655965768518035e-03 +-1.7822946595617542e-03 +-1.6946608980481274e-03 +-1.6062849484651176e-03 +-1.5199411633406146e-03 +-1.4375756202709578e-03 +-1.3604133109323289e-03 +-1.2891102253065445e-03 +-1.2239049509886139e-03 +-1.1647485295830883e-03 +-1.1114063318554083e-03 +-1.0635333653310599e-03 +-1.0207274522672002e-03 +-9.8256529238803405e-04 +-9.4862591651062882e-04 +-9.1850517716333556e-04 +-8.9182405441590705e-04 +-8.6823281288971174e-04 +-8.4741246086682059e-04 +-8.2907452286230029e-04 +-8.1295981695099810e-04 +-7.9883670016905222e-04 +-7.8649908567404389e-04 +-7.7576442514658609e-04 +-7.6647177485741967e-04 +-7.5848001341973122e-04 +-7.5166624597824971e-04 +-7.4592440811966374e-04 +-7.4116406941677983e-04 +-7.3730942863938322e-04 +-7.3429848852969454e-04 +-7.3208239639696408e-04 +-7.3062493686550914e-04 +-7.2990216429406310e-04 +-1.8021223087817321e-03 +-1.8057046626873941e-03 +-1.8128407786817519e-03 +-1.8234680472777951e-03 +-1.8374671600338622e-03 +-1.8546009959125669e-03 +-1.8743925429855371e-03 +-1.8959351517765679e-03 +-1.9176693276975114e-03 +-1.9372203793600381e-03 +-1.9514372388462790e-03 +-1.9567490914378814e-03 +-1.9498287791378129e-03 +-1.9283676760502965e-03 +-1.8916553141418301e-03 +-1.8407244396965367e-03 +-1.7780343353163538e-03 +-1.7068697052182518e-03 +-1.6307033612069188e-03 +-1.5527062419611964e-03 +-1.4754715351922079e-03 +-1.4009284112255216e-03 +-1.3303816232167688e-03 +-1.2646137863998896e-03 +-1.2040051799833917e-03 +-1.1486455674952283e-03 +-1.0984271204893805e-03 +-1.0531162148682009e-03 +-1.0124061010874511e-03 +-9.7595397164079516e-04 +-9.4340607328062662e-04 +-9.1441404062914036e-04 +-8.8864498804261751e-04 +-8.6578728355583715e-04 +-8.4555341463767291e-04 +-8.2768095333667253e-04 +-8.1193232670297545e-04 +-7.9809387819446901e-04 +-7.8597454819981426e-04 +-7.7540439073418572e-04 +-7.6623306607228085e-04 +-7.5832839597621336e-04 +-7.5157503219687883e-04 +-7.4587326497660953e-04 +-7.4113798273231512e-04 +-7.3729778437187326e-04 +-7.3429424000154416e-04 +-7.3208129283189836e-04 +-7.3062479403919131e-04 +-7.2990216253018640e-04 +-1.6665476723162114e-03 +-1.6698512013770502e-03 +-1.6763958981133131e-03 +-1.6860535131549734e-03 +-1.6986162348111874e-03 +-1.7137609571459438e-03 +-1.7309785720732098e-03 +-1.7494636134591905e-03 +-1.7679816510432229e-03 +-1.7847656136129651e-03 +-1.7975216703486610e-03 +-1.8036213984658673e-03 +-1.8004966792700013e-03 +-1.7861505453412735e-03 +-1.7596111376058543e-03 +-1.7211549941921402e-03 +-1.6722227446438016e-03 +-1.6150832847799047e-03 +-1.5523885362481364e-03 +-1.4867631759248844e-03 +-1.4205166448355525e-03 +-1.3554968659250410e-03 +-1.2930596527566487e-03 +-1.2341115455854494e-03 +-1.1791875146302969e-03 +-1.1285366830599188e-03 +-1.0822010284371707e-03 +-1.0400806858331759e-03 +-1.0019846781123760e-03 +-9.6766847927298532e-04 +-9.3686076843757526e-04 +-9.0928181933652773e-04 +-8.8465567521639997e-04 +-8.6271784682211237e-04 +-8.4321986828671128e-04 +-8.2593170224066538e-04 +-8.1064271256042796e-04 +-7.9716171543760110e-04 +-7.8531646566306875e-04 +-7.7495282339749665e-04 +-7.6593376689455318e-04 +-7.5813836032198156e-04 +-7.5146074657746816e-04 +-7.4580920802852849e-04 +-7.4110531990597306e-04 +-7.3728320909088852e-04 +-7.3428892342594426e-04 +-7.3207991211886748e-04 +-7.3062461536894485e-04 +-7.2990216032437633e-04 +-1.5143557317074067e-03 +-1.5173505457441740e-03 +-1.5232645752091664e-03 +-1.5319444351987825e-03 +-1.5431513009828497e-03 +-1.5565418563891998e-03 +-1.5716312595786372e-03 +-1.5877352645982854e-03 +-1.6038991288449610e-03 +-1.6188379097236652e-03 +-1.6309297570858492e-03 +-1.6383075300688092e-03 +-1.6390710056183150e-03 +-1.6315919129397832e-03 +-1.6148294756294145e-03 +-1.5885506583946630e-03 +-1.5533782829139982e-03 +-1.5106578680931079e-03 +-1.4622005803700720e-03 +-1.4099904147732920e-03 +-1.3559322232634596e-03 +-1.3016816859427590e-03 +-1.2485623093425251e-03 +-1.1975518654789546e-03 +-1.1493130826962371e-03 +-1.1042458628627745e-03 +-1.0625448943911082e-03 +-1.0242532591778304e-03 +-9.8930774428882548e-04 +-9.5757479238069566e-04 +-9.2887773722018663e-04 +-9.0301668814198413e-04 +-8.7978257901716577e-04 +-8.5896677343808654e-04 +-8.4036738942128760e-04 +-8.2379326328385876e-04 +-8.0906625356360457e-04 +-7.9602240538717225e-04 +-7.8451235405757787e-04 +-7.7440123900103552e-04 +-7.6556831923481588e-04 +-7.5790642309168401e-04 +-7.5132132285600549e-04 +-7.4573109505984944e-04 +-7.4106550623368004e-04 +-7.3726544946418426e-04 +-7.3428244737045823e-04 +-7.3207823071322657e-04 +-7.3062439782599538e-04 +-7.2990215763938889e-04 +-1.3589599961563266e-03 +-1.3616429209805342e-03 +-1.3669346920531860e-03 +-1.3746858028690200e-03 +-1.3846671639930401e-03 +-1.3965604950669128e-03 +-1.4099402755692258e-03 +-1.4242458050440468e-03 +-1.4387464760685115e-03 +-1.4525111310727369e-03 +-1.4644011359627174e-03 +-1.4731111653036070e-03 +-1.4772749381589216e-03 +-1.4756323193972039e-03 +-1.4672254739533704e-03 +-1.4515701084129697e-03 +-1.4287481154388144e-03 +-1.3993930954550279e-03 +-1.3645775932738542e-03 +-1.3256409969445294e-03 +-1.2840071503674025e-03 +-1.2410312811936598e-03 +-1.1978965685459097e-03 +-1.1555622114331181e-03 +-1.1147531720734508e-03 +-1.0759775481534763e-03 +-1.0395584882874674e-03 +-1.0056708904779739e-03 +-9.7437677863622006e-04 +-9.4565622367327642e-04 +-9.1943269463381138e-04 +-8.9559290570684260e-04 +-8.7400180371626998e-04 +-8.5451354440252598e-04 +-8.3697930387101717e-04 +-8.2125267382425590e-04 +-8.0719325930298891e-04 +-7.9466896863866082e-04 +-7.8355737177116587e-04 +-7.7374640956801347e-04 +-7.6513466288388190e-04 +-7.5763133333655978e-04 +-7.5115604507105561e-04 +-7.4563854518398245e-04 +-7.4101835743457963e-04 +-7.3724442728713381e-04 +-7.3427478456814617e-04 +-7.3207624179271347e-04 +-7.3062414055075965e-04 +-7.2990215446475072e-04 +-1.2115521878331580e-03 +-1.2139414302518520e-03 +-1.2186549953684866e-03 +-1.2255621944903211e-03 +-1.2344642938834464e-03 +-1.2450897615430946e-03 +-1.2570858502799691e-03 +-1.2700059477420468e-03 +-1.2832939880967190e-03 +-1.2962705354676411e-03 +-1.3081292507229666e-03 +-1.3179553697853293e-03 +-1.3247766436895925e-03 +-1.3276497133718193e-03 +-1.3257719620288766e-03 +-1.3185955435301860e-03 +-1.3059137894308882e-03 +-1.2878954082682372e-03 +-1.2650573986962056e-03 +-1.2381861634355317e-03 +-1.2082295290191001e-03 +-1.1761857257532816e-03 +-1.1430099045610183e-03 +-1.1095490019149832e-03 +-1.0765064101532298e-03 +-1.0444316829078960e-03 +-1.0137278730633140e-03 +-9.8466915858564860e-04 +-9.5742288798011921e-04 +-9.3207204783187316e-04 +-9.0863582701901629e-04 +-8.8708719654199074e-04 +-8.6736723135435860e-04 +-8.4939635845794116e-04 +-8.3308293150829646e-04 +-8.1832959885399072e-04 +-8.0503791654325913e-04 +-7.9311160400422217e-04 +-7.8245877358815163e-04 +-7.7299339970412833e-04 +-7.6463623521603801e-04 +-7.5731533427302684e-04 +-7.5096630176738825e-04 +-7.4553235912886654e-04 +-7.4096429280279209e-04 +-7.3722033413873634e-04 +-7.3426600630236468e-04 +-7.3207396415799137e-04 +-7.3062384600204220e-04 +-7.2990215083098436e-04 +-1.0795759508447208e-03 +-1.0817035231172225e-03 +-1.0859052414343906e-03 +-1.0920737022242983e-03 +-1.1000462276997145e-03 +-1.1096024727885200e-03 +-1.1204605556542815e-03 +-1.1322715881688140e-03 +-1.1446132271383271e-03 +-1.1569842193395101e-03 +-1.1688037011090601e-03 +-1.1794205710279830e-03 +-1.1881384458579355e-03 +-1.1942593881035543e-03 +-1.1971444589383268e-03 +-1.1962825069041086e-03 +-1.1913532444784148e-03 +-1.1822695434089059e-03 +-1.1691882339102809e-03 +-1.1524870280299805e-03 +-1.1327140216312729e-03 +-1.1105221041006039e-03 +-1.0866018770076973e-03 +-1.0616239574545935e-03 +-1.0361967949637241e-03 +-1.0108414223833468e-03 +-9.8598117982678793e-04 +-9.6194274738046137e-04 +-9.3896450418323306e-04 +-9.1720876055495916e-04 +-8.9677528853102117e-04 +-8.7771446866643122e-04 +-8.6003910791933487e-04 +-8.4373451483370904e-04 +-8.2876676018625822e-04 +-8.1508924600241046e-04 +-8.0264779864248643e-04 +-7.9138453038042731e-04 +-7.8124070625182568e-04 +-7.7215882738629056e-04 +-7.6408410987646789e-04 +-7.5696550584487159e-04 +-7.5075638393641098e-04 +-7.4541496126470327e-04 +-7.4090455808519711e-04 +-7.3719372982374628e-04 +-7.3425631799895288e-04 +-7.3207145141091835e-04 +-7.3062352113883403e-04 +-7.2990214682406359e-04 +-9.6691786406963461e-04 +-9.6882273780119735e-04 +-9.7258991133988490e-04 +-9.7813386793688529e-04 +-9.8532536638110515e-04 +-9.9399017227011976e-04 +-1.0039072419437702e-03 +-1.0148064168569546e-03 +-1.0263659864923867e-03 +-1.0382110180662577e-03 +-1.0499140946162852e-03 +-1.0610008373746252e-03 +-1.0709629003235986e-03 +-1.0792805113254839e-03 +-1.0854547785360898e-03 +-1.0890470883178408e-03 +-1.0897198711540268e-03 +-1.0872711019781918e-03 +-1.0816552045445887e-03 +-1.0729857366485629e-03 +-1.0615194459422340e-03 +-1.0476254528585481e-03 +-1.0317460265139257e-03 +-1.0143560328918372e-03 +-9.9592691187869913e-04 +-9.7689880411573810e-04 +-9.5766209866579002e-04 +-9.3854783131739998e-04 +-9.1982527371612061e-04 +-9.0170465927964479e-04 +-8.8434308728951535e-04 +-8.6785200358568829e-04 +-8.5230509524690686e-04 +-8.3774584653407752e-04 +-8.2419433271265592e-04 +-8.1165306563386766e-04 +-8.0011186005889134e-04 +-7.8955178080967819e-04 +-7.7994827666371671e-04 +-7.7127362329639491e-04 +-7.6349879639638096e-04 +-7.5659488555794997e-04 +-7.5053414497872940e-04 +-7.4529076152713542e-04 +-7.4084140612150655e-04 +-7.3716562139281971e-04 +-7.3424608755301738e-04 +-7.3206879920877143e-04 +-7.3062317834992078e-04 +-7.2990214259690839e-04 +-8.7486260945523911e-04 +-8.7658582294655794e-04 +-8.7999863131738997e-04 +-8.8503354309660764e-04 +-8.9158869352777223e-04 +-8.9952711805362862e-04 +-9.0867584634245343e-04 +-9.1882492568376906e-04 +-9.2972660976758503e-04 +-9.4109516573646153e-04 +-9.5260805408036006e-04 +-9.6390955713738841e-04 +-9.7461812878220702e-04 +-9.8433860962840220e-04 +-9.9267982207000734e-04 +-9.9927689938037237e-04 +-1.0038162357664403e-03 +-1.0060596366638615e-03 +-1.0058636474712028e-03 +-1.0031905068742678e-03 +-9.9810867189855561e-04 +-9.9078294204204631e-04 +-9.8145619901835834e-04 +-9.7042609247688784e-04 +-9.5802036996816642e-04 +-9.4457406039576413e-04 +-9.3041070411375743e-04 +-9.1582866784613998e-04 +-9.0109258990593089e-04 +-8.8642932405066824e-04 +-8.7202740755443361e-04 +-8.5803900586386105e-04 +-8.4458338719661894e-04 +-8.3175116671000110e-04 +-8.1960876615317225e-04 +-8.0820272228836621e-04 +-7.9756362823341716e-04 +-7.8770960277565853e-04 +-7.7864925784064973e-04 +-7.7038418096378610e-04 +-7.6291097543907012e-04 +-7.5622291244222082e-04 +-7.5031125201773007e-04 +-7.4516628712006797e-04 +-7.4077815944660348e-04 +-7.3713748921094380e-04 +-7.3423585425079496e-04 +-7.3206614746023084e-04 +-7.3062283572712379e-04 +-7.2990213837262319e-04 +-8.0313974055165420e-04 +-8.0472152357066891e-04 +-8.0785824518921285e-04 +-8.1249603566765189e-04 +-8.1855365987206158e-04 +-8.2592206217898167e-04 +-8.3446386678778372e-04 +-8.4401294114039445e-04 +-8.5437418897708797e-04 +-8.6532382979215262e-04 +-8.7661054379562593e-04 +-8.8795799619458991e-04 +-8.9906935261933061e-04 +-9.0963438277837864e-04 +-9.1933954068529756e-04 +-9.2788096208126986e-04 +-9.3497967056924884e-04 +-9.4039757660147657e-04 +-9.4395230940267348e-04 +-9.4552876108238326e-04 +-9.4508556216482741e-04 +-9.4265549710121678e-04 +-9.3833989577184239e-04 +-9.3229801540247337e-04 +-9.2473310743560540e-04 +-9.1587711946877152e-04 +-9.0597583157955646e-04 +-8.9527579342604292e-04 +-8.8401387714578960e-04 +-8.7240973478315293e-04 +-8.6066103831566128e-04 +-8.4894111869342193e-04 +-8.3739849786892929e-04 +-8.2615779164100600e-04 +-8.1532151233596796e-04 +-8.0497238475732077e-04 +-7.9517588165693947e-04 +-7.8598277106579418e-04 +-7.7743153978787085e-04 +-7.6955061312206313e-04 +-7.6236033141031468e-04 +-7.5587467172946764e-04 +-7.5010272074696005e-04 +-7.4504991506484997e-04 +-7.4071907047449704e-04 +-7.3711122313554187e-04 +-7.3422630503662675e-04 +-7.3206367406836452e-04 +-7.3062251624724883e-04 +-7.2990213443440994e-04 +-7.5076490807220175e-04 +-7.5224339625821373e-04 +-7.5517826674246092e-04 +-7.5952517333445599e-04 +-7.6521728327039000e-04 +-7.7216496386176003e-04 +-7.8025546930554049e-04 +-7.8935271976269010e-04 +-7.9929729566609873e-04 +-8.0990681075700038e-04 +-8.2097687848981004e-04 +-8.3228294222166587e-04 +-8.4358328332144624e-04 +-8.5462352473184109e-04 +-8.6514287606399528e-04 +-8.7488219210031277e-04 +-8.8359363616750453e-04 +-8.9105138917444638e-04 +-8.9706250145148625e-04 +-9.0147674858670924e-04 +-9.0419431374068500e-04 +-9.0517031835863314e-04 +-9.0441563151315730e-04 +-9.0199391222130741e-04 +-8.9801535437460990e-04 +-8.9262799711050441e-04 +-8.8600766663543377e-04 +-8.7834761891960732e-04 +-8.6984879539153204e-04 +-8.6071135121732422e-04 +-8.5112783574837819e-04 +-8.4127815034662739e-04 +-8.3132621122931774e-04 +-8.2141811460097267e-04 +-8.1168153345772751e-04 +-8.0222605711289001e-04 +-7.9314420022550433e-04 +-7.8451284364169135e-04 +-7.7639491342434248e-04 +-7.6884114925250850e-04 +-7.6189185419612800e-04 +-7.5557855237793595e-04 +-7.4992550851594520e-04 +-7.4495108408983535e-04 +-7.4066891971177645e-04 +-7.3708894322259844e-04 +-7.3421820910677608e-04 +-7.3206157794303533e-04 +-7.3062224557359130e-04 +-7.2990213109834631e-04 +-7.1661650779501328e-04 +-7.1802753712785087e-04 +-7.2083045553461675e-04 +-7.2498687585319200e-04 +-7.3043897115722162e-04 +-7.3710923589502455e-04 +-7.4490026015114905e-04 +-7.5369459459091921e-04 +-7.6335480270658691e-04 +-7.7372381797499994e-04 +-7.8462574698121620e-04 +-7.9586728362749282e-04 +-8.0723991838394828e-04 +-8.1852312936605903e-04 +-8.2948871411129502e-04 +-8.3990634735149291e-04 +-8.4955032214929554e-04 +-8.5820725436015061e-04 +-8.6568432684439706e-04 +-8.7181746097593558e-04 +-8.7647867820491452e-04 +-8.7958189696499831e-04 +-8.8108652143667899e-04 +-8.8099840827087980e-04 +-8.7936810407089714e-04 +-8.7628656949288199e-04 +-8.7187888274879754e-04 +-8.6629659884098051e-04 +-8.5970950945521180e-04 +-8.5229750755091657e-04 +-8.4424313636616169e-04 +-8.3572523104079495e-04 +-8.2691387842955065e-04 +-8.1796675547863738e-04 +-8.0902677640310469e-04 +-8.0022089066356637e-04 +-7.9165982578310076e-04 +-7.8343855449870142e-04 +-7.7563727548129178e-04 +-7.6832272176858391e-04 +-7.6154964337632285e-04 +-7.5536234447460095e-04 +-7.4979618719307902e-04 +-7.4487900139395564e-04 +-7.4063236174174449e-04 +-7.3707271007564603e-04 +-7.3421231294078780e-04 +-7.3206005188190424e-04 +-7.3062204855945322e-04 +-7.2990212867048187e-04 +-6.9978952011402968e-04 +-7.0116707971071344e-04 +-7.0390447760538990e-04 +-7.0796617817206020e-04 +-7.1329866422941497e-04 +-7.1983023255525833e-04 +-7.2747080598364519e-04 +-7.3611183148382311e-04 +-7.4562634813136607e-04 +-7.5586932287307240e-04 +-7.6667836577513947e-04 +-7.7787494938768003e-04 +-7.8926626646694969e-04 +-8.0064786149705352e-04 +-8.1180715652693161e-04 +-8.2252795157895982e-04 +-8.3259590627014432e-04 +-8.4180489944627639e-04 +-8.4996402400840977e-04 +-8.5690482305489119e-04 +-8.6248824023672842e-04 +-8.6661067640184748e-04 +-8.6920854651763367e-04 +-8.7026083102724884e-04 +-8.6978930740679960e-04 +-8.6785640078306122e-04 +-8.6456086080043701e-04 +-8.6003170543878760e-04 +-8.5442103076665101e-04 +-8.4789634759684269e-04 +-8.4063307294284179e-04 +-8.3280769593384459e-04 +-8.2459198490060547e-04 +-8.1614843677617821e-04 +-8.0762701832924058e-04 +-7.9916312828048940e-04 +-7.9087662735702552e-04 +-7.8287173899825786e-04 +-7.7523761063163739e-04 +-7.6804933566471437e-04 +-7.6136926088781994e-04 +-7.5524843538192651e-04 +-7.4972808966747360e-04 +-7.4484106402306516e-04 +-7.4061313061378269e-04 +-7.3706417450460733e-04 +-7.3420921384343145e-04 +-7.3205925000445721e-04 +-7.3062194505858075e-04 +-7.2990212739513897e-04 +-6.9978945542015474e-04 +-7.0116649672644017e-04 +-7.0390285445886549e-04 +-7.0796298755493184e-04 +-7.1329337497495619e-04 +-7.1982231627999791e-04 +-7.2745975022031173e-04 +-7.3609716031507850e-04 +-7.4560765061078196e-04 +-7.5584628843652815e-04 +-7.6665082442112535e-04 +-7.7784291277277506e-04 +-7.8922996449611884e-04 +-8.0060776788627762e-04 +-8.1176399663304786e-04 +-8.2248268691178291e-04 +-8.3254969267762763e-04 +-8.4175901978023537e-04 +-8.4991980050841680e-04 +-8.5686351878604399e-04 +-8.6245096165889494e-04 +-8.6657828974500491e-04 +-8.6918161881124997e-04 +-8.7023960273180292e-04 +-8.6977369850992992e-04 +-8.6784604710370486e-04 +-8.6455517316412879e-04 +-8.6002994205134264e-04 +-8.5442237272309888e-04 +-8.4789996875050695e-04 +-8.4063819775237990e-04 +-8.3281364173290690e-04 +-8.2459818770744557e-04 +-8.1615446188142246e-04 +-8.0763255828960830e-04 +-7.9916799161038217e-04 +-7.9088072127623957e-04 +-7.8287504924524833e-04 +-7.7524018077215762e-04 +-7.6805124766853039e-04 +-7.6137061811992562e-04 +-7.5524934862281816e-04 +-7.4972866636629490e-04 +-7.4484140069844436e-04 +-7.4061330813496046e-04 +-7.3706425588761833e-04 +-7.3420924415971197e-04 +-7.3205925800018986e-04 +-7.3062194610384391e-04 +-7.2990212740810950e-04 +-7.1661630360172427e-04 +-7.1802569705998055e-04 +-7.2082533250145901e-04 +-7.2497680608176580e-04 +-7.3042228015684216e-04 +-7.3708426126261619e-04 +-7.4486539590876350e-04 +-7.5364836026367002e-04 +-7.6329593779340856e-04 +-7.7365139865850419e-04 +-7.8453931697123908e-04 +-7.9576698547011420e-04 +-8.0712660643207873e-04 +-8.1839844235999837e-04 +-8.2935508554426215e-04 +-8.3976693670547527e-04 +-8.4940885992904904e-04 +-8.5806780747987898e-04 +-8.6555100576008522e-04 +-8.7169410253493118e-04 +-8.7636854512691971e-04 +-8.7948743402213397e-04 +-8.8100919963630573e-04 +-8.8093867367407817e-04 +-8.7932543081282685e-04 +-8.7625960099363962e-04 +-8.7186563412140902e-04 +-8.6629468868878968e-04 +-8.5971639048452000e-04 +-8.5231067127075090e-04 +-8.4426027551625651e-04 +-8.3574435220453726e-04 +-8.2693336495653219e-04 +-8.1798538645169630e-04 +-8.0904371068166918e-04 +-8.0023562624692872e-04 +-7.9167214436130339e-04 +-7.8344845967155360e-04 +-7.7564493125186081e-04 +-7.6832839595963984e-04 +-7.6155365884111436e-04 +-7.5536503951673800e-04 +-7.4979788551854897e-04 +-7.4487999117268098e-04 +-7.4063288290284845e-04 +-7.3707294873206629e-04 +-7.3421240176717675e-04 +-7.3206007529454944e-04 +-7.3062205161883301e-04 +-7.2990212870839945e-04 +-7.5076453235986020e-04 +-7.5224001058054636e-04 +-7.5516884082891178e-04 +-7.5950664801955139e-04 +-7.6518658517842248e-04 +-7.7211905430671227e-04 +-7.8019143670292085e-04 +-7.8926792146189980e-04 +-7.9918954930941681e-04 +-8.0977462673527195e-04 +-8.2081971420391799e-04 +-8.3210144714520771e-04 +-8.4337949393815438e-04 +-8.5440096377222712e-04 +-8.6490651450473626e-04 +-8.7463824711806880e-04 +-8.8334920289741996e-04 +-8.9081393452544321e-04 +-8.9683927735610442e-04 +-9.0127420201843332e-04 +-9.0401757555186519e-04 +-9.0502284055426878e-04 +-9.0429901602940112e-04 +-9.0190794057547891e-04 +-8.9795819508402296e-04 +-8.9259654361991531e-04 +-8.8599794651596068e-04 +-8.7835521547280284e-04 +-8.6986923276454614e-04 +-8.6074040951132397e-04 +-8.5116177919042130e-04 +-8.4131386620121351e-04 +-8.3136126794778199e-04 +-8.2145075423873434e-04 +-8.1171061605436203e-04 +-8.0225097444819695e-04 +-7.9316477418978776e-04 +-7.8452922133788960e-04 +-7.7640746777777204e-04 +-7.6885039081648981e-04 +-7.6189835726531673e-04 +-7.5558289654669895e-04 +-7.4992823542811263e-04 +-7.4495266823862362e-04 +-7.4066975165867606e-04 +-7.3708932340284326e-04 +-7.3421835037842649e-04 +-7.3206161513485061e-04 +-7.3062225042974226e-04 +-7.2990213115853243e-04 +-8.0313913433236524e-04 +-8.0471606075837850e-04 +-8.0784303726679266e-04 +-8.1246615203877368e-04 +-8.1850416090809789e-04 +-8.2584809556386152e-04 +-8.3436084369329982e-04 +-8.4387680144706835e-04 +-8.5420175234323108e-04 +-8.6511321145340127e-04 +-8.7636159194906819e-04 +-8.8767268559775787e-04 +-8.9875205302604856e-04 +-9.0929191870099560e-04 +-9.1898097700342674e-04 +-9.2751708978420697e-04 +-9.3462222272522398e-04 +-9.4005826352297863e-04 +-9.4364180715955550e-04 +-9.4525580449341599e-04 +-9.4485627587574900e-04 +-9.4247305106874785e-04 +-9.3820450833102310e-04 +-9.3220726562729523e-04 +-9.2468247343719561e-04 +-9.1586063819426252e-04 +-9.0598677816427174e-04 +-8.9530729793471512e-04 +-8.8405942493344398e-04 +-8.7246352572977425e-04 +-8.6071820436159927e-04 +-8.4899781586549581e-04 +-8.3745189816676439e-04 +-8.2620600304259017e-04 +-8.1536345366637101e-04 +-8.0500763810301352e-04 +-7.9520453989942734e-04 +-7.8600529298860971e-04 +-7.7744862068787331e-04 +-7.6956307520462900e-04 +-7.6236903551902884e-04 +-7.5588045007352837e-04 +-7.5010632910036041e-04 +-7.4505200225988136e-04 +-7.4072016274648518e-04 +-7.3711172086576111e-04 +-7.3422648958130837e-04 +-7.3206372257359072e-04 +-7.3062252257379543e-04 +-7.2990213451275591e-04 +-8.7486167854632384e-04 +-8.7657743436217255e-04 +-8.7997528017922733e-04 +-8.8498766976334011e-04 +-8.9151275459415659e-04 +-8.9941377191754394e-04 +-9.0851828159535704e-04 +-9.1861734474970084e-04 +-9.2946485372408412e-04 +-9.4077742899357011e-04 +-9.5223559401462509e-04 +-9.6348726417374696e-04 +-9.7415480202851172e-04 +-9.8384679788204128e-04 +-9.9217514903553292e-04 +-9.9877689021502219e-04 +-1.0033387771761033e-03 +-1.0056213000298004e-03 +-1.0054781500323227e-03 +-1.0028675619067069e-03 +-9.9785339198619062e-04 +-9.9059583870174405e-04 +-9.8133370490405183e-04 +-9.7036145031362329e-04 +-9.5800469963703086e-04 +-9.4459742862657708e-04 +-9.3046306460375927e-04 +-9.1590059455650254e-04 +-9.0117577746248333e-04 +-8.8651686773137531e-04 +-8.7211389868483357e-04 +-8.5812048825583710e-04 +-8.4465722026217283e-04 +-8.3181583503613612e-04 +-8.1966366691046564e-04 +-8.0824795310879588e-04 +-7.9759979041428152e-04 +-7.8773762840097020e-04 +-7.7867026474751717e-04 +-7.7039935625439605e-04 +-7.6292148617963275e-04 +-7.5622984101342868e-04 +-7.5031555303122996e-04 +-7.4516876268330393e-04 +-7.4077944968402982e-04 +-7.3713807521580237e-04 +-7.3423607096592030e-04 +-7.3206620431265660e-04 +-7.3062284313307106e-04 +-7.2990213846429444e-04 +-9.6691646889601496e-04 +-9.6881016584271366e-04 +-9.7255491873328274e-04 +-9.7806514858287579e-04 +-9.8521169903774278e-04 +-9.9382077382725214e-04 +-1.0036723737718966e-03 +-1.0144982566253995e-03 +-1.0259797211595982e-03 +-1.0377460367832114e-03 +-1.0493750763677103e-03 +-1.0603984638985643e-03 +-1.0703139151507844e-03 +-1.0786069202306425e-03 +-1.0847821503598288e-03 +-1.0884021344791969e-03 +-1.0891276886109251e-03 +-1.0867525800165186e-03 +-1.0812250709266013e-03 +-1.0726515589061202e-03 +-1.0612816681714900e-03 +-1.0474783204011213e-03 +-1.0316790986850146e-03 +-1.0143559356453047e-03 +-9.9597902480136379e-04 +-9.7698867171816810e-04 +-9.5777646368583845e-04 +-9.3867527826311289e-04 +-9.1995653079895588e-04 +-9.0183263602575418e-04 +-8.8446273057519640e-04 +-8.6796004577215818e-04 +-8.5239975243756722e-04 +-8.3782650823192796e-04 +-8.2426126937265880e-04 +-8.1170716901393723e-04 +-8.0015442297514251e-04 +-7.8958431743627233e-04 +-7.7997238123623180e-04 +-7.7129086334886895e-04 +-7.6351063596228437e-04 +-7.5660263369982958e-04 +-7.5053892530302932e-04 +-7.4529349880601706e-04 +-7.4084282666681553e-04 +-7.3716626434002278e-04 +-7.3424632467689727e-04 +-7.3206886128901461e-04 +-7.3062318642598014e-04 +-7.2990214269679822e-04 +-1.0795738980408989e-03 +-1.0816850256079300e-03 +-1.0858537628642062e-03 +-1.0919726527794632e-03 +-1.0998792584788755e-03 +-1.1093541385562315e-03 +-1.1201174206922175e-03 +-1.1318237748725772e-03 +-1.1440562865360293e-03 +-1.1563210466726463e-03 +-1.1680460658242040e-03 +-1.1785897450578458e-03 +-1.1872644717191912e-03 +-1.1933787721210302e-03 +-1.1962964720057085e-03 +-1.1955047026000691e-03 +-1.1906770903470909e-03 +-1.1817170719795106e-03 +-1.1687703390104276e-03 +-1.1522035741042054e-03 +-1.1325554819395080e-03 +-1.1104721519382581e-03 +-1.0866402822798356e-03 +-1.0617292520111996e-03 +-1.0363483747481731e-03 +-1.0110209639867826e-03 +-9.8617340756605070e-04 +-9.6213567672291949e-04 +-9.3914931709497454e-04 +-9.1737945835034863e-04 +-8.9692823823400432e-04 +-8.7784792451071035e-04 +-8.6015275883200492e-04 +-8.4382908498993950e-04 +-8.2884367332660433e-04 +-8.1515035401148760e-04 +-8.0269516928873480e-04 +-7.9142028660094408e-04 +-7.8126690873894919e-04 +-7.7217739264617878e-04 +-7.6409675683232806e-04 +-7.5697372511719066e-04 +-7.5076142496797820e-04 +-7.4541783338261016e-04 +-7.4090604237415805e-04 +-7.3719439932370934e-04 +-7.3425656424802642e-04 +-7.3207151575021613e-04 +-7.3062352949753828e-04 +-7.2990214692738166e-04 +-1.2115492324832301e-03 +-1.2139148007323998e-03 +-1.2185808985757717e-03 +-1.2254168306770369e-03 +-1.2342244237484059e-03 +-1.2447339208223067e-03 +-1.2565963231089923e-03 +-1.2693714493345048e-03 +-1.2825127570193229e-03 +-1.2953532312271179e-03 +-1.3071007944219966e-03 +-1.3168548086150691e-03 +-1.3236544056740727e-03 +-1.3265622690241043e-03 +-1.3247747457299757e-03 +-1.3177356638204752e-03 +-1.3052242346836386e-03 +-1.2873920138697422e-03 +-1.2647389768909167e-03 +-1.2380372972256384e-03 +-1.2082249505862774e-03 +-1.1762950790113851e-03 +-1.1432019439660589e-03 +-1.1097947017560811e-03 +-1.0767808595741725e-03 +-1.0447149158862993e-03 +-1.0140049106507265e-03 +-9.8492955654300445e-04 +-9.5766003538344134e-04 +-9.3228239229883447e-04 +-9.0881813535445880e-04 +-8.8724190721543828e-04 +-8.6749591950510273e-04 +-8.4950131268731615e-04 +-8.3316683071224063e-04 +-8.1839527310305718e-04 +-8.0508817568109210e-04 +-7.9314911925719509e-04 +-7.8248599985130318e-04 +-7.7301252861888836e-04 +-7.6464917135682798e-04 +-7.5732368859133701e-04 +-7.5097139789267239e-04 +-7.4553524923681020e-04 +-7.4096578059289176e-04 +-7.3722100307533993e-04 +-7.3426625172012773e-04 +-7.3207402815831952e-04 +-7.3062385430615697e-04 +-7.2990215093355856e-04 +-1.3589558709693912e-03 +-1.3616057517415784e-03 +-1.3668312916443755e-03 +-1.3744830987995314e-03 +-1.3843332413639060e-03 +-1.3960667438501734e-03 +-1.4092647898148994e-03 +-1.4233778492449990e-03 +-1.4376913354833434e-03 +-1.4512941042562745e-03 +-1.4630690582640873e-03 +-1.4717300007710374e-03 +-1.4759228588851374e-03 +-1.4743891621765411e-03 +-1.4661609386783828e-03 +-1.4507337695559498e-03 +-1.4281638009162408e-03 +-1.3990586627750296e-03 +-1.3644693696066050e-03 +-1.3257209529454722e-03 +-1.2842306147884512e-03 +-1.2413535112764072e-03 +-1.1982773264394607e-03 +-1.1559682521779930e-03 +-1.1151590192815277e-03 +-1.0763651086908074e-03 +-1.0399160285846306e-03 +-1.0059917720634257e-03 +-9.7465820771622832e-04 +-9.4589815011854620e-04 +-9.1963691234066823e-04 +-8.9576235624813161e-04 +-8.7414005997531023e-04 +-8.5462444164029943e-04 +-8.3706668542529088e-04 +-8.2132022265605543e-04 +-8.0724439205889591e-04 +-7.9470677428524264e-04 +-7.8358458151131277e-04 +-7.7376538846901058e-04 +-7.6514741647078623e-04 +-7.5763952446745422e-04 +-7.5116101787322804e-04 +-7.4564135384160262e-04 +-7.4101979830444120e-04 +-7.3724507327821735e-04 +-7.3427502102775121e-04 +-7.3207630335135436e-04 +-7.3062414852891001e-04 +-7.2990215456325233e-04 +-1.5143502250194302e-03 +-1.5173009307900122e-03 +-1.5231265908685772e-03 +-1.5316741789892245e-03 +-1.5427070364742196e-03 +-1.5558876163783723e-03 +-1.5707424029697281e-03 +-1.5866054957344431e-03 +-1.6025475576273332e-03 +-1.6173137954574720e-03 +-1.6293121959559964e-03 +-1.6366981343980444e-03 +-1.6375797711936410e-03 +-1.6303192826688233e-03 +-1.6138496254952119e-03 +-1.5879009368421251e-03 +-1.5530574073083241e-03 +-1.5106321993563607e-03 +-1.4624152999198412e-03 +-1.4103817127756079e-03 +-1.3564374850569322e-03 +-1.3022462353181629e-03 +-1.2491426698439435e-03 +-1.1981163175343965e-03 +-1.1498405336757180e-03 +-1.1047239213758419e-03 +-1.0629677714870701e-03 +-1.0246198527379066e-03 +-9.8962006200118465e-04 +-9.5783674286074806e-04 +-9.2909425331377674e-04 +-9.0319312087695574e-04 +-8.7992429774274704e-04 +-8.5907891547822555e-04 +-8.4045471395348132e-04 +-8.2386007545096746e-04 +-8.0911637445554461e-04 +-7.9605917106935833e-04 +-7.8453863240143112e-04 +-7.7441945702630367e-04 +-7.6558049637786619e-04 +-7.5791420760294378e-04 +-7.5132602967388398e-04 +-7.4573374421393283e-04 +-7.4106686124773206e-04 +-7.3726605546701345e-04 +-7.3428266875491814e-04 +-7.3207828826151497e-04 +-7.3062440527692858e-04 +-7.2990215773132165e-04 +-1.6665407673256941e-03 +-1.6697889909318777e-03 +-1.6762229435590241e-03 +-1.6857151405420860e-03 +-1.6980614340204165e-03 +-1.7129480079152513e-03 +-1.7298834943116569e-03 +-1.7480903727007636e-03 +-1.7663714610539215e-03 +-1.7830012885654027e-03 +-1.7957228928225880e-03 +-1.8019289805588632e-03 +-1.7990482238218024e-03 +-1.7850543768643460e-03 +-1.7589270854285650e-03 +-1.7208880505565163e-03 +-1.6723301679641524e-03 +-1.6154906734892672e-03 +-1.5530083465737947e-03 +-1.4875103090386053e-03 +-1.4213184806892694e-03 +-1.3562976821592796e-03 +-1.2938208272247800e-03 +-1.2348093055191708e-03 +-1.1798097014005106e-03 +-1.1290794883985478e-03 +-1.0826661908343077e-03 +-1.0404733114709852e-03 +-1.0023116673754124e-03 +-9.6793745880005653e-04 +-9.3707940861473900e-04 +-9.0945742727527572e-04 +-8.8479497463396777e-04 +-8.6282687886002709e-04 +-8.4330396684304931e-04 +-8.2599551260689546e-04 +-8.1069023324690224e-04 +-7.9719635077923272e-04 +-7.8534108194193214e-04 +-7.7496980452602948e-04 +-7.6594506774240335e-04 +-7.5814555696373273e-04 +-7.5146508338757862e-04 +-7.4581164186099456e-04 +-7.4110656170946784e-04 +-7.3728376331823027e-04 +-7.3428912556038886e-04 +-7.3207996459735344e-04 +-7.3062462215775969e-04 +-7.2990216040811707e-04 +-1.8021143507188156e-03 +-1.8056329689340755e-03 +-1.8126415408406108e-03 +-1.8230787732345453e-03 +-1.8368308852957445e-03 +-1.8536742740955759e-03 +-1.8731571427676856e-03 +-1.8944115141933868e-03 +-1.9159274084971443e-03 +-1.9353816995750582e-03 +-1.9496627042015705e-03 +-1.9552117706144239e-03 +-1.9486781720831486e-03 +-1.9276977715818847e-03 +-1.8914883204912193e-03 +-1.8410149476161819e-03 +-1.7786895083016369e-03 +-1.7077756869175807e-03 +-1.6317485879386057e-03 +-1.5537965993569992e-03 +-1.4765368228588224e-03 +-1.4019222887897481e-03 +-1.3312779122639461e-03 +-1.2654014867735887e-03 +-1.2046836638512151e-03 +-1.1492206309812931e-03 +-1.0989080597779627e-03 +-1.0535138286719831e-03 +-1.0127314232816049e-03 +-9.7621753067841379e-04 +-9.4361750688991112e-04 +-9.1458193622727651e-04 +-8.8877685784825356e-04 +-8.6588961394917969e-04 +-8.4563175158248311e-04 +-8.2774000098047101e-04 +-8.1197604631800299e-04 +-7.9812558094891593e-04 +-7.8599697906021415e-04 +-7.7541980296964158e-04 +-7.6624328696414873e-04 +-7.5833488483772462e-04 +-7.5157893194021958e-04 +-7.4587544839927258e-04 +-7.4113909453663105e-04 +-7.3729827974718684e-04 +-7.3429442042747975e-04 +-7.3208133962636131e-04 +-7.3062480008850579e-04 +-7.2990216260476780e-04 +-1.9091949485606986e-03 +-1.9129347930173810e-03 +-1.9204384590650477e-03 +-1.9317481701020209e-03 +-1.9468945676393492e-03 +-1.9658095735035218e-03 +-1.9881457573801800e-03 +-2.0129895527226625e-03 +-2.0385193928710351e-03 +-2.0617560376306491e-03 +-2.0786259493989585e-03 +-2.0845124815360638e-03 +-2.0752468194484962e-03 +-2.0481919757578963e-03 +-2.0029399982140071e-03 +-1.9413253355679190e-03 +-1.8668241569870867e-03 +-1.7836753892751856e-03 +-1.6960759783389038e-03 +-1.6076469645876490e-03 +-1.5211945209943696e-03 +-1.4386913705971118e-03 +-1.3613820576392599e-03 +-1.2899353824820112e-03 +-1.2245973524150282e-03 +-1.1653225816533430e-03 +-1.1118775087747531e-03 +-1.0639167201784920e-03 +-1.0210368289009419e-03 +-9.8281298623122994e-04 +-9.4882260286264022e-04 +-9.1865998571269620e-04 +-8.9194471351900114e-04 +-8.6832581820917639e-04 +-8.4748324323036001e-04 +-8.2912760282243653e-04 +-8.1299894102012087e-04 +-7.9886495790713538e-04 +-7.8651900897300827e-04 +-7.7577807200665376e-04 +-7.6648080020779808e-04 +-7.5848572942009110e-04 +-7.5166967394313519e-04 +-7.4592632384952700e-04 +-7.4116504336304808e-04 +-7.3730986201310945e-04 +-7.3429864620359626e-04 +-7.3208243725716722e-04 +-7.3062494214477217e-04 +-7.2990216435914082e-04 +-1.9821987889402435e-03 +-1.9860977482212181e-03 +-1.9939767469614364e-03 +-2.0059908717909272e-03 +-2.0223314444079679e-03 +-2.0431143454851782e-03 +-2.0681455290734560e-03 +-2.0965418526842374e-03 +-2.1262673562238302e-03 +-2.1537812835907976e-03 +-2.1741114263784975e-03 +-2.1816070961593183e-03 +-2.1712847411674329e-03 +-2.1402313234712292e-03 +-2.0883859977766789e-03 +-2.0183709941580322e-03 +-1.9345870038894426e-03 +-1.8420825241045062e-03 +-1.7456288299594592e-03 +-1.6491790498417969e-03 +-1.5556803379069516e-03 +-1.4671191455149371e-03 +-1.3846803239595229e-03 +-1.3089373832435500e-03 +-1.2400291126431092e-03 +-1.1778044510966953e-03 +-1.1219325756518274e-03 +-1.0719821141747590e-03 +-1.0274756488072980e-03 +-9.8792565204342615e-04 +-9.5285706721413691e-04 +-9.2182060495620065e-04 +-8.9439977928687053e-04 +-8.7021385194104310e-04 +-8.4891819999590617e-04 +-8.3020314197727039e-04 +-8.1379191509529979e-04 +-7.9943825671407521e-04 +-7.8692387843937823e-04 +-7.7605600959940646e-04 +-7.6666511239455940e-04 +-7.5860282206611867e-04 +-7.5174013398661118e-04 +-7.4596583992974264e-04 +-7.4118520409477927e-04 +-7.3731886305386442e-04 +-7.3430193093600811e-04 +-7.3208329060142684e-04 +-7.3062505259856509e-04 +-7.2990216572384550e-04 +-2.0242433861244742e-03 +-2.0282401953181247e-03 +-2.0363542987397376e-03 +-2.0488196172171870e-03 +-2.0659447395899224e-03 +-2.0879958534941248e-03 +-2.1149431125384996e-03 +-2.1460297400689447e-03 +-2.1792053061619279e-03 +-2.2106382753559633e-03 +-2.2347166305504871e-03 +-2.2449172334543990e-03 +-2.2354646561735594e-03 +-2.2030589559613048e-03 +-2.1477728470390969e-03 +-2.0727490006100728e-03 +-1.9830519459736679e-03 +-1.8843372122258771e-03 +-1.7818291376024999e-03 +-1.6797668107628870e-03 +-1.5812453879305529e-03 +-1.4883014895829885e-03 +-1.4021081867550034e-03 +-1.3231922975796846e-03 +-1.2516294569785867e-03 +-1.1872006536475228e-03 +-1.1295091381240503e-03 +-1.0780632093928180e-03 +-1.0323322357853346e-03 +-9.9178288091375608e-04 +-9.5590129672686389e-04 +-9.2420570443449337e-04 +-8.9625259786813927e-04 +-8.7163885774836798e-04 +-8.5000135400071196e-04 +-8.3101509840381792e-04 +-8.1439064712500952e-04 +-7.9987120230247323e-04 +-7.8722969194628669e-04 +-7.7626599392751695e-04 +-7.6680439524373309e-04 +-7.5869132961465841e-04 +-7.5179340618445592e-04 +-7.4599572368623317e-04 +-7.4120045390851453e-04 +-7.3732567291055675e-04 +-7.3430441646776215e-04 +-7.3208393640739012e-04 +-7.3062513619733742e-04 +-7.2990216675741424e-04 +-2.0445767988107612e-03 +-2.0486232262670878e-03 +-2.0568444046769139e-03 +-2.0694915118773969e-03 +-2.0869069413430035e-03 +-2.1094249623191891e-03 +-2.1371435389061417e-03 +-2.1695013918392541e-03 +-2.2046527094527384e-03 +-2.2388269490134336e-03 +-2.2661560969309989e-03 +-2.2795182940541759e-03 +-2.2724072007022948e-03 +-2.2409735910117602e-03 +-2.1851133261810932e-03 +-2.1081444485119578e-03 +-2.0155104773690192e-03 +-1.9132928814464467e-03 +-1.8070871253727738e-03 +-1.7014065010947941e-03 +-1.5995212994431782e-03 +-1.5035613666758223e-03 +-1.4147336813957439e-03 +-1.3335604657190743e-03 +-1.2600905549742455e-03 +-1.1940674117772419e-03 +-1.1350534389389505e-03 +-1.0825171355145398e-03 +-1.0358914106032538e-03 +-9.9461077899571141e-04 +-9.5813373840440664e-04 +-9.2595510715550117e-04 +-8.9761178210143210e-04 +-8.7268433898664798e-04 +-8.5079612669127956e-04 +-8.3161095498713504e-04 +-8.1483009084494431e-04 +-8.0018901565787320e-04 +-7.8745421948957987e-04 +-7.7642019204238503e-04 +-7.6690669452071820e-04 +-7.5875634850243933e-04 +-7.5183254822680750e-04 +-7.4601768501790890e-04 +-7.4121166281357440e-04 +-7.3733067906179347e-04 +-7.3430624390549476e-04 +-7.3208441127278821e-04 +-7.3062519767271722e-04 +-7.2990216751821430e-04 +-2.0529831542710330e-03 +-2.0570490470222117e-03 +-2.0652910456543157e-03 +-2.0779262142133527e-03 +-2.0952572444216996e-03 +-2.1176017464027675e-03 +-2.1451158491061374e-03 +-2.1774278955288581e-03 +-2.2130163295684918e-03 +-2.2484480753529219e-03 +-2.2779752429223977e-03 +-2.2942049064234786e-03 +-2.2900297300827779e-03 +-2.2609404405410116e-03 +-2.2063865887700265e-03 +-2.1295636653424189e-03 +-2.0360611163312043e-03 +-1.9322466686721323e-03 +-1.8240253066301648e-03 +-1.7161724431051760e-03 +-1.6121469136277020e-03 +-1.5141956468804779e-03 +-1.4235859757096134e-03 +-1.3408609858054066e-03 +-1.2660657698241101e-03 +-1.1989264931175517e-03 +-1.1389821184474291e-03 +-1.0856761245614645e-03 +-1.0384173831956671e-03 +-9.9661861978597678e-04 +-9.5971926734750247e-04 +-9.2719783470731818e-04 +-8.9857746554363610e-04 +-8.7342724063205744e-04 +-8.5136094869612199e-04 +-8.3203446457076797e-04 +-8.1514246803795695e-04 +-8.0041496219460649e-04 +-7.8761386762855130e-04 +-7.7652984914498369e-04 +-7.6697945500552435e-04 +-7.5880260028119361e-04 +-7.5186039643839202e-04 +-7.4603331198803220e-04 +-7.4121963976971669e-04 +-7.3733424217605154e-04 +-7.3430754471102402e-04 +-7.3208474931820951e-04 +-7.3062524143826363e-04 +-7.2990216806070396e-04 +-2.0560405208134513e-03 +-2.0601111836566904e-03 +-2.0683355859430460e-03 +-2.0808779511464898e-03 +-2.0979701901383935e-03 +-2.1198645838280119e-03 +-2.1467069127336859e-03 +-2.1782445061471851e-03 +-2.2132621658409787e-03 +-2.2487710879787320e-03 +-2.2793896787696895e-03 +-2.2977420263845306e-03 +-2.2963017241912570e-03 +-2.2699028494913469e-03 +-2.2174180473371135e-03 +-2.1417484635570094e-03 +-2.0484824939523139e-03 +-1.9441730900058407e-03 +-1.8349744081261796e-03 +-1.7258922453479010e-03 +-1.6205606672289818e-03 +-1.5213418765838197e-03 +-1.4295687227170572e-03 +-1.3458142266581932e-03 +-1.2701306222546436e-03 +-1.2022380736347730e-03 +-1.1416629384119691e-03 +-1.0878335634600604e-03 +-1.0401435095042538e-03 +-9.9799123524033193e-04 +-9.6080348845836445e-04 +-9.2804781781630576e-04 +-8.9923806622622710e-04 +-8.7393550913384657e-04 +-8.5174742661479278e-04 +-8.3232428222689665e-04 +-8.1535625886160212e-04 +-8.0056961736606972e-04 +-7.8772315575399677e-04 +-7.7660492451506831e-04 +-7.6702927556736755e-04 +-7.5883427360860941e-04 +-7.5187946920233833e-04 +-7.4604401583386684e-04 +-7.4122510423203195e-04 +-7.3733668324625070e-04 +-7.3430843595610230e-04 +-7.3208498094400217e-04 +-7.3062527142764874e-04 +-7.2990216843345560e-04 +-2.0570060116994289e-03 +-2.0610760983621234e-03 +-2.0692759569898066e-03 +-2.0817235273254599e-03 +-2.0985849909449295e-03 +-2.1200397342811188e-03 +-2.1461856688408600e-03 +-2.1768113199148592e-03 +-2.2109133871156938e-03 +-2.2459040356054157e-03 +-2.2768385483562586e-03 +-2.2965260543212022e-03 +-2.2971969899577100e-03 +-2.2731351620349717e-03 +-2.2226581546613295e-03 +-2.1483358607568086e-03 +-2.0556908146130278e-03 +-1.9513904529652919e-03 +-1.8417746168535643e-03 +-1.7320298362750483e-03 +-1.6259312554593515e-03 +-1.5259361366092474e-03 +-1.4334334682099795e-03 +-1.3490243200417907e-03 +-1.2727707957445658e-03 +-1.2043922489059736e-03 +-1.1434086297997424e-03 +-1.0892394618736106e-03 +-1.0412689162950265e-03 +-9.9888648383133398e-04 +-9.6151082747822933e-04 +-9.2860245208180802e-04 +-8.9966919173036072e-04 +-8.7426726203502635e-04 +-8.5199971443869189e-04 +-8.3251349170066630e-04 +-8.1549584808360395e-04 +-8.0067060578548532e-04 +-7.8779452719600839e-04 +-7.7665395808209292e-04 +-7.6706181792633027e-04 +-7.5885496443651047e-04 +-7.5189192983946267e-04 +-7.4605100952907497e-04 +-7.4122867491626255e-04 +-7.3733827845428430e-04 +-7.3430901841104704e-04 +-7.3208513232608720e-04 +-7.3062529102868243e-04 +-7.2990216867830770e-04 +-2.0572330512130996e-03 +-2.0613014101904378e-03 +-2.0694820267670058e-03 +-2.0818612583759395e-03 +-2.0985587209009452e-03 +-2.1196966736632392e-03 +-2.1453213010548550e-03 +-2.1752171681837015e-03 +-2.2084980563008977e-03 +-2.2428644505876560e-03 +-2.2737453092211541e-03 +-2.2941714008914964e-03 +-2.2962556100075892e-03 +-2.2738865053133685e-03 +-2.2249478410641113e-03 +-2.1517328295488497e-03 +-2.0596893031104083e-03 +-1.9555511808809836e-03 +-1.8457833228800763e-03 +-1.7356977332568762e-03 +-1.6291688136218403e-03 +-1.5287214863490229e-03 +-1.4357854430580581e-03 +-1.3509829303401161e-03 +-1.2743845351065174e-03 +-1.2057105658690303e-03 +-1.1444778979691613e-03 +-1.0901011415576178e-03 +-1.0419589975057086e-03 +-9.9943562255469911e-04 +-9.6194481641779476e-04 +-9.2894281817792101e-04 +-8.9993380739342664e-04 +-8.7447091367934325e-04 +-8.5215460457809650e-04 +-8.3262966870972094e-04 +-8.1558156693311895e-04 +-8.0073262718324324e-04 +-7.8783836400950333e-04 +-7.7668407785838351e-04 +-7.6708180964710150e-04 +-7.5886767663656870e-04 +-7.5189958621332646e-04 +-7.4605530714178978e-04 +-7.4123086927016600e-04 +-7.3733925885428463e-04 +-7.3430937640405229e-04 +-7.3208522537428124e-04 +-7.3062530307748210e-04 +-7.2990216883035339e-04 +-2.0572420146247414e-03 +-2.0613089178331788e-03 +-2.0694774268344867e-03 +-2.0818153763959481e-03 +-2.0984144672430627e-03 +-2.1193607031164217e-03 +-2.1446621726380934e-03 +-2.1740867041301587e-03 +-2.2068029204067264e-03 +-2.2406860590899404e-03 +-2.2714201509061653e-03 +-2.2922117504093338e-03 +-2.2951262944906829e-03 +-2.2738078121354107e-03 +-2.2258564771028217e-03 +-2.1533780759320793e-03 +-2.0617632163435593e-03 +-1.9577810231608483e-03 +-1.8479708648879742e-03 +-1.7377211043936439e-03 +-1.6309670845920320e-03 +-1.5302755844019346e-03 +-1.4371017659744450e-03 +-1.3520814415106197e-03 +-1.2752909966698813e-03 +-1.2064519014210288e-03 +-1.1450796758189349e-03 +-1.0905863886140326e-03 +-1.0423477946350371e-03 +-9.9974512677179815e-04 +-9.6218949336848518e-04 +-9.2913475914619325e-04 +-9.0008306189034060e-04 +-8.7458580268164033e-04 +-8.5224199916861840e-04 +-8.3269522966538919e-04 +-8.1562994645170207e-04 +-8.0076763652129734e-04 +-7.8786311178879727e-04 +-7.7670108385303094e-04 +-7.6709309854949132e-04 +-7.5887485576134198e-04 +-7.5190391056254035e-04 +-7.4605773469487672e-04 +-7.4123210888930164e-04 +-7.3733981274041105e-04 +-7.3430957866971560e-04 +-7.3208527794951198e-04 +-7.3062530988629115e-04 +-7.2990216891822396e-04 +-2.0572136757945401e-03 +-2.0612796903194440e-03 +-2.0694417385397389e-03 +-2.0817581793686085e-03 +-2.0983062564856104e-03 +-2.1191526034613543e-03 +-2.1442833087912542e-03 +-2.1734524981671791e-03 +-2.2058511755993597e-03 +-2.2394446690228121e-03 +-2.2700594109830315e-03 +-2.2910085789243067e-03 +-2.2943424363104704e-03 +-2.2735769854620499e-03 +-2.2261579258610873e-03 +-2.1540863154240705e-03 +-2.0627182264889550e-03 +-1.9588387787888716e-03 +-1.8490253140305230e-03 +-1.7387058804021640e-03 +-1.6318477882821048e-03 +-1.5310399488490370e-03 +-1.4377511374182885e-03 +-1.3526245571507250e-03 +-1.2757399032941744e-03 +-1.2068194998494312e-03 +-1.1453783706606760e-03 +-1.0908274344346020e-03 +-1.0425410536266644e-03 +-9.9989905348733333e-04 +-9.6231123352183922e-04 +-9.2923029650497787e-04 +-9.0015737678815510e-04 +-8.7464302338142530e-04 +-8.5228553760802607e-04 +-8.3272789879921085e-04 +-8.1565405942115850e-04 +-8.0078508928961871e-04 +-7.8787545145859192e-04 +-7.7670956495898389e-04 +-7.6709872950149851e-04 +-7.5887843736586959e-04 +-7.5190606830107291e-04 +-7.4605894616824289e-04 +-7.4123272761006257e-04 +-7.3734008923157825e-04 +-7.3430967964838731e-04 +-7.3208530419956945e-04 +-7.3062531328682155e-04 +-7.2990216896475619e-04 +-2.0571951340663673e-03 +-2.0612607322577476e-03 +-2.0694199671458472e-03 +-2.0817271676686418e-03 +-2.0982533616113260e-03 +-2.1190566725346979e-03 +-2.1441130567819459e-03 +-2.1731692033324233e-03 +-2.2054236036688408e-03 +-2.2388792894349192e-03 +-2.2694258624938284e-03 +-2.2904267456072881e-03 +-2.2939297962866652e-03 +-2.2733977206804293e-03 +-2.2262092033655968e-03 +-2.1543184830208778e-03 +-2.0630648458316685e-03 +-1.9592387353264337e-03 +-1.8494327840471642e-03 +-1.7390915212314110e-03 +-1.6321957490548838e-03 +-1.5313438500612353e-03 +-1.4380105234052803e-03 +-1.3528422736137158e-03 +-1.2759203575402889e-03 +-1.2069675996579912e-03 +-1.1454989289601653e-03 +-1.0909248703414680e-03 +-1.0426192707053577e-03 +-9.9996141747397634e-04 +-9.6236060145713127e-04 +-9.2926906891398805e-04 +-9.0018755699049289e-04 +-8.7466627554216695e-04 +-8.5230323956365071e-04 +-8.3274118816642397e-04 +-8.1566387283648625e-04 +-8.0079219527739325e-04 +-7.8788047771347774e-04 +-7.7671302089672050e-04 +-7.6710102490961329e-04 +-7.5887989790245059e-04 +-7.5190694850153024e-04 +-7.4605944051812749e-04 +-7.4123298015638876e-04 +-7.3734020211739309e-04 +-7.3430972088515663e-04 +-7.3208531492162984e-04 +-7.3062531467706993e-04 +-7.2990216898746448e-04 +-2.0571887358419583e-03 +-2.0612541984025108e-03 +-2.0694125561029173e-03 +-2.0817168881788911e-03 +-2.0982362522143738e-03 +-2.1190259890612193e-03 +-2.1440585732178485e-03 +-2.1730777432049406e-03 +-2.2052834090303961e-03 +-2.2386896001779745e-03 +-2.2692058111919138e-03 +-2.2902126993337179e-03 +-2.2937597104698525e-03 +-2.2732948448049590e-03 +-2.2261765864242940e-03 +-2.1543441018389274e-03 +-2.0631303515762289e-03 +-1.9593262813796027e-03 +-1.8495283789390215e-03 +-1.7391857266586060e-03 +-1.6322830290549895e-03 +-1.5314215130677801e-03 +-1.4380777325034874e-03 +-1.3528992875536901e-03 +-1.2759680106622822e-03 +-1.2070069731085586e-03 +-1.1455311572431807e-03 +-1.0909510364712374e-03 +-1.0426403560718478e-03 +-9.9997828372001916e-04 +-9.6237398997186055e-04 +-9.2927960919228568e-04 +-9.0019577875982964e-04 +-8.7467262181910863e-04 +-8.5230807916795168e-04 +-8.3274482701080484e-04 +-8.1566656375909913e-04 +-8.0079414641936401e-04 +-7.8788185956411936e-04 +-7.7671397217586450e-04 +-7.6710165747107960e-04 +-7.5888030083375187e-04 +-7.5190719158119037e-04 +-7.4605957717095652e-04 +-7.4123305002883383e-04 +-7.3734023337410483e-04 +-7.3430973231100008e-04 +-7.3208531789476416e-04 +-7.3062531506449657e-04 +-7.2990216899971910e-04 +-2.0571877673335529e-03 +-2.0612532080990778e-03 +-2.0694114304713185e-03 +-2.0817153137045485e-03 +-2.0982335738867208e-03 +-2.1190210220454172e-03 +-2.1440493884942909e-03 +-2.1730616012729468e-03 +-2.2052573088235283e-03 +-2.2386518460371977e-03 +-2.2691578909779103e-03 +-2.2901596525345181e-03 +-2.2937082015050537e-03 +-2.2732504305926775e-03 +-2.2261421370722793e-03 +-2.1543198663493898e-03 +-2.0631149218642416e-03 +-1.9593176090049805e-03 +-1.8495244509946715e-03 +-1.7391848803174105e-03 +-1.6322840261902348e-03 +-1.5314234966074388e-03 +-1.4380801432496498e-03 +-1.3529017809141698e-03 +-1.2759703882378568e-03 +-1.2070091318059401e-03 +-1.1455330536489169e-03 +-1.0909526629291966e-03 +-1.0426417251316654e-03 +-9.9997941831412034e-04 +-9.6237491739458358e-04 +-9.2928035754243988e-04 +-9.0019637494661946e-04 +-8.7467309053867548e-04 +-8.5230844246766643e-04 +-8.3274510419688178e-04 +-8.1566677149452229e-04 +-8.0079429891742799e-04 +-7.8788196882106703e-04 +-7.7671404820976394e-04 +-7.6710170854977079e-04 +-7.5888033368397734e-04 +-7.5190721157739472e-04 +-7.4605958850552478e-04 +-7.4123305586790481e-04 +-7.3734023600362144e-04 +-7.3430973327810809e-04 +-7.3208531814858359e-04 +-7.3062531510026711e-04 +-7.2990216900941361e-04 +-2.0571877672736741e-03 +-2.0612532076205660e-03 +-2.0694114285390863e-03 +-2.0817153038325932e-03 +-2.0982335308527959e-03 +-2.1190208759199174e-03 +-2.1440489825991483e-03 +-2.1730606377425542e-03 +-2.2052553122884327e-03 +-2.2386482198451180e-03 +-2.2691521281389079e-03 +-2.2901516224634994e-03 +-2.2936982974408999e-03 +-2.2732394495534373e-03 +-2.2261309911146901e-03 +-2.1543093206705041e-03 +-2.0631054697322565e-03 +-1.9593094739435248e-03 +-1.8495176545948544e-03 +-1.7391793220235534e-03 +-1.6322795478590545e-03 +-1.5314199251384292e-03 +-1.4380773144603151e-03 +-1.3528995504818665e-03 +-1.2759686349026308e-03 +-1.2070077565072251e-03 +-1.1455319768685051e-03 +-1.0909518215079675e-03 +-1.0426410691941970e-03 +-9.9997890857065437e-04 +-9.6237452289626773e-04 +-9.2928005387253240e-04 +-9.0019614279212169e-04 +-8.7467291457677049e-04 +-8.5230831050440103e-04 +-8.3274500650376332e-04 +-8.1566670029819036e-04 +-8.0079424800648044e-04 +-7.8788193324183888e-04 +-7.7671402402919581e-04 +-7.6710169266862532e-04 +-7.5888032368767028e-04 +-7.5190720561488049e-04 +-7.4605958518910711e-04 +-7.4123305418872772e-04 +-7.3734023525900830e-04 +-7.3430973300795158e-04 +-7.3208531807872530e-04 +-7.3062531509126010e-04 +-7.2990216900932058e-04 +-2.0571887354973980e-03 +-2.0612542041132101e-03 +-2.0694126130475243e-03 +-2.0817170822703579e-03 +-2.0982366366677908e-03 +-2.1190263978529099e-03 +-2.1440582843955530e-03 +-2.1730749879189217e-03 +-2.2052749009960270e-03 +-2.2386706527773963e-03 +-2.2691717187934388e-03 +-2.2901610824460719e-03 +-2.2936921829750465e-03 +-2.2732166330643854e-03 +-2.2260945039729745e-03 +-2.1542643786523672e-03 +-2.0630573812201024e-03 +-1.9592623978425877e-03 +-1.8494742508050974e-03 +-1.7391409355568719e-03 +-1.6322465812539609e-03 +-1.5313921999988288e-03 +-1.4380543469970427e-03 +-1.3528807338538508e-03 +-1.2759533472002863e-03 +-1.2069954175754230e-03 +-1.1455220732185206e-03 +-1.0909439129160160e-03 +-1.0426347857196798e-03 +-9.9997394322490544e-04 +-9.6237062289855049e-04 +-9.2927701202308538e-04 +-9.0019378967073785e-04 +-8.7467111182148245e-04 +-8.5230694518777879e-04 +-8.3274398651323009e-04 +-8.1566595058318219e-04 +-8.0079370754835156e-04 +-7.8788155261173636e-04 +-7.7671376341626418e-04 +-7.6710152027896202e-04 +-7.5888021443241581e-04 +-7.5190714002113456e-04 +-7.4605954848110253e-04 +-7.4123303549752885e-04 +-7.3734022692850752e-04 +-7.3430972997189808e-04 +-7.3208531728978228e-04 +-7.3062531498643770e-04 +-7.2990216899877162e-04 +-2.0571951350198884e-03 +-2.0612608121130236e-03 +-2.0694205636594626e-03 +-2.0817293346307186e-03 +-2.0982588231907200e-03 +-2.1190675689101621e-03 +-2.1441312403169461e-03 +-2.1731948654448866e-03 +-2.2054531616663544e-03 +-2.2389035398737403e-03 +-2.2694309303905045e-03 +-2.2903992788652324e-03 +-2.2938634936878464e-03 +-2.2732961857593122e-03 +-2.2260835339967134e-03 +-2.1541822930242604e-03 +-2.0629300764820140e-03 +-1.9591136751462919e-03 +-1.8493219507522147e-03 +-1.7389964840756849e-03 +-1.6321161593891298e-03 +-1.5312783123442545e-03 +-1.4379572032461349e-03 +-1.3527992680505820e-03 +-1.2758858921449560e-03 +-1.2069401147400038e-03 +-1.1454771016317429e-03 +-1.0909076032848874e-03 +-1.0426056662410314e-03 +-9.9995074729713053e-04 +-9.6235227732280998e-04 +-9.2926261660517342e-04 +-9.0018259430226454e-04 +-8.7466249420988917e-04 +-8.5230039070543909e-04 +-8.3273907069277865e-04 +-8.1566232428136249e-04 +-8.0079108456046098e-04 +-7.8787969941660212e-04 +-7.7671249071276603e-04 +-7.6710067598959920e-04 +-7.5887967788615266e-04 +-7.5190681706541174e-04 +-7.4605936731459137e-04 +-7.4123294304983991e-04 +-7.3734018564738533e-04 +-7.3430971490505599e-04 +-7.3208531337433044e-04 +-7.3062531447736813e-04 +-7.2990216898501852e-04 +-2.0572136877874529e-03 +-2.0612800774015287e-03 +-2.0694443244041101e-03 +-2.0817674930870482e-03 +-2.0983304073959458e-03 +-2.1192035606561943e-03 +-2.1443761819325046e-03 +-2.1736027609695150e-03 +-2.2060680907084814e-03 +-2.2397212954279799e-03 +-2.2703660650540002e-03 +-2.2912991802204767e-03 +-2.2945728245734698e-03 +-2.2737219639582182e-03 +-2.2262160214331162e-03 +-2.1540731845532987e-03 +-2.0626564090133717e-03 +-1.9587498176898981e-03 +-1.8489259320329647e-03 +-1.7386072561115296e-03 +-1.6317564063810526e-03 +-1.5309589118222753e-03 +-1.4376813742402780e-03 +-1.3525657385983433e-03 +-1.2756910598069940e-03 +-1.2067794045122909e-03 +-1.1453457585120291e-03 +-1.0908011166113755e-03 +-1.0425199681302901e-03 +-9.9988228005972986e-04 +-9.6229798968749600e-04 +-9.2921992485911118e-04 +-9.0014932919195326e-04 +-8.7463684505025366e-04 +-8.5228085251290182e-04 +-8.3272439692801451e-04 +-8.1565148597847082e-04 +-8.0078323568860145e-04 +-7.8787414786310385e-04 +-7.7670867411446160e-04 +-7.6709814160680768e-04 +-7.5887806577117902e-04 +-7.5190584585205797e-04 +-7.4605882205384738e-04 +-7.4123266460177312e-04 +-7.3734006122974237e-04 +-7.3430966947093978e-04 +-7.3208530156423977e-04 +-7.3062531294651283e-04 +-7.2990216896057388e-04 +-2.0572420711519050e-03 +-2.0613102008866903e-03 +-2.0694852294085449e-03 +-2.0818428227580813e-03 +-2.0984856722524839e-03 +-2.1195129250951134e-03 +-2.1449459241273143e-03 +-2.1745606276473632e-03 +-2.2075172769314929e-03 +-2.2416525253300111e-03 +-2.2725834957148402e-03 +-2.2934524553232583e-03 +-2.2963024696594394e-03 +-2.2748076348270371e-03 +-2.2266265158851863e-03 +-2.1539195501187563e-03 +-2.0621109566640369e-03 +-1.9579818939546452e-03 +-1.8480696094958554e-03 +-1.7377539763915532e-03 +-1.6309606183514875e-03 +-1.5302478411292971e-03 +-1.4370643353534996e-03 +-1.3520413541866687e-03 +-1.2752522478277184e-03 +-1.2064165533477178e-03 +-1.1450486090936016e-03 +-1.0905597926408135e-03 +-1.0423254774558116e-03 +-9.9972670499938942e-04 +-9.6217450508140248e-04 +-9.2912272852257983e-04 +-9.0007353428576747e-04 +-8.7457836202871927e-04 +-8.5223627508273819e-04 +-8.3269089876996977e-04 +-8.1562673061892925e-04 +-8.0076529960692872e-04 +-7.8786145574970734e-04 +-7.7669994473065747e-04 +-7.6709234255807049e-04 +-7.5887437558817491e-04 +-7.5190362191079419e-04 +-7.4605757306676142e-04 +-7.4123202658886672e-04 +-7.3733977607352385e-04 +-7.3430956531630347e-04 +-7.3208527448661957e-04 +-7.3062530943866332e-04 +-7.2990216891271784e-04 +-2.0572332401244805e-03 +-2.0613048630991363e-03 +-2.0695012662693274e-03 +-2.0819268926923510e-03 +-2.0987273607136741e-03 +-2.1200571082541516e-03 +-2.1459964119240750e-03 +-2.1763540302891671e-03 +-2.2102320196524384e-03 +-2.2452504118289449e-03 +-2.2766870993642572e-03 +-2.2974135509027170e-03 +-2.2994652897135471e-03 +-2.2767724394754923e-03 +-2.2273380935080816e-03 +-2.1535828855558312e-03 +-2.0610446513950925e-03 +-1.9565005604009465e-03 +-1.8464236714967118e-03 +-1.7361151800746328e-03 +-1.6294318243629305e-03 +-1.5288808399062685e-03 +-1.4358770874911811e-03 +-1.3510314877795819e-03 +-1.2744064555610991e-03 +-1.2057166174506313e-03 +-1.1444749977270938e-03 +-1.0900936441613138e-03 +-1.0419495770891806e-03 +-9.9942586483691819e-04 +-9.6193561107624443e-04 +-9.2893461638486705e-04 +-8.9992678957879504e-04 +-8.7446509808747613e-04 +-8.5214991701241074e-04 +-8.3262598694960638e-04 +-8.1557874866150493e-04 +-8.0073052720689775e-04 +-7.8783684452961940e-04 +-7.7668301424223642e-04 +-7.6708109328579746e-04 +-7.5886721592542802e-04 +-7.5189930632269160e-04 +-7.4605514901891789e-04 +-7.4123078815439662e-04 +-7.3733922249464841e-04 +-7.3430936309847310e-04 +-7.3208522191132454e-04 +-7.3062530262875771e-04 +-7.2990216882482710e-04 +-2.0570065261444766e-03 +-2.0610841870780830e-03 +-2.0693175203207099e-03 +-2.0818604983146986e-03 +-2.0989315395601878e-03 +-2.1207750084747618e-03 +-2.1475573515452803e-03 +-2.1791150854424037e-03 +-2.2144231758043833e-03 +-2.2507430517556912e-03 +-2.2828456710270685e-03 +-2.3032307186507919e-03 +-2.3039586741786418e-03 +-2.2793630592585373e-03 +-2.2279702177583085e-03 +-2.1525931280218205e-03 +-2.0589400400473409e-03 +-1.9537792777210884e-03 +-1.8434820477447630e-03 +-1.7332247042707914e-03 +-1.6267541623219901e-03 +-1.5264958517892356e-03 +-1.4338102655832555e-03 +-1.3492756276378165e-03 +-1.2729368472389679e-03 +-1.2045008343534618e-03 +-1.1434787573145892e-03 +-1.0892840420669854e-03 +-1.0412966705702221e-03 +-9.9890327490549007e-04 +-9.6152057586328631e-04 +-9.2860776275047185e-04 +-8.9967178082700201e-04 +-8.7426824684008113e-04 +-8.5199981024776448e-04 +-8.3251314548454531e-04 +-8.1549532921157397e-04 +-8.0067006756937844e-04 +-7.8779404855950958e-04 +-7.7665357167432418e-04 +-7.6706152896064534e-04 +-7.5885476317941603e-04 +-7.5189179973608018e-04 +-7.4605093233200473e-04 +-7.4122863374492158e-04 +-7.3733825942687791e-04 +-7.3430901128278920e-04 +-7.3208513043884044e-04 +-7.3062529078136128e-04 +-7.2990216867525534e-04 +-2.0560417248730377e-03 +-2.0601281436175528e-03 +-2.0684165477674690e-03 +-2.0811351503727351e-03 +-2.0986084189681415e-03 +-2.1212021676662537e-03 +-2.1491775506557011e-03 +-2.1823551863892838e-03 +-2.2194721630543011e-03 +-2.2572850877596376e-03 +-2.2899506333771392e-03 +-2.3095883464123146e-03 +-2.3083750853701269e-03 +-2.2811919678305021e-03 +-2.2272273455524348e-03 +-2.1497783722674397e-03 +-2.0547559525874930e-03 +-1.9489039793535901e-03 +-1.8384503998365653e-03 +-1.7283991405820005e-03 +-1.6223454665515245e-03 +-1.5226016269067751e-03 +-1.4304529365208808e-03 +-1.3464327237574733e-03 +-1.2705623759722037e-03 +-1.2025391057508739e-03 +-1.1418726543638235e-03 +-1.0879795453044754e-03 +-1.0402450159758575e-03 +-9.9806170223176922e-04 +-9.6085229138002156e-04 +-9.2808150381889804e-04 +-8.9926121205765827e-04 +-8.7395131731720786e-04 +-8.5175813972826150e-04 +-8.3233147108086622e-04 +-8.1536102328692796e-04 +-8.0057272640596787e-04 +-7.8772514576199446e-04 +-7.7660616796818656e-04 +-7.6703002945704719e-04 +-7.5883471357282171e-04 +-7.5187971367341767e-04 +-7.4604414318563323e-04 +-7.4122516499161096e-04 +-7.3733670881413597e-04 +-7.3430844483125953e-04 +-7.3208498316063909e-04 +-7.3062527170679730e-04 +-7.2990216843686747e-04 +-2.0529856109088754e-03 +-2.0570809040340696e-03 +-2.0654334376166532e-03 +-2.0783620223185496e-03 +-2.0963152185974440e-03 +-2.1197850249811360e-03 +-2.1490948747322778e-03 +-2.1839632507103268e-03 +-2.2227731297931627e-03 +-2.2617080137632022e-03 +-2.2943633018124398e-03 +-2.3126333225343279e-03 +-2.3089679114528172e-03 +-2.2788787395010635e-03 +-2.2222264461971356e-03 +-2.1427662064974953e-03 +-2.0465746709754156e-03 +-1.9403324448871034e-03 +-1.8300862166593015e-03 +-1.7206331917177216e-03 +-1.6153891713128012e-03 +-1.5165332745661654e-03 +-1.4252632875582111e-03 +-1.3420615466370276e-03 +-1.2669243603739444e-03 +-1.1995406255757694e-03 +-1.1394217073788827e-03 +-1.0859910471831291e-03 +-1.0386431455828155e-03 +-9.9678049454131768e-04 +-9.5983526665089703e-04 +-9.2728082576090383e-04 +-8.9863666753053938e-04 +-8.7346928128774612e-04 +-8.5139060961878573e-04 +-8.3205520740098663e-04 +-8.1515680660072256e-04 +-8.0042472637783190e-04 +-7.8762039110425992e-04 +-7.7653410346461313e-04 +-7.6698214588037964e-04 +-7.5880423716957149e-04 +-7.5186134325294673e-04 +-7.4603382442349378e-04 +-7.4121989310408363e-04 +-7.3733435225173383e-04 +-7.3430758398815158e-04 +-7.3208475934600841e-04 +-7.3062524272079685e-04 +-7.2990216807644647e-04 +-2.0445811336284071e-03 +-2.0486759802069900e-03 +-2.0570669100882987e-03 +-2.0701481353187111e-03 +-2.0884650098087301e-03 +-2.1125880200164012e-03 +-2.1428287012927516e-03 +-2.1787201305810064e-03 +-2.2182622189047163e-03 +-2.2571778061693335e-03 +-2.2887750808355850e-03 +-2.3050418273447542e-03 +-2.2988837845678641e-03 +-2.2664078341142102e-03 +-2.2079623550468473e-03 +-2.1275528235774445e-03 +-2.0312704551712058e-03 +-1.9256510283204506e-03 +-1.8165273009019846e-03 +-1.7084823837974978e-03 +-1.6047557398917451e-03 +-1.5074002241387988e-03 +-1.4175342696984418e-03 +-1.3355979181206810e-03 +-1.2615712507164415e-03 +-1.1951435475243001e-03 +-1.1358360651124286e-03 +-1.0830867840014198e-03 +-1.0363063126247901e-03 +-9.9491301747421049e-04 +-9.5835376152317764e-04 +-9.2611499802728041e-04 +-8.9772760945478641e-04 +-8.7276784020459588e-04 +-8.5085591075411402e-04 +-8.3165336225946571e-04 +-8.1485980837228363e-04 +-8.0020951852291782e-04 +-7.8746808846621248e-04 +-7.7642934326679122e-04 +-7.6691254655879488e-04 +-7.5875994485000695e-04 +-7.5183464804717565e-04 +-7.4601883119898929e-04 +-7.4121223376364016e-04 +-7.3733092877533465e-04 +-7.3430633349411188e-04 +-7.3208443424216537e-04 +-7.3062520061898751e-04 +-7.2990216755441234e-04 +-2.0242499165478152e-03 +-2.0283158218012457e-03 +-2.0366575190432080e-03 +-2.0496839648883043e-03 +-2.0679503722052513e-03 +-2.0920049412808846e-03 +-2.1220632177055667e-03 +-2.1574630150514775e-03 +-2.1959602713697559e-03 +-2.2331458671747736e-03 +-2.2624940696170420e-03 +-2.2764837871741606e-03 +-2.2686274731749285e-03 +-2.2354693524458892e-03 +-2.1774847132773880e-03 +-2.0985430019125292e-03 +-2.0044658294452330e-03 +-1.9014957770322450e-03 +-1.7952091845956665e-03 +-1.6899919829779597e-03 +-1.5889475664980605e-03 +-1.4940461541154779e-03 +-1.4063656058194496e-03 +-1.3263356398526722e-03 +-1.2539458181752971e-03 +-1.1889064338678648e-03 +-1.1307653019466994e-03 +-1.0789885170250373e-03 +-1.0330139224849397e-03 +-9.9228491680443875e-04 +-9.5627060641629636e-04 +-9.2447677101815842e-04 +-8.9645083441506127e-04 +-8.7178306015158868e-04 +-8.5010547915065284e-04 +-8.3108955142491704e-04 +-8.1444321340898881e-04 +-7.9990772342286500e-04 +-7.8725455727361466e-04 +-7.7628249979096154e-04 +-7.6681500897630755e-04 +-7.5869788532385168e-04 +-7.5179725150429689e-04 +-7.4599783128631700e-04 +-7.4120150757611063e-04 +-7.3732613517828215e-04 +-7.3430458273714572e-04 +-7.3208397912057619e-04 +-7.3062514168350157e-04 +-7.2990216682484663e-04 +-1.9822071560064995e-03 +-1.9861909039503027e-03 +-1.9943341754337556e-03 +-2.0069773559505733e-03 +-2.0245723804728946e-03 +-2.0475320268058231e-03 +-2.0759196453041095e-03 +-2.1089545090640718e-03 +-2.1444159426751387e-03 +-2.1782035950279818e-03 +-2.2044520120655352e-03 +-2.2165016337082691e-03 +-2.2085762961047964e-03 +-2.1774621825632642e-03 +-2.1233524148565781e-03 +-2.0495140537544216e-03 +-1.9611169361234758e-03 +-1.8638793792095142e-03 +-1.7630332502552729e-03 +-1.6627760807627772e-03 +-1.5661322706167597e-03 +-1.4750607721763739e-03 +-1.3906665475294576e-03 +-1.3134261121362952e-03 +-1.2433841242455866e-03 +-1.1803074581850730e-03 +-1.1237980498610552e-03 +-1.0733715383281506e-03 +-1.0285097940694629e-03 +-9.8869452491940637e-04 +-9.5342767108693100e-04 +-9.2224285185937512e-04 +-8.9471092247490295e-04 +-8.7044177576032968e-04 +-8.4908384624837307e-04 +-8.3032229306826777e-04 +-8.1387650258715576e-04 +-7.9949732192320590e-04 +-7.8696427904187145e-04 +-7.7608294142482177e-04 +-7.6668249707061880e-04 +-7.5861359746145368e-04 +-7.5174647428637479e-04 +-7.4596932474416339e-04 +-7.4118695055233575e-04 +-7.3731963086636149e-04 +-7.3430220757799412e-04 +-7.3208336176203235e-04 +-7.3062506174678612e-04 +-7.2990216583633896e-04 +-1.9092041540524694e-03 +-1.9130340908131939e-03 +-1.9208052062391076e-03 +-1.9327306276594187e-03 +-1.9490820618014478e-03 +-1.9700684087562712e-03 +-1.9955890165741937e-03 +-2.0248467571458754e-03 +-2.0558912485779414e-03 +-2.0852879346539782e-03 +-2.1081993814608280e-03 +-2.1190944850781328e-03 +-2.1130031696889838e-03 +-2.0868536529017401e-03 +-2.0402834876785572e-03 +-1.9755800143524543e-03 +-1.8968824095034061e-03 +-1.8090932064333790e-03 +-1.7169339817007156e-03 +-1.6243618617322207e-03 +-1.5343468802702868e-03 +-1.4488997721545677e-03 +-1.3692267040527311e-03 +-1.2959209972602677e-03 +-1.2291420993659850e-03 +-1.1687617036148039e-03 +-1.1144738063951828e-03 +-1.0658731015905794e-03 +-1.0225084081323303e-03 +-9.8391762114364450e-04 +-9.4964955759601016e-04 +-9.1927679826814181e-04 +-8.9240251294154193e-04 +-8.6866337690905246e-04 +-8.4773003312897948e-04 +-8.2930608476558163e-04 +-8.1312627316772982e-04 +-7.9895426859419901e-04 +-7.8658034567277908e-04 +-7.7581911085523880e-04 +-7.6650737935840573e-04 +-7.5850225325147544e-04 +-7.5167942282786072e-04 +-7.4593169491483826e-04 +-7.4116774074721632e-04 +-7.3731104999449177e-04 +-7.3429907485351813e-04 +-7.3208254764161023e-04 +-7.3062495634625829e-04 +-7.2990216453382270e-04 +-1.8021232219798680e-03 +-1.8057262296491087e-03 +-1.8129748032582481e-03 +-1.8239473898532743e-03 +-1.8387284864446278e-03 +-1.8573259876384848e-03 +-1.8795037398179422e-03 +-1.9045182380476732e-03 +-1.9308032830796791e-03 +-1.9557273888567753e-03 +-1.9756110134230946e-03 +-1.9861598212814590e-03 +-1.9833009273758318e-03 +-1.9641661701984094e-03 +-1.9278229949356439e-03 +-1.8754475579340953e-03 +-1.8099153230801081e-03 +-1.7350468839111236e-03 +-1.6548287192586517e-03 +-1.5728351210759089e-03 +-1.4919233890665223e-03 +-1.4141601868679335e-03 +-1.3408929031137162e-03 +-1.2728861773996880e-03 +-1.2104698810408503e-03 +-1.1536706137121207e-03 +-1.1023166371551196e-03 +-1.0561159969365321e-03 +-1.0147118156875955e-03 +-9.7771982677811249e-04 +-9.4475284554543975e-04 +-9.1543599913982505e-04 +-8.8941561230464639e-04 +-8.6636385327714522e-04 +-8.4598062445376894e-04 +-8.2799372329690995e-04 +-8.1215796940862410e-04 +-7.9825376209355099e-04 +-7.8608537236100808e-04 +-7.7547916355628476e-04 +-7.6628186048713061e-04 +-7.5835893716683588e-04 +-7.5159316049630684e-04 +-7.4588330603696218e-04 +-7.4114304881838747e-04 +-7.3730002433774545e-04 +-7.3429505081435028e-04 +-7.3208150213928912e-04 +-7.3062482101215716e-04 +-7.2990216286223741e-04 +-1.6665484406729136e-03 +-1.6698679702040378e-03 +-1.6764972077856321e-03 +-1.6864122530195517e-03 +-1.6995570059732167e-03 +-1.7157938070287257e-03 +-1.7348035841801852e-03 +-1.7559271340412954e-03 +-1.7779691538638614e-03 +-1.7990330311974223e-03 +-1.8164954928280887e-03 +-1.8272266232728332e-03 +-1.8280811614791151e-03 +-1.8165494389852613e-03 +-1.7913416947343420e-03 +-1.7526785776006990e-03 +-1.7021890968912181e-03 +-1.6424915450608544e-03 +-1.5766426958585108e-03 +-1.5076394093408107e-03 +-1.4380795852185989e-03 +-1.3700012270728415e-03 +-1.3048618706822544e-03 +-1.2436027651898222e-03 +-1.1867494464944700e-03 +-1.1345166653878062e-03 +-1.0869009729777531e-03 +-1.0437549212478736e-03 +-1.0048428271890698e-03 +-9.6988072209800444e-04 +-9.3856385003347948e-04 +-9.1058488432226579e-04 +-8.8564548481123110e-04 +-8.6346321780371188e-04 +-8.4377533025405799e-04 +-8.2634044628550004e-04 +-8.1093893432109237e-04 +-7.9737245983442409e-04 +-7.8546307233983543e-04 +-7.7505205844143087e-04 +-7.6599871177740985e-04 +-7.5817911518086571e-04 +-7.5148499279066279e-04 +-7.4582266479831865e-04 +-7.4111212120725489e-04 +-7.3728622072895093e-04 +-7.3429001487907992e-04 +-7.3208019413179947e-04 +-7.3062465173403222e-04 +-7.2990216077218760e-04 +-1.5143563290070882e-03 +-1.5173626663506816e-03 +-1.5233357183754455e-03 +-1.5321936811635488e-03 +-1.5438024503699607e-03 +-1.5579488159829075e-03 +-1.5742865348502696e-03 +-1.5922496861368498e-03 +-1.6109421175468847e-03 +-1.6290355068970034e-03 +-1.6447328606525836e-03 +-1.6558608974213656e-03 +-1.6601250239737897e-03 +-1.6554938303616035e-03 +-1.6406063477869689e-03 +-1.6150627822975132e-03 +-1.5794969215462652e-03 +-1.5354174054578588e-03 +-1.4848921259638702e-03 +-1.4301893261087619e-03 +-1.3734727225655861e-03 +-1.3166010416481766e-03 +-1.2610359343618804e-03 +-1.2078340306193929e-03 +-1.1576904523795111e-03 +-1.1110053618045002e-03 +-1.0679541594895781e-03 +-1.0285506673504258e-03 +-9.9269896747581775e-04 +-9.6023335997707506e-04 +-9.3094776442439217e-04 +-9.0461654460065441e-04 +-8.8100874992533393e-04 +-8.5989750065259131e-04 +-8.4106589809868364e-04 +-8.2431051141123820e-04 +-8.0944321528548255e-04 +-7.9629193544501157e-04 +-7.8470069476939896e-04 +-7.7452923275301059e-04 +-7.6565238452244147e-04 +-7.5795934437458798e-04 +-7.5135289595483273e-04 +-7.4574866164706240e-04 +-7.4107440371060356e-04 +-7.3726939641346990e-04 +-7.3428387989200319e-04 +-7.3207860126710560e-04 +-7.3062444564455699e-04 +-7.2990215822846564e-04 +-1.3589604341685177e-03 +-1.3616512361415891e-03 +-1.3669820935398977e-03 +-1.3748500004825905e-03 +-1.3850942821928712e-03 +-1.3974829044126594e-03 +-1.4116853411852012e-03 +-1.4272287686948324e-03 +-1.4434406391280073e-03 +-1.4593917144741485e-03 +-1.4738664212275998e-03 +-1.4853944802395238e-03 +-1.4923697628536584e-03 +-1.4932548453293496e-03 +-1.4868308510013297e-03 +-1.4724221204887528e-03 +-1.4500243248732456e-03 +-1.4202970946317261e-03 +-1.3844312329981602e-03 +-1.3439401181718400e-03 +-1.3004380304097183e-03 +-1.2554556265745372e-03 +-1.2103176617927209e-03 +-1.1660843660030804e-03 +-1.1235432838566984e-03 +-1.0832335301535234e-03 +-1.0454861191149252e-03 +-1.0104685540731095e-03 +-9.7822660049093455e-04 +-9.4871987659464940e-04 +-9.2185031770540820e-04 +-8.9748390979968277e-04 +-8.7546668303035437e-04 +-8.5563610951336355e-04 +-8.3782897751629739e-04 +-8.2188664964403006e-04 +-8.0765842855829004e-04 +-7.9500358471997672e-04 +-7.8379245939856168e-04 +-7.7390694450963271e-04 +-7.6524055562300001e-04 +-7.5769825106598192e-04 +-7.5119610374386060e-04 +-7.4566089903538172e-04 +-7.4102970859483714e-04 +-7.3724947352871520e-04 +-7.3427661926385966e-04 +-7.3207671700750861e-04 +-7.3062420193042120e-04 +-7.2990215522122730e-04 +-1.2115524961074857e-03 +-1.2139469397814476e-03 +-1.2186855039683600e-03 +-1.2256666328371206e-03 +-1.2347346643864310e-03 +-1.2456730413718785e-03 +-1.2581912579372324e-03 +-1.2719039109277243e-03 +-1.2863027962535566e-03 +-1.3007277627814543e-03 +-1.3143481391436828e-03 +-1.3261712574922592e-03 +-1.3350938055643614e-03 +-1.3400022136219980e-03 +-1.3399109436674696e-03 +-1.3341091166213397e-03 +-1.3222763004381284e-03 +-1.3045342806201515e-03 +-1.2814215886139395e-03 +-1.2538018876143253e-03 +-1.2227347732543801e-03 +-1.1893420744993287e-03 +-1.1546957068731493e-03 +-1.1197405492965121e-03 +-1.0852538668929821e-03 +-1.0518349917625687e-03 +-1.0199158326894817e-03 +-9.8978306334629429e-04 +-9.6160485162487676e-04 +-9.3545741864402494e-04 +-9.1134881703931368e-04 +-8.8923883293619396e-04 +-8.6905486106424092e-04 +-8.5070410806713269e-04 +-8.3408269180524513e-04 +-8.1908224467835912e-04 +-8.0559458069939718e-04 +-7.9351490142546221e-04 +-7.8274392407702315e-04 +-7.7318923061924058e-04 +-7.6476606492125289e-04 +-7.5739774740181279e-04 +-7.5101583166921392e-04 +-7.4556009359819802e-04 +-7.4097841795722199e-04 +-7.3722662918767419e-04 +-7.3426829962986676e-04 +-7.3207455907030772e-04 +-7.3062392292103095e-04 +-7.2990215177946621e-04 +-1.0795761618685666e-03 +-1.0817070984745140e-03 +-1.0859244927786563e-03 +-1.0921388206215127e-03 +-1.1002139462659320e-03 +-1.1099637504818529e-03 +-1.1211459710491782e-03 +-1.1334525371732623e-03 +-1.1464966938405999e-03 +-1.1597991810085944e-03 +-1.1727784474859270e-03 +-1.1847524247609342e-03 +-1.1949601500284583e-03 +-1.2026088291104049e-03 +-1.2069452178533069e-03 +-1.2073411370557071e-03 +-1.2033752928787061e-03 +-1.1948914408959090e-03 +-1.1820181399327010e-03 +-1.1651460276576665e-03 +-1.1448701137360042e-03 +-1.1219123966646749e-03 +-1.0970419326626871e-03 +-1.0710060808901164e-03 +-1.0444806087436607e-03 +-1.0180403620254571e-03 +-9.9214795824978624e-04 +-9.6715588121918338e-04 +-9.4331703686679222e-04 +-9.2079956366174318e-04 +-8.9970283211935449e-04 +-8.8007269366301556e-04 +-8.6191494485801114e-04 +-8.4520660748431994e-04 +-8.2990501805627189e-04 +-8.1595493181805460e-04 +-8.0329393602822689e-04 +-7.9185648387651185e-04 +-7.8157683784403523e-04 +-7.7239117164337181e-04 +-7.6423903588187841e-04 +-7.5706435103455646e-04 +-7.5081605519164386e-04 +-7.4544850422355506e-04 +-7.4092169823602820e-04 +-7.3720138972374432e-04 +-7.3425911477553946e-04 +-7.3207217814684228e-04 +-7.3062361520858082e-04 +-7.2990214798469258e-04 +-9.6691800584467857e-04 +-9.6882503441991330e-04 +-9.7260196691958587e-04 +-9.7817418683719681e-04 +-9.8542868879887839e-04 +-9.9421234977017893e-04 +-1.0043290012128640e-03 +-1.0155350380751621e-03 +-1.0275336980717750e-03 +-1.0399689367753941e-03 +-1.0524209776354289e-03 +-1.0644068436510216e-03 +-1.0753898918071686e-03 +-1.0848018330394779e-03 +-1.0920784227423644e-03 +-1.0967061550827648e-03 +-1.0982730420226049e-03 +-1.0965136775087550e-03 +-1.0913387998397748e-03 +-1.0828428222985781e-03 +-1.0712881746534567e-03 +-1.0570707413607027e-03 +-1.0406743028958296e-03 +-1.0226228031060879e-03 +-1.0034377898015512e-03 +-9.8360557350161341e-04 +-9.6355569031384260e-04 +-9.4364994802115406e-04 +-9.2417998920394208e-04 +-9.0537084210336465e-04 +-8.8738807845554699e-04 +-8.7034666303942548e-04 +-8.5432013417307271e-04 +-8.3934926064140286e-04 +-8.2544971816441500e-04 +-8.1261860746910375e-04 +-8.0083981219026808e-04 +-7.9008829310398107e-04 +-7.8033346006299922e-04 +-7.7154177442274061e-04 +-7.6367872725742524e-04 +-7.5671032199075173e-04 +-7.5060417020902991e-04 +-7.4533028978766359e-04 +-7.4086167674909990e-04 +-7.3717470714598451e-04 +-7.3424941281211432e-04 +-7.3206966481535426e-04 +-7.3062329052980563e-04 +-7.2990214398181491e-04 +-8.7486270329201221e-04 +-8.7658729371296363e-04 +-8.8000619998518761e-04 +-8.8505862532302978e-04 +-8.9165270404652837e-04 +-8.9966456142181669e-04 +-9.0893686967325014e-04 +-9.1927683692053441e-04 +-9.3045372570923991e-04 +-9.4219631560211884e-04 +-9.5419120324097338e-04 +-9.6608338808018026e-04 +-9.7748101881079482e-04 +-9.8796617837286884e-04 +-9.9711288784611616e-04 +-1.0045120313658239e-03 +-1.0098009149922783e-03 +-1.0126932943536737e-03 +-1.0130046974066158e-03 +-1.0106682620800226e-03 +-1.0057381063234190e-03 +-9.9837988088809920e-04 +-9.8885074326977157e-04 +-9.7747275009578763e-04 +-9.6460421691408531e-04 +-9.5061303637410544e-04 +-9.3585469791506067e-04 +-9.2065631525372238e-04 +-9.0530673180596222e-04 +-8.9005193610902774e-04 +-8.7509460235993557e-04 +-8.6059649083288111e-04 +-8.4668257665919953e-04 +-8.3344601040505426e-04 +-8.2095326861997666e-04 +-8.0924907972576066e-04 +-7.9836089005824870e-04 +-7.8830276387173502e-04 +-7.7907869612871890e-04 +-7.7068536774897787e-04 +-7.6311439949516369e-04 +-7.5635417109154457e-04 +-7.5039127276757480e-04 +-7.4521165157775851e-04 +-7.4080150745306343e-04 +-7.3714798574590901e-04 +-7.3423970503783218e-04 +-7.3206715167064781e-04 +-7.3062296602622939e-04 +-7.2990213998219082e-04 +-8.0313980146509321e-04 +-8.0472246562105811e-04 +-8.0786305281735967e-04 +-8.1251190698861857e-04 +-8.1859410064399245e-04 +-8.2600888083181909e-04 +-8.3462890597063273e-04 +-8.4429928821710878e-04 +-8.5483652467326901e-04 +-8.6602753115569051e-04 +-8.7762919097822704e-04 +-8.8936907439911999e-04 +-9.0094820330109465e-04 +-9.1204681783258119e-04 +-9.2233392033612698e-04 +-9.3148084458610618e-04 +-9.3917825535840276e-04 +-9.4515500512162419e-04 +-9.4919646043448939e-04 +-9.5115957136340887e-04 +-9.5098227570025197e-04 +-9.4868576352212920e-04 +-9.4436941399974890e-04 +-9.3819948071322793e-04 +-9.3039350974615171e-04 +-9.2120284926903084e-04 +-9.1089546246539736e-04 +-8.9974074121872800e-04 +-8.8799734430043784e-04 +-8.7590443513876795e-04 +-8.6367618731107286e-04 +-8.5149910387896926e-04 +-8.3953154739170339e-04 +-8.2790485916260951e-04 +-8.1672551028341364e-04 +-8.0607783019140725e-04 +-7.9602697091828655e-04 +-7.8662186814504429e-04 +-7.7789804528928801e-04 +-7.6988017197365376e-04 +-7.6258433492577978e-04 +-7.5602001081752444e-04 +-7.5019175028218088e-04 +-7.4510059355592506e-04 +-7.4074524349535399e-04 +-7.3712302312061578e-04 +-7.3423064377152729e-04 +-7.3206480743421946e-04 +-7.3062266347015620e-04 +-7.2990213625406157e-04 +-7.5076494604910083e-04 +-7.5224399834687814e-04 +-7.5518138737917459e-04 +-7.5953555391072738e-04 +-7.6524384482868442e-04 +-7.7222215349310823e-04 +-7.8036447282418733e-04 +-7.8954240070496873e-04 +-7.9960467019143586e-04 +-8.1037683371499084e-04 +-8.2166131532898136e-04 +-8.3323815207136302e-04 +-8.4486685185928081e-04 +-8.5628985913688900e-04 +-8.6723808658704417e-04 +-8.7743879321680487e-04 +-8.8662574952750759e-04 +-8.9455116786641006e-04 +-9.0099838973983044e-04 +-9.0579394972729497e-04 +-9.0881750730932055e-04 +-9.1000832214617813e-04 +-9.0936742025216153e-04 +-9.0695524464610457e-04 +-9.0288524346872302e-04 +-8.9731436984278744e-04 +-8.9043175585294242e-04 +-8.8244685818849938e-04 +-8.7357820024710033e-04 +-8.6404353601532370e-04 +-8.5405192080398947e-04 +-8.4379786112788826e-04 +-8.3345747132335113e-04 +-8.2318640205153795e-04 +-8.1311922047580510e-04 +-8.0336989784332872e-04 +-7.9403307833135505e-04 +-7.8518584565739468e-04 +-7.7688975716469391e-04 +-7.6919296924626336e-04 +-7.6213232725230208e-04 +-7.5573533457718367e-04 +-7.5002194859328348e-04 +-7.4500617586485099e-04 +-7.4069745664998000e-04 +-7.3710184033338327e-04 +-7.3422296038747319e-04 +-7.3206282085843755e-04 +-7.3062240718139244e-04 +-7.2990213309675036e-04 +-7.1661652908064691e-04 +-7.1802791670015696e-04 +-7.2083255597298035e-04 +-7.2499407387978203e-04 +-7.3045766861583609e-04 +-7.3714984798995342e-04 +-7.4497812957339431e-04 +-7.5383074740603944e-04 +-7.6357642872664985e-04 +-7.7406433202617357e-04 +-7.8512427734086447e-04 +-7.9656745004332919e-04 +-8.0818781285611340e-04 +-8.1976450142830204e-04 +-8.3106548316669174e-04 +-8.4185270141235260e-04 +-8.5188878892255172e-04 +-8.6094521570641920e-04 +-8.6881146294203566e-04 +-8.7530454007953029e-04 +-8.8027795509486415e-04 +-8.8362917239667672e-04 +-8.8530468626208921e-04 +-8.8530209480025090e-04 +-8.8366893197873388e-04 +-8.8049842570667473e-04 +-8.7592271508489018e-04 +-8.7010431406451898e-04 +-8.6322671893721285e-04 +-8.5548502604616361e-04 +-8.4707728464054649e-04 +-8.3819710334196329e-04 +-8.2902780366871142e-04 +-8.1973820787811856e-04 +-8.1047998462252502e-04 +-8.0138636420612366e-04 +-7.9257197414727885e-04 +-7.8413352689431259e-04 +-7.7615110344359136e-04 +-7.6868980770006398e-04 +-7.6180160682254175e-04 +-7.5552721510821789e-04 +-7.4989791831436131e-04 +-7.4493726897409114e-04 +-7.4066261015537111e-04 +-7.3708640524553512e-04 +-7.3421736537468819e-04 +-7.3206137497045670e-04 +-7.3062222071209031e-04 +-7.2990213080002667e-04 +-6.9978952820064059e-04 +-7.0116730880131258e-04 +-7.0390598379819591e-04 +-7.0797169301161907e-04 +-7.1331343819250781e-04 +-7.1986286514687367e-04 +-7.2753402543045088e-04 +-7.3622316227749845e-04 +-7.4580857884229607e-04 +-7.5615066445004883e-04 +-7.6709217819541440e-04 +-7.7845891912220108e-04 +-7.9006094541276227e-04 +-8.0169453397701824e-04 +-8.1314508405551660e-04 +-8.2419114796277652e-04 +-8.3460970336270038e-04 +-8.4418265546224488e-04 +-8.5270437837559358e-04 +-8.5998989457685944e-04 +-8.6588308910474649e-04 +-8.7026421037427382e-04 +-8.7305586822690646e-04 +-8.7422682973186110e-04 +-8.7379313154688188e-04 +-8.7181633895416094e-04 +-8.6839912631039276e-04 +-8.6367866424853302e-04 +-8.5781851915932425e-04 +-8.5099986874393428e-04 +-8.4341281200609960e-04 +-8.3524842664441307e-04 +-8.2669204012284934e-04 +-8.1791797446408335e-04 +-8.0908583406256193e-04 +-8.0033825356681993e-04 +-7.9179991918436039e-04 +-7.8357762093680516e-04 +-7.7576107773445052e-04 +-7.6842429071137292e-04 +-7.6162721185711114e-04 +-7.5541755499353960e-04 +-7.4983261739421710e-04 +-7.4490101815308934e-04 +-7.4064429125287646e-04 +-7.3707829623537028e-04 +-7.3421442758052509e-04 +-7.3206061609954007e-04 +-7.3062212287315620e-04 +-7.2990212959513187e-04 +-6.9978945167056079e-04 +-7.0116661915598194e-04 +-7.0390406368567846e-04 +-7.0796791864895356e-04 +-7.1330718123280995e-04 +-7.1985350053655676e-04 +-7.2752094694564316e-04 +-7.3620580693380241e-04 +-7.4578646051664925e-04 +-7.5612341577185362e-04 +-7.6705959807862694e-04 +-7.7842102137914244e-04 +-7.9001800203718365e-04 +-8.0164710538037083e-04 +-8.1309402832470759e-04 +-8.2413760253335433e-04 +-8.3455503554883531e-04 +-8.4412838280020070e-04 +-8.5265206497780457e-04 +-8.5994103454091724e-04 +-8.6583899126413399e-04 +-8.7022589938291002e-04 +-8.7302401480808143e-04 +-8.7420171830883539e-04 +-8.7377466745706836e-04 +-8.7180409139418161e-04 +-8.6839239833364239e-04 +-8.6367657837422391e-04 +-8.5782010669032218e-04 +-8.5100415241404052e-04 +-8.4341887440756260e-04 +-8.3525546022990391e-04 +-8.2669937773737531e-04 +-8.1792510187102025e-04 +-8.0909238757182931e-04 +-8.0034400665898069e-04 +-7.9180476210308107e-04 +-7.8358153680962159e-04 +-7.7576411809624022e-04 +-7.6842655252764398e-04 +-7.6162881740337337e-04 +-7.5541863531783512e-04 +-7.4983329960396825e-04 +-7.4490141642553345e-04 +-7.4064450125278054e-04 +-7.3707839250796792e-04 +-7.3421446344337869e-04 +-7.3206062555814606e-04 +-7.3062212410965549e-04 +-7.2990212961047355e-04 +-7.1661628752876013e-04 +-7.1802573997899524e-04 +-7.2082649564515723e-04 +-7.2498216177394308e-04 +-7.3043792388340382e-04 +-7.3712030408452976e-04 +-7.4493688670274278e-04 +-7.5377605425173391e-04 +-7.6350679420272047e-04 +-7.7397866334512377e-04 +-7.8502203479734385e-04 +-7.9644880234490617e-04 +-8.0805377075548047e-04 +-8.1961700357026162e-04 +-8.3090740833291238e-04 +-8.4168778715761289e-04 +-8.5172144824108157e-04 +-8.6078025948723021e-04 +-8.6865375352403467e-04 +-8.7515861609412647e-04 +-8.8014767599265656e-04 +-8.8351743005021962e-04 +-8.8521322066808139e-04 +-8.8523143355088269e-04 +-8.8361845298602323e-04 +-8.8046652423990246e-04 +-8.7590704319312203e-04 +-8.7010205476239361e-04 +-8.6323485899102636e-04 +-8.5550059811119689e-04 +-8.4709755939892139e-04 +-8.3821972271711800e-04 +-8.2905085526234100e-04 +-8.1976024741181998e-04 +-8.1050001706676556e-04 +-8.0140379571320801e-04 +-7.9258654646081601e-04 +-7.8414524426716930e-04 +-7.7616015987951883e-04 +-7.6869652001822979e-04 +-7.6180635694197475e-04 +-7.5553040322601174e-04 +-7.4989992735992436e-04 +-7.4493843983961981e-04 +-7.4066322666650915e-04 +-7.3708668756581090e-04 +-7.3421747045248676e-04 +-7.3206140266661034e-04 +-7.3062222433120628e-04 +-7.2990213084488293e-04 +-7.5076450159753565e-04 +-7.5223999323578575e-04 +-7.5517023692901622e-04 +-7.5951363926161366e-04 +-7.6520753031396945e-04 +-7.7216784449004379e-04 +-7.8028872507945228e-04 +-7.8944208812437022e-04 +-7.9947721121798303e-04 +-8.1022046632061218e-04 +-8.2147539779594040e-04 +-8.3302345288227065e-04 +-8.4462578027849622e-04 +-8.5602658256944740e-04 +-8.6695848558386145e-04 +-8.7715022242257855e-04 +-8.8633660204062454e-04 +-8.9427027644304322e-04 +-9.0073433272276366e-04 +-9.0555435317696384e-04 +-9.0860844038950133e-04 +-9.0983386809872320e-04 +-9.0922947389349823e-04 +-9.0685354745708682e-04 +-9.0281762894860629e-04 +-8.9727716322854020e-04 +-8.9042025814068239e-04 +-8.8245584483197411e-04 +-8.7360237670132141e-04 +-8.6407791047828184e-04 +-8.5409207412839297e-04 +-8.4384011115081284e-04 +-8.3349894166285035e-04 +-8.2322501314662519e-04 +-8.1315362379979713e-04 +-8.0339937388832080e-04 +-7.9405741638963049e-04 +-7.8520521973465265e-04 +-7.7690460840695169e-04 +-7.6920390160997124e-04 +-7.6214002009929735e-04 +-7.5574047354025104e-04 +-7.5002517441245104e-04 +-7.4500804984452957e-04 +-7.4069844080732687e-04 +-7.3710229007024994e-04 +-7.3422312750575660e-04 +-7.3206286485475347e-04 +-7.3062241292600827e-04 +-7.2990213316794612e-04 +-8.0313908433372167e-04 +-8.0471600334904741e-04 +-8.0784506249967694e-04 +-8.1247655594491686e-04 +-8.1853554551693155e-04 +-8.2592138156853921e-04 +-8.3450703424502236e-04 +-8.4413824119272825e-04 +-8.5463254032085677e-04 +-8.6577838013715883e-04 +-8.7733469404834930e-04 +-8.8903156798641710e-04 +-9.0057285699683904e-04 +-9.1164170500365044e-04 +-9.2190976441905729e-04 +-9.3105041067223352e-04 +-9.3875542269730120e-04 +-9.4475362580693709e-04 +-9.4882916296428453e-04 +-9.5083668783021134e-04 +-9.5071105062397119e-04 +-9.4846994640062580e-04 +-9.4420926297317438e-04 +-9.3809213204671131e-04 +-9.3033361454265319e-04 +-9.2118335389436206e-04 +-9.1090841211029228e-04 +-8.9977800941668331e-04 +-8.8805122479971026e-04 +-8.7596806685235099e-04 +-8.6374381165958366e-04 +-8.5156617367045605e-04 +-8.3959471724283005e-04 +-8.2796189088608061e-04 +-8.1677512487649754e-04 +-8.0611953325748222e-04 +-7.9606087231092425e-04 +-7.8664851056820006e-04 +-7.7791825123657208e-04 +-7.6989491407008213e-04 +-7.6259463150690570e-04 +-7.5602684634791127e-04 +-7.5019601880828811e-04 +-7.4510306261763742e-04 +-7.4074653560607818e-04 +-7.3712361191404830e-04 +-7.3423086207994887e-04 +-7.3206486481381739e-04 +-7.3062267095419032e-04 +-7.2990213634674308e-04 +-8.7486160206675875e-04 +-8.7657737037840429e-04 +-8.7997857659420620e-04 +-8.8500435915224798e-04 +-8.9156287159749918e-04 +-8.9953047796125082e-04 +-9.0875047773770297e-04 +-9.1903127847989068e-04 +-9.3014408133805743e-04 +-9.4182044992696136e-04 +-9.5375060437533630e-04 +-9.6558384191311572e-04 +-9.7693293491399650e-04 +-9.8738440172580454e-04 +-9.9651590042504519e-04 +-1.0039205639139198e-03 +-1.0092361254360341e-03 +-1.0121747843359638e-03 +-1.0125486922272018e-03 +-1.0102862508068191e-03 +-1.0054361361005256e-03 +-9.9815855656763168e-04 +-9.8870584509488067e-04 +-9.7739628511659565e-04 +-9.6458568111700601e-04 +-9.5064067991755638e-04 +-9.3591663713642821e-04 +-9.2074140007259906e-04 +-9.0540513766939256e-04 +-8.9015549522774770e-04 +-8.7519691659372167e-04 +-8.6069288019729898e-04 +-8.4676991742697156e-04 +-8.3352250986462638e-04 +-8.2101821360387706e-04 +-8.0930258568727453e-04 +-7.9840366827342764e-04 +-7.8833591693182195e-04 +-7.7910354637048158e-04 +-7.7070331945270048e-04 +-7.6312683324364187e-04 +-7.5636236729103115e-04 +-7.5039636068074359e-04 +-7.4521458006233964e-04 +-7.4080303374838186e-04 +-7.3714867896444030e-04 +-7.3423996140250213e-04 +-7.3206721892462093e-04 +-7.3062297478714553e-04 +-7.2990214009063283e-04 +-9.6691635541423717e-04 +-9.6881016233377312e-04 +-9.7256057217381985e-04 +-9.7809289481948572e-04 +-9.8529422532240185e-04 +-9.9401195903385986e-04 +-1.0040511631600843e-03 +-1.0151704998006355e-03 +-1.0270767668445423e-03 +-1.0394188911866816e-03 +-1.0517833541069214e-03 +-1.0636942795171096e-03 +-1.0746221947681249e-03 +-1.0840050349294683e-03 +-1.0912827692200447e-03 +-1.0959432423334368e-03 +-1.0975725556700508e-03 +-1.0959003255704765e-03 +-1.0908300020533103e-03 +-1.0824475291619329e-03 +-1.0710069111087969e-03 +-1.0568967005033293e-03 +-1.0405951351211112e-03 +-1.0226226890411108e-03 +-1.0034994356175877e-03 +-9.8371188020481720e-04 +-9.6369097601806174e-04 +-9.4380070924340420e-04 +-9.2433525810167239e-04 +-9.0552223104667547e-04 +-8.8752960979702588e-04 +-8.7047447122566189e-04 +-8.5443210883469768e-04 +-8.3944467949387226e-04 +-8.2552890106596388e-04 +-8.1268260927044454e-04 +-8.0089016219356333e-04 +-7.9012678248240010e-04 +-7.8036197470949587e-04 +-7.7156216865095653e-04 +-7.6369273294923001e-04 +-7.5671948770716739e-04 +-7.5060982512629732e-04 +-7.4533352787061261e-04 +-7.4086335719304470e-04 +-7.3717546772486271e-04 +-7.3424969331946485e-04 +-7.3206973825361223e-04 +-7.3062330008343674e-04 +-7.2990214409998069e-04 +-1.0795737334898595e-03 +-1.0816852167167634e-03 +-1.0858635958509405e-03 +-1.0920192835267521e-03 +-1.1000164290949693e-03 +-1.1096699825397830e-03 +-1.1207400591923041e-03 +-1.1329227979007884e-03 +-1.1458378661284153e-03 +-1.1590146922549629e-03 +-1.1718822230221337e-03 +-1.1837696303666368e-03 +-1.1939263252578609e-03 +-1.2015671577893588e-03 +-1.2059421519029284e-03 +-1.2064210952313645e-03 +-1.2025754939901177e-03 +-1.1942379435012096e-03 +-1.1815238279847271e-03 +-1.1648107401680051e-03 +-1.1446825823513433e-03 +-1.1218533102068837e-03 +-1.0970873628156643e-03 +-1.0711306345254623e-03 +-1.0446599143093909e-03 +-1.0182527451703953e-03 +-9.9237534932037600e-04 +-9.6738410337734114e-04 +-9.4353565879915630e-04 +-9.2100148905486850e-04 +-8.9988376312350382e-04 +-8.8023056490830803e-04 +-8.6204938817865658e-04 +-8.4531847940412692e-04 +-8.2999600269124496e-04 +-8.1602721979185582e-04 +-8.0334997337073988e-04 +-7.9189878189808672e-04 +-7.8160783423485212e-04 +-7.7241313353592776e-04 +-7.6425399668178355e-04 +-7.5707407407824988e-04 +-7.5082201851448655e-04 +-7.4545190181530207e-04 +-7.4092345408597964e-04 +-7.3720218171339699e-04 +-7.3425940607760147e-04 +-7.3207225425746443e-04 +-7.3062362509656838e-04 +-7.2990214810691339e-04 +-1.2115490000555330e-03 +-1.2139154382057851e-03 +-1.2185978506648182e-03 +-1.2254946738157362e-03 +-1.2344509088611161e-03 +-1.2452520988257671e-03 +-1.2576121728649038e-03 +-1.2711533366390169e-03 +-1.2853786529681095e-03 +-1.2996426649018056e-03 +-1.3131315715389309e-03 +-1.3248694135212329e-03 +-1.3337663379141443e-03 +-1.3387159185262636e-03 +-1.3387313879989681e-03 +-1.3330920167666952e-03 +-1.3214606707570339e-03 +-1.3039388480326590e-03 +-1.2810449470152894e-03 +-1.2536258022271907e-03 +-1.2227293584909083e-03 +-1.1894714261262214e-03 +-1.1549228677564132e-03 +-1.1200311869417135e-03 +-1.0855785151003023e-03 +-1.0521700327010177e-03 +-1.0202435472201877e-03 +-9.9009109622697953e-04 +-9.6188538204159367e-04 +-9.3570624384910553e-04 +-9.1156447781522284e-04 +-8.8942184764230004e-04 +-8.6920709276878776e-04 +-8.5082826390335705e-04 +-8.3418194066490884e-04 +-8.1915993432905984e-04 +-8.0565403501163058e-04 +-7.9355928031215868e-04 +-7.8277613155394027e-04 +-7.7321185929287914e-04 +-7.6478136781525478e-04 +-7.5740763019942984e-04 +-7.5102186016567625e-04 +-7.4556351247142432e-04 +-7.4098017794888081e-04 +-7.3722742051089956e-04 +-7.3426858994852530e-04 +-7.3207463477994387e-04 +-7.3062393274444214e-04 +-7.2990215190080773e-04 +-1.3589555542496668e-03 +-1.3616072665318052e-03 +-1.3668597753362750e-03 +-1.3746102105355207e-03 +-1.3846992671959473e-03 +-1.3968988215659734e-03 +-1.4108862799663501e-03 +-1.4262020348708587e-03 +-1.4421924923022390e-03 +-1.4579520896869154e-03 +-1.4722907284380588e-03 +-1.4837607522720096e-03 +-1.4907704661896073e-03 +-1.4917844081738041e-03 +-1.4855717061903501e-03 +-1.4714328951170447e-03 +-1.4493331956345725e-03 +-1.4199015250384158e-03 +-1.3843032245482215e-03 +-1.3440346934199573e-03 +-1.3007023555588046e-03 +-1.2558367815534105e-03 +-1.2107680529381609e-03 +-1.1665646692963049e-03 +-1.1240233631358903e-03 +-1.0836919820413240e-03 +-1.0459090626617844e-03 +-1.0108481353759591e-03 +-9.7855951374704983e-04 +-9.4900606176531916e-04 +-9.2209189631588609e-04 +-8.9768436117967899e-04 +-8.7563023344917293e-04 +-8.5576729571852899e-04 +-8.3793234587972948e-04 +-8.2196655686719020e-04 +-8.0771891633628292e-04 +-7.9504830713724296e-04 +-7.8382464733337844e-04 +-7.7392939572534889e-04 +-7.6525564256446437e-04 +-7.5770794082025443e-04 +-7.5120198635451202e-04 +-7.4566422155641649e-04 +-7.4103141308188040e-04 +-7.3725023770837724e-04 +-7.3427689898540073e-04 +-7.3207678982873173e-04 +-7.3062421136822851e-04 +-7.2990215533774911e-04 +-1.5143498148318983e-03 +-1.5173039739964673e-03 +-1.5231724888988684e-03 +-1.5318739801718070e-03 +-1.5432769067009315e-03 +-1.5571748850793862e-03 +-1.5732350734383959e-03 +-1.5909132564009103e-03 +-1.6093433379677986e-03 +-1.6272326605524657e-03 +-1.6428195198658370e-03 +-1.6539572581166346e-03 +-1.6583611855806729e-03 +-1.6539885824001898e-03 +-1.6394474074223882e-03 +-1.6142943114016771e-03 +-1.5791173982159425e-03 +-1.5353870451222131e-03 +-1.4851460972944797e-03 +-1.4306521626147178e-03 +-1.3740703681919873e-03 +-1.3172688260845696e-03 +-1.2617224314023783e-03 +-1.2085017185606579e-03 +-1.1583143787786917e-03 +-1.1115708665603969e-03 +-1.0684543927424550e-03 +-1.0289843237504472e-03 +-9.9306842075821055e-04 +-9.6054323291576719e-04 +-9.3120389169016595e-04 +-9.0482525576986682e-04 +-8.8117639640380909e-04 +-8.6003015947886514e-04 +-8.4116919905329176e-04 +-8.2438954721884654e-04 +-8.0950250608711658e-04 +-7.9633542763720300e-04 +-7.8473178090651360e-04 +-7.7455078388737302e-04 +-7.6566678955645388e-04 +-7.5796855311565585e-04 +-7.5135846391762517e-04 +-7.4575179548231230e-04 +-7.4107600663392845e-04 +-7.3727011328875093e-04 +-7.3428414178029874e-04 +-7.3207866934425683e-04 +-7.3062445445869163e-04 +-7.2990215833721936e-04 +-1.6665402723659197e-03 +-1.6697943779276927e-03 +-1.6762926100950867e-03 +-1.6860119735869050e-03 +-1.6989007041094564e-03 +-1.7148321346106955e-03 +-1.7335081836656482e-03 +-1.7543027114822203e-03 +-1.7760644807508273e-03 +-1.7969460859151667e-03 +-1.8143678534157483e-03 +-1.8252248423573805e-03 +-1.8263679769489809e-03 +-1.8152529482943173e-03 +-1.7905326393246623e-03 +-1.7523628521516562e-03 +-1.7023161521628370e-03 +-1.6429733933190529e-03 +-1.5773758050199491e-03 +-1.5085231337373919e-03 +-1.4390280322253938e-03 +-1.3709484853848223e-03 +-1.3057622524374865e-03 +-1.2444281458838171e-03 +-1.1874854396739991e-03 +-1.1351587627937377e-03 +-1.0874512284639319e-03 +-1.0442193731478764e-03 +-1.0052296368842065e-03 +-9.7019891056058898e-04 +-9.3882249032781542e-04 +-9.1079262001261450e-04 +-8.8581026949182578e-04 +-8.6359219771587822e-04 +-8.4387481506742142e-04 +-8.2641593111945741e-04 +-8.1099514920634336e-04 +-7.9741343193296885e-04 +-7.8549219232924882e-04 +-7.7507214638184634e-04 +-7.6601208019261052e-04 +-7.5818762849786943e-04 +-7.5149012305027608e-04 +-7.4582554391738388e-04 +-7.4111359020736470e-04 +-7.3728687635605584e-04 +-7.3429025399543272e-04 +-7.3208025621158989e-04 +-7.3062465976490680e-04 +-7.2990216087124801e-04 +-1.8021138079334917e-03 +-1.8056414190292193e-03 +-1.8127391136163499e-03 +-1.8234868965640578e-03 +-1.8379758059174054e-03 +-1.8562297318596118e-03 +-1.8780423553197230e-03 +-1.9027159249579619e-03 +-1.9287428157682340e-03 +-1.9535525304881767e-03 +-1.9735120942660899e-03 +-1.9843415320118765e-03 +-1.9819400611290985e-03 +-1.9633738596863313e-03 +-1.9276254881590131e-03 +-1.8757911491631700e-03 +-1.8106902261592098e-03 +-1.7361184530832129e-03 +-1.6560650127842628e-03 +-1.5741248253328317e-03 +-1.4931834672536649e-03 +-1.4153358194175136e-03 +-1.3419531172509606e-03 +-1.2738179545507267e-03 +-1.2112724731615442e-03 +-1.1543508731149002e-03 +-1.1028855577093150e-03 +-1.0565863508932322e-03 +-1.0150966542054108e-03 +-9.7803160363136134e-04 +-9.4500296116211086e-04 +-9.1563461169917397e-04 +-8.8957160821514483e-04 +-8.6648490551381838e-04 +-8.4607329357433056e-04 +-8.2806357405987372e-04 +-8.1220968780275728e-04 +-7.9829126507403902e-04 +-7.8611190709744429e-04 +-7.7549739556504924e-04 +-7.6629395136143389e-04 +-7.5836661321048262e-04 +-7.5159777372480906e-04 +-7.4588588893202527e-04 +-7.4114436403506772e-04 +-7.3730061034543563e-04 +-7.3429526425047289e-04 +-7.3208155749512709e-04 +-7.3062482816823671e-04 +-7.2990216295046480e-04 +-1.9091944233890052e-03 +-1.9129464340616339e-03 +-1.9205617250786522e-03 +-1.9322556611135590e-03 +-1.9483085904211171e-03 +-1.9689499911055958e-03 +-1.9941168794465080e-03 +-2.0230685652965091e-03 +-2.0539241849870087e-03 +-2.0833162400783539e-03 +-2.1064488935434293e-03 +-2.1177859791387996e-03 +-2.1122989951542740e-03 +-2.0868192420887507e-03 +-2.0408795283680769e-03 +-1.9766854399457189e-03 +-1.8983343356346045e-03 +-1.8107263110217484e-03 +-1.7186077578918539e-03 +-1.6259729111008582e-03 +-1.5358294347747764e-03 +-1.4502195786486687e-03 +-1.3703726380893050e-03 +-1.2968970895969026e-03 +-1.2299611597509910e-03 +-1.1694407698057668e-03 +-1.1150311807470131e-03 +-1.0663265893185098e-03 +-1.0228743847029011e-03 +-9.8421063075532808e-04 +-9.4988222820610721e-04 +-9.1945992962712015e-04 +-8.9254524719724912e-04 +-8.6877339805405422e-04 +-8.4781376554280471e-04 +-8.2936887603551836e-04 +-8.1317255523895597e-04 +-7.9898769627352042e-04 +-7.8660391407423588e-04 +-7.7583525450188680e-04 +-7.6651805595897606e-04 +-7.5850901503378269e-04 +-7.5168347796279527e-04 +-7.4593396114084731e-04 +-7.4116889288375744e-04 +-7.3731156265696945e-04 +-7.3429926137496139e-04 +-7.3208259597747245e-04 +-7.3062496259139833e-04 +-7.2990216461080604e-04 +-1.9821983553621101e-03 +-1.9861116317813616e-03 +-1.9941141100403297e-03 +-2.0065488712457673e-03 +-2.0238776897769529e-03 +-2.0465363476827435e-03 +-2.0746298041843096e-03 +-2.1074387169938346e-03 +-2.1428157361690833e-03 +-2.1767260238498686e-03 +-2.2033339759324456e-03 +-2.2159515790866331e-03 +-2.2087151795328491e-03 +-2.1782914049304340e-03 +-2.1247630079750533e-03 +-2.0513284004757891e-03 +-1.9631401018683930e-03 +-1.8659395260358855e-03 +-1.7650025261849401e-03 +-1.6645741356935936e-03 +-1.5677192604923648e-03 +-1.4764264231809628e-03 +-1.3918194978021459e-03 +-1.3143854258705753e-03 +-1.2441733573572947e-03 +-1.1809509249895110e-03 +-1.1243187196060863e-03 +-1.0737900216820587e-03 +-1.0288439996393420e-03 +-9.8895969333319574e-04 +-9.5363659826790462e-04 +-9.2240618802883520e-04 +-8.9483748320102444e-04 +-8.7053883254109164e-04 +-8.4915738262558965e-04 +-8.3037722264963352e-04 +-8.1391685074563380e-04 +-7.9952637539877126e-04 +-7.8698470847355663e-04 +-7.7609690176615978e-04 +-7.6669171034383324e-04 +-7.5861942164191613e-04 +-7.5174996142041140e-04 +-7.4597127076245998e-04 +-7.4118793868407559e-04 +-7.3732007009917199e-04 +-7.3430236725031397e-04 +-7.3208340311386121e-04 +-7.3062506708727057e-04 +-7.2990216590214797e-04 +-2.0242430917348534e-03 +-2.0282543535308211e-03 +-2.0364870016230346e-03 +-2.0493527406273099e-03 +-2.0674164148526222e-03 +-2.0912485092802382e-03 +-2.1211047808144157e-03 +-2.1563822051035002e-03 +-2.1949062683164324e-03 +-2.2323258489512932e-03 +-2.2621308546094247e-03 +-2.2767509251941692e-03 +-2.2695905486960766e-03 +-2.2370653826302052e-03 +-2.1795492630914261e-03 +-2.1008660773348588e-03 +-2.0068469405330179e-03 +-1.9037786469180936e-03 +-1.7972929344800906e-03 +-1.6918258718944697e-03 +-1.5905183740715122e-03 +-1.4953647627561038e-03 +-1.4074560107483821e-03 +-1.3272272358479068e-03 +-1.2546686059639062e-03 +-1.1894883941720087e-03 +-1.1312312013515781e-03 +-1.0793595734681198e-03 +-1.0333079374696523e-03 +-9.9251662704208442e-04 +-9.5645211053189060e-04 +-9.2461795370640701e-04 +-8.9655975098601665e-04 +-8.7186626761128112e-04 +-8.5016831236930327e-04 +-8.3113634895457542e-04 +-8.1447749991082517e-04 +-7.9993235613288452e-04 +-7.8727184345472846e-04 +-7.7629429123368795e-04 +-7.6682277861414583e-04 +-7.5870279006696702e-04 +-7.5180018453547290e-04 +-7.4599946632838119e-04 +-7.4120233703624152e-04 +-7.3732650359363983e-04 +-7.3430471658113056e-04 +-7.3208401376677356e-04 +-7.3062514615652410e-04 +-7.2990216687996194e-04 +-2.0445766419060138e-03 +-2.0486355313672449e-03 +-2.0569548202142318e-03 +-2.0699311630877413e-03 +-2.0881182063238954e-03 +-2.1121055588817889e-03 +-2.1422395401212704e-03 +-2.1781050023184029e-03 +-2.2177627591584781e-03 +-2.2569835896801356e-03 +-2.2890787231131552e-03 +-2.3059726720835510e-03 +-2.3004542849018204e-03 +-2.2685060163648309e-03 +-2.2103932456524573e-03 +-2.1301010164544846e-03 +-2.0337516579365025e-03 +-1.9279373520093915e-03 +-1.8185489205789808e-03 +-1.7102159424039233e-03 +-1.6062089961153584e-03 +-1.5085984378323714e-03 +-1.4185102862501727e-03 +-1.3363858956632519e-03 +-1.2622031953735181e-03 +-1.1956477283845861e-03 +-1.1362365585650873e-03 +-1.0834036266786657e-03 +-1.0365559360799061e-03 +-9.9510877588363661e-04 +-9.5850645281123472e-04 +-9.2623333222269949e-04 +-8.9781860805504489e-04 +-8.7283716591070760e-04 +-8.5090813418700400e-04 +-8.3169217492957666e-04 +-8.1488819147451782e-04 +-8.0022987632312568e-04 +-7.8748235381910091e-04 +-7.7643906150159795e-04 +-7.6691894275600142e-04 +-7.5876397847019492e-04 +-7.5183705798180522e-04 +-7.4602017358140469e-04 +-7.4121291429572853e-04 +-7.3733123086992586e-04 +-7.3430644319318755e-04 +-7.3208446262830863e-04 +-7.3062520428292493e-04 +-7.2990216759955028e-04 +-2.0529830949179632e-03 +-2.0570582532054419e-03 +-2.0653707852738875e-03 +-2.0782414966149377e-03 +-2.0961255345444533e-03 +-2.1195300940173236e-03 +-2.1488066450433964e-03 +-2.1837162548223768e-03 +-2.2226925406419089e-03 +-2.2619569278056919e-03 +-2.2950988150171555e-03 +-2.3139433450469148e-03 +-2.3108256004332516e-03 +-2.2811463981437814e-03 +-2.2247047876278962e-03 +-2.1452559522532264e-03 +-2.0489199986116384e-03 +-1.9424366439608832e-03 +-1.8319064689834687e-03 +-1.7221659642450281e-03 +-1.6166547650147643e-03 +-1.5175635764223803e-03 +-1.4260935991902202e-03 +-1.3427258629857169e-03 +-1.2674530700209712e-03 +-1.1999597093269581e-03 +-1.1397527644655960e-03 +-1.0862517184292140e-03 +-1.0388476816887197e-03 +-9.9694033514882339e-04 +-9.5995956679715210e-04 +-9.2737690618388492e-04 +-8.9871038601421814e-04 +-8.7352533189021886e-04 +-8.5143276024435873e-04 +-8.3208648670867228e-04 +-8.1517965035399437e-04 +-8.0044109191343838e-04 +-7.8763184708259678e-04 +-7.7654190065750220e-04 +-7.6698727353599074e-04 +-7.5880746847740326e-04 +-7.5186327260604242e-04 +-7.4603489851265004e-04 +-7.4122043736047272e-04 +-7.3733459375418555e-04 +-7.3430767165560517e-04 +-7.3208478202546536e-04 +-7.3062524564764843e-04 +-7.2990216811250216e-04 +-2.0560405120496768e-03 +-2.0601172308397191e-03 +-2.0683864756902695e-03 +-2.0810780269734431e-03 +-2.0985214022547069e-03 +-2.1210940657658208e-03 +-2.1490789432157898e-03 +-2.1823303726385213e-03 +-2.2196260392630895e-03 +-2.2577516224709659e-03 +-2.2908527933945596e-03 +-2.3109817964430410e-03 +-2.3102118967529310e-03 +-2.2833320428310220e-03 +-2.2294882857393492e-03 +-2.1519902639200806e-03 +-2.0567951702578479e-03 +-1.9507013079518272e-03 +-1.8399823583389954e-03 +-1.7296732979102611e-03 +-1.6233866787113329e-03 +-1.5234419157172197e-03 +-1.4311251710810661e-03 +-1.3469672453764894e-03 +-1.2709855603873575e-03 +-1.2028730531791199e-03 +-1.1421354579234802e-03 +-1.0881858039823512e-03 +-1.0404064076370823e-03 +-9.9818752513501597e-04 +-9.6094993609564003e-04 +-9.2815684589187116e-04 +-8.9931892951657913e-04 +-8.7399514276546516e-04 +-8.5179105818658312e-04 +-8.3235587418849255e-04 +-8.1537882910650661e-04 +-8.0058547251173008e-04 +-7.8773406180565055e-04 +-7.7661223261788110e-04 +-7.6703401552154096e-04 +-7.5883722424052095e-04 +-7.5188121209188630e-04 +-7.4604497705064857e-04 +-7.4122558738357221e-04 +-7.3733689618961807e-04 +-7.3430851283477956e-04 +-7.3208500075002813e-04 +-7.3062527397649540e-04 +-7.2990216846482634e-04 +-2.0570060206988134e-03 +-2.0610796445145480e-03 +-2.0693051036433699e-03 +-2.0818375663534351e-03 +-2.0988992309625707e-03 +-2.1207431651469213e-03 +-2.1475522106222241e-03 +-2.1791886428615928e-03 +-2.2146587512599071e-03 +-2.2512455866055669e-03 +-2.2837078072819868e-03 +-2.3044861167547640e-03 +-2.3055547641803588e-03 +-2.2811753439695489e-03 +-2.2298467004860825e-03 +-2.1543989665709401e-03 +-2.0605822779415596e-03 +-1.9552102211987318e-03 +-1.8446900446968692e-03 +-1.7342213399163693e-03 +-1.6275630871639263e-03 +-1.5271449662194122e-03 +-1.4343270710315797e-03 +-1.3496848971413546e-03 +-1.2732597572554733e-03 +-1.2047549097400218e-03 +-1.1436782082969714e-03 +-1.0894402470321926e-03 +-1.0414186743662414e-03 +-9.9899824189767211e-04 +-9.6159417558715850e-04 +-9.2866448568991011e-04 +-8.9971519077353612e-04 +-8.7430117946204068e-04 +-8.5202452781892295e-04 +-8.3253145678102583e-04 +-8.1550868221138444e-04 +-8.0067962117997800e-04 +-7.8780072832795509e-04 +-7.7665811335723327e-04 +-7.6706451294973133e-04 +-7.5885664207149290e-04 +-7.5189292077774733e-04 +-7.4605155603205239e-04 +-7.4122894961016754e-04 +-7.3733839952096192e-04 +-7.3430906211910353e-04 +-7.3208514358637472e-04 +-7.3062529247775918e-04 +-7.2990216869614922e-04 +-2.0572330618369539e-03 +-2.0613032652032053e-03 +-2.0694969821975595e-03 +-2.0819195255445729e-03 +-2.0987192275717568e-03 +-2.1200567612339092e-03 +-2.1460242016751907e-03 +-2.1764490250088687e-03 +-2.2104562211563692e-03 +-2.2456812529264140e-03 +-2.2773910909562847e-03 +-2.2984105780121142e-03 +-2.3007093035843874e-03 +-2.2781648337274266e-03 +-2.2287630203891725e-03 +-2.1549407583580111e-03 +-2.0622692956009650e-03 +-1.9575601801236904e-03 +-1.8473129252089189e-03 +-1.7368452015888555e-03 +-1.6300218765358154e-03 +-1.5293526580085267e-03 +-1.4362516221497932e-03 +-1.3513273477668859e-03 +-1.2746393918153926e-03 +-1.2058995689209872e-03 +-1.1446183957965019e-03 +-1.0902058028517214e-03 +-1.0420370802904277e-03 +-9.9949391111689499e-04 +-9.6198830334088680e-04 +-9.2897519687663399e-04 +-8.9995782639521317e-04 +-8.7448863116524960e-04 +-8.5216757139804436e-04 +-8.3263906026562748e-04 +-8.1558827853396392e-04 +-8.0073734330740501e-04 +-7.8784160890654320e-04 +-7.7668625280056993e-04 +-7.6708322061468082e-04 +-7.5886855514791884e-04 +-7.5190010522965627e-04 +-7.4605559342831758e-04 +-7.4123101319009362e-04 +-7.3733932229234705e-04 +-7.3430939930901917e-04 +-7.3208523127562175e-04 +-7.3062530383695770e-04 +-7.2990216883971092e-04 +-2.0572420216072584e-03 +-2.0613097602554470e-03 +-2.0694841128386212e-03 +-2.0818413330559228e-03 +-2.0984859326831570e-03 +-2.1195212348980052e-03 +-2.1449765059924188e-03 +-2.1746403536030399e-03 +-2.2076885994262094e-03 +-2.2419682240272997e-03 +-2.2730881554320075e-03 +-2.2941576237896391e-03 +-2.2971738819668663e-03 +-2.2757755187762171e-03 +-2.2276106499988066e-03 +-2.1548522354028809e-03 +-2.0629482008596967e-03 +-1.9587034430634501e-03 +-1.8486731169486161e-03 +-1.7382480178025534e-03 +-1.6313589856430681e-03 +-1.5305657460226425e-03 +-1.4373162659406988e-03 +-1.3522400805644648e-03 +-1.2754085200591164e-03 +-1.2065391660013303e-03 +-1.1451446294896478e-03 +-1.0906348389380224e-03 +-1.0423839891768440e-03 +-9.9977218128433402e-04 +-9.6220970341194577e-04 +-9.2914982513299241e-04 +-9.0009425100005683e-04 +-8.7459406524089507e-04 +-8.5224805237474463e-04 +-8.3269961795993453e-04 +-8.1563308520657635e-04 +-8.0076984379992262e-04 +-7.8786463157436008e-04 +-7.7670210316917101e-04 +-7.6709376020188912e-04 +-7.5887526793978830e-04 +-7.5190415418569770e-04 +-7.4605786913028028e-04 +-7.4123217649525047e-04 +-7.3733984254899698e-04 +-7.3430958943497364e-04 +-7.3208528072362690e-04 +-7.3062531024335189e-04 +-7.2990216892263027e-04 +-2.0572136790356632e-03 +-2.0612800020557926e-03 +-2.0694441811930676e-03 +-2.0817676373904451e-03 +-2.0983322953585658e-03 +-2.1192111715998860e-03 +-2.1443982899643672e-03 +-2.1736558222022399e-03 +-2.2061780526149953e-03 +-2.2399203493536223e-03 +-2.2706811679761643e-03 +-2.2917367440122394e-03 +-2.2951110570899715e-03 +-2.2743175369024623e-03 +-2.2268196559766160e-03 +-2.1546436881993247e-03 +-2.0631673262164287e-03 +-1.9591892500651167e-03 +-1.8492928514385611e-03 +-1.7389071924187687e-03 +-1.6319979666289497e-03 +-1.5311514859814431e-03 +-1.4378338532442492e-03 +-1.3526859292898677e-03 +-1.2757855162226239e-03 +-1.2068534774228850e-03 +-1.1454037408326256e-03 +-1.0908464165268999e-03 +-1.0425552759210594e-03 +-9.9990971424005533e-04 +-9.6231921847064782e-04 +-9.2923626395916361e-04 +-9.0016181901008741e-04 +-8.7464631082012872e-04 +-8.5228795080229125e-04 +-8.3272965144188334e-04 +-8.1565531509142678e-04 +-8.0078597365007271e-04 +-7.8787606120005497e-04 +-7.7670997441283134e-04 +-7.6709899557636648e-04 +-7.5887860328095031e-04 +-7.5190616645265135e-04 +-7.4605900037133315e-04 +-7.4123275488612516e-04 +-7.3734010126473321e-04 +-7.3430968399607651e-04 +-7.3208530532031736e-04 +-7.3062531343111043e-04 +-7.2990216896654458e-04 +-2.0571951350832245e-03 +-2.0612608144700028e-03 +-2.0694206041006386e-03 +-2.0817296308504110e-03 +-2.0982601534443963e-03 +-2.1190719959923816e-03 +-2.1441432697439262e-03 +-2.1732229226733130e-03 +-2.2055105222010462e-03 +-2.2390066598056099e-03 +-2.2695935388005149e-03 +-2.2906245165156608e-03 +-2.2941400280290210e-03 +-2.2736017034536565e-03 +-2.2263927729254040e-03 +-2.1544742216562064e-03 +-2.0631912553104831e-03 +-1.9593381214239930e-03 +-1.8495092259200973e-03 +-1.7391494787713732e-03 +-1.6322393143944230e-03 +-1.5313764507038866e-03 +-1.4380348805661197e-03 +-1.3528604781083103e-03 +-1.2759339839946682e-03 +-1.2069778202145585e-03 +-1.1455066109853985e-03 +-1.0909306544253079e-03 +-1.0426236303798123e-03 +-9.9996470381311792e-04 +-9.6236307589489133e-04 +-9.2927092718848273e-04 +-9.0018894653886867e-04 +-8.7466730811957465e-04 +-8.5230400040260646e-04 +-8.3274174263934890e-04 +-8.1566427131833771e-04 +-8.0079247671165999e-04 +-7.8788067224340864e-04 +-7.7671315182284222e-04 +-7.6710111016111099e-04 +-7.5887995115794533e-04 +-7.5190698005636169e-04 +-7.4605945796817411e-04 +-7.4123298894812953e-04 +-7.3734020599988789e-04 +-7.3430972228908601e-04 +-7.3208531528376117e-04 +-7.3062531472371415e-04 +-7.2990216898805190e-04 +-2.0571887360121342e-03 +-2.0612542093860304e-03 +-2.0694126398964857e-03 +-2.0817172128985728e-03 +-2.0982371546775132e-03 +-2.1190280483170550e-03 +-2.1440626901285242e-03 +-2.1730851809914089e-03 +-2.2052956578847986e-03 +-2.2387078928268233e-03 +-2.2692303748218390e-03 +-2.2902422692165979e-03 +-2.2937918031071050e-03 +-2.2733266425359541e-03 +-2.2262058083152331e-03 +-2.1543694157412753e-03 +-2.0631513261557188e-03 +-1.9593431095428779e-03 +-1.8495415810201555e-03 +-1.7391959309927655e-03 +-1.6322908436967754e-03 +-1.5314274667728098e-03 +-1.4380822578858074e-03 +-1.3529027257211880e-03 +-1.2759706245387941e-03 +-1.2070089626358737e-03 +-1.1455326733607800e-03 +-1.0909521927848699e-03 +-1.0426412380931350e-03 +-9.9997895595930618e-04 +-9.6237450128181239e-04 +-9.2927999674873702e-04 +-9.0019607100867032e-04 +-8.7467284065125819e-04 +-8.5230824152354918e-04 +-8.3274494606383497e-04 +-8.1566664979456651e-04 +-8.0079420748567509e-04 +-7.8788190196124640e-04 +-7.7671400082372061e-04 +-7.6710167619052486e-04 +-7.5888031256396101e-04 +-7.5190719855059600e-04 +-7.4605958103429412e-04 +-7.4123305197926735e-04 +-7.3734023423691303e-04 +-7.3430973262343083e-04 +-7.3208531797543921e-04 +-7.3062531507489840e-04 +-7.2990216899986157e-04 +-2.0571877673401912e-03 +-2.0612532082802011e-03 +-2.0694114317236886e-03 +-2.0817153187304123e-03 +-2.0982335890017299e-03 +-2.1190210600676306e-03 +-2.1440494729008381e-03 +-2.1730617707594511e-03 +-2.2052576182001421e-03 +-2.2386523556681710e-03 +-2.2691586413023626e-03 +-2.2901606364591318e-03 +-2.2937093571408864e-03 +-2.2732516618261577e-03 +-2.2261433464018914e-03 +-2.1543209796679287e-03 +-2.0631158970550495e-03 +-1.9593184321211954e-03 +-1.8495251273266779e-03 +-1.7391854256004469e-03 +-1.6322844601418950e-03 +-1.5314238390002079e-03 +-1.4380804119257995e-03 +-1.3529019910394464e-03 +-1.2759705522413223e-03 +-1.2070092596448145e-03 +-1.1455331531896483e-03 +-1.0909527403367982e-03 +-1.0426417852189551e-03 +-9.9997946483470872e-04 +-9.6237495327925881e-04 +-9.2928038508534750e-04 +-9.0019639594968073e-04 +-8.7467310642255866e-04 +-8.5230845435658596e-04 +-8.3274511298323938e-04 +-8.1566677788818143e-04 +-8.0079430348336601e-04 +-7.8788197200828976e-04 +-7.7671405037368305e-04 +-7.6710170996970863e-04 +-7.5888033457705332e-04 +-7.5190721210972769e-04 +-7.4605958880144074e-04 +-7.4123305601765882e-04 +-7.3734023607000107e-04 +-7.3430973330218432e-04 +-7.3208531815480973e-04 +-7.3062531510107473e-04 +-7.2990216900943952e-04 +-2.0571877672716735e-03 +-2.0612532076811525e-03 +-2.0694114290990477e-03 +-2.0817153058609386e-03 +-2.0982335355765949e-03 +-2.1190208838972875e-03 +-2.1440489919034795e-03 +-2.1730606411124345e-03 +-2.2052552939259501e-03 +-2.2386481548125141e-03 +-2.2691519886675108e-03 +-2.2901513907887276e-03 +-2.2936979766013019e-03 +-2.2732390634801567e-03 +-2.2261305747599317e-03 +-2.1543089080221034e-03 +-2.0631050861272147e-03 +-1.9593091339775133e-03 +-1.8495173637007255e-03 +-1.7391790793694825e-03 +-1.6322793490887160e-03 +-1.5314197643864428e-03 +-1.4380771856109963e-03 +-1.3528994478451655e-03 +-1.2759685535079328e-03 +-1.2070076921748506e-03 +-1.1455319261666921e-03 +-1.0909517816606019e-03 +-1.0426410379753646e-03 +-9.9997888420400830e-04 +-9.6237450396683170e-04 +-9.2928003925302660e-04 +-9.0019613158320833e-04 +-8.7467290605948639e-04 +-8.5230830410273906e-04 +-8.3274500175544352e-04 +-8.1566669683190169e-04 +-8.0079424552416010e-04 +-7.8788193150482611e-04 +-7.7671402284734399e-04 +-7.6710169189165016e-04 +-7.5888032319818553e-04 +-7.5190720532269776e-04 +-7.4605958502648665e-04 +-7.4123305410634397e-04 +-7.3734023522245898e-04 +-7.3430973299468518e-04 +-7.3208531807529207e-04 +-7.3062531509081265e-04 +-7.2990216900929912e-04 +-2.0571887355651619e-03 +-2.0612542113592697e-03 +-2.0694126697063451e-03 +-2.0817172990950706e-03 +-2.0982372232887228e-03 +-2.1190276881087751e-03 +-2.1440607498490615e-03 +-2.1730792118048697e-03 +-2.2052814476439552e-03 +-2.2386797860723907e-03 +-2.2691830912083713e-03 +-2.2901736820744307e-03 +-2.2937046709993560e-03 +-2.2732278406358687e-03 +-2.2261037512119378e-03 +-2.1542715005584520e-03 +-2.0630625694091345e-03 +-1.9592660099049617e-03 +-1.8494766710539729e-03 +-1.7391425016822155e-03 +-1.6322475593250816e-03 +-1.5313927858692487e-03 +-1.4380546783936503e-03 +-1.3528809045306380e-03 +-1.2759534194234274e-03 +-1.2069954318601997e-03 +-1.1455220554235886e-03 +-1.0909438792010473e-03 +-1.0426347459172392e-03 +-9.9997390309230962e-04 +-9.6237058560263121e-04 +-9.2927697911004330e-04 +-9.0019376169487599e-04 +-8.7467108875001302e-04 +-8.5230692665947880e-04 +-8.3274397200214115e-04 +-8.1566593950075804e-04 +-8.0079369930582771e-04 +-7.8788154665680190e-04 +-7.7671375925318761e-04 +-7.6710151747805939e-04 +-7.5888021263270091e-04 +-7.5190713892860463e-04 +-7.4605954786427769e-04 +-7.4123303518127120e-04 +-7.3734022678680858e-04 +-7.3430972992006151e-04 +-7.3208531727629307e-04 +-7.3062531498468617e-04 +-7.2990216899873595e-04 +-2.0571951357346726e-03 +-2.0612608701758676e-03 +-2.0694210112240587e-03 +-2.0817310509985659e-03 +-2.0982635028552570e-03 +-2.1190779799546249e-03 +-2.1441514272222497e-03 +-2.1732300705859680e-03 +-2.2055088903685754e-03 +-2.2389832389079580e-03 +-2.2695330806063296e-03 +-2.2905163144341452e-03 +-2.2939840771385614e-03 +-2.2734093487644185e-03 +-2.2261818360400721e-03 +-2.1542626420578137e-03 +-2.0629927957603340e-03 +-1.9591610168613952e-03 +-1.8493568531069181e-03 +-1.7390218120027182e-03 +-1.6321343571583837e-03 +-1.5312913134460564e-03 +-1.4379664678403892e-03 +-1.3528058671443614e-03 +-1.2758905971392612e-03 +-1.2069434752354097e-03 +-1.1454795069238102e-03 +-1.0909093284809468e-03 +-1.0426069057813342e-03 +-9.9995163886604948e-04 +-9.6235291871669102e-04 +-9.2926307756056685e-04 +-9.0018292476866607e-04 +-8.7466273013454127e-04 +-8.5230055808365943e-04 +-8.3273918841093853e-04 +-8.1566240611863968e-04 +-8.0079114060384511e-04 +-7.8787973706548168e-04 +-7.7671251539607016e-04 +-7.6710069168092689e-04 +-7.5887968747687822e-04 +-7.5190682263749349e-04 +-7.4605937034253472e-04 +-7.4123294455219783e-04 +-7.3734018630222740e-04 +-7.3430971513932671e-04 +-7.3208531343426286e-04 +-7.3062531448504038e-04 +-7.2990216898509983e-04 +-2.0572136909886860e-03 +-2.0612803062574686e-03 +-2.0694460715251638e-03 +-2.0817741859286416e-03 +-2.0983486797397678e-03 +-2.1192443129403947e-03 +-2.1444554480034793e-03 +-2.1737414888717463e-03 +-2.2062885761805120e-03 +-2.2400381267902972e-03 +-2.2707745288566522e-03 +-2.2917704820403732e-03 +-2.2950624375494303e-03 +-2.2741857573638862e-03 +-2.2266230828623841e-03 +-2.1544096511308952e-03 +-2.0629222315895644e-03 +-1.9589530631745852e-03 +-1.8490778371826205e-03 +-1.7387191005290106e-03 +-1.6318380057525031e-03 +-1.5310181576762660e-03 +-1.4377243141650814e-03 +-1.3525968707927705e-03 +-1.2757136690159821e-03 +-1.2067958636686647e-03 +-1.1453577724046646e-03 +-1.0908099077686546e-03 +-1.0425264139360404e-03 +-9.9988701187729979e-04 +-9.6230146367204438e-04 +-9.2922247221941749e-04 +-9.0015119176372260e-04 +-8.7463820046509099e-04 +-8.5228183202927261e-04 +-8.3272509809681190e-04 +-8.1565198167069604e-04 +-8.0078358055905190e-04 +-7.8787438300276051e-04 +-7.7670883042204491e-04 +-7.6709824225209514e-04 +-7.5887812801411737e-04 +-7.5190588240318533e-04 +-7.4605884210788979e-04 +-7.4123267463649617e-04 +-7.3734006563554036e-04 +-7.3430967105659424e-04 +-7.3208530197177294e-04 +-7.3062531299886895e-04 +-7.2990216896120564e-04 +-2.0572420812129530e-03 +-2.0613108437769153e-03 +-2.0694900863238988e-03 +-2.0818613850854995e-03 +-2.0985363293778854e-03 +-2.1196259188913614e-03 +-2.1451656987961547e-03 +-2.1749450598339648e-03 +-2.2081277420487127e-03 +-2.2425292935845365e-03 +-2.2737144189294667e-03 +-2.2947597691548240e-03 +-2.2976647776346642e-03 +-2.2761033436641668e-03 +-2.2277691102018321e-03 +-2.1548688625860853e-03 +-2.0628650257291333e-03 +-1.9585616800479638e-03 +-1.8485054225298285e-03 +-1.7380767252490664e-03 +-1.6311974806142385e-03 +-1.5304208457000334e-03 +-1.4371904828974326e-03 +-1.3521333707925015e-03 +-1.2753194824755224e-03 +-1.2064657989726780e-03 +-1.1450847736755832e-03 +-1.0905864156422408e-03 +-1.0423451135080843e-03 +-9.9974120300967738e-04 +-9.6218520874444160e-04 +-9.2913061938398249e-04 +-9.0007933349486825e-04 +-8.7458260266995783e-04 +-8.5223935365282618e-04 +-8.3269311190658775e-04 +-8.1562830139724916e-04 +-8.0076639645317233e-04 +-7.8786220611931602e-04 +-7.7670044507087475e-04 +-7.6709266562717960e-04 +-7.5887457589375747e-04 +-7.5190373980485621e-04 +-7.4605763788088771e-04 +-7.4123205907797546e-04 +-7.3733979035940406e-04 +-7.3430957046411718e-04 +-7.3208527581091430e-04 +-7.3062530960891310e-04 +-7.2990216891480092e-04 +-2.0572332660434042e-03 +-2.0613063434605137e-03 +-2.0695123145612385e-03 +-2.0819689759991400e-03 +-2.0988420322193952e-03 +-2.1203125214349673e-03 +-2.1464920495354446e-03 +-2.1772178773209147e-03 +-2.2115976445994442e-03 +-2.2472036766257772e-03 +-2.2792001096419525e-03 +-2.3003171786491112e-03 +-2.3024955835034720e-03 +-2.2796630654116964e-03 +-2.2298969019757084e-03 +-2.1557179478967066e-03 +-2.0627481191041025e-03 +-1.9578160946491043e-03 +-1.8474167824142186e-03 +-1.7368536983135773e-03 +-1.6299759809750723e-03 +-1.5292798210885261e-03 +-1.4361690858664810e-03 +-1.3512452442093349e-03 +-1.2745631830797083e-03 +-1.2058317951217454e-03 +-1.1445598535883216e-03 +-1.0901563056673704e-03 +-1.0419959312201433e-03 +-9.9946018702264951e-04 +-9.6196101903265035e-04 +-9.2895339519235523e-04 +-8.9994062370919855e-04 +-8.7447523687373232e-04 +-8.5215729276485531e-04 +-8.3263129946966469e-04 +-8.1558252591562585e-04 +-8.0073316908174479e-04 +-7.8783865456057882e-04 +-7.7668422278650250e-04 +-7.6708187459693217e-04 +-7.5886770087949017e-04 +-7.5189959203434927e-04 +-7.4605530623056600e-04 +-7.4123086701911845e-04 +-7.3733925719483969e-04 +-7.3430937560902559e-04 +-7.3208522513100612e-04 +-7.3062530304279620e-04 +-7.2990216882991006e-04 +-2.0570065846464282e-03 +-2.0610871704534539e-03 +-2.0693394717636372e-03 +-2.0819437405225523e-03 +-2.0991577329748088e-03 +-2.1212771711354500e-03 +-2.1485270430935395e-03 +-2.1807935113176656e-03 +-2.2170551087449977e-03 +-2.2544794623004880e-03 +-2.2876284310969978e-03 +-2.3087465029894170e-03 +-2.3097213741006661e-03 +-2.2848782358081319e-03 +-2.2328748119287037e-03 +-2.1567068640713058e-03 +-2.0622397313326078e-03 +-1.9563407181696856e-03 +-1.8454251215498602e-03 +-1.7346761648852696e-03 +-1.6278280573617857e-03 +-1.5272862302295538e-03 +-1.4343907260373791e-03 +-1.3497019129892439e-03 +-1.2732503263239790e-03 +-1.2047318377669206e-03 +-1.1436493784874255e-03 +-1.0894103336850413e-03 +-1.0413902999590393e-03 +-9.9897274223790210e-04 +-9.6157209787573622e-04 +-9.2864590857067873e-04 +-8.9969992755445621e-04 +-8.7428890554300698e-04 +-8.5201485937174489e-04 +-8.3252399831429999e-04 +-8.1550305439745765e-04 +-8.0067547624868615e-04 +-7.8779775767435231e-04 +-7.7665605031756167e-04 +-7.6706313260165948e-04 +-7.5885575923139684e-04 +-7.5189238692227611e-04 +-7.4605125560403302e-04 +-7.4122879598987940e-04 +-7.3733833084265886e-04 +-7.3430903703895062e-04 +-7.3208513706902849e-04 +-7.3062529163413095e-04 +-7.2990216868573589e-04 +-2.0560418437188840e-03 +-2.0601335576167870e-03 +-2.0684557401665377e-03 +-2.0812829363194537e-03 +-2.0990083161012076e-03 +-2.1220852721774300e-03 +-2.1508699748253716e-03 +-2.1852554495630319e-03 +-2.2239695396311350e-03 +-2.2636059059965678e-03 +-2.2979870947703847e-03 +-2.3188340692562848e-03 +-2.3180504976442378e-03 +-2.2904950154244430e-03 +-2.2355542203700688e-03 +-2.1568136502426042e-03 +-2.0604409633104858e-03 +-1.9533484364598563e-03 +-1.8418440700625814e-03 +-1.7309492887510210e-03 +-1.6242423229557799e-03 +-1.5240043415464934e-03 +-1.4314874636789049e-03 +-1.3471953367276996e-03 +-1.2711250687275756e-03 +-1.2029550038669956e-03 +-1.1421806704822062e-03 +-1.0882080891457433e-03 +-1.0404148238580323e-03 +-9.9818793861706904e-04 +-9.6094608477093459e-04 +-9.2815105864662662e-04 +-8.9931260951972287e-04 +-8.7398909098216617e-04 +-8.5178568925752896e-04 +-8.3235136006683361e-04 +-8.1537519426682714e-04 +-8.0058265670746194e-04 +-7.8773196105693126e-04 +-7.7661072558593493e-04 +-7.6703298005330930e-04 +-7.5883654730072257e-04 +-7.5188079523735071e-04 +-7.4604473890545111e-04 +-7.4122546409219152e-04 +-7.3733684051431212e-04 +-7.3430849234214246e-04 +-7.3208499539352404e-04 +-7.3062527328041896e-04 +-7.2990216845621549e-04 +-2.0529858282532470e-03 +-2.0570897688031451e-03 +-2.0654964501447500e-03 +-2.0785980514718026e-03 +-2.0969505759399444e-03 +-2.1211789067878146e-03 +-2.1517421145139525e-03 +-2.1884484012906044e-03 +-2.2296437036468347e-03 +-2.2712625620178177e-03 +-2.3064310124569836e-03 +-2.3264960417747967e-03 +-2.3235239748354876e-03 +-2.2929741959490583e-03 +-2.2349615283922958e-03 +-2.1536380073526248e-03 +-2.0554520852535917e-03 +-1.9473420600121917e-03 +-1.8354877796098307e-03 +-1.7247257264841535e-03 +-1.6184556402885307e-03 +-1.5188155815238611e-03 +-1.4269560895096857e-03 +-1.3433156287318893e-03 +-1.2678537261488524e-03 +-1.2002301770832997e-03 +-1.1399341191819690e-03 +-1.0863723843367080e-03 +-1.0389272264289071e-03 +-9.9699217606597423e-04 +-9.5999287203685799e-04 +-9.2739791758716711e-04 +-8.9872333448896239e-04 +-8.7353306886850293e-04 +-8.5143719267994885e-04 +-8.3208887662299200e-04 +-8.1518082111412741e-04 +-8.0044157028704972e-04 +-7.8763196101825294e-04 +-7.7654184650256428e-04 +-7.6698716211713429e-04 +-7.5880735654354600e-04 +-7.5186318411268763e-04 +-7.4603483884687555e-04 +-7.4122040264190138e-04 +-7.3733457669170467e-04 +-7.3430766497860388e-04 +-7.3208478020370614e-04 +-7.3062524540432592e-04 +-7.2990216810944763e-04 +-2.0445814855169788e-03 +-2.0486888780101970e-03 +-2.0571567760219881e-03 +-2.0704823127935495e-03 +-2.0893598072890657e-03 +-2.1145388554267091e-03 +-2.1465035217163881e-03 +-2.1848851445850706e-03 +-2.2276110829008836e-03 +-2.2700739028485772e-03 +-2.3049994312465518e-03 +-2.3237057942434480e-03 +-2.3186111009474045e-03 +-2.2857157825494382e-03 +-2.2256387932435436e-03 +-2.1428606238396344e-03 +-2.0439505718213885e-03 +-1.9358007332639967e-03 +-1.8244473353500256e-03 +-1.7145511851912141e-03 +-1.6093487651112097e-03 +-1.5108489551336228e-03 +-1.4201120032764109e-03 +-1.3375204726632484e-03 +-1.2630043846479310e-03 +-1.1962123304737346e-03 +-1.1366338458567906e-03 +-1.0836828196727484e-03 +-1.0367518599458620e-03 +-9.9524601569535623e-04 +-9.5860234921893407e-04 +-9.2630011578552995e-04 +-8.9786490902785273e-04 +-8.7286907797090411e-04 +-8.5092996250388036e-04 +-8.3170696203937664e-04 +-8.1489808716322986e-04 +-8.0023639809779742e-04 +-7.8748657062643944e-04 +-7.7644172356961048e-04 +-7.6692057357898740e-04 +-7.5876494016839224e-04 +-7.5183759790755506e-04 +-7.4602045769192854e-04 +-7.4121305115351817e-04 +-7.3733128897238024e-04 +-7.3430646351920132e-04 +-7.3208446773694600e-04 +-7.3062520492919866e-04 +-7.2990216760742581e-04 +-2.0242504115088825e-03 +-2.0283322012798646e-03 +-2.0367692161164948e-03 +-2.0500962143517147e-03 +-2.0690491502575316e-03 +-2.0943897229860988e-03 +-2.1265318513047373e-03 +-2.1649162316452896e-03 +-2.2072035548042174e-03 +-2.2486101831169334e-03 +-2.2819719097581189e-03 +-2.2990302234695706e-03 +-2.2927273550248902e-03 +-2.2594192409930406e-03 +-2.1998051474364602e-03 +-2.1182421598586812e-03 +-2.0210943817102573e-03 +-1.9150474094109947e-03 +-1.8059607615669446e-03 +-1.6983549121570760e-03 +-1.5953618722177312e-03 +-1.4989194097216340e-03 +-1.4100458329518578e-03 +-1.3291052854978863e-03 +-1.2560266631873465e-03 +-1.1904689028219514e-03 +-1.1319385593407086e-03 +-1.0798696466602249e-03 +-1.0336755806913862e-03 +-9.9278140304102447e-04 +-9.5664253265516971e-04 +-9.2475458389226978e-04 +-8.9665743930764054e-04 +-8.7193576140950945e-04 +-8.5021740854606136e-04 +-8.3117071793207382e-04 +-8.1450127477381950e-04 +-7.9994855429717389e-04 +-7.8728266905881707e-04 +-7.7630135263455119e-04 +-7.6682724547098337e-04 +-7.5870550743288665e-04 +-7.5180175633570063e-04 +-7.4600031700630470e-04 +-7.4120275757839221e-04 +-7.3732668631746061e-04 +-7.3430478177907222e-04 +-7.3208403041204162e-04 +-7.3062514828541253e-04 +-7.2990216690605977e-04 +-1.9822077559928141e-03 +-1.9862089245009200e-03 +-1.9944542866818160e-03 +-2.0074172763312735e-03 +-2.0257406157591176e-03 +-2.0500615698221536e-03 +-2.0806512137382599e-03 +-2.1168385860450912e-03 +-2.1563163611884100e-03 +-2.1946269724845268e-03 +-2.2252896253204166e-03 +-2.2409122362942843e-03 +-2.2351037899693031e-03 +-2.2043649072346007e-03 +-2.1490019339621027e-03 +-2.0726974583321414e-03 +-1.9811560644303135e-03 +-1.8805849280507953e-03 +-1.7765691479750385e-03 +-1.6735083724835566e-03 +-1.5745063672752020e-03 +-1.4815205455661756e-03 +-1.3956107091339981e-03 +-1.3171909288393598e-03 +-1.2462418435239258e-03 +-1.1824725964767980e-03 +-1.1254366263545492e-03 +-1.0746105659634676e-03 +-1.0294457769080597e-03 +-9.8940053244357239e-04 +-9.5395897760051907e-04 +-9.2264131013277144e-04 +-8.9500829574707872e-04 +-8.7066224698935716e-04 +-8.4924589409878350e-04 +-8.3044008865581641e-04 +-8.1396094763231416e-04 +-7.9955682068209399e-04 +-7.8700531370023551e-04 +-7.7611050301862176e-04 +-7.6670041056327385e-04 +-7.5862476947863549e-04 +-7.5175308442038970e-04 +-7.4597297567888146e-04 +-7.4118878805795780e-04 +-7.3732044162292049e-04 +-7.3430250055165106e-04 +-7.3208343729292899e-04 +-7.3062507147162673e-04 +-7.2990216595599118e-04 +-1.9092047849792336e-03 +-1.9130513855304891e-03 +-1.9209177342295592e-03 +-1.9331395198881635e-03 +-1.9501646468444793e-03 +-1.9724109052627345e-03 +-1.9999754501230588e-03 +-2.0321778671405755e-03 +-2.0670184613196642e-03 +-2.1007803444434282e-03 +-2.1281095748156690e-03 +-2.1428236308077431e-03 +-2.1393490545712729e-03 +-2.1142472108367509e-03 +-2.0671245122502089e-03 +-2.0005398181556192e-03 +-1.9190769423095624e-03 +-1.8281073640389264e-03 +-1.7327396439187712e-03 +-1.6371917119833478e-03 +-1.5445726343627170e-03 +-1.4569392419714669e-03 +-1.3754845409044215e-03 +-1.3007575392930300e-03 +-1.2328616393415409e-03 +-1.1716123033970148e-03 +-1.1166529268451569e-03 +-1.0675354314178618e-03 +-1.0237738766480126e-03 +-9.8487862713379478e-04 +-9.5037706051002773e-04 +-9.1982524167664396e-04 +-8.9281369867961298e-04 +-8.6896945976254112e-04 +-8.4795580853874568e-04 +-8.2947072326434524e-04 +-8.1324462963475424e-04 +-7.9903786891373995e-04 +-7.8663813092396100e-04 +-7.7585800057496297e-04 +-7.6653270057587899e-04 +-7.5851807039047613e-04 +-7.5168879462559680e-04 +-7.4593687767312341e-04 +-7.4117035206163091e-04 +-7.3731220324422197e-04 +-7.3429949190578618e-04 +-7.3208265522341849e-04 +-7.3062497020323159e-04 +-7.2990216470435350e-04 +-1.8021238077666857e-03 +-1.8057409678344082e-03 +-1.8130683059576224e-03 +-1.8242843174845695e-03 +-1.8396180799731057e-03 +-1.8592513493903555e-03 +-1.8831189590922089e-03 +-1.9105933552046306e-03 +-1.9401038936157958e-03 +-1.9688373007811363e-03 +-1.9927395372795515e-03 +-2.0070033413999758e-03 +-2.0070269811827014e-03 +-1.9895452714447583e-03 +-1.9534677371900598e-03 +-1.9000717047013439e-03 +-1.8325272875719708e-03 +-1.7550347874539999e-03 +-1.6719448448043110e-03 +-1.5871178622237424e-03 +-1.5035986104706604e-03 +-1.4235514630716994e-03 +-1.3483542317306370e-03 +-1.2787589559373372e-03 +-1.2150598631883842e-03 +-1.1572388252929985e-03 +-1.1050788183995575e-03 +-1.0582465394802429e-03 +-1.0163495669315834e-03 +-9.7897423005577941e-04 +-9.4570962920841398e-04 +-9.1616208508829816e-04 +-8.8996317050495783e-04 +-8.6677355702309024e-04 +-8.4628421447550581e-04 +-8.2821600166333277e-04 +-8.1231833720140658e-04 +-7.9836739972455155e-04 +-7.8616414429044993e-04 +-7.7553231297324877e-04 +-7.6631654541274032e-04 +-7.5838064771807374e-04 +-7.5160604757787072e-04 +-7.4589044422790156e-04 +-7.4114665037876293e-04 +-7.3730161679424447e-04 +-7.3429562725326207e-04 +-7.3208165094589342e-04 +-7.3062484018866986e-04 +-7.2990216309829663e-04 +-1.6665489319228587e-03 +-1.6698793792245456e-03 +-1.6765677130917138e-03 +-1.6866640440160606e-03 +-1.7002198940486799e-03 +-1.7172291893221172e-03 +-1.7375077538834946e-03 +-1.7605002988146153e-03 +-1.7850395102923045e-03 +-1.8091371750394083e-03 +-1.8299366403198402e-03 +-1.8439525354909537e-03 +-1.8476303825055024e-03 +-1.8380968400310532e-03 +-1.8138364520488258e-03 +-1.7750298565420079e-03 +-1.7234392423735023e-03 +-1.6619303351229707e-03 +-1.5938468048707921e-03 +-1.5224493911057892e-03 +-1.4505406177318595e-03 +-1.3802934142693028e-03 +-1.3132376024958608e-03 +-1.2503391830882976e-03 +-1.1921171123448759e-03 +-1.1387618464647343e-03 +-1.0902377760972893e-03 +-1.0463637422991180e-03 +-1.0068723763222373e-03 +-9.7145174589503716e-04 +-9.3977338539148931e-04 +-9.1151039233167445e-04 +-8.8634854839749974e-04 +-8.6399268874328252e-04 +-8.4416992252901908e-04 +-8.2663082732415652e-04 +-8.1114938696278576e-04 +-7.9752219099804382e-04 +-7.8556723855556358e-04 +-7.7512256889587946e-04 +-7.6604485916574605e-04 +-7.5820807486661845e-04 +-7.5150222215374617e-04 +-7.4583222739026285e-04 +-7.4111695440974871e-04 +-7.3728836092039340e-04 +-7.3429079051960775e-04 +-7.3208039454606907e-04 +-7.3062467757727817e-04 +-7.2990216109041677e-04 +-1.5143567098114662e-03 +-1.5173708767195937e-03 +-1.5233851011599441e-03 +-1.5323683477489393e-03 +-1.5442607966946718e-03 +-1.5589415518846344e-03 +-1.5761627447058498e-03 +-1.5954424960740931e-03 +-1.6159263753063979e-03 +-1.6362554954954230e-03 +-1.6545088577435590e-03 +-1.6682962452446480e-03 +-1.6750434924421842e-03 +-1.6724332984411304e-03 +-1.6588775086585795e-03 +-1.6338578453496326e-03 +-1.5980155836255226e-03 +-1.5529747535209884e-03 +-1.5009850788555823e-03 +-1.4445162486679103e-03 +-1.3859155230831143e-03 +-1.3271856634530011e-03 +-1.2698863739954659e-03 +-1.2151303090447570e-03 +-1.1636356592066525e-03 +-1.1158028519389638e-03 +-1.0717936714208960e-03 +-1.0316012333695733e-03 +-9.9510645573365583e-04 +-9.6212086196433976e-04 +-9.3241752164262824e-04 +-9.0575254465507518e-04 +-8.8187946105613600e-04 +-8.6055845165570230e-04 +-8.4156196527118124e-04 +-8.2467786778096927e-04 +-8.0971094962906044e-04 +-7.9648337449514167e-04 +-7.8483447207265320e-04 +-7.7462014877135771e-04 +-7.6571209909733634e-04 +-7.5799693717573701e-04 +-7.5137532449265408e-04 +-7.4576114063537070e-04 +-7.4108072442136304e-04 +-7.3727220033924560e-04 +-7.3428489757122045e-04 +-7.3207886451489071e-04 +-7.3062447961586582e-04 +-7.2990215864694556e-04 +-1.3589607127437882e-03 +-1.3616568443987499e-03 +-1.3670149073426393e-03 +-1.3749648751968002e-03 +-1.3853946020696594e-03 +-1.3981332443679876e-03 +-1.4129176951331647e-03 +-1.4293375316979657e-03 +-1.4467614928530971e-03 +-1.4642618387853171e-03 +-1.4805685799686278e-03 +-1.4940945935505712e-03 +-1.5030637596676597e-03 +-1.5057420529408902e-03 +-1.5007254416665363e-03 +-1.4872024449705075e-03 +-1.4651074151166977e-03 +-1.4351182395752622e-03 +-1.3985093946657493e-03 +-1.3569174993275776e-03 +-1.3120917997317579e-03 +-1.2656873375758962e-03 +-1.2191292932512304e-03 +-1.1735495981379472e-03 +-1.1297802440198702e-03 +-1.0883824071752041e-03 +-1.0496927370329157e-03 +-1.0138735389439797e-03 +-9.8095908311761630e-04 +-9.5089450800686138e-04 +-9.2356649429013856e-04 +-8.9882633823117259e-04 +-8.7650666033778173e-04 +-8.5643310343729657e-04 +-8.3843225240791495e-04 +-8.2233679594745943e-04 +-8.0798872830223887e-04 +-7.9524119144363549e-04 +-7.8395939728563699e-04 +-7.7402094496086525e-04 +-7.6531575491600213e-04 +-7.5774577344280740e-04 +-7.5122455240067272e-04 +-7.4567677443794966e-04 +-7.4103777014915186e-04 +-7.3725305739417166e-04 +-7.3427792228611378e-04 +-7.3207705451301273e-04 +-7.3062424552349317e-04 +-7.2990215575848016e-04 +-1.2115526917651561e-03 +-1.2139506401882831e-03 +-1.2187065649682451e-03 +-1.2257395714961607e-03 +-1.2349245488292734e-03 +-1.2460839414851722e-03 +-1.2589714131265527e-03 +-1.2732450169836893e-03 +-1.2884305604825223e-03 +-1.3038816567672380e-03 +-1.3187504786667278e-03 +-1.3319892112750675e-03 +-1.3424016811565301e-03 +-1.3487536644415281e-03 +-1.3499299110503922e-03 +-1.3451038832179645e-03 +-1.3338743828519551e-03 +-1.3163297967427583e-03 +-1.2930237919863822e-03 +-1.2648746986285556e-03 +-1.2330212807352204e-03 +-1.1986729630618002e-03 +-1.1629844481015250e-03 +-1.1269700839472206e-03 +-1.0914595553315101e-03 +-1.0570875368021160e-03 +-1.0243064438088746e-03 +-9.9341185123711121e-04 +-9.6457254170520177e-04 +-9.3785996523937972e-04 +-9.1327429714454492e-04 +-8.9076598760847651e-04 +-8.7025273940315130e-04 +-8.5163238963837653e-04 +-8.3479238207823754e-04 +-8.1961653807630260e-04 +-8.0598976259136105e-04 +-7.9380121529859862e-04 +-7.8294636712899102e-04 +-7.7332826447037116e-04 +-7.6485824195700455e-04 +-7.5745626053325620e-04 +-7.5105099837195744e-04 +-7.4557978562046832e-04 +-7.4098844721998092e-04 +-7.3723109889786730e-04 +-7.3426992798790284e-04 +-7.3207498148544455e-04 +-7.3062397753727976e-04 +-7.2990215245292305e-04 +-1.0795762955712127e-03 +-1.0817094903619112e-03 +-1.0859377458485031e-03 +-1.0921842176954161e-03 +-1.1003315958431090e-03 +-1.1102180411190817e-03 +-1.1216294048261930e-03 +-1.1342865903338146e-03 +-1.1478281215379731e-03 +-1.1617903891098450e-03 +-1.1755914181815405e-03 +-1.1885272473851681e-03 +-1.1997911797904993e-03 +-1.2085232013145867e-03 +-1.2138890320078236e-03 +-1.2151774960941530e-03 +-1.2118956330875793e-03 +-1.2038381195399403e-03 +-1.1911133828898894e-03 +-1.1741211398882576e-03 +-1.1534895905965941e-03 +-1.1299896820971514e-03 +-1.1044460697649198e-03 +-1.0776605203843123e-03 +-1.0503565448512873e-03 +-1.0231471687626088e-03 +-9.9652288899322421e-04 +-9.7085451639017471e-04 +-9.4640528594344426e-04 +-9.2334749345606771e-04 +-9.0178024493197089e-04 +-8.8174619590341468e-04 +-8.6324618344576251e-04 +-8.4625136121421589e-04 +-8.3071287736010519e-04 +-8.1656935849881869e-04 +-8.0375255059573071e-04 +-7.9219147555098979e-04 +-7.8181542919251448e-04 +-7.7255609671229852e-04 +-7.6434900920249282e-04 +-7.5713451689100853e-04 +-7.5085841381185650e-04 +-7.4547231554314181e-04 +-7.4093386573639017e-04 +-7.3720682740400958e-04 +-7.3426110019104637e-04 +-7.3207269405520497e-04 +-7.3062368198873926e-04 +-7.2990214880861229e-04 +-9.6691809554750447e-04 +-9.6882656547587185e-04 +-9.7261024483791779e-04 +-9.7820224719601351e-04 +-9.8550108242062410e-04 +-9.9436860316701875e-04 +-1.0046262904147966e-03 +-1.0160493853899229e-03 +-1.0283588415944177e-03 +-1.0412120412928612e-03 +-1.0541946653593000e-03 +-1.0668176830100288e-03 +-1.0785244280301872e-03 +-1.0887122435029525e-03 +-1.0967705662275398e-03 +-1.1021327902777482e-03 +-1.1043341439620248e-03 +-1.1030642455676415e-03 +-1.0982028090593618e-03 +-1.0898306170968252e-03 +-1.0782140727938023e-03 +-1.0637679897090768e-03 +-1.0470055465565948e-03 +-1.0284854651485857e-03 +-1.0087648158499821e-03 +-9.8836265129404626e-04 +-9.6773627860976240e-04 +-9.4726934320503214e-04 +-9.2726937039052575e-04 +-9.0797189886343544e-04 +-8.8954852599372133e-04 +-8.7211672713692569e-04 +-8.5574994754622740e-04 +-8.4048704001875622e-04 +-8.2634056748236324e-04 +-8.1330379827985794e-04 +-8.0135641303604322e-04 +-7.9046904539027663e-04 +-7.8060682307712435e-04 +-7.7173208374902921e-04 +-7.6380642797962668e-04 +-7.5679225085250712e-04 +-7.5065386994144397e-04 +-7.4535834489305260e-04 +-7.4087606391854365e-04 +-7.3718115584881893e-04 +-7.3425177296164500e-04 +-7.3207027919458458e-04 +-7.3062337015165392e-04 +-7.2990214496476810e-04 +-8.7486276260552247e-04 +-8.7658827158597591e-04 +-8.8001138623739926e-04 +-8.8507605728256589e-04 +-8.9169751059892002e-04 +-8.9976115641134428e-04 +-9.0912076480952379e-04 +-9.1959572217923324e-04 +-9.3096736619182935e-04 +-9.4297478630770868e-04 +-9.5531108138158878e-04 +-9.6762178646225231e-04 +-9.7950777094576590e-04 +-9.9053500633186110e-04 +-1.0002528565286055e-03 +-1.0082208401785743e-03 +-1.0140414552549050e-03 +-1.0173943734376580e-03 +-1.0180660141650988e-03 +-1.0159688484402229e-03 +-1.0111467902532323e-03 +-1.0037660578225663e-03 +-9.9409389955788427e-04 +-9.8246965421690128e-04 +-9.6927329704730872e-04 +-9.5489601723497397e-04 +-9.3971596004497520e-04 +-9.2408063052123860e-04 +-9.0829604682182675e-04 +-8.9262177899104606e-04 +-8.7727053926916403e-04 +-8.6241090449534774e-04 +-8.4817190799192220e-04 +-8.3464850773299986e-04 +-8.2190722667157862e-04 +-8.0999151653369638e-04 +-7.9892659610542147e-04 +-7.8872365688589612e-04 +-7.7938342101433681e-04 +-7.7089909021273661e-04 +-7.6325875148014987e-04 +-7.5644731484832671e-04 +-7.5044805769250184e-04 +-7.4524384373622003e-04 +-7.4081807611658295e-04 +-7.3715543454631394e-04 +-7.3424243773826292e-04 +-7.3206786430843297e-04 +-7.3062305849319728e-04 +-7.2990214112441212e-04 +-8.0313983995303738e-04 +-8.0472309126707801e-04 +-8.0786634421492704e-04 +-8.1252293078216996e-04 +-8.1862239684527363e-04 +-8.2606987845113044e-04 +-8.3474515238898155e-04 +-8.4450130968889659e-04 +-8.5516307622911128e-04 +-8.6652496351889165e-04 +-8.7834968560353570e-04 +-8.9036759818693551e-04 +-9.0227822077974026e-04 +-9.1375505365561644e-04 +-9.2445473951026185e-04 +-9.3403103610297715e-04 +-9.4215308575373120e-04 +-9.4852629727588391e-04 +-9.5291315007650027e-04 +-9.5515076418771559e-04 +-9.5516238299480434e-04 +-9.5296095139613905e-04 +-9.4864444195932158e-04 +-9.4238404871744045e-04 +-9.3440743794686036e-04 +-9.2497970416331580e-04 +-9.1438453569468823e-04 +-9.0290752211755491e-04 +-8.9082277552830660e-04 +-8.7838330221088029e-04 +-8.6581498602183364e-04 +-8.5331367992155034e-04 +-8.4104473367227093e-04 +-8.2914426597817371e-04 +-8.1772156213815871e-04 +-8.0686209503998076e-04 +-7.9663079345063082e-04 +-7.8707529654535385e-04 +-7.7822902804114695e-04 +-7.7011399506970426e-04 +-7.6274326800956243e-04 +-7.5612313161305730e-04 +-7.5025491893956843e-04 +-7.4513655145924099e-04 +-7.4076381414765508e-04 +-7.3713139565434211e-04 +-7.3423372227927040e-04 +-7.3206561160541622e-04 +-7.3062276793125916e-04 +-7.2990213754517311e-04 +-7.5076497006207864e-04 +-7.5224439903538449e-04 +-7.5518352729259282e-04 +-7.5954277190933461e-04 +-7.6526244390967741e-04 +-7.7226235604422211e-04 +-7.8044128137108809e-04 +-7.8967626493773007e-04 +-7.9982182521706757e-04 +-8.1070915008343738e-04 +-8.2214550088457138e-04 +-8.3391418152607439e-04 +-8.4577558025833845e-04 +-8.5746989853996262e-04 +-8.6872217583405895e-04 +-8.7925003856859953e-04 +-8.8877421998057190e-04 +-8.9703135559553778e-04 +-9.0378797160154843e-04 +-9.0885411459548226e-04 +-9.1209487921114682e-04 +-9.1343826346410929e-04 +-9.1287829855058052e-04 +-9.1047313244276744e-04 +-9.0633850821977206e-04 +-9.0063769023978387e-04 +-8.9356923966206904e-04 +-8.8535409861016981e-04 +-8.7622325864851827e-04 +-8.6640695653266418e-04 +-8.5612595725975151e-04 +-8.4558513022511383e-04 +-8.3496924614442133e-04 +-8.2444073717512928e-04 +-8.1413906488222705e-04 +-8.0418131254928946e-04 +-7.9466363814736712e-04 +-7.8566327194628269e-04 +-7.7724080244842206e-04 +-7.6944255510713816e-04 +-7.6230292357574103e-04 +-7.5584655978617197e-04 +-7.5009036602603990e-04 +-7.4504525980129870e-04 +-7.4071770179178246e-04 +-7.3711099004558048e-04 +-7.3422633114033926e-04 +-7.3206370263529871e-04 +-7.3062252183297223e-04 +-7.2990213451449367e-04 +-7.1661654258932470e-04 +-7.1802817159272842e-04 +-7.2083400580034063e-04 +-7.2499910051272232e-04 +-7.3047079928676545e-04 +-7.3717845633655351e-04 +-7.4503308428497395e-04 +-7.5392694883237652e-04 +-7.6373315027748821e-04 +-7.7430526450083343e-04 +-7.8547716710163020e-04 +-7.9706323335302298e-04 +-8.0885918467124009e-04 +-8.2064391972337105e-04 +-8.3218269555537198e-04 +-8.4323197788127840e-04 +-8.5354613433885390e-04 +-8.6288589619310939e-04 +-8.7102819116542782e-04 +-8.7777661462040983e-04 +-8.8297154076765025e-04 +-8.8649875889710455e-04 +-8.8829560033244759e-04 +-8.8835379839069843e-04 +-8.8671874284214792e-04 +-8.8348526280235598e-04 +-8.7879049967091538e-04 +-8.7280473596011276e-04 +-8.6572118557353946e-04 +-8.5774572709027095e-04 +-8.4908740801223175e-04 +-8.3995031671192124e-04 +-8.3052716372901565e-04 +-8.2099467879779252e-04 +-8.1151074235520323e-04 +-8.0221304190776466e-04 +-7.9321897322914728e-04 +-7.8462648443607716e-04 +-7.7651557441780811e-04 +-7.6895019256751327e-04 +-7.6198033289814275e-04 +-7.5564416389114542e-04 +-7.4997008021019437e-04 +-7.4497860060180395e-04 +-7.4068406667625872e-04 +-7.3709611984888756e-04 +-7.3422094930066201e-04 +-7.3206231349978658e-04 +-7.3062234282820365e-04 +-7.2990213231060338e-04 +-6.9978953343284513e-04 +-7.0116746674276102e-04 +-7.0390703938727288e-04 +-7.0797557938726626e-04 +-7.1332387491451527e-04 +-7.1988594695830774e-04 +-7.2757877532256330e-04 +-7.3630200507140953e-04 +-7.4593767317570638e-04 +-7.5635001530126821e-04 +-7.6738544330753606e-04 +-7.7887282594268762e-04 +-7.9062425514556632e-04 +-8.0243652901847162e-04 +-8.1409361402069746e-04 +-8.2537034247369238e-04 +-8.3603753620262275e-04 +-8.4586860967402811e-04 +-8.5464749883410243e-04 +-8.6217750947570305e-04 +-8.6829042774676788e-04 +-8.7285504521798926e-04 +-8.7578417910171371e-04 +-8.7703935079208161e-04 +-8.7663252310723398e-04 +-8.7462464920081610e-04 +-8.7112118483837462e-04 +-8.6626508100455838e-04 +-8.6022803791052573e-04 +-8.5320092547668371e-04 +-8.4538425537814552e-04 +-8.3697945216819434e-04 +-8.2818146039237677e-04 +-8.1917298953302134e-04 +-8.1012048012794706e-04 +-8.0117169961473067e-04 +-7.9245475735870846e-04 +-7.8407826434663834e-04 +-7.7613234533447425e-04 +-7.6869022717894562e-04 +-7.6181016367478079e-04 +-7.5553750334052749e-04 +-7.4990675395028464e-04 +-7.4494354082131967e-04 +-7.4066639206162466e-04 +-7.3708831213728184e-04 +-7.3421812544946822e-04 +-7.3206158500967774e-04 +-7.3062224898911459e-04 +-7.2990213115547715e-04 +-6.9978944951421288e-04 +-7.0116671051605498e-04 +-7.0390493389872332e-04 +-7.0797144063129182e-04 +-7.1331701388127622e-04 +-7.1987567824985420e-04 +-7.2756443418975640e-04 +-7.3628297418103781e-04 +-7.4591341947917694e-04 +-7.5632013597084330e-04 +-7.6734971785778077e-04 +-7.7883126953738049e-04 +-7.9057716605819269e-04 +-8.0238452178512851e-04 +-8.1403762958805117e-04 +-8.2531162809867454e-04 +-8.3597759120257800e-04 +-8.4580909807748298e-04 +-8.5459013572853802e-04 +-8.6212393316334565e-04 +-8.6824207337419710e-04 +-8.7281303631789125e-04 +-8.7574925111446331e-04 +-8.7701181557618333e-04 +-8.7661227685209336e-04 +-8.7461121951698149e-04 +-8.7111380750965232e-04 +-8.6626279385753236e-04 +-8.6022977875087304e-04 +-8.5320562271182568e-04 +-8.4539090304868001e-04 +-8.3698716477633816e-04 +-8.2818950638175804e-04 +-8.1918080502493189e-04 +-8.1012766632170973e-04 +-8.0117800812157009e-04 +-7.9246006782489212e-04 +-7.8408255826946177e-04 +-7.7613567922302327e-04 +-7.6869270735926856e-04 +-7.6181192422675160e-04 +-7.5553868796373398e-04 +-7.4990750202342550e-04 +-7.4494397754468569e-04 +-7.4066662233582552e-04 +-7.3708841770445338e-04 +-7.3421816477467722e-04 +-7.3206159538145778e-04 +-7.3062225034499007e-04 +-7.2990213117229887e-04 +-7.1661627771696021e-04 +-7.1802578472139915e-04 +-7.2082736038207266e-04 +-7.2498603836071700e-04 +-7.3044914831414372e-04 +-7.3714606014178841e-04 +-7.4498785966984249e-04 +-7.5386697541384123e-04 +-7.6365679303896678e-04 +-7.7421132519025961e-04 +-7.8536505395969489e-04 +-7.9693313143858332e-04 +-8.0871220238941117e-04 +-8.2048218295068095e-04 +-8.3200936105328935e-04 +-8.4305114406268305e-04 +-8.5336264022246064e-04 +-8.6270501705782235e-04 +-8.7085525866201815e-04 +-8.7761660540871969e-04 +-8.8282868674591426e-04 +-8.8637623098589884e-04 +-8.8819530640512289e-04 +-8.8827631691415542e-04 +-8.8666339165960166e-04 +-8.8345028229034370e-04 +-8.7877331526316259e-04 +-8.7280225878843068e-04 +-8.6573011157528741e-04 +-8.5776280251203055e-04 +-8.4910964009168746e-04 +-8.3997511975204603e-04 +-8.3055244072324287e-04 +-8.2101884604173522e-04 +-8.1153270875762476e-04 +-8.0223215628641691e-04 +-7.9323495239047375e-04 +-7.8463933303921703e-04 +-7.7652550519272925e-04 +-7.6895755291765027e-04 +-7.6198554161272642e-04 +-7.5564765980285615e-04 +-7.4997228321745395e-04 +-7.4497988450769647e-04 +-7.4068474270804646e-04 +-7.3709642942559070e-04 +-7.3422106452312997e-04 +-7.3206234386984852e-04 +-7.3062234679672578e-04 +-7.2990213235979103e-04 +-7.5076448270120649e-04 +-7.5224000725337243e-04 +-7.5517130032944958e-04 +-7.5951874152564952e-04 +-7.6522262343928194e-04 +-7.7220280383322485e-04 +-7.8035822066306799e-04 +-7.8956626786889602e-04 +-7.9968206105656661e-04 +-8.1053768677913276e-04 +-8.2194163488400883e-04 +-8.3367875564705743e-04 +-8.4551123651519042e-04 +-8.5718120680654665e-04 +-8.6841558447255877e-04 +-8.7893361226706131e-04 +-8.8845716203381578e-04 +-8.9672335129797995e-04 +-9.0349842718994257e-04 +-9.0859139204754562e-04 +-9.1186563331236933e-04 +-9.1324697141247665e-04 +-9.1272703793684378e-04 +-9.1036161973981073e-04 +-9.0626436781357273e-04 +-9.0059689271267953e-04 +-8.9355663251007502e-04 +-8.8536395305610302e-04 +-8.7624976914166253e-04 +-8.6644464946260583e-04 +-8.5616998692208458e-04 +-8.4563145901872419e-04 +-8.3501472001653817e-04 +-8.2448307580408413e-04 +-8.1417678954671848e-04 +-8.0421363426953947e-04 +-7.9469032586399044e-04 +-7.8568451645588796e-04 +-7.7725708748050608e-04 +-7.6945454292194485e-04 +-7.6231135912052238e-04 +-7.5585219488580931e-04 +-7.5009390327936804e-04 +-7.4504731470299531e-04 +-7.4071878096393351e-04 +-7.3711148320199863e-04 +-7.3422651439294950e-04 +-7.3206375087920986e-04 +-7.3062252813219726e-04 +-7.2990213459256175e-04 +-8.0313905358665933e-04 +-8.0471600509911256e-04 +-8.0784661703382343e-04 +-8.1248416679753556e-04 +-8.1855818856500675e-04 +-8.2597393167467017e-04 +-8.3461151476281383e-04 +-8.4432471477555388e-04 +-8.5493939893516700e-04 +-8.6625175947616095e-04 +-8.7802675851914893e-04 +-8.8999751035026477e-04 +-9.0186664115724652e-04 +-9.1331083525620109e-04 +-9.2398964111521566e-04 +-9.3355905505746698e-04 +-9.4168944090864250e-04 +-9.4808617752023408e-04 +-9.5251040247060171e-04 +-9.5479671768988424e-04 +-9.5486498101951252e-04 +-9.5272430510396169e-04 +-9.4846883430289213e-04 +-9.4226633957499788e-04 +-9.3434176225112744e-04 +-9.2495832760321347e-04 +-9.1439873579276197e-04 +-9.0294838813160898e-04 +-8.9088185743932727e-04 +-8.7845307669239491e-04 +-8.6588913863391262e-04 +-8.5338722451547505e-04 +-8.4111400190194498e-04 +-8.2920680356677755e-04 +-8.1777596658745360e-04 +-8.0690782420433634e-04 +-7.9666796777283348e-04 +-7.8710451111096654e-04 +-7.7825118474104894e-04 +-7.7013016042370216e-04 +-7.6275455866358125e-04 +-7.5613062707373499e-04 +-7.5025959956721399e-04 +-7.4513925889475895e-04 +-7.4076523100434087e-04 +-7.3713204129245442e-04 +-7.3423396166413964e-04 +-7.3206567452469191e-04 +-7.3062277613783521e-04 +-7.2990213764680318e-04 +-8.7486155506315223e-04 +-8.7657739020938566e-04 +-8.7998109596460112e-04 +-8.8501655202621974e-04 +-8.9159900536694015e-04 +-8.9961412805991811e-04 +-9.0891637808132347e-04 +-9.1932645713665626e-04 +-9.3062782877844199e-04 +-9.4256263542871147e-04 +-9.5482794935689106e-04 +-9.6707401834097279e-04 +-9.7890678175594414e-04 +-9.8989707447899372e-04 +-9.9959824816848249e-04 +-1.0075722868965677e-03 +-1.0134221566628081e-03 +-1.0168258223713065e-03 +-1.0175660011383194e-03 +-1.0155499706992763e-03 +-1.0108156781201540e-03 +-1.0035233743498782e-03 +-9.9393501779725959e-04 +-9.8238581002301384e-04 +-9.6925297291379996e-04 +-9.5492632955344642e-04 +-9.3978387838208628e-04 +-9.2417392872206348e-04 +-9.0840395209840804e-04 +-8.9273533515558088e-04 +-8.7738273054629458e-04 +-8.6251659908692711e-04 +-8.4826768057277878e-04 +-8.3473239248182160e-04 +-8.2197844153267230e-04 +-8.1005018807471410e-04 +-7.9897350424660847e-04 +-7.8876001064875803e-04 +-7.7941067038700830e-04 +-7.7091877504264757e-04 +-7.6327238563265673e-04 +-7.5645630234292562e-04 +-7.5045363681437716e-04 +-7.4524705494928589e-04 +-7.4081974976706276e-04 +-7.3715619469117821e-04 +-7.3424271885349558e-04 +-7.3206793805539766e-04 +-7.3062306809992968e-04 +-7.2990214124332286e-04 +-9.6691628577727485e-04 +-9.6881025757366993e-04 +-9.7256485366495706e-04 +-9.7811310690965351e-04 +-9.8535363733260879e-04 +-9.9414886609568457e-04 +-1.0043216293583509e-03 +-1.0156496545747444e-03 +-1.0278577993807175e-03 +-1.0406088975565783e-03 +-1.0534954921086455e-03 +-1.0660363386518741e-03 +-1.0776826332269368e-03 +-1.0878385432759518e-03 +-1.0958981253655635e-03 +-1.1012962536309286e-03 +-1.1035660608025521e-03 +-1.1023917069151745e-03 +-1.0976449144292149e-03 +-1.0893971798889490e-03 +-1.0779056683160675e-03 +-1.0635771543617706e-03 +-1.0469187394428761e-03 +-1.0284853408282857e-03 +-1.0088324120322584e-03 +-9.8847921912880018e-04 +-9.6788462290114171e-04 +-9.4743465721492911e-04 +-9.2743962761426759e-04 +-9.0813790196715932e-04 +-8.8970372020676298e-04 +-8.7225687364839264e-04 +-8.5587273216750429e-04 +-8.4059167066059251e-04 +-8.2642739482257158e-04 +-8.1337397896195701e-04 +-8.0141162397371843e-04 +-7.9051125066124375e-04 +-7.8063809063176712e-04 +-7.7175444691541682e-04 +-7.6382178583780686e-04 +-7.5680230146548733e-04 +-7.5066007080849687e-04 +-7.4536189559447547e-04 +-7.4087790659983495e-04 +-7.3718198985729352e-04 +-7.3425208055039894e-04 +-7.3207035972289267e-04 +-7.3062338062763446e-04 +-7.2990214509434229e-04 +-1.0795736327461852e-03 +-1.0816854960439245e-03 +-1.0858709696708866e-03 +-1.0920531400086166e-03 +-1.1001150096860456e-03 +-1.1098959121397848e-03 +-1.1211843060577153e-03 +-1.1337057112948985e-03 +-1.1471056947740198e-03 +-1.1609301748218945e-03 +-1.1746086881209820e-03 +-1.1874495984994210e-03 +-1.1986575832040925e-03 +-1.2073810087745638e-03 +-1.2127891771070637e-03 +-1.2141686816816838e-03 +-1.2110186666195845e-03 +-1.2031215715122871e-03 +-1.1905713788140483e-03 +-1.1737535027418217e-03 +-1.1532839651958073e-03 +-1.1299248949087637e-03 +-1.1044958846739492e-03 +-1.0777970948525838e-03 +-1.0505531560710737e-03 +-1.0233800509764864e-03 +-9.9677222866413596e-04 +-9.7110476825730335e-04 +-9.4664501164120349e-04 +-9.2356891146371163e-04 +-9.0197864231471303e-04 +-8.8191930773335485e-04 +-8.6339360587286301e-04 +-8.4637403334263909e-04 +-8.3081264581390268e-04 +-8.1664862533477138e-04 +-8.0381399795426784e-04 +-7.9223785716971455e-04 +-7.8184941809112502e-04 +-7.7258017889293414e-04 +-7.6436541437947206e-04 +-7.5714517863825423e-04 +-7.5086495285937578e-04 +-7.4547604115306166e-04 +-7.4093579110371961e-04 +-7.3720769585579305e-04 +-7.3426141961668032e-04 +-7.3207277751387865e-04 +-7.3062369283135632e-04 +-7.2990214894263290e-04 +-1.2115488581890370e-03 +-1.2139160973134607e-03 +-1.2186104492442279e-03 +-1.2255510108919621e-03 +-1.2346133987176399e-03 +-1.2456223606478359e-03 +-1.2583364241666086e-03 +-1.2724219867837200e-03 +-1.2874172115189420e-03 +-1.3026918249191002e-03 +-1.3174164987260545e-03 +-1.3305617380277958e-03 +-1.3409461252561058e-03 +-1.3473432662909335e-03 +-1.3486365601575020e-03 +-1.3439886665272390e-03 +-1.3329800739791901e-03 +-1.3156769261855265e-03 +-1.2926108170791329e-03 +-1.2646816263588217e-03 +-1.2330153442376421e-03 +-1.1988147961921041e-03 +-1.1632335296109673e-03 +-1.1272887695886807e-03 +-1.0918155358761359e-03 +-1.0574549151173606e-03 +-1.0246657903162637e-03 +-9.9374961774358365e-04 +-9.6488015204955577e-04 +-9.3813281058629833e-04 +-9.1351077708567031e-04 +-8.9096667029028235e-04 +-8.7041966756525946e-04 +-8.5176853162961688e-04 +-8.3490121263031405e-04 +-8.1970172809946900e-04 +-8.0605495681532614e-04 +-7.9384987868242967e-04 +-7.8298168403964326e-04 +-7.7335307780729864e-04 +-7.6487502225593021e-04 +-7.5746709745801849e-04 +-7.5105760888533686e-04 +-7.4558353456650518e-04 +-7.4099037712888451e-04 +-7.3723196661888560e-04 +-7.3427024633519169e-04 +-7.3207506450441971e-04 +-7.3062398830908617e-04 +-7.2990215258597981e-04 +-1.3589553616962025e-03 +-1.3616086297719647e-03 +-1.3668807800313646e-03 +-1.3747019350753903e-03 +-1.3849614514654567e-03 +-1.3974927744191575e-03 +-1.4120414963486284e-03 +-1.4282116884952747e-03 +-1.4453928748955915e-03 +-1.4626832773447383e-03 +-1.4788408389975589e-03 +-1.4923032396506938e-03 +-1.5013101804167599e-03 +-1.5041297811668644e-03 +-1.4993448537508234e-03 +-1.4861178146163797e-03 +-1.4643496309956088e-03 +-1.4346845187520399e-03 +-1.3983690397682109e-03 +-1.3570211980812343e-03 +-1.3123816255951398e-03 +-1.2661052680979757e-03 +-1.2196231445215935e-03 +-1.1740762522214705e-03 +-1.1303066562966910e-03 +-1.0888851079097269e-03 +-1.0501565046493622e-03 +-1.0142897606074976e-03 +-9.8132413319632484e-04 +-9.5120832009184034e-04 +-9.2383139427929732e-04 +-8.9904614103382451e-04 +-8.7668600001397667e-04 +-8.5657695457544815e-04 +-8.3854560020437568e-04 +-8.2242441765409294e-04 +-8.0805505577748692e-04 +-7.9529023152974799e-04 +-7.8399469277054556e-04 +-7.7404556370879178e-04 +-7.6533229841405765e-04 +-7.5775639868725102e-04 +-7.5123100294388688e-04 +-7.4568041772956391e-04 +-7.4103963919478909e-04 +-7.3725389535106900e-04 +-7.3427822901319219e-04 +-7.3207713436471394e-04 +-7.3062425587246702e-04 +-7.2990215588625079e-04 +-1.5143495667292886e-03 +-1.5173065179514525e-03 +-1.5232061128469202e-03 +-1.5320177818020149e-03 +-1.5436845164082957e-03 +-1.5580929076729191e-03 +-1.5750097844062893e-03 +-1.5939770713155267e-03 +-1.6141732978123900e-03 +-1.6342786841387169e-03 +-1.6524109225648747e-03 +-1.6662089808967091e-03 +-1.6731095425040715e-03 +-1.6707828974744051e-03 +-1.6576068192345817e-03 +-1.6330152775815103e-03 +-1.5975994651024072e-03 +-1.5529414657015443e-03 +-1.5012635442921381e-03 +-1.4450237288421530e-03 +-1.3865708234384860e-03 +-1.3279178773512098e-03 +-1.2706391138753755e-03 +-1.2158624316167964e-03 +-1.1643198024128504e-03 +-1.1164229390691037e-03 +-1.0723421899158511e-03 +-1.0320767506184327e-03 +-9.9551157365210382e-04 +-9.6246064889033301e-04 +-9.3269837502763940e-04 +-9.0598140480310405e-04 +-8.8206329232951648e-04 +-8.6070391764534880e-04 +-8.4167523918652698e-04 +-8.2476453396286044e-04 +-8.0977596457844413e-04 +-7.9653106559116245e-04 +-7.8486855939065325e-04 +-7.7464378054163229e-04 +-7.6572789485426708e-04 +-7.5800703496812160e-04 +-7.5138143001062538e-04 +-7.4576457702468075e-04 +-7.4108248209788570e-04 +-7.3727298642479295e-04 +-7.3428518474335559e-04 +-7.3207893916450782e-04 +-7.3062448928095617e-04 +-7.2990215876619956e-04 +-1.6665399750117520e-03 +-1.6697986820323385e-03 +-1.6763433627316486e-03 +-1.6862251204940986e-03 +-1.6995002327462735e-03 +-1.7161746818397728e-03 +-1.7360873125963296e-03 +-1.7587190957777297e-03 +-1.7829510391198932e-03 +-1.8068488833108405e-03 +-1.8276037736161324e-03 +-1.8417577090254292e-03 +-1.8457520142186547e-03 +-1.8366753588712344e-03 +-1.8129494026549030e-03 +-1.7746836941978320e-03 +-1.7235785470924834e-03 +-1.6624586447553989e-03 +-1.5946506139990057e-03 +-1.5234183548490468e-03 +-1.4515805617221348e-03 +-1.3813320683859090e-03 +-1.3142248683427899e-03 +-1.2512442190783521e-03 +-1.1929241405143564e-03 +-1.1394659207869516e-03 +-1.0908411466106621e-03 +-1.0468730287022090e-03 +-1.0072965267833077e-03 +-9.7180065152239852e-04 +-9.4005699467969786e-04 +-9.1173818299462557e-04 +-8.8652924169098737e-04 +-8.6413412070631779e-04 +-8.4427901191464372e-04 +-8.2671359972743272e-04 +-8.1121102904494380e-04 +-7.9756711870549368e-04 +-7.8559916990825868e-04 +-7.7514459621039482e-04 +-7.6605951822472250e-04 +-7.5821741009588373e-04 +-7.5150784771083892e-04 +-7.4583538447199811e-04 +-7.4111856523352885e-04 +-7.3728907984459829e-04 +-7.3429105272129617e-04 +-7.3208046261931262e-04 +-7.3062468638348762e-04 +-7.2990216119904017e-04 +-1.8021134848470650e-03 +-1.8056479692324671e-03 +-1.8128098619297488e-03 +-1.8237793670668628e-03 +-1.8387927363663710e-03 +-1.8580492689491514e-03 +-1.8815165179046102e-03 +-1.9086171047614790e-03 +-1.9378446150229564e-03 +-1.9664526437262139e-03 +-1.9904381962342140e-03 +-2.0050097360126253e-03 +-2.0055349272017193e-03 +-1.9886765903859658e-03 +-1.9532511929779882e-03 +-1.9004484155273566e-03 +-1.8333768955911941e-03 +-1.7562096798107007e-03 +-1.6733003674143047e-03 +-1.5885319700233280e-03 +-1.5049802555587234e-03 +-1.4248405326628903e-03 +-1.3495167590444218e-03 +-1.2797806609727035e-03 +-1.2159399215256610e-03 +-1.1579847474897345e-03 +-1.1057026572975810e-03 +-1.0587622987386367e-03 +-1.0167715566040776e-03 +-9.7931610553297519e-04 +-9.4598389110658540e-04 +-9.1637987201708499e-04 +-8.9013422663199453e-04 +-8.6690629600185776e-04 +-8.4638583018724247e-04 +-8.2829259607710001e-04 +-8.1237504869161937e-04 +-7.9840852339516631e-04 +-7.8619324080095115e-04 +-7.7555230517744602e-04 +-7.6632980359189718e-04 +-7.5838906484013298e-04 +-7.5161110618747386e-04 +-7.4589327648689617e-04 +-7.4114809257219553e-04 +-7.3730225937767430e-04 +-7.3429586129544029e-04 +-7.3208171164602606e-04 +-7.3062484803562905e-04 +-7.2990216319504238e-04 +-1.9091941148749146e-03 +-1.9129552660196870e-03 +-1.9206507464730371e-03 +-1.9326186990284355e-03 +-1.9493165056822083e-03 +-1.9711845249414600e-03 +-1.9983612217166595e-03 +-2.0302280723589767e-03 +-2.0648616094960585e-03 +-2.0986184636330148e-03 +-2.1261902828791407e-03 +-2.1413889724551578e-03 +-2.1385770025961997e-03 +-2.1142094829160732e-03 +-2.0677780023423292e-03 +-2.0017518016287269e-03 +-1.9206688506300002e-03 +-1.8298979496369197e-03 +-1.7345748559858588e-03 +-1.6389581769168031e-03 +-1.5461982327436179e-03 +-1.4583864075718284e-03 +-1.3767410682479640e-03 +-1.3018278420943313e-03 +-1.2337597592757461e-03 +-1.1723569197110144e-03 +-1.1172641065779591e-03 +-1.0680326972772147e-03 +-1.0241751841089334e-03 +-9.8519992396546401e-04 +-9.5063219346802608e-04 +-9.2002605294997514e-04 +-8.9297021291037779e-04 +-8.6909010271407953e-04 +-8.4804762478462008e-04 +-8.2953957664643526e-04 +-8.1329537996369062e-04 +-7.9907452383973525e-04 +-7.8666397471838668e-04 +-7.7587570279826032e-04 +-7.6654440794147918e-04 +-7.5852548498454267e-04 +-7.5169324126088605e-04 +-7.4593936269046310e-04 +-7.4117161543045800e-04 +-7.3731276540137201e-04 +-7.3429969643482322e-04 +-7.3208270822583518e-04 +-7.3062497705130426e-04 +-7.2990216478876872e-04 +-1.9821981056956637e-03 +-1.9861219990561191e-03 +-1.9942129753348805e-03 +-2.0069474247384339e-03 +-2.0249788605097457e-03 +-2.0489697757500609e-03 +-2.0792368756416121e-03 +-2.1151765119117030e-03 +-2.1545617592059257e-03 +-2.1930068738821099e-03 +-2.2240637703789395e-03 +-2.2403091483703557e-03 +-2.2352560611926856e-03 +-2.2052740609335721e-03 +-2.1505485047915896e-03 +-2.0746867256563922e-03 +-1.9833743175419515e-03 +-1.8828437675449802e-03 +-1.7787283893476475e-03 +-1.6754799064650624e-03 +-1.5762464951051590e-03 +-1.4830179921962519e-03 +-1.3968749384351883e-03 +-1.3182428392500207e-03 +-1.2471072607270358e-03 +-1.1831781792578501e-03 +-1.1260075596326053e-03 +-1.0750694490803997e-03 +-1.0298122467318879e-03 +-9.8969130056958160e-04 +-9.5418807507112230e-04 +-9.2282041523805626e-04 +-8.9514707506124476e-04 +-8.7076867398214804e-04 +-8.4932652996054395e-04 +-8.3050032135923791e-04 +-8.1400519116851572e-04 +-7.9958867910244187e-04 +-7.8702771547635724e-04 +-7.7612581115135942e-04 +-7.6671051332574431e-04 +-7.5863115595077254e-04 +-7.5175690821752594e-04 +-7.4597510957426813e-04 +-7.4118987158824728e-04 +-7.3732092326118405e-04 +-7.3430267563943420e-04 +-7.3208348263704428e-04 +-7.3062507732770516e-04 +-7.2990216602815405e-04 +-2.0242429277985432e-03 +-2.0282647985976764e-03 +-2.0365822362775456e-03 +-2.0497330128306885e-03 +-2.0684636448423648e-03 +-2.0935602695325325e-03 +-2.1254809014427615e-03 +-2.1637311113414546e-03 +-2.2060478474748017e-03 +-2.2477110559463659e-03 +-2.2815736624017036e-03 +-2.2993231215481221e-03 +-2.2937832886922370e-03 +-2.2611691524904304e-03 +-2.2020687619974163e-03 +-2.1207892552801096e-03 +-2.0237051472639148e-03 +-1.9175504974209250e-03 +-1.8082455549725636e-03 +-1.7003657634769972e-03 +-1.5970842743125867e-03 +-1.5003652860733064e-03 +-1.4112414879638058e-03 +-1.3300829466272716e-03 +-1.2568192241132845e-03 +-1.1911070434635809e-03 +-1.1324494360141868e-03 +-1.0802765249658161e-03 +-1.0339979802865579e-03 +-9.9303548310098323e-04 +-9.5684155969437770e-04 +-9.2490939682179636e-04 +-8.9677687107767631e-04 +-8.7202700203695257e-04 +-8.5028630793525370e-04 +-8.3122203348805603e-04 +-8.1453887143858607e-04 +-7.9997556515388883e-04 +-7.8730162412211457e-04 +-7.7631428247411903e-04 +-7.6683576522337154e-04 +-7.5871088570123892e-04 +-7.5180497253448623e-04 +-7.4600210990246078e-04 +-7.4120366711822336e-04 +-7.3732709030124486e-04 +-7.3430492854493937e-04 +-7.3208406840313388e-04 +-7.3062515319027995e-04 +-7.2990216696649612e-04 +-2.0445765601439562e-03 +-2.0486445240644061e-03 +-2.0570338645387195e-03 +-2.0702443933887250e-03 +-2.0889795230638821e-03 +-2.1140098190118944e-03 +-2.1458574888132396e-03 +-2.1842106443057136e-03 +-2.2270634223701654e-03 +-2.2698609465174016e-03 +-2.3053323659971078e-03 +-2.3247264239188402e-03 +-2.3203330692582319e-03 +-2.2880163208440860e-03 +-2.2283041397871089e-03 +-2.1456546128084254e-03 +-2.0466711415542409e-03 +-1.9383076547331444e-03 +-1.8266640381071955e-03 +-1.7164520481304870e-03 +-1.6109422866252157e-03 +-1.5121628261368467e-03 +-1.4211822346965001e-03 +-1.3383845167440854e-03 +-1.2636973352028601e-03 +-1.1967651843914490e-03 +-1.1370730031158801e-03 +-1.0840302508286364e-03 +-1.0370255826340322e-03 +-9.9546067319414787e-04 +-9.5876978183456697e-04 +-9.2642987439559411e-04 +-8.9796469298440945e-04 +-8.7294509665911048e-04 +-8.5098722780244270e-04 +-8.3174952184778992e-04 +-8.1492921049098146e-04 +-8.0025872132746193e-04 +-7.8750221321812126e-04 +-7.7645238004495477e-04 +-7.6692758729288624e-04 +-7.5876936321184294e-04 +-7.5184024050778191e-04 +-7.4602192967379924e-04 +-7.4121379738714460e-04 +-7.3733162023250189e-04 +-7.3430658380910457e-04 +-7.3208449886361137e-04 +-7.3062520894686853e-04 +-7.2990216765692160e-04 +-2.0529830693574464e-03 +-2.0570649311650847e-03 +-2.0654277490843218e-03 +-2.0784658897879341e-03 +-2.0967425793777866e-03 +-2.1208993649192709e-03 +-2.1514260605846442e-03 +-2.1881775633768173e-03 +-2.2295553361283823e-03 +-2.2715354976705340e-03 +-2.3072374973311591e-03 +-2.3279324569349942e-03 +-2.3255608826316804e-03 +-2.2954606215068243e-03 +-2.2376789717752986e-03 +-2.1563679749415205e-03 +-2.0580237234714325e-03 +-1.9496493229903475e-03 +-1.8374837101456018e-03 +-1.7264064432355574e-03 +-1.6198433975872610e-03 +-1.5199453398398739e-03 +-1.4278665551917520e-03 +-1.3440440765258486e-03 +-1.2684334771189156e-03 +-1.2006897195198604e-03 +-1.1402971371216831e-03 +-1.0866582214481186e-03 +-1.0391515090778696e-03 +-9.9716744823614696e-04 +-9.6012917258083807e-04 +-9.2750327398958871e-04 +-8.9880417005328895e-04 +-8.7359453082841844e-04 +-8.5148341270453449e-04 +-8.3212317576838730e-04 +-8.1520587030150800e-04 +-8.0045951582217978e-04 +-7.8764452300642538e-04 +-7.7655039647035729e-04 +-7.6699278481894993e-04 +-7.5881089981592344e-04 +-7.5186529973394784e-04 +-7.4603601663328627e-04 +-7.4122099944317775e-04 +-7.3733484150985699e-04 +-7.3430776110985614e-04 +-7.3208480507273670e-04 +-7.3062524861374834e-04 +-7.2990216814898426e-04 +-2.0560405138041206e-03 +-2.0601215912717618e-03 +-2.0684227648032961e-03 +-2.0812202980049583e-03 +-2.0989128985275905e-03 +-2.1219667339603932e-03 +-2.1507618479451574e-03 +-2.1852282404177976e-03 +-2.2241382692129541e-03 +-2.2641174707486483e-03 +-2.2989763236282703e-03 +-2.3203619924364806e-03 +-2.3200645591623971e-03 +-2.2928416030280866e-03 +-2.2380333425889988e-03 +-2.1592390024823870e-03 +-2.0626769907384226e-03 +-1.9553192412174519e-03 +-1.8435239004226949e-03 +-1.7323464399306709e-03 +-1.6253840468711594e-03 +-1.5249257487692169e-03 +-1.4322245947874267e-03 +-1.3477814611540300e-03 +-1.2715891079374383e-03 +-1.2033211913162793e-03 +-1.1424688458389143e-03 +-1.0884342607096502e-03 +-1.0405917968483826e-03 +-9.9832590894283028e-04 +-9.6105315649541972e-04 +-9.2823367455152433e-04 +-8.9937589926304380e-04 +-8.7403714752472630e-04 +-8.5182178580455240e-04 +-8.3237811915551948e-04 +-8.1539471913724335e-04 +-8.0059663337758550e-04 +-7.8774173789421839e-04 +-7.7661737574332562e-04 +-7.6703735094984734e-04 +-7.5883930035923399e-04 +-7.5188243831967704e-04 +-7.4604565327543438e-04 +-7.4122592726371620e-04 +-7.3733704597984083e-04 +-7.3430856691101881e-04 +-7.3208501468106923e-04 +-7.3062527576924321e-04 +-7.2990216848687370e-04 +-2.0570060304026952e-03 +-2.0610821893309005e-03 +-2.0693258563267520e-03 +-2.0819185946154839e-03 +-2.0991223051870047e-03 +-2.1212422535637696e-03 +-2.1485214058565936e-03 +-2.1808741698775718e-03 +-2.2173134255385248e-03 +-2.2550305071641968e-03 +-2.2885737854221305e-03 +-2.3101230729902799e-03 +-2.3114715149954333e-03 +-2.2868654369067190e-03 +-2.2349324103552795e-03 +-2.1586870056133169e-03 +-2.0640404875311457e-03 +-1.9579097901036928e-03 +-1.8467497301446853e-03 +-1.7357690116378104e-03 +-1.6287150742817498e-03 +-1.5279980100420052e-03 +-1.4349574244362300e-03 +-1.3501506941868003e-03 +-1.2736044109342769e-03 +-1.2050104423917199e-03 +-1.1438680851654549e-03 +-1.0895816192631209e-03 +-1.0415240824806929e-03 +-9.9907687772865755e-04 +-9.6165280322218680e-04 +-9.2870810778164666e-04 +-8.9974752848212579e-04 +-8.7432501762165187e-04 +-8.5204196328389991e-04 +-8.3254407746267186e-04 +-8.1551769655387077e-04 +-8.0068595220642578e-04 +-7.8780508233674629e-04 +-7.7666103047434223e-04 +-7.6706640467806976e-04 +-7.5885781951991421e-04 +-7.5189361619419864e-04 +-7.4605193951880571e-04 +-7.4122914235013476e-04 +-7.3733848446203704e-04 +-7.3430909278322462e-04 +-7.3208515148588313e-04 +-7.3062529349430670e-04 +-7.2990216870864736e-04 +-2.0572330705430821e-03 +-2.0613045912966001e-03 +-2.0695076168864789e-03 +-2.0819608975955620e-03 +-2.0988331138711469e-03 +-2.1203121409116435e-03 +-2.1465225221855623e-03 +-2.1773220429780289e-03 +-2.2118434904620722e-03 +-2.2476761099826754e-03 +-2.2799720607746851e-03 +-2.3014104508354521e-03 +-2.3038596825624177e-03 +-2.2811898676004918e-03 +-2.2314593784231065e-03 +-2.1572068997764544e-03 +-2.0640909839826382e-03 +-1.9589780066002161e-03 +-1.8483918833687501e-03 +-1.7376541961037326e-03 +-1.6306229974651196e-03 +-1.5297971894677308e-03 +-1.4365797791044865e-03 +-1.3515696674531467e-03 +-1.2748186078150488e-03 +-1.2060324094125803e-03 +-1.1447170958701913e-03 +-1.0902792926122706e-03 +-1.0420918823430228e-03 +-9.9953480277689341e-04 +-9.6201879843275061e-04 +-9.2899789349883404e-04 +-8.9997465695371463e-04 +-8.7450104193671102e-04 +-8.5217665158151428e-04 +-8.3264563494047283e-04 +-8.1559297584347414e-04 +-8.0074064323830494e-04 +-7.8784387891123013e-04 +-7.7668777400938770e-04 +-7.6708420730742970e-04 +-7.5886916939636511e-04 +-7.5190046807127901e-04 +-7.4605579354518835e-04 +-7.4123111378074336e-04 +-7.3733936662744308e-04 +-7.3430941531549537e-04 +-7.3208523539937311e-04 +-7.3062530436764095e-04 +-7.2990216884623066e-04 +-2.0572420268849113e-03 +-2.0613103606050699e-03 +-2.0694888619553153e-03 +-2.0818597515609304e-03 +-2.0985366149514580e-03 +-2.1196350309556941e-03 +-2.1451992331463646e-03 +-2.1750324827824528e-03 +-2.2083156044156245e-03 +-2.2428754702275037e-03 +-2.2742677984914357e-03 +-2.2955330137604006e-03 +-2.2986203144132774e-03 +-2.2771646651180621e-03 +-2.2288482509703034e-03 +-2.1558915884622686e-03 +-2.0637830974986589e-03 +-1.9593528881860396e-03 +-1.8491671936473825e-03 +-1.7386184626094908e-03 +-1.6316343074516512e-03 +-1.5307694421883430e-03 +-1.4374667357741264e-03 +-1.3523512829753369e-03 +-1.2754908418502165e-03 +-1.2066002491535135e-03 +-1.1451900642811198e-03 +-1.0906687072262209e-03 +-1.0424092742003799e-03 +-9.9979106977056940e-04 +-9.6222380527377974e-04 +-9.2916033201854943e-04 +-9.0010205029071848e-04 +-8.7459982193854521e-04 +-8.5225226797589447e-04 +-8.3270267288515617e-04 +-8.1563526948450100e-04 +-8.0077137936238312e-04 +-7.8786568855193921e-04 +-7.7670281189446246e-04 +-7.6709422013651965e-04 +-7.5887555439689005e-04 +-7.5190432346790151e-04 +-7.4605796252767025e-04 +-7.4123222345697513e-04 +-7.3733986325270906e-04 +-7.3430959691130873e-04 +-7.3208528265006920e-04 +-7.3062531049128973e-04 +-7.2990216892567016e-04 +-2.0572136813918219e-03 +-2.0612802236373864e-03 +-2.0694459144877629e-03 +-2.0817743441635733e-03 +-2.0983507499742842e-03 +-2.1192526586766730e-03 +-2.1444796904355056e-03 +-2.1737996728436277e-03 +-2.2064091542083096e-03 +-2.2402563980255378e-03 +-2.2711200526887459e-03 +-2.2922502892668587e-03 +-2.2956526321461579e-03 +-2.2748388281166074e-03 +-2.2272849935858420e-03 +-2.1550352325905978e-03 +-2.0634824741599610e-03 +-1.9594349197207912e-03 +-1.8494801802396942e-03 +-1.7390479937835501e-03 +-1.6321028871553211e-03 +-1.5312293237126199e-03 +-1.4378915141162456e-03 +-1.3527286651949316e-03 +-1.2758172446532044e-03 +-1.2068770878940979e-03 +-1.1454213525875555e-03 +-1.0908595811335413e-03 +-1.0425651304938395e-03 +-9.9991709467249089e-04 +-9.6232474197423799e-04 +-9.2924038876732781e-04 +-9.0016488740332515e-04 +-8.7464858010166235e-04 +-8.5228961561848208e-04 +-8.3273085990437563e-04 +-8.1565618046292628e-04 +-8.0078658285527256e-04 +-7.8787648106161119e-04 +-7.7671025625689364e-04 +-7.6709917866760147e-04 +-7.5887871741742695e-04 +-7.5190623395595822e-04 +-7.4605903764092302e-04 +-7.4123277363729299e-04 +-7.3734010953568332e-04 +-7.3430968698405064e-04 +-7.3208530609047832e-04 +-7.3062531353025140e-04 +-7.2990216896775260e-04 +-2.0571951358039852e-03 +-2.0612608727602613e-03 +-2.0694210555694632e-03 +-2.0817313758164594e-03 +-2.0982649615372728e-03 +-2.1190828344464069e-03 +-2.1441646180217207e-03 +-2.1732608365783784e-03 +-2.2055717887287220e-03 +-2.2390963144580619e-03 +-2.2697113878751723e-03 +-2.2907632973928759e-03 +-2.2942873091477299e-03 +-2.2737443622842502e-03 +-2.2265209300679728e-03 +-2.1545827546087986e-03 +-2.0632791898260324e-03 +-1.9594071320901507e-03 +-1.8495622085910070e-03 +-1.7391895774462166e-03 +-1.6322694020690135e-03 +-1.5313989265018327e-03 +-1.4380516444625411e-03 +-1.3528729866852380e-03 +-1.2759433319843964e-03 +-1.2069848209601425e-03 +-1.1455118652387737e-03 +-1.0909346050788102e-03 +-1.0426266042563405e-03 +-9.9996694280493322e-04 +-9.6236475983001656e-04 +-9.2927219048384352e-04 +-9.0018989027790882e-04 +-8.7466800880007416e-04 +-8.5230451627674403e-04 +-8.3274211831889085e-04 +-8.1566454113106098e-04 +-8.0079266715939526e-04 +-7.8788080381323258e-04 +-7.7671324033259687e-04 +-7.6710116776924984e-04 +-7.5887998713152123e-04 +-7.5190700136429996e-04 +-7.4605946974820928e-04 +-7.4123299488170803e-04 +-7.3734020861964886e-04 +-7.3430972323624297e-04 +-7.3208531552803810e-04 +-7.3062531475516978e-04 +-7.2990216898842606e-04 +-2.0571887361294540e-03 +-2.0612542171410128e-03 +-2.0694126991472835e-03 +-2.0817174423345642e-03 +-2.0982377913092223e-03 +-2.1190294979157834e-03 +-2.1440655809305442e-03 +-2.1730903889607797e-03 +-2.2053042084927464e-03 +-2.2387206214372602e-03 +-2.2692474101426458e-03 +-2.2902627069647133e-03 +-2.2938139088862258e-03 +-2.2733484708934455e-03 +-2.2262258013531298e-03 +-2.1543866783797594e-03 +-2.0631655841940317e-03 +-1.9593545138618233e-03 +-1.8495505016198157e-03 +-1.7392028066162931e-03 +-1.6322960950565988e-03 +-1.5314314574511108e-03 +-1.4380852839212114e-03 +-1.3529050195887093e-03 +-1.2759723647915347e-03 +-1.2070102846198664e-03 +-1.1455336789498248e-03 +-1.0909529584445644e-03 +-1.0426418212309795e-03 +-9.9997939977795967e-04 +-9.6237483842193398e-04 +-9.2928025199413020e-04 +-9.0019626328312341e-04 +-8.7467298448855562e-04 +-8.5230834814915770e-04 +-8.3274502419194507e-04 +-8.1566670621705689e-04 +-8.0079424750927877e-04 +-7.8788192973403524e-04 +-7.7671401958099304e-04 +-7.6710168844200247e-04 +-7.5888032023829191e-04 +-7.5190720310875411e-04 +-7.4605958356029544e-04 +-7.4123305325422774e-04 +-7.3734023480079899e-04 +-7.3430973282758458e-04 +-7.3208531802814629e-04 +-7.3062531508168735e-04 +-7.2990216899993096e-04 +-2.0571877673444747e-03 +-2.0612532084043323e-03 +-2.0694114325909667e-03 +-2.0817153221969189e-03 +-2.0982335993393413e-03 +-2.1190210858232847e-03 +-2.1440495295408949e-03 +-2.1730618835155910e-03 +-2.2052578224603051e-03 +-2.2386526899258407e-03 +-2.2691591306400580e-03 +-2.2901612750347083e-03 +-2.2937101040528714e-03 +-2.2732524547788703e-03 +-2.2261441228803806e-03 +-2.1543216926299315e-03 +-2.0631165201491792e-03 +-1.9593189570166832e-03 +-1.8495255578826317e-03 +-1.7391857722122736e-03 +-1.6322847356247336e-03 +-1.5314240561094775e-03 +-1.4380805821192801e-03 +-1.3529021240247931e-03 +-1.2759706559548405e-03 +-1.2070093404318778e-03 +-1.1455332160549899e-03 +-1.0909527891971584e-03 +-1.0426418231282604e-03 +-9.9997949417220686e-04 +-9.6237497590086131e-04 +-9.2928040244256050e-04 +-9.0019640918169279e-04 +-8.7467311642689543e-04 +-8.5230846184303417e-04 +-8.3274511851490652e-04 +-8.1566678191276353e-04 +-8.0079430635702142e-04 +-7.8788197401395558e-04 +-7.7671405173523986e-04 +-7.6710171086305306e-04 +-7.5888033513887517e-04 +-7.5190721244458439e-04 +-7.4605958898756974e-04 +-7.4123305611184726e-04 +-7.3734023611174827e-04 +-7.3430973331732445e-04 +-7.3208531815872218e-04 +-7.3062531510157509e-04 +-7.2990216900942987e-04 diff --git a/AMSS_NCKU_source/BH_diagnostics.C b/AMSS_NCKU_source/BH_diagnostics.C new file mode 100644 index 0000000..c24adf7 --- /dev/null +++ b/AMSS_NCKU_source/BH_diagnostics.C @@ -0,0 +1,724 @@ +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" +#include "myglobal.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" +#include "driver.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + BH_diagnostics::BH_diagnostics() + : centroid_x(0.0), centroid_y(0.0), centroid_z(0.0), + quadrupole_xx(0.0), quadrupole_xy(0.0), quadrupole_xz(0.0), + quadrupole_yy(0.0), quadrupole_yz(0.0), + quadrupole_zz(0.0), + min_radius(0.0), max_radius(0.0), + mean_radius(0.0), + min_x(0.0), max_x(0.0), + min_y(0.0), max_y(0.0), + min_z(0.0), max_z(0.0), + circumference_xy(0.0), circumference_xz(0.0), circumference_yz(0.0), + area(0.0), irreducible_mass(0.0), areal_radius(0.0) // no comma + { + } + + void BH_diagnostics::copy_to_buffer(double buffer[N_buffer]) + const + { + buffer[posn__centroid_x] = centroid_x; + buffer[posn__centroid_y] = centroid_y; + buffer[posn__centroid_z] = centroid_z; + + buffer[posn__quadrupole_xx] = quadrupole_xx; + buffer[posn__quadrupole_xy] = quadrupole_xy; + buffer[posn__quadrupole_xz] = quadrupole_xz; + buffer[posn__quadrupole_yy] = quadrupole_yy; + buffer[posn__quadrupole_xz] = quadrupole_yz; + buffer[posn__quadrupole_zz] = quadrupole_zz; + + buffer[posn__min_radius] = min_radius; + buffer[posn__max_radius] = max_radius; + buffer[posn__mean_radius] = mean_radius; + + buffer[posn__min_x] = min_x; + buffer[posn__max_x] = max_x; + buffer[posn__min_y] = min_y; + buffer[posn__max_y] = max_y; + buffer[posn__min_z] = min_z; + buffer[posn__max_z] = max_z; + + buffer[posn__circumference_xy] = circumference_xy; + buffer[posn__circumference_xz] = circumference_xz; + buffer[posn__circumference_yz] = circumference_yz; + + buffer[posn__area] = area; + buffer[posn__irreducible_mass] = irreducible_mass; + buffer[posn__areal_radius] = areal_radius; + } + + void BH_diagnostics::copy_from_buffer(const double buffer[N_buffer]) + { + centroid_x = buffer[posn__centroid_x]; + centroid_y = buffer[posn__centroid_y]; + centroid_z = buffer[posn__centroid_z]; + + quadrupole_xx = buffer[posn__quadrupole_xx]; + quadrupole_xy = buffer[posn__quadrupole_xy]; + quadrupole_xz = buffer[posn__quadrupole_xz]; + quadrupole_yy = buffer[posn__quadrupole_yy]; + quadrupole_yz = buffer[posn__quadrupole_yz]; + quadrupole_zz = buffer[posn__quadrupole_zz]; + + min_radius = buffer[posn__min_radius]; + max_radius = buffer[posn__max_radius]; + mean_radius = buffer[posn__mean_radius]; + + min_x = buffer[posn__min_x]; + max_x = buffer[posn__max_x]; + min_y = buffer[posn__min_y]; + max_y = buffer[posn__max_y]; + min_z = buffer[posn__min_z]; + max_z = buffer[posn__max_z]; + + circumference_xy = buffer[posn__circumference_xy]; + circumference_xz = buffer[posn__circumference_xz]; + circumference_yz = buffer[posn__circumference_yz]; + + area = buffer[posn__area]; + irreducible_mass = buffer[posn__irreducible_mass]; + areal_radius = buffer[posn__areal_radius]; + } + void BH_diagnostics::compute(patch_system &ps) + { + jtutil::norm h_norms; + ps.ghosted_gridfn_norms(gfns::gfn__h, h_norms); + min_radius = h_norms.min_abs_value(); + max_radius = h_norms.max_abs_value(); + + jtutil::norm x_norms; + jtutil::norm y_norms; + jtutil::norm z_norms; + + ps.gridfn_norms(gfns::gfn__global_x, x_norms); + ps.gridfn_norms(gfns::gfn__global_y, y_norms); + ps.gridfn_norms(gfns::gfn__global_z, z_norms); + + min_x = x_norms.min_value(); + max_x = x_norms.max_value(); + min_y = y_norms.min_value(); + max_y = y_norms.max_value(); + min_z = z_norms.min_value(); + max_z = z_norms.max_value(); + +// adjust the bounding box for the symmetries +#define REFLECT(origin_, max_) (origin_ - (max_ - origin_)) + switch (ps.type()) + { + case patch_system::patch_system__full_sphere: + break; + case patch_system::patch_system__plus_z_hemisphere: + min_z = REFLECT(ps.origin_z(), max_z); + break; + case patch_system::patch_system__plus_xy_quadrant_mirrored: + case patch_system::patch_system__plus_xy_quadrant_rotating: + min_x = REFLECT(ps.origin_x(), max_x); + min_y = REFLECT(ps.origin_y(), max_y); + break; + case patch_system::patch_system__plus_xz_quadrant_mirrored: + case patch_system::patch_system__plus_xz_quadrant_rotating: + min_x = REFLECT(ps.origin_x(), max_x); + min_z = REFLECT(ps.origin_z(), max_z); + break; + case patch_system::patch_system__plus_xyz_octant_mirrored: + case patch_system::patch_system__plus_xyz_octant_rotating: + min_x = REFLECT(ps.origin_x(), max_x); + min_y = REFLECT(ps.origin_y(), max_y); + min_z = REFLECT(ps.origin_z(), max_z); + break; + default: + error_exit(PANIC_EXIT, + "***** BH_diagnostics::compute(): unknown patch system type()=(int)%d!\n" + " (this should never happen!)\n", + int(ps.type())); /*NOTREACHED*/ + } + + // + // surface integrals + // + const fp integral_one = surface_integral(ps, + gfns::gfn__one, true, true, true, + patch::integration_method__automatic_choice); + const fp integral_h = surface_integral(ps, + gfns::gfn__h, true, true, true, + patch::integration_method__automatic_choice); + const fp integral_x = surface_integral(ps, + gfns::gfn__global_x, true, true, false, + patch::integration_method__automatic_choice); + const fp integral_y = surface_integral(ps, + gfns::gfn__global_y, true, false, true, + patch::integration_method__automatic_choice); + const fp integral_z = surface_integral(ps, + gfns::gfn__global_z, false, true, true, + patch::integration_method__automatic_choice); + const fp integral_xx = surface_integral(ps, + gfns::gfn__global_xx, true, true, true, + patch::integration_method__automatic_choice); + const fp integral_xy = surface_integral(ps, + gfns::gfn__global_xy, true, false, false, + patch::integration_method__automatic_choice); + const fp integral_xz = surface_integral(ps, + gfns::gfn__global_xz, false, true, false, + patch::integration_method__automatic_choice); + const fp integral_yy = surface_integral(ps, + gfns::gfn__global_yy, true, true, true, + patch::integration_method__automatic_choice); + const fp integral_yz = surface_integral(ps, + gfns::gfn__global_yz, false, false, true, + patch::integration_method__automatic_choice); + const fp integral_zz = surface_integral(ps, + gfns::gfn__global_zz, true, true, true, + patch::integration_method__automatic_choice); + + // + // centroids + // + centroid_x = integral_x / integral_one; + centroid_y = integral_y / integral_one; + centroid_z = integral_z / integral_one; + + // + // quadrupoles (taken about centroid position) + // + quadrupole_xx = integral_xx / integral_one - centroid_x * centroid_x; + quadrupole_xy = integral_xy / integral_one - centroid_x * centroid_y; + quadrupole_xz = integral_xz / integral_one - centroid_x * centroid_z; + quadrupole_yy = integral_yy / integral_one - centroid_y * centroid_y; + quadrupole_yz = integral_yz / integral_one - centroid_y * centroid_z; + quadrupole_zz = integral_zz / integral_one - centroid_z * centroid_z; + + // + // mean radius of horizon + // + mean_radius = integral_h / integral_one; + + // + // surface area and quantities derived from it + // + area = integral_one; + irreducible_mass = sqrt(area / (16.0 * PI)); + areal_radius = sqrt(area / (4.0 * PI)); + + // + // proper circumferences + // + circumference_xy = ps.circumference("xy", gfns::gfn__h, + gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13, + gfns::gfn__g_dd_22, gfns::gfn__g_dd_23, + gfns::gfn__g_dd_33, + patch::integration_method__automatic_choice); + circumference_xz = ps.circumference("xz", gfns::gfn__h, + gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13, + gfns::gfn__g_dd_22, gfns::gfn__g_dd_23, + gfns::gfn__g_dd_33, + patch::integration_method__automatic_choice); + circumference_yz = ps.circumference("yz", gfns::gfn__h, + gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13, + gfns::gfn__g_dd_22, gfns::gfn__g_dd_23, + gfns::gfn__g_dd_33, + patch::integration_method__automatic_choice); + + // prepare P^i,S^i in xx,xy,xz and yy,yz,zz + { + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const fp g_xx = p.gridfn(gfns::gfn__g_dd_11, irho, isigma); + const fp g_xy = p.gridfn(gfns::gfn__g_dd_12, irho, isigma); + const fp g_xz = p.gridfn(gfns::gfn__g_dd_13, irho, isigma); + const fp g_yy = p.gridfn(gfns::gfn__g_dd_22, irho, isigma); + const fp g_yz = p.gridfn(gfns::gfn__g_dd_23, irho, isigma); + const fp g_zz = p.gridfn(gfns::gfn__g_dd_33, irho, isigma); + + const fp k_xx = p.gridfn(gfns::gfn__K_dd_11, irho, isigma); + const fp k_xy = p.gridfn(gfns::gfn__K_dd_12, irho, isigma); + const fp k_xz = p.gridfn(gfns::gfn__K_dd_13, irho, isigma); + const fp k_yy = p.gridfn(gfns::gfn__K_dd_22, irho, isigma); + const fp k_yz = p.gridfn(gfns::gfn__K_dd_23, irho, isigma); + const fp k_zz = p.gridfn(gfns::gfn__K_dd_33, irho, isigma); + const fp trk = p.gridfn(gfns::gfn__trK, irho, isigma); + + const fp r = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + fp xx, yy, zz; // local Cardesian coordinate + p.xyz_of_r_rho_sigma(r, rho, sigma, xx, yy, zz); + const fp X_ud_11 = p.partial_rho_wrt_x(xx, yy, zz); + const fp X_ud_12 = p.partial_rho_wrt_y(xx, yy, zz); + const fp X_ud_13 = p.partial_rho_wrt_z(xx, yy, zz); + const fp X_ud_21 = p.partial_sigma_wrt_x(xx, yy, zz); + const fp X_ud_22 = p.partial_sigma_wrt_y(xx, yy, zz); + const fp X_ud_23 = p.partial_sigma_wrt_z(xx, yy, zz); +#if 0 // for P^i and S^i + // F,i = x^i/r-X_ud_1i(dh/drho)-X_ud_2i(dh/dsigma) + double nx,ny,nz; + nx = xx/r-X_ud_11*p.partial_rho(gfns::gfn__h, irho,isigma)-X_ud_21*p.partial_sigma(gfns::gfn__h, irho,isigma); + ny = yy/r-X_ud_12*p.partial_rho(gfns::gfn__h, irho,isigma)-X_ud_22*p.partial_sigma(gfns::gfn__h, irho,isigma); + nz = zz/r-X_ud_13*p.partial_rho(gfns::gfn__h, irho,isigma)-X_ud_23*p.partial_sigma(gfns::gfn__h, irho,isigma); + double eps; // volume element + fp g_uu_11, g_uu_12, g_uu_13, g_uu_22, g_uu_23, g_uu_33; + double pxx,pxy,pxz,pyy,pyz,pzz; + { + fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15; + fp t18, t21; + t1 = g_yy; + t2 = g_zz; + t4 = g_yz; + t5 = t4*t4; + t7 = g_xx; + t8 = t7*t1; + t11 = g_xy; + t12 = t11*t11; + t14 = g_xz; + t15 = t11*t14; + t18 = t14*t14; + eps = t8*t2-t7*t5-t12*t2+2.0*t15*t4-t18*t1; + t21 = 1/eps; + eps = sqrt(eps); + g_uu_11 = (t1*t2-t5)*t21; + g_uu_12 = -(t11*t2-t14*t4)*t21; + g_uu_13 = -(-t11*t4+t14*t1)*t21; + g_uu_22 = (t7*t2-t18)*t21; + g_uu_23 = -(t7*t4-t15)*t21; + g_uu_33 = (t8-t12)*t21; + + t5 = g_uu_11*nx*nx+g_uu_22*ny*ny+g_uu_33*nz*nz+2*(g_uu_12*nx*ny+g_uu_13*nx*nz+g_uu_23*ny*nz); + t5 = sqrt(t5); + nx = nx/t5; // lower index + ny = ny/t5; + nz = nz/t5; + + pxx= g_uu_11*(g_uu_11*k_xx+g_uu_12*k_xy+g_uu_13*k_xz) + +g_uu_12*(g_uu_11*k_xy+g_uu_12*k_yy+g_uu_13*k_yz) + +g_uu_13*(g_uu_11*k_xz+g_uu_12*k_yz+g_uu_13*k_zz); //k^xx + pxy= g_uu_11*(g_uu_12*k_xx+g_uu_22*k_xy+g_uu_23*k_xz) + +g_uu_12*(g_uu_12*k_xy+g_uu_22*k_yy+g_uu_23*k_yz) + +g_uu_13*(g_uu_12*k_xz+g_uu_22*k_yz+g_uu_23*k_zz); //k^xy + pxz= g_uu_11*(g_uu_13*k_xx+g_uu_23*k_xy+g_uu_33*k_xz) + +g_uu_12*(g_uu_13*k_xy+g_uu_23*k_yy+g_uu_33*k_yz) + +g_uu_13*(g_uu_13*k_xz+g_uu_23*k_yz+g_uu_33*k_zz); //k^xz + pyy= g_uu_12*(g_uu_12*k_xx+g_uu_22*k_xy+g_uu_23*k_xz) + +g_uu_22*(g_uu_12*k_xy+g_uu_22*k_yy+g_uu_23*k_yz) + +g_uu_23*(g_uu_12*k_xz+g_uu_22*k_yz+g_uu_23*k_zz); //k^yy + pyz= g_uu_12*(g_uu_13*k_xx+g_uu_23*k_xy+g_uu_33*k_xz) + +g_uu_22*(g_uu_13*k_xy+g_uu_23*k_yy+g_uu_33*k_yz) + +g_uu_23*(g_uu_13*k_xz+g_uu_23*k_yz+g_uu_33*k_zz); //k^yz + pzz= g_uu_13*(g_uu_13*k_xx+g_uu_23*k_xy+g_uu_33*k_xz) + +g_uu_23*(g_uu_13*k_xy+g_uu_23*k_yy+g_uu_33*k_yz) + +g_uu_33*(g_uu_13*k_xz+g_uu_23*k_yz+g_uu_33*k_zz); //k^zz + } + + pxx = pxx-g_uu_11*trk; // tracefree + pyy = pyy-g_uu_22*trk; + pzz = pzz-g_uu_33*trk; + double tx,ty,tz; + double sxx,sxy,sxz,syx,syy,syz,szx,szy,szz; + tx = nx*pxx + ny*pxy + nz*pxz; + ty = nx*pxy + ny*pyy + nz*pyz; + tz = nx*pxz + ny*pyz + nz*pzz; + sxx = xx*tx; + sxy = xx*ty; + sxz = xx*tz; + syx = yy*tx; + syy = yy*ty; + syz = yy*tz; + szx = zz*tx; + szy = zz*ty; + szz = zz*tz; + p.gridfn(gfns::gfn__global_xx, irho,isigma) = tx; //p^x + p.gridfn(gfns::gfn__global_xy, irho,isigma) = ty; //p^y + p.gridfn(gfns::gfn__global_xz, irho,isigma) = tz; //p^z + tx = eps*(syz-szy); //s_x + ty = eps*(szx-sxz); + tz = eps*(sxy-syx); + p.gridfn(gfns::gfn__global_yy, irho,isigma) = g_uu_11*tx+g_uu_12*ty+g_uu_13*tz; //s^x + p.gridfn(gfns::gfn__global_yz, irho,isigma) = g_uu_12*tx+g_uu_22*ty+g_uu_23*tz; //s^y + p.gridfn(gfns::gfn__global_zz, irho,isigma) = g_uu_13*tx+g_uu_23*ty+g_uu_33*tz; //s^z +#endif +#if 1 // for P_i and S_i + // F,i = x^i/r-X_ud_1i(dh/drho)-X_ud_2i(dh/dsigma) + double nx, ny, nz; + nx = xx / r - X_ud_11 * p.partial_rho(gfns::gfn__h, irho, isigma) - X_ud_21 * p.partial_sigma(gfns::gfn__h, irho, isigma); + ny = yy / r - X_ud_12 * p.partial_rho(gfns::gfn__h, irho, isigma) - X_ud_22 * p.partial_sigma(gfns::gfn__h, irho, isigma); + nz = zz / r - X_ud_13 * p.partial_rho(gfns::gfn__h, irho, isigma) - X_ud_23 * p.partial_sigma(gfns::gfn__h, irho, isigma); + { + fp g_uu_11, g_uu_12, g_uu_13, g_uu_22, g_uu_23, g_uu_33; + fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15; + fp t18, t21; + t1 = g_yy; + t2 = g_zz; + t4 = g_yz; + t5 = t4 * t4; + t7 = g_xx; + t8 = t7 * t1; + t11 = g_xy; + t12 = t11 * t11; + t14 = g_xz; + t15 = t11 * t14; + t18 = t14 * t14; + t21 = 1 / (t8 * t2 - t7 * t5 - t12 * t2 + 2.0 * t15 * t4 - t18 * t1); + g_uu_11 = (t1 * t2 - t5) * t21; + g_uu_12 = -(t11 * t2 - t14 * t4) * t21; + g_uu_13 = -(-t11 * t4 + t14 * t1) * t21; + g_uu_22 = (t7 * t2 - t18) * t21; + g_uu_23 = -(t7 * t4 - t15) * t21; + g_uu_33 = (t8 - t12) * t21; + + t1 = g_uu_11 * nx + g_uu_12 * ny + g_uu_13 * nz; + t2 = g_uu_12 * nx + g_uu_22 * ny + g_uu_23 * nz; + t4 = g_uu_13 * nx + g_uu_23 * ny + g_uu_33 * nz; + t5 = g_uu_11 * nx * nx + g_uu_22 * ny * ny + g_uu_33 * nz * nz + 2 * (g_uu_12 * nx * ny + g_uu_13 * nx * nz + g_uu_23 * ny * nz); + t5 = sqrt(t5); + nx = t1 / t5; // uper index + ny = t2 / t5; + nz = t4 / t5; + } + + double pxx, pxy, pxz, pyy, pyz, pzz; + double sxx, sxy, sxz, syx, syy, syz, szx, szy, szz; + // these tensor components are same for local Cardisean and global Cardisean + pxx = k_xx - g_xx * trk; // lower index + pxy = k_xy; + pxz = k_xz; + pyy = k_yy - g_yy * trk; + pyz = k_yz; + pzz = k_zz - g_zz * trk; + /* + sxx = yy*pxy - zz*pxz; + sxy = yy*pyy - zz*pyz; + sxz = yy*pyz - zz*pzz; + syx = zz*pxy - yy*pxz; + syy = zz*pyy - yy*pyz; + syz = zz*pyz - yy*pzz; + szx = xx*pxy - yy*pxx; + szy = xx*pyy - yy*pxy; + szz = xx*pyz - yy*pxz; + */ + // we need Cardisean coordinate whose original point coincide with centroid_x^i + xx = p.gridfn(gfns::gfn__global_x, irho, isigma) - centroid_x; + yy = p.gridfn(gfns::gfn__global_y, irho, isigma) - centroid_y; + zz = p.gridfn(gfns::gfn__global_z, irho, isigma) - centroid_z; + sxx = yy * pxz - zz * pxy; + sxy = zz * pxx - xx * pxz; + sxz = xx * pxy - yy * pxx; + syx = yy * pyz - zz * pyy; + syy = zz * pxy - xx * pyz; + syz = xx * pyy - yy * pxy; + szx = yy * pzz - zz * pyz; + szy = zz * pxz - xx * pzz; + szz = xx * pyz - yy * pxz; + + p.gridfn(gfns::gfn__global_xx, irho, isigma) = nx * pxx + ny * pxy + nz * pxz; // p_x + p.gridfn(gfns::gfn__global_xy, irho, isigma) = nx * pxy + ny * pyy + nz * pyz; // p_y + p.gridfn(gfns::gfn__global_xz, irho, isigma) = nx * pxz + ny * pyz + nz * pzz; // p_z + p.gridfn(gfns::gfn__global_yy, irho, isigma) = nx * sxx + ny * syx + nz * szx; // s_x + p.gridfn(gfns::gfn__global_yz, irho, isigma) = nx * sxy + ny * syy + nz * szy; // s_y + p.gridfn(gfns::gfn__global_zz, irho, isigma) = nx * sxz + ny * syz + nz * szz; // s_z +#endif + } + } + } + } + + Px = surface_integral(ps, + gfns::gfn__global_xx, true, true, false, // z,y,x direction, even or odd function + patch::integration_method__automatic_choice); + Py = surface_integral(ps, + gfns::gfn__global_xy, true, false, true, + patch::integration_method__automatic_choice); + Pz = surface_integral(ps, + gfns::gfn__global_xz, false, true, true, + patch::integration_method__automatic_choice); + Sx = surface_integral(ps, + gfns::gfn__global_yy, false, false, true, + patch::integration_method__automatic_choice); + Sy = surface_integral(ps, + gfns::gfn__global_yz, false, true, false, + patch::integration_method__automatic_choice); + Sz = surface_integral(ps, + gfns::gfn__global_zz, true, false, false, + patch::integration_method__automatic_choice); + const double F1o8pi = 1.0 / 8 / PI; + Px = Px * F1o8pi; + Py = Py * F1o8pi; + Pz = Pz * F1o8pi; + Sx = Sx * F1o8pi; + Sy = Sy * F1o8pi; + Sz = Sz * F1o8pi; + } + + //****************************************************************************** + + // + // This function computes the surface integral of a gridfn over the + // horizon. + // + fp BH_diagnostics::surface_integral(const patch_system &ps, + int src_gfn, bool src_gfn_is_even_across_xy_plane, + bool src_gfn_is_even_across_xz_plane, + bool src_gfn_is_even_across_yz_plane, + enum patch::integration_method method) + { + return ps.integrate_gridfn(src_gfn, src_gfn_is_even_across_xy_plane, + src_gfn_is_even_across_xz_plane, + src_gfn_is_even_across_yz_plane, + gfns::gfn__h, + gfns::gfn__g_dd_11, gfns::gfn__g_dd_12, gfns::gfn__g_dd_13, + gfns::gfn__g_dd_22, gfns::gfn__g_dd_23, + gfns::gfn__g_dd_33, + method); + } + // with triad theta and phi + // since Thornburg uses vertex center, we will meet nan at pole points + void BH_diagnostics::compute_signature(patch_system &ps, const double dT) + { + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) + { + const fp r = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + fp xx, yy, zz; + p.xyz_of_r_rho_sigma(r, rho, sigma, xx, yy, zz); + + const fp sintheta = sqrt(1 - zz * zz / r / r); + + const fp X_ud_11 = xx * zz / r / r / sqrt(xx * xx + yy * yy); + const fp X_ud_12 = yy * zz / r / r / sqrt(xx * xx + yy * yy); + const fp X_ud_13 = -sqrt(xx * xx + yy * yy) / r / r; + const fp X_ud_21 = -yy / (xx * xx + yy * yy); + const fp X_ud_22 = xx / (xx * xx + yy * yy); + const fp X_ud_23 = 0; + + const fp g_dd_11 = p.gridfn(gfns::gfn__g_dd_11, irho, isigma); + const fp g_dd_12 = p.gridfn(gfns::gfn__g_dd_12, irho, isigma); + const fp g_dd_13 = p.gridfn(gfns::gfn__g_dd_13, irho, isigma); + const fp g_dd_22 = p.gridfn(gfns::gfn__g_dd_22, irho, isigma); + const fp g_dd_23 = p.gridfn(gfns::gfn__g_dd_23, irho, isigma); + const fp g_dd_33 = p.gridfn(gfns::gfn__g_dd_33, irho, isigma); + + const fp Lap = 1.0 + p.gridfn(gfns::gfn__global_xx, irho, isigma); + const fp Sfx = p.gridfn(gfns::gfn__global_xy, irho, isigma); + const fp Sfy = p.gridfn(gfns::gfn__global_xz, irho, isigma); + const fp Sfz = p.gridfn(gfns::gfn__global_yy, irho, isigma); + + const fp dfdt = (r - p.gridfn(gfns::gfn__oldh, irho, isigma)) / dT; + + double Br = Sfx * xx / r + Sfy * yy / r + Sfz * zz / r; + double Brho = Sfx * X_ud_11 + Sfy * X_ud_12 + Sfz * X_ud_13; + double Bsigma = Sfx * X_ud_21 + Sfy * X_ud_22 + Sfz * X_ud_23; + + double g_uu_11, g_uu_12, g_uu_13, g_uu_22, g_uu_23, g_uu_33; + double g11, g12, g13, g22, g23, g33; + { + // g^uu + fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15; + fp t18, t21; + t1 = g_dd_22; + t2 = g_dd_33; + t4 = g_dd_23; + t5 = t4 * t4; + t7 = g_dd_11; + t8 = t7 * t1; + t11 = g_dd_12; + t12 = t11 * t11; + t14 = g_dd_13; + t15 = t11 * t14; + t18 = t14 * t14; + t21 = 1 / (t8 * t2 - t7 * t5 - t12 * t2 + 2.0 * t15 * t4 - t18 * t1); + g11 = (t1 * t2 - t5) * t21; + g12 = -(t11 * t2 - t14 * t4) * t21; + g13 = -(-t11 * t4 + t14 * t1) * t21; + g22 = (t7 * t2 - t18) * t21; + g23 = -(t7 * t4 - t15) * t21; + g33 = (t8 - t12) * t21; + } + // 1 r;2 rho; 3 sigma + g_uu_22 = (g11 * X_ud_11 + g12 * X_ud_12 + g13 * X_ud_13) * X_ud_11 + (g12 * X_ud_11 + g22 * X_ud_12 + g23 * X_ud_13) * X_ud_12 + (g13 * X_ud_11 + g23 * X_ud_12 + g33 * X_ud_13) * X_ud_13; + g_uu_23 = (g11 * X_ud_11 + g12 * X_ud_12 + g13 * X_ud_13) * X_ud_21 + (g12 * X_ud_11 + g22 * X_ud_12 + g23 * X_ud_13) * X_ud_22 + (g13 * X_ud_11 + g23 * X_ud_12 + g33 * X_ud_13) * X_ud_23; + g_uu_12 = (g11 * X_ud_11 + g12 * X_ud_12 + g13 * X_ud_13) * xx / r + (g12 * X_ud_11 + g22 * X_ud_12 + g23 * X_ud_13) * yy / r + (g13 * X_ud_11 + g23 * X_ud_12 + g33 * X_ud_13) * zz / r; + g_uu_33 = (g11 * X_ud_21 + g12 * X_ud_22 + g13 * X_ud_23) * X_ud_21 + (g12 * X_ud_21 + g22 * X_ud_22 + g23 * X_ud_23) * X_ud_22 + (g13 * X_ud_21 + g23 * X_ud_22 + g33 * X_ud_23) * X_ud_23; + g_uu_13 = (g11 * X_ud_21 + g12 * X_ud_22 + g13 * X_ud_23) * xx / r + (g12 * X_ud_21 + g22 * X_ud_22 + g23 * X_ud_23) * yy / r + (g13 * X_ud_21 + g23 * X_ud_22 + g33 * X_ud_23) * zz / r; + g_uu_11 = (g11 * xx / r + g12 * yy / r + g13 * zz / r) * xx / r + (g12 * xx / r + g22 * yy / r + g23 * zz / r) * yy / r + (g13 * xx / r + g23 * yy / r + g33 * zz / r) * zz / r; + { + // g_uu + fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15; + fp t18, t21; + t1 = g_uu_22; + t2 = g_uu_33; + t4 = g_uu_23; + t5 = t4 * t4; + t7 = g_uu_11; + t8 = t7 * t1; + t11 = g_uu_12; + t12 = t11 * t11; + t14 = g_uu_13; + t15 = t11 * t14; + t18 = t14 * t14; + t21 = 1 / (t8 * t2 - t7 * t5 - t12 * t2 + 2.0 * t15 * t4 - t18 * t1); + g11 = (t1 * t2 - t5) * t21; + g12 = -(t11 * t2 - t14 * t4) * t21; + g13 = -(-t11 * t4 + t14 * t1) * t21; + g22 = (t7 * t2 - t18) * t21; + g23 = -(t7 * t4 - t15) * t21; + g33 = (t8 - t12) * t21; + } + + double q11 = g22, q12 = g23, q13 = Br + dfdt * g12; + double q22 = g33, q23 = Bsigma + dfdt * g13; + double q33 = (-Lap * Lap + g11 * Br * Br + g22 * Brho * Brho + g33 * Bsigma * Bsigma + + 2 * (g12 * Br * Brho + g13 * Br * Bsigma + g23 * Brho * Bsigma)) + + 2 * dfdt * Br + dfdt * dfdt * g11; + q12 = q12 / sintheta; + q22 = q22 / sintheta / sintheta; + q23 = q23 / sintheta; + // we use gfns::gfn__global_zz to store determinant + p.gridfn(gfns::gfn__global_zz, irho, isigma) = q11 * q22 * q33 + q12 * q23 * q13 + q13 * q12 * q23 - q13 * q22 * q13 - q12 * q12 * q33 - q11 * q23 * q23; + } // end for irho isigma + } + } + FILE *BH_diagnostics::setup_output_file(int N_horizons, int hn) + const + { + char file_name_buffer[50]; + sprintf(file_name_buffer, "infoah%02d.dat", hn); + const char *const file_open_mode = "w"; + + FILE *fileptr = fopen(file_name_buffer, file_open_mode); + if (fileptr == NULL) + printf("\n" + " BH_diagnostics::setup_output_file():\n" + " can't open BH-diagnostics output file\n" + " \"%s\"!", + file_name_buffer); + /* + fprintf(fileptr, "# apparent horizon %d/%d\n", hn, N_horizons); + fprintf(fileptr, "#\n"); + fprintf(fileptr, "# column 1 = cctk_time\n"); + fprintf(fileptr, "# column 2 = centroid_x\n"); + fprintf(fileptr, "# column 3 = centroid_y\n"); + fprintf(fileptr, "# column 4 = centroid_z\n"); + fprintf(fileptr, "# column 5 = min radius\n"); + fprintf(fileptr, "# column 6 = max radius\n"); + fprintf(fileptr, "# column 7 = mean radius\n"); + fprintf(fileptr, "# column 8 = quadrupole_xx\n"); + fprintf(fileptr, "# column 9 = quadrupole_xy\n"); + fprintf(fileptr, "# column 10 = quadrupole_xz\n"); + fprintf(fileptr, "# column 11 = quadrupole_yy\n"); + fprintf(fileptr, "# column 12 = quadrupole_yz\n"); + fprintf(fileptr, "# column 13 = quadrupole_zz\n"); + fprintf(fileptr, "# column 14 = min x\n"); + fprintf(fileptr, "# column 15 = max x\n"); + fprintf(fileptr, "# column 16 = min y\n"); + fprintf(fileptr, "# column 17 = max y\n"); + fprintf(fileptr, "# column 18 = min z\n"); + fprintf(fileptr, "# column 19 = max z\n"); + fprintf(fileptr, "# column 20 = xy-plane circumference\n"); + fprintf(fileptr, "# column 21 = xz-plane circumference\n"); + fprintf(fileptr, "# column 22 = yz-plane circumference\n"); + fprintf(fileptr, "# column 23 = ratio of xz/xy-plane circumferences\n"); + fprintf(fileptr, "# column 24 = ratio of yz/xy-plane circumferences\n"); + fprintf(fileptr, "# column 25 = area\n"); + fprintf(fileptr, "# column 26 = irreducible mass\n"); + fprintf(fileptr, "# column 27 = areal radius\n"); + */ + + fprintf(fileptr, "#time Mass x y z Px Py Pz Sx Sy Sz\n"); + fflush(fileptr); + + return fileptr; + } + void BH_diagnostics::output(FILE *fileptr, double time) + const + { + assert(fileptr != NULL); + /* + fprintf(fileptr, + "%f\t%f\t%f\t%f\t%#.10g\t%#.10g\t%#.10g\t", + double(time), + double(centroid_x), double(centroid_y), double(centroid_z), + double(min_radius), double(max_radius), double(mean_radius)); + + fprintf(fileptr, + "%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t", + double(quadrupole_xx), double(quadrupole_xy), double(quadrupole_xz), + double(quadrupole_yy), double(quadrupole_yz), + double(quadrupole_zz)); + + fprintf(fileptr, + "%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t", + double(min_x), double(max_x), + double(min_y), double(max_y), + double(min_z), double(max_z)); + + fprintf(fileptr, + "%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t", + double(circumference_xy), + double(circumference_xz), + double(circumference_yz), + double(circumference_xz / circumference_xy), + double(circumference_yz / circumference_xy)); + + fprintf(fileptr, + "%#.10g\t%#.10g\t%#.10g\n", + double(area), double(irreducible_mass), double(areal_radius)); + */ + + fprintf(fileptr, + "%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\t%#.10g\n", + double(time), double(irreducible_mass), + double(centroid_x), double(centroid_y), double(centroid_z), + double(Px), double(Py), double(Pz), double(Sx), double(Sy), double(Sz)); + + fflush(fileptr); + } + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/BH_diagnostics.h b/AMSS_NCKU_source/BH_diagnostics.h new file mode 100644 index 0000000..d2d3cd4 --- /dev/null +++ b/AMSS_NCKU_source/BH_diagnostics.h @@ -0,0 +1,101 @@ +#ifndef BH_DIAGNOSTICS_H +#define BH_DIAGNOSTICS_H +namespace AHFinderDirect +{ + + struct BH_diagnostics + { + public: + // mean x,y,z + fp centroid_x, centroid_y, centroid_z; + + // these are quadrupole moments about the centroid, i.e. + // mean(xi*xj) - centroid_i*centroid_j + fp quadrupole_xx, quadrupole_xy, quadrupole_xz, + quadrupole_yy, quadrupole_yz, + quadrupole_zz; + + // min,max,mean surface radius about local coordinate origin + fp min_radius, max_radius, mean_radius; + + // xyz bounding box + fp min_x, max_x, + min_y, max_y, + min_z, max_z; + + // proper circumference + // (computed using induced metric along these local-coordinate planes) + fp circumference_xy, + circumference_xz, + circumference_yz; + + // surface area (computed using induced metric) + // and quantities derived from it + fp area, irreducible_mass, areal_radius; + + double Px, Py, Pz, Sx, Sy, Sz; + + public: + // position of diagnostics in buffer and number of diagnostics + enum + { + posn__centroid_x = 0, + posn__centroid_y, + posn__centroid_z, + posn__quadrupole_xx, + posn__quadrupole_xy, + posn__quadrupole_xz, + posn__quadrupole_yy, + posn__quadrupole_yz, + posn__quadrupole_zz, + posn__min_radius, + posn__max_radius, + posn__mean_radius, + + posn__min_x, + posn__max_x, + posn__min_y, + posn__max_y, + posn__min_z, + posn__max_z, + + posn__circumference_xy, + posn__circumference_xz, + posn__circumference_yz, + + posn__area, + posn__irreducible_mass, + posn__areal_radius, + + N_buffer // no comma // size of buffer + }; + + // copy diagnostics to/from buffer + void copy_to_buffer(double buffer[N_buffer]) const; + void copy_from_buffer(const double buffer[N_buffer]); + + public: + void compute(patch_system &ps); + + void compute_signature(patch_system &ps, const double dT); + + FILE *setup_output_file(int N_horizons, int hn) + const; + + void output(FILE *fileptr, double time) + const; + + BH_diagnostics(); + + private: + static double surface_integral(const patch_system &ps, + int src_gfn, bool src_gfn_is_even_across_xy_plane, + bool src_gfn_is_even_across_xz_plane, + bool src_gfn_is_even_across_yz_plane, + enum patch::integration_method method); + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* BH_DIAGNOSTICS_H */ diff --git a/AMSS_NCKU_source/Block.C b/AMSS_NCKU_source/Block.C new file mode 100644 index 0000000..fcae198 --- /dev/null +++ b/AMSS_NCKU_source/Block.C @@ -0,0 +1,199 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "Block.h" +#include "misc.h" + +Block::Block(int DIM, int *shapei, double *bboxi, int ranki, int ingfsi, int fngfsi, int levi, const int cgpui) : rank(ranki), ingfs(ingfsi), fngfs(fngfsi), lev(levi), cgpu(cgpui) +{ + for (int i = 0; i < dim; i++) + X[i] = 0; + + if (DIM != dim) + { + cout << "dimension is not consistent in Block construction" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + bool flag = false; + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; + if (shape[i] <= 0) + flag = true; + bbox[i] = bboxi[i]; + bbox[dim + i] = bboxi[dim + i]; + } + + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (flag) + { + cout << "myrank: " << myrank << ", on rank: " << rank << endl; + cout << "error shape in Block construction: (" << shape[0] << "," << shape[1] << "," << shape[2] << ")" << endl; + cout << "box boundary: (" << bbox[0] << ":" << bbox[3] << "," << bbox[1] << ":" << bbox[4] << "," << bbox[2] << ":" << bbox[5] << ")" << endl; + cout << "belong to level " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + +#ifndef FAKECHECK + if (myrank == rank) + { + for (int i = 0; i < dim; i++) + { + X[i] = new double[shape[i]]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + double h = (bbox[dim + i] - bbox[i]) / (shape[i] - 1); + for (int j = 0; j < shape[i]; j++) + X[i][j] = bbox[i] + j * h; +#else +#ifdef Cell + double h = (bbox[dim + i] - bbox[i]) / shape[i]; + for (int j = 0; j < shape[i]; j++) + X[i][j] = bbox[i] + (j + 0.5) * h; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + int nn = shape[0] * shape[1] * shape[2]; + fgfs = new double *[fngfs]; + for (int i = 0; i < fngfs; i++) + { + fgfs[i] = (double *)malloc(sizeof(double) * nn); + if (!(fgfs[i])) + { + cout << "on node#" << rank << ", out of memory when constructing Block." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + memset(fgfs[i], 0, sizeof(double) * nn); + } + + igfs = new int *[ingfs]; + for (int i = 0; i < ingfs; i++) + { + igfs[i] = (int *)malloc(sizeof(int) * nn); + if (!(igfs[i])) + { + cout << "on node#" << rank << ", out of memory when constructing Block." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + memset(igfs[i], 0, sizeof(int) * nn); + } + } +#endif +} +Block::~Block() +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == rank) + { + for (int i = 0; i < dim; i++) + delete[] X[i]; + for (int i = 0; i < ingfs; i++) + free(igfs[i]); + delete[] igfs; + for (int i = 0; i < fngfs; i++) + free(fgfs[i]); + delete[] fgfs; + X[0] = X[1] = X[2] = 0; + igfs = 0; + fgfs = 0; + } +} +void Block::checkBlock() +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << "belong to level " << lev << endl; + cout << "shape: ["; + for (int i = 0; i < dim; i++) + { + cout << shape[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]"; + } + cout << " resolution: ["; + for (int i = 0; i < dim; i++) + { + cout << getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << "locate on node " << rank << ", at (includes ghost zone):" << endl; + cout << "("; + for (int i = 0; i < dim; i++) + { + cout << bbox[i] << ":" << bbox[dim + i]; + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + cout << "has " << ingfs << " int type grids functions," << fngfs << " double type grids functions" << endl; + } +} +double Block::getdX(int dir) +{ + if (dir < 0 || dir >= dim) + { + cout << "Block::getdX: error input dir = " << dir << ", this Block has direction (0," << dim - 1 << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double h; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (shape[dir] == 1) + { + cout << "Block::getdX: for direction " << dir << ", this Block has only one point. Can not determine dX for vertex center grid." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + h = (bbox[dim + dir] - bbox[dir]) / (shape[dir] - 1); +#else +#ifdef Cell + h = (bbox[dim + dir] - bbox[dir]) / shape[dir]; +#else +#error Not define Vertex nor Cell +#endif +#endif + return h; +} +void Block::swapList(MyList *VarList1, MyList *VarList2, int myrank) +{ + if (rank == myrank) + { + MyList *varl1 = VarList1, *varl2 = VarList2; + while (varl1 && varl2) + { + misc::swap(fgfs[varl1->data->sgfn], fgfs[varl2->data->sgfn]); + varl1 = varl1->next; + varl2 = varl2->next; + } + if (varl1 || varl2) + { + cout << "error in Block::swaplist, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +} diff --git a/AMSS_NCKU_source/Block.h b/AMSS_NCKU_source/Block.h new file mode 100644 index 0000000..28193fd --- /dev/null +++ b/AMSS_NCKU_source/Block.h @@ -0,0 +1,34 @@ + +#ifndef BLOCK_H +#define BLOCK_H + +#include +#include "macrodef.h" //need dim here; Vertex or Cell +#include "var.h" +#include "MyList.h" +class Block +{ + +public: + int shape[dim]; + double bbox[2 * dim]; + double *X[dim]; + int rank; // where the real data locate in + int lev, cgpu; + int ingfs, fngfs; + int *(*igfs); + double *(*fgfs); + +public: + Block() {}; + Block(int DIM, int *shapei, double *bboxi, int ranki, int ingfsi, int fngfs, int levi, const int cgpui = 0); + + ~Block(); + + void checkBlock(); + + double getdX(int dir); + void swapList(MyList *VarList1, MyList *VarList2, int myrank); +}; + +#endif /* BLOCK_H */ diff --git a/AMSS_NCKU_source/DataCT.C b/AMSS_NCKU_source/DataCT.C new file mode 100644 index 0000000..1079039 --- /dev/null +++ b/AMSS_NCKU_source/DataCT.C @@ -0,0 +1,283 @@ + +//----------------------------------------------------------------------- +// Read binary files and do fancy things with them... +//----------------------------------------------------------------------- +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include "microdef.fh" + +int main(int argc, char *argv[]) +{ + // + // USE: DataCT flag file1 [ file2 ] + // + // where: - flag can be XY,XZ,YZ + // + void set_fname(char *fname); + + if (argc < 3) + { + cout << "\aUsage: DataCT flag binaryfile1 [ binaryfile2 ] \n " + << " where: - flag can be XY,XZ,YZ" + << endl; + exit(1); + } + ifstream infile1; + infile1.open(argv[2]); + if (!infile1) + { + cerr << "\a Can't open " << argv[2] << " for input." << endl; + exit(1); + } + + /* read properties of the binary file */ + double time; + int nx, ny, nz; + double xmin, xmax, ymin, ymax, zmin, zmax; + infile1.seekg(0, ios::beg); + infile1.read((char *)&time, sizeof(double)); + infile1.read((char *)&nx, sizeof(int)); + infile1.read((char *)&ny, sizeof(int)); + infile1.read((char *)&nz, sizeof(int)); + infile1.read((char *)&xmin, sizeof(double)); + infile1.read((char *)&xmax, sizeof(double)); + infile1.read((char *)&ymin, sizeof(double)); + infile1.read((char *)&ymax, sizeof(double)); + infile1.read((char *)&zmin, sizeof(double)); + infile1.read((char *)&zmax, sizeof(double)); + + /* get rid of any 4 character suffix */ + set_fname(argv[2]); + + /* sanity check */ + if (nx != ny || nx != nz) + { + cout << "\n" + << endl; + cout << " nx, ny and nz do not agree! Using a symmetry?... "; + cout << "\n" + << endl; + } + + cout << "\n Reading file : " << argv[2] << endl; + cout << "\n Time : " << time << endl; + cout << " Dimensions : " << setw(16) << nx << setw(16) << ny << setw(16) << nz << endl; + cout << " xmin, xmax : " << setw(16) << xmin << setw(16) << xmax << endl; + cout << " ymin, ymax : " << setw(16) << ymin << setw(16) << ymax << endl; + cout << " zmin, zmax : " << setw(16) << zmin << setw(16) << zmax << endl; + cout << "\n"; + + double *data; + data = new double[nx * ny * nz]; + int i = 0, j = 0, k = 0; + infile1.read((char *)data, nx * ny * nz * sizeof(double)); + infile1.close(); + // + // + // if second file given, open second file and subtract from first one! + // + // + if (argc == 4) + { + infile1.open(argv[3]); + if (!infile1) + { + cerr << "\a Can't open " << argv[3] << " for input." << endl; + exit(1); + } + double *indata; + indata = new double[nx * ny * nz]; + // read in header + infile1.seekg(0, ios::beg); + int nxin, nyin, nzin; + infile1.read((char *)&time, sizeof(double)); + infile1.read((char *)&nxin, sizeof(int)); + infile1.read((char *)&nyin, sizeof(int)); + infile1.read((char *)&nzin, sizeof(int)); + infile1.read((char *)&xmin, sizeof(double)); + infile1.read((char *)&xmax, sizeof(double)); + infile1.read((char *)&ymin, sizeof(double)); + infile1.read((char *)&ymax, sizeof(double)); + infile1.read((char *)&zmin, sizeof(double)); + infile1.read((char *)&zmax, sizeof(double)); + if (nxin != nx || nyin != ny || nzin != nz) + { + cerr << "\a Number of indices do not agree! " << endl; + exit(1); + } + cout << " Comparing with data at time " << time << "\n" + << endl; + infile1.read((char *)indata, nx * ny * nz * sizeof(double)); + infile1.close(); + for (i = 0; i < nx * ny * nz; i++) + data[i] -= indata[i]; + } + + double *X, *Y, *Z; + X = new double[nx]; + Y = new double[ny]; + Z = new double[nz]; + double dd; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (xmax - xmin) / (nx - 1); + for (i = 0; i < nx; i++) + X[i] = xmin + i * dd; + dd = (ymax - ymin) / (ny - 1); + for (j = 0; j < ny; j++) + Y[j] = ymin + j * dd; + dd = (zmax - zmin) / (nz - 1); + for (k = 0; k < nz; k++) + Z[k] = zmin + k * dd; +#else +#ifdef Cell + dd = (xmax - xmin) / nx; + for (i = 0; i < nx; i++) + X[i] = xmin + (i + 0.5) * dd; + dd = (ymax - ymin) / ny; + for (j = 0; j < ny; j++) + Y[j] = ymin + (j + 0.5) * dd; + dd = (zmax - zmin) / nz; + for (k = 0; k < nz; k++) + Z[k] = zmin + (k + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + + int ext[3]; + ext[0] = nx; + ext[1] = ny; + ext[2] = nz; + void writefile(int *ext, double *XX, double *YY, double *ZZ, double *datain, + char *filename, const char *flag); + writefile(ext, X, Y, Z, data, argv[2], argv[1]); + + delete[] data; + delete[] X; + delete[] Y; + delete[] Z; +} + +/*-----------------------------------*/ +/* get rid of any 4 character suffix */ +/*-----------------------------------*/ +void set_fname(char *fname) +{ + int len = strlen(fname) - 4; + char *n_fname; + n_fname = new char[len]; + + for (int i = 0; i < len; ++i) + { + n_fname[i] = fname[i]; + // cout << n_fname[i] << " " << i << endl; + } + n_fname[len] = '\0'; + + // cout << "n_fname: " << n_fname << " fname: " << fname << ", " + // << len << endl; + + strcpy(fname, n_fname); /* Send back the old pointer */ + delete n_fname; +} +//|---------------------------------------------------------------------------- +// writefile +//|---------------------------------------------------------------------------- +void writefile(int *ext, double *XX, double *YY, double *ZZ, double *datain, + char *filename, const char *flag) +{ + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + char filename_h[50]; + //|--->open out put file + ofstream outfile; + + if (!strcmp(flag, "YZ")) + { + for (i = 0; i < nx; i++) + { + sprintf(filename_h, "%s_%d.dat", filename, i); + outfile.open(filename_h); + outfile << "# CT along X at " << i << endl; + for (k = 0; k < nz; k++) + { + for (j = 0; j < ny; j++) + { + outfile << setw(10) << setprecision(10) << YY[j] << " " + << setw(10) << setprecision(10) << ZZ[k] << " " + << datain[i + j * nx + k * nx * ny] << " " + << endl; + } + outfile << "\n"; /* blanck line for gnuplot */ + } + outfile.close(); + } + } + else if (!strcmp(flag, "XZ")) + { + for (j = 0; j < ny; j++) + { + sprintf(filename_h, "%s_%d.dat", filename, j); + outfile.open(filename_h); + outfile << "# CT along Y at " << j << endl; + for (k = 0; k < nz; k++) + { + for (i = 0; i < nx; i++) + { + outfile << setw(10) << setprecision(10) << XX[i] << " " + << setw(10) << setprecision(10) << ZZ[k] << " " + << datain[i + j * nx + k * nx * ny] << " " + << endl; + } + outfile << "\n"; /* blanck line for gnuplot */ + } + outfile.close(); + } + } + else if (!strcmp(flag, "XY")) + { + for (k = 0; k < nz; k++) + { + sprintf(filename_h, "%s_%d.dat", filename, k); + outfile.open(filename_h); + outfile << "# CT along Z at " << k << endl; + for (j = 0; j < ny; j++) + { + for (i = 0; i < nx; i++) + { + outfile << setw(10) << setprecision(10) << XX[i] << " " + << setw(10) << setprecision(10) << YY[j] << " " + << datain[i + j * nx + k * nx * ny] << " " + << endl; + } + outfile << "\n"; /* blanck line for gnuplot */ + } + outfile.close(); + } + } + else + { + cout << "In output_data: not recognized flag-->" << flag << endl; + exit(0); + } +} diff --git a/AMSS_NCKU_source/FFT.f90 b/AMSS_NCKU_source/FFT.f90 new file mode 100644 index 0000000..3c4a12c --- /dev/null +++ b/AMSS_NCKU_source/FFT.f90 @@ -0,0 +1,93 @@ + + +#if 0 +program checkFFT +use dfport +implicit none +double precision::x +integer,parameter::N=256 +double precision,dimension(N*2)::p +double precision,dimension(N/2)::s +integer::ncount,j,idum +character(len=8)::tt +tt=clock() +idum=iachar(tt(8:8))-48 +p=0.0 +open(77,file='prime.dat',status='unknown') +loop1:do ncount=1,N + x=ran(idum) + p(2*ncount-1)=x + write(77,'(f15.3)')x +enddo loop1 +close(77) +call four1(p,N,1) +do j=1,N/2 + s(j)=p(2*j)*p(2*j)+p(2*j-1)*p(2*j-1) +enddo +x=0.0 +do j=1,N/2 + x=x+s(j) +enddo +s=s/x +open(77,file='power.dat',status='unknown') +do j=1,N/2 + write(77,'(2(1x,f15.3))')dble(j-1)/dble(N),s(j) +enddo +close(77) +end program checkFFT +#endif + +!------------- +SUBROUTINE four1(dataa,nn,isign) +implicit none +INTEGER::isign,nn +double precision,dimension(2*nn)::dataa +INTEGER::i,istep,j,m,mmax,n +double precision::tempi,tempr +DOUBLE PRECISION::theta,wi,wpi,wpr,wr,wtemp +n=2*nn +j=1 +do i=1,n,2 + if(j.gt.i)then + tempr=dataa(j) + tempi=dataa(j+1) + dataa(j)=dataa(i) + dataa(j+1)=dataa(i+1) + dataa(i)=tempr + dataa(i+1)=tempi + endif + m=nn +1 if ((m.ge.2).and.(j.gt.m)) then + j=j-m + m=m/2 +goto 1 + endif +j=j+m +enddo +mmax=2 +2 if (n.gt.mmax) then + istep=2*mmax + theta=6.28318530717959d0/(isign*mmax) + wpr=-2.d0*sin(0.5d0*theta)**2 + wpi=sin(theta) + wr=1.d0 + wi=0.d0 + do m=1,mmax,2 + do i=m,n,istep + j=i+mmax + tempr=sngl(wr)*dataa(j)-sngl(wi)*dataa(j+1) + tempi=sngl(wr)*dataa(j+1)+sngl(wi)*dataa(j) + dataa(j)=dataa(i)-tempr + dataa(j+1)=dataa(i+1)-tempi + dataa(i)=dataa(i)+tempr + dataa(i+1)=dataa(i+1)+tempi + enddo + wtemp=wr + wr=wr*wpr-wi*wpi+wr + wi=wi*wpr+wtemp*wpi+wi + enddo +mmax=istep +goto 2 +endif +return +END SUBROUTINE four1 diff --git a/AMSS_NCKU_source/IntPnts.C b/AMSS_NCKU_source/IntPnts.C new file mode 100644 index 0000000..d8739c9 --- /dev/null +++ b/AMSS_NCKU_source/IntPnts.C @@ -0,0 +1,97 @@ +//$Id: IntPnts.C,v 1.1 2012/04/03 10:49:42 zjcao Exp $ + +#include "macrodef.h" +#ifdef With_AHF + +#include +#include + +#include +using namespace std; + +#include "myglobal.h" + +namespace AHFinderDirect +{ + extern struct state state; + int globalInterpGFL(double *X, double *Y, double *Z, int Ns, + double *Data) + { + if (Ns == 0) + return 0; + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[Ns]; + for (n = 0; n < Ns; n++) + { + pox[0][n] = X[n]; + pox[1][n] = Y[n]; + pox[2][n] = Z[n]; + } + + const int InList = 35; + + double *datap; + datap = new double[Ns * InList]; + if (!(state.ADM->AH_Interp_Points(state.AHList, Ns, pox, datap, state.Symmetry))) + return 0; + // reform data + for (int pnt = 0; pnt < Ns; pnt++) + for (int ii = 0; ii < InList; ii++) + { + if (ii == 0 || ii == 12 || ii == 20) + Data[pnt + ii * Ns] = datap[ii + pnt * InList] + 1; + else if (ii == 24) // from chi-1 to psi + Data[pnt + ii * Ns] = pow(datap[ii + pnt * InList] + 1, -0.25); + else if (ii == 25 || ii == 26 || ii == 27) // from chi,i to psi,i + Data[pnt + ii * Ns] = -pow(datap[24 + pnt * InList] + 1, -1.25) / 4 * datap[ii + pnt * InList]; + else + Data[pnt + ii * Ns] = datap[ii + pnt * InList]; + } + delete[] datap; + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + + return 1; + } + // inerpolate lapse and shift + int globalInterpGFLlash(double *X, double *Y, double *Z, int Ns, + double *Data) + { + if (Ns == 0) + return 0; + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[Ns]; + for (n = 0; n < Ns; n++) + { + pox[0][n] = X[n]; + pox[1][n] = Y[n]; + pox[2][n] = Z[n]; + } + + double SYM = 1.0, ANT = -1.0; + const int InList = 4; + + double *datap; + datap = new double[Ns * InList]; + state.ADM->AH_Interp_Points(state.GaugeList, Ns, pox, datap, state.Symmetry); + // reform data + for (int pnt = 0; pnt < Ns; pnt++) + for (int ii = 0; ii < InList; ii++) + Data[pnt + ii * Ns] = datap[ii + pnt * InList]; + + delete[] datap; + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + + return 1; + } + +} // namespace AHFinderDirect +#endif diff --git a/AMSS_NCKU_source/IntPnts0.C b/AMSS_NCKU_source/IntPnts0.C new file mode 100644 index 0000000..fb176d8 --- /dev/null +++ b/AMSS_NCKU_source/IntPnts0.C @@ -0,0 +1,43 @@ + +#include +#include +#include +#include + +#include + +#include "myglobal.h" + +int CCTK_VInfo(const char *thorn, const char *format, ...) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD,&myrank); + if (myrank !=0) return 0; + + va_list ap; + va_start (ap, format); + fprintf (stdout, "INFO (%s): ", thorn); + vfprintf (stdout, format, ap); + fprintf (stdout, "\n"); + va_end (ap); + return 0; +} +int CCTK_VWarn (int level, + int line, + const char *file, + const char *thorn, + const char *format, + ...) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD,&myrank); + if (myrank !=0) return 0; + + va_list ap; + va_start (ap, format); + fprintf (stdout, "WARN (%s): ", thorn); + vfprintf (stdout, format, ap); + fprintf (stdout, "\n"); + va_end (ap); + return 0; +} diff --git a/AMSS_NCKU_source/Jacobian.C b/AMSS_NCKU_source/Jacobian.C new file mode 100644 index 0000000..c8de8f2 --- /dev/null +++ b/AMSS_NCKU_source/Jacobian.C @@ -0,0 +1,270 @@ +#include +#include +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" + +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" +#include "ilucg.h" +// all the code in this file is inside this namespace +namespace AHFinderDirect +{ + // this represents a single element stored in the matrix for + // sort_row_into_column_order() and sort_row_into_column_order__cmp() + struct matrix_element + { + int JA; + fp A; + }; + + Jacobian::Jacobian(patch_system &ps) + : ps_(ps), + N_rows_(ps.N_grid_points()), + N_nonzeros_(0), current_N_rows_(0), N_nonzeros_allocated_(0), + IA_(new integer[N_rows_ + 1]), JA_(NULL), A_(NULL), + itemp_(NULL), rtemp_(NULL) + { + IO_ = 1; + zero_matrix(); + } + + Jacobian::~Jacobian() + { + if (A_) + delete[] A_; + if (JA_) + delete[] JA_; + if (IA_) + delete[] IA_; + if (rtemp_) + delete[] rtemp_; + if (itemp_) + delete[] itemp_; + } + + double Jacobian::element(int II, int JJ) + const + { + const int posn = find_element(II, JJ); + return (posn >= 0) ? A_[posn] : 0.0; + } + + void Jacobian::zero_matrix() + { + + N_nonzeros_ = 0; + current_N_rows_ = 0; + IA_[0] = IO_; + } + + void Jacobian::set_element(int II, int JJ, fp value) + { + const int posn = find_element(II, JJ); + if (posn >= 0) + then A_[posn] = value; + else + insert_element(II, JJ, value); + } + + void Jacobian::sum_into_element(int II, int JJ, fp value) + { + const int posn = find_element(II, JJ); + if (posn >= 0) + then A_[posn] += value; + else + insert_element(II, JJ, value); + } + + int Jacobian::find_element(int II, int JJ) + const + { + if (II >= current_N_rows_) + then return -1; // this row not defined yet + + const int start = IA_[II] - IO_; + const int stop = IA_[II + 1] - IO_; + for (int posn = start; posn < stop; ++posn) + { + if (JA_[posn] - IO_ == JJ) + then return posn; // found + } + + return -1; // not found + } + + int Jacobian::insert_element(int II, int JJ, double value) + { + if (!((II == current_N_rows_ - 1) || (II == current_N_rows_))) + { + printf( + "***** row_sparse_Jacobian::insert_element(II=%d, JJ=%d, value=%g):\n" + " attempt to insert element elsewhere than {last row, last row+1}!\n" + " N_rows_=%d current_N_rows_=%d IO_=%d\n" + " N_nonzeros_=%d N_nonzeros_allocated_=%d\n", + II, JJ, double(value), + N_rows_, current_N_rows_, IO_, + N_nonzeros_, N_nonzeros_allocated_); + abort(); + } + + // start a new row if necessary + if (II == current_N_rows_) + then + { + assert(current_N_rows_ < N_rows_); + IA_[current_N_rows_ + 1] = IA_[current_N_rows_]; + ++current_N_rows_; + } + + // insert into current row + assert(II == current_N_rows_ - 1); + if (IA_[II + 1] - IO_ >= N_nonzeros_allocated_) + then grow_arrays(); + const int posn = IA_[II + 1] - IO_; + assert(posn < N_nonzeros_allocated_); + JA_[posn] = JJ + IO_; + A_[posn] = value; + ++IA_[II + 1]; + ++N_nonzeros_; + + return posn; + } + + void Jacobian::grow_arrays() + { + N_nonzeros_allocated_ += base_growth_amount + (N_nonzeros_allocated_ >> 1); + + int *const new_JA = new int[N_nonzeros_allocated_]; + double *const new_A = new double[N_nonzeros_allocated_]; + for (int posn = 0; posn < N_nonzeros_; ++posn) + { + new_JA[posn] = JA_[posn]; + new_A[posn] = A_[posn]; + } + delete[] A_; + delete[] JA_; + JA_ = new_JA; + A_ = new_A; + } + + int compare_matrix_elements(const void *x, const void *y) + { + const struct matrix_element *const px = static_cast(x); + const struct matrix_element *const py = static_cast(y); + + return px->JA - py->JA; + } + + void Jacobian::sort_each_row_into_column_order() + { + // buffer must be big enough to hold the largest row + int max_N_in_row = 0; + { + for (int II = 0; II < N_rows_; ++II) + { + max_N_in_row = max(max_N_in_row, IA_[II + 1] - IA_[II]); + } + } + + // contiguous buffer for sorting + struct matrix_element *const buffer = new struct matrix_element[max_N_in_row]; + + { + for (int II = 0; II < N_rows_; ++II) + { + const int N_in_row = IA_[II + 1] - IA_[II]; + + // copy this row's JA_[] and A_[] values to the buffer + const int start = IA_[II] - IO_; + for (int p = 0; p < N_in_row; ++p) + { + const int posn = start + p; + buffer[p].JA = JA_[posn]; + buffer[p].A = A_[posn]; + } + + // sort the buffer + qsort(static_cast(buffer), N_in_row, sizeof(buffer[0]), + &compare_matrix_elements); + + // copy the buffer values back to this row's JA_[] and A_[] + for (int p = 0; p < N_in_row; ++p) + { + const int posn = start + p; + JA_[posn] = buffer[p].JA; + A_[posn] = buffer[p].A; + } + } + } + + delete[] buffer; + } + + double Jacobian::solve_linear_system(int rhs_gfn, int x_gfn, bool print_msg_flag) + { + assert(IO_ == Fortran_index_origin); + assert(current_N_rows_ == N_rows_); + + if (itemp_ == NULL) + then + { + itemp_ = new int[3 * N_rows_ + 3 * N_nonzeros_ + 2]; + rtemp_ = new double[4 * N_rows_ + N_nonzeros_]; + } + + // initial guess = all zeros + double *x = ps_.gridfn_data(x_gfn); + for (int II = 0; II < N_rows_; ++II) + { + x[II] = 0.0; + } + + const int N = N_rows_; + const double *rhs = ps_.gridfn_data(rhs_gfn); + const double eps = 1e-10; + const int max_iterations = N_rows_; + int istatus; + + // the actual linear solution + f_ilucg(N, + IA_, JA_, A_, + rhs, x, + itemp_, rtemp_, + eps, max_iterations, + istatus); + + if (istatus < 0) + { + printf( + "***** row_sparse_Jacobian__ILUCG::solve_linear_system(rhs_gfn=%d, x_gfn=%d):\n" + " error return from [sd]ilucg() routine!\n" + " istatus=%d < 0 ==> bad matrix structure, eg. zero diagonal element!\n", + rhs_gfn, x_gfn, + int(istatus)); + abort(); + } + + return -1.0; + } + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/Jacobian.h b/AMSS_NCKU_source/Jacobian.h new file mode 100644 index 0000000..b9c4490 --- /dev/null +++ b/AMSS_NCKU_source/Jacobian.h @@ -0,0 +1,90 @@ +#ifndef AHFINDERDIRECT__JACOBIAN_HH +#define AHFINDERDIRECT__JACOBIAN_HH + +namespace AHFinderDirect +{ + class Jacobian + { + public: + // basic meta-info + patch_system &my_patch_system() const { return ps_; } + int N_rows() const { return N_rows_; } + + // convert (patch,irho,isigma) <--> row/column index + int II_of_patch_irho_isigma(const patch &p, int irho, int isigma) + const + { + return ps_.gpn_of_patch_irho_isigma(p, irho, isigma); + } + const patch &patch_irho_isigma_of_II(int II, int &irho, int &isigma) + const + { + return ps_.patch_irho_isigma_of_gpn(II, irho, isigma); + } + + double element(int II, int JJ) const; + + // is the matrix element (II,JJ) stored explicitly? + bool is_explicitly_stored(int II, int JJ) const + { + return find_element(II, JJ) > 0; + } + + int IO() const { return IO_; } + enum + { + C_index_origin = 0, + Fortran_index_origin = 1 + }; + + void zero_matrix(); + + void set_element(int II, int JJ, fp value); + + void sum_into_element(int II, int JJ, fp value); + + int find_element(int II, int JJ) const; + + int insert_element(int II, int JJ, fp value); + + void grow_arrays(); + + enum + { + base_growth_amount = 1000 + }; + + void sort_each_row_into_column_order(); + + double solve_linear_system(int rhs_gfn, int x_gfn, + bool print_msg_flag); + + public: + Jacobian(patch_system &ps); + ~Jacobian(); + + protected: + patch_system &ps_; + int N_rows_; + + int IO_; + + int N_nonzeros_; + int current_N_rows_; + + int N_nonzeros_allocated_; + + int *IA_; + + int *JA_; + + double *A_; + + int *itemp_; + double *rtemp_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* AHFINDERDIRECT__JACOBIAN_HH */ diff --git a/AMSS_NCKU_source/MPatch.C b/AMSS_NCKU_source/MPatch.C new file mode 100644 index 0000000..f0deb56 --- /dev/null +++ b/AMSS_NCKU_source/MPatch.C @@ -0,0 +1,1532 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "misc.h" +#include "MPatch.h" +#include "Parallel.h" +#include "fmisc.h" + +Patch::Patch(int DIM, int *shapei, double *bboxi, int levi, bool buflog, int Symmetry) : lev(levi) +{ + + int hbuffer_width = buffer_width; + if (lev == 0) + hbuffer_width = CS_width; // specific for shell-box coulping + + if (DIM != dim) + { + cout << "dimension is not consistent in Patch construction" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; + bbox[i] = bboxi[i]; + bbox[dim + i] = bboxi[dim + i]; + lli[i] = uui[i] = 0; + if (buflog) + { + double DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[dim + i] - bbox[i]) / (shape[i] - 1); +#else +#ifdef Cell + DH = (bbox[dim + i] - bbox[i]) / shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + uui[i] = hbuffer_width; + bbox[dim + i] = bbox[dim + i] + uui[i] * DH; + shape[i] = shape[i] + uui[i]; + } + } + + if (buflog) + { + if (DIM != 3) + { + cout << "Symmetry in Patch construction only support 3 yet but dim = " << DIM << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double tmpb, DH; + if (Symmetry > 0) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[5] - bbox[2]) / (shape[2] - 1); +#else +#ifdef Cell + DH = (bbox[5] - bbox[2]) / shape[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + tmpb = Mymax(0, bbox[2] - hbuffer_width * DH); + lli[2] = int((bbox[2] - tmpb) / DH + 0.4); + bbox[2] = bbox[2] - lli[2] * DH; + shape[2] = shape[2] + lli[2]; + if (lli[2] < hbuffer_width) + { + if (feq(bbox[2], 0, DH / 2)) + lli[2] = 0; + else + { + cout << "Code mistake for lli[2] = " << lli[2] << ", bbox[2] = " << bbox[2] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + if (Symmetry > 1) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[3] - bbox[0]) / (shape[0] - 1); +#else +#ifdef Cell + DH = (bbox[3] - bbox[0]) / shape[0]; +#else +#error Not define Vertex nor Cell +#endif +#endif + tmpb = Mymax(0, bbox[0] - hbuffer_width * DH); + lli[0] = int((bbox[0] - tmpb) / DH + 0.4); + bbox[0] = bbox[0] - lli[0] * DH; + shape[0] = shape[0] + lli[0]; + if (lli[0] < hbuffer_width) + { + if (feq(bbox[0], 0, DH / 2)) + lli[0] = 0; + else + { + cout << "Code mistake for lli[0] = " << lli[0] << ", bbox[0] = " << bbox[0] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[4] - bbox[1]) / (shape[1] - 1); +#else +#ifdef Cell + DH = (bbox[4] - bbox[1]) / shape[1]; +#else +#error Not define Vertex nor Cell +#endif +#endif + tmpb = Mymax(0, bbox[1] - hbuffer_width * DH); + lli[1] = int((bbox[1] - tmpb) / DH + 0.4); + bbox[1] = bbox[1] - lli[1] * DH; + shape[1] = shape[1] + lli[1]; + if (lli[1] < hbuffer_width) + { + if (feq(bbox[1], 0, DH / 2)) + lli[1] = 0; + else + { + cout << "Code mistake for lli[1] = " << lli[1] << ", bbox[1] = " << bbox[1] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + else + { + for (int i = 0; i < 2; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[dim + i] - bbox[i]) / (shape[i] - 1); +#else +#ifdef Cell + DH = (bbox[dim + i] - bbox[i]) / shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + lli[i] = hbuffer_width; + bbox[i] = bbox[i] - lli[i] * DH; + shape[i] = shape[i] + lli[i]; + } + } + } + else + { + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH = (bbox[dim + i] - bbox[i]) / (shape[i] - 1); +#else +#ifdef Cell + DH = (bbox[dim + i] - bbox[i]) / shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + lli[i] = hbuffer_width; + bbox[i] = bbox[i] - lli[i] * DH; + shape[i] = shape[i] + lli[i]; + } + } + } + + blb = ble = 0; +} +Patch::~Patch() +{ +} +// buflog 1: with buffer points; 0 without +void Patch::checkPatch(bool buflog) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (buflog) + { + cout << " belong to level " << lev << endl; + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << shape[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]"; + } + cout << " resolution: ["; + for (int i = 0; i < dim; i++) + { + cout << getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << bbox[i] << ":" << bbox[dim + i]; + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + } + else + { + cout << " belong to level " << lev << endl; + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << shape[i] - lli[i] - uui[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]"; + } + cout << " resolution: ["; + for (int i = 0; i < dim; i++) + { + cout << getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << bbox[i] + lli[i] * getdX(i) << ":" << bbox[dim + i] - uui[i] * getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + } + } +} +void Patch::checkPatch(bool buflog, const int out_rank) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == out_rank) + { + cout << " out_rank = " << out_rank << endl; + if (buflog) + { + cout << " belong to level " << lev << endl; + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << shape[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]"; + } + cout << " resolution: ["; + for (int i = 0; i < dim; i++) + { + cout << getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << bbox[i] << ":" << bbox[dim + i]; + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + } + else + { + cout << " belong to level " << lev << endl; + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << shape[i] - lli[i] - uui[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]"; + } + cout << " resolution: ["; + for (int i = 0; i < dim; i++) + { + cout << getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << bbox[i] + lli[i] * getdX(i) << ":" << bbox[dim + i] - uui[i] * getdX(i); + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + } + } +} +void Patch::Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + for (int i = 0; i < dim; i++) + { + pox[i] = XX[i][j]; + if (myrank == 0 && (XX[i][j] < bbox[i] + lli[i] * DH[i] || XX[i][j] > bbox[dim + i] - uui[i] * DH[i])) + { + cout << "Patch::Interp_Points: point ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + else + cout << ") is out of current Patch." << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *Bp = blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (XX[i][j] - llb[i] < -DH[i] / 2 || XX[i][j] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + // shellf[j*num_var+k] = Parallel::global_interp(dim,BP->shape,BP->X,BP->fgfs[varl->data->sgfn], + // pox,ordn,varl->data->SoA,Symmetry); + f_global_interp(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + // misc::tillherecheck("print me"); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: Patch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: Patch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j][i]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on Patch ("; + for (int j = 0; j < dim; j++) + { + cout << bbox[j] << "+" << lli[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")--"; + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << bbox[dim + j] << "-" << uui[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } +#if 0 + checkBlock(); +#else + cout << "splited domains:" << endl; + { + MyList *Bp = blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == ble) + break; + Bp = Bp->next; + } + } +#endif + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} +void Patch::Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank, lmyrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + MPI_Comm_rank(Comm_here, &lmyrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + for (int i = 0; i < dim; i++) + { + pox[i] = XX[i][j]; + if (lmyrank == 0 && (XX[i][j] < bbox[i] + lli[i] * DH[i] || XX[i][j] > bbox[dim + i] - uui[i] * DH[i])) + { + cout << "Patch::Interp_Points: point ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + else + cout << ") is out of current Patch." << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *Bp = blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (XX[i][j] - llb[i] < -DH[i] / 2 || XX[i][j] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + // shellf[j*num_var+k] = Parallel::global_interp(dim,BP->shape,BP->X,BP->fgfs[varl->data->sgfn], + // pox,ordn,varl->data->SoA,Symmetry); + f_global_interp(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, Comm_here); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, Comm_here); + + // misc::tillherecheck("print me"); + // if(lmyrank == 0) cout<<"myrank = "< 1) + { + if (lmyrank == 0) + cout << "WARNING: Patch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } +#if 0 // for not involved levels, this may fail + else if(Weight[i] == 0 && lmyrank == 0) + { + cout<<"ERROR: Patch::Interp_Points fails to find point ("; + for(int j=0;j *Bp=blb; + while(Bp) + { + Block *BP=Bp->data; + + for(int i=0;ibbox[i] ,bbox[i] ,DH[i]/2)) ? BP->bbox[i]+lli[i]*DH[i] : BP->bbox[i] +(ghost_width-0.5)*DH[i]; + uub[i] = (feq(BP->bbox[dim+i],bbox[dim+i],DH[i]/2)) ? BP->bbox[dim+i]-uui[i]*DH[i] : BP->bbox[dim+i]-(ghost_width-0.5)*DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i] ,bbox[i] ,DH[i]/2)) ? BP->bbox[i]+lli[i]*DH[i] : BP->bbox[i] +ghost_width*DH[i]; + uub[i] = (feq(BP->bbox[dim+i],bbox[dim+i],DH[i]/2)) ? BP->bbox[dim+i]-uui[i]*DH[i] : BP->bbox[dim+i]-ghost_width*DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout<<"("; + for(int j=0;jnext; + } + } +#endif + MPI_Abort(MPI_COMM_WORLD,1); + } +#endif + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} +void Patch::checkBlock() +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + MyList *BP = blb; + while (BP) + { + BP->data->checkBlock(); + if (BP == ble) + break; + BP = BP->next; + } + } +} +double Patch::getdX(int dir) +{ + if (dir < 0 || dir >= dim) + { + cout << "Patch::getdX: error input dir = " << dir << ", this Patch has direction (0," << dim - 1 << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double h; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (shape[dir] == 1) + { + cout << "Patch::getdX: for direction " << dir << ", this Patch has only one point. Can not determine dX for vertex center grid." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + h = (bbox[dim + dir] - bbox[dir]) / (shape[dir] - 1); +#else +#ifdef Cell + h = (bbox[dim + dir] - bbox[dir]) / shape[dir]; +#else +#error Not define Vertex nor Cell +#endif +#endif + return h; +} +bool Patch::Interp_ONE_Point(MyList *VarList, double *XX, + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[num_var]; + memset(shellf, 0, sizeof(double) * num_var); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + double pox[dim]; + for (int i = 0; i < dim; i++) + { + pox[i] = XX[i]; + // has excluded the buffer points + if (XX[i] < bbox[i] + lli[i] * DH[i] - DH[i] / 100 || XX[i] > bbox[dim + i] - uui[i] * DH[i] + DH[i] / 100) + { + delete[] shellf; + delete[] DH; + delete[] llb; + delete[] uub; + return false; // out of current patch, + // remember to delete the allocated arrays before return!!! + } + } + + MyList *Bp = blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (XX[i] - llb[i] < -DH[i] / 2 || XX[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { +// test old code +#if 0 +#define floorint(a) ((a) < 0 ? int(a) - 1 : int(a)) +//---> interpolation + int ixl,iyl,izl,ixu,iyu,izu; + double Delx,Dely,Delz; + + ixl = 1+floorint((pox[0]-BP->X[0][0])/DH[0]); + iyl = 1+floorint((pox[1]-BP->X[1][0])/DH[1]); + izl = 1+floorint((pox[2]-BP->X[2][0])/DH[2]); + + int nn=ordn/2; + + ixl = ixl-nn; + iyl = iyl-nn; + izl = izl-nn; + + int tmi; + tmi = (Symmetry==2)?-1:0; + if(ixl0)?-1:0; + if(izlBP->shape[0]) ixl=BP->shape[0]-ordn; + if(iyl+ordn>BP->shape[1]) iyl=BP->shape[1]-ordn; + if(izl+ordn>BP->shape[2]) izl=BP->shape[2]-ordn; +// support cell center + if(ixl>=0) Delx = ( pox[0] - BP->X[0][ixl] )/ DH[0]; + else Delx = ( pox[0] + BP->X[0][0] )/ DH[0]; + if(iyl>=0) Dely = ( pox[1] - BP->X[1][iyl] )/ DH[1]; + else Dely = ( pox[1] + BP->X[1][0] )/ DH[1]; + if(izl>=0) Delz = ( pox[2] - BP->X[2][izl] )/ DH[2]; + else Delz = ( pox[2] + BP->X[2][0] )/ DH[2]; +//change to fortran index + ixl++; + iyl++; + izl++; + ixu = ixl + ordn - 1; + iyu = iyl + ordn - 1; + izu = izl + ordn - 1; + varl=VarList; + int j=0; + while(varl) + { + f_interp_2(BP->shape,BP->fgfs[varl->data->sgfn],shellf[j],ixl,ixu,iyl,iyu,izl,izu,Delx,Dely,Delz, + ordn,varl->data->SoA,Symmetry); + varl=varl->next; + j++; + } //varl +#else + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + // shellf[j*num_var+k] = Parallel::global_interp(dim,BP->shape,BP->X,BP->fgfs[varl->data->sgfn], + // pox,ordn,varl->data->SoA,Symmetry); + f_global_interp(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry); + varl = varl->next; + k++; + } +#endif + } + } + if (Bp == ble) + break; + Bp = Bp->next; + } + + if (notfind && myrank == 0) + { + cout << "ERROR: Patch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on Patch ("; + for (int j = 0; j < dim; j++) + { + cout << bbox[j] << "+" << lli[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")--"; + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << bbox[dim + j] << "-" << uui[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } +#if 0 + checkBlock(); +#else + cout << "splited domains:" << endl; + { + MyList *Bp = blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == ble) + break; + Bp = Bp->next; + } + } +#endif + MPI_Abort(MPI_COMM_WORLD, 1); + } + + MPI_Allreduce(shellf, Shellf, num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + delete[] shellf; + delete[] DH; + delete[] llb; + delete[] uub; + + return true; +} +bool Patch::Interp_ONE_Point(MyList *VarList, double *XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[num_var]; + memset(shellf, 0, sizeof(double) * num_var); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + double pox[dim]; + for (int i = 0; i < dim; i++) + { + pox[i] = XX[i]; + // has excluded the buffer points + if (XX[i] < bbox[i] + lli[i] * DH[i] - DH[i] / 100 || XX[i] > bbox[dim + i] - uui[i] * DH[i] + DH[i] / 100) + { + delete[] shellf; + delete[] DH; + delete[] llb; + delete[] uub; + return false; // out of current patch, + // remember to delete the allocated arrays before return!!! + } + } + + MyList *Bp = blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (XX[i] - llb[i] < -DH[i] / 2 || XX[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { +// test old code +#if 0 +#define floorint(a) ((a) < 0 ? int(a) - 1 : int(a)) +//---> interpolation + int ixl,iyl,izl,ixu,iyu,izu; + double Delx,Dely,Delz; + + ixl = 1+floorint((pox[0]-BP->X[0][0])/DH[0]); + iyl = 1+floorint((pox[1]-BP->X[1][0])/DH[1]); + izl = 1+floorint((pox[2]-BP->X[2][0])/DH[2]); + + int nn=ordn/2; + + ixl = ixl-nn; + iyl = iyl-nn; + izl = izl-nn; + + int tmi; + tmi = (Symmetry==2)?-1:0; + if(ixl0)?-1:0; + if(izlBP->shape[0]) ixl=BP->shape[0]-ordn; + if(iyl+ordn>BP->shape[1]) iyl=BP->shape[1]-ordn; + if(izl+ordn>BP->shape[2]) izl=BP->shape[2]-ordn; +// support cell center + if(ixl>=0) Delx = ( pox[0] - BP->X[0][ixl] )/ DH[0]; + else Delx = ( pox[0] + BP->X[0][0] )/ DH[0]; + if(iyl>=0) Dely = ( pox[1] - BP->X[1][iyl] )/ DH[1]; + else Dely = ( pox[1] + BP->X[1][0] )/ DH[1]; + if(izl>=0) Delz = ( pox[2] - BP->X[2][izl] )/ DH[2]; + else Delz = ( pox[2] + BP->X[2][0] )/ DH[2]; +//change to fortran index + ixl++; + iyl++; + izl++; + ixu = ixl + ordn - 1; + iyu = iyl + ordn - 1; + izu = izl + ordn - 1; + varl=VarList; + int j=0; + while(varl) + { + f_interp_2(BP->shape,BP->fgfs[varl->data->sgfn],shellf[j],ixl,ixu,iyl,iyu,izl,izu,Delx,Dely,Delz, + ordn,varl->data->SoA,Symmetry); + varl=varl->next; + j++; + } //varl +#else + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + // shellf[j*num_var+k] = Parallel::global_interp(dim,BP->shape,BP->X,BP->fgfs[varl->data->sgfn], + // pox,ordn,varl->data->SoA,Symmetry); + f_global_interp(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry); + varl = varl->next; + k++; + } +#endif + } + } + if (Bp == ble) + break; + Bp = Bp->next; + } + + if (notfind && myrank == 0) + { + cout << "ERROR: Patch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on Patch ("; + for (int j = 0; j < dim; j++) + { + cout << bbox[j] << "+" << lli[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")--"; + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << bbox[dim + j] << "-" << uui[j] * getdX(j); + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } +#if 0 + checkBlock(); +#else + cout << "splited domains:" << endl; + { + MyList *Bp = blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? BP->bbox[i] + lli[i] * DH[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] - uui[i] * DH[i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == ble) + break; + Bp = Bp->next; + } + } +#endif + MPI_Abort(MPI_COMM_WORLD, 1); + } + + MPI_Allreduce(shellf, Shellf, num_var, MPI_DOUBLE, MPI_SUM, Comm_here); + + delete[] shellf; + delete[] DH; + delete[] llb; + delete[] uub; + + return true; +} +// find maximum of abstract value, XX store position for maximum, Shellf store maximum themselvs +void Patch::Find_Maximum(MyList *VarList, double *XX, + double *Shellf) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf, *xx; + shellf = new double[num_var]; + xx = new double[dim * num_var]; + memset(shellf, 0, sizeof(double) * num_var); + memset(xx, 0, sizeof(double) * dim * num_var); + + double *DH; + int *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + + llb = new int[dim]; + uub = new int[dim]; + + MyList *Bp = blb; + while (Bp) // run along Blocks + { + Block *BP = Bp->data; + + if (myrank == BP->rank) + { + + for (int i = 0; i < dim; i++) + { + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? lli[i] : ghost_width; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? uui[i] : ghost_width; + } + + varl = VarList; + int k = 0; + double tmp, tmpx[dim]; + while (varl) // run along variables + { + f_find_maximum(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], tmp, tmpx, llb, uub); + if (tmp > shellf[k]) + { + shellf[k] = tmp; + for (int i = 0; i < dim; i++) + xx[dim * k + i] = tmpx[i]; + } + varl = varl->next; + k++; + } + } + + if (Bp == ble) + break; + Bp = Bp->next; + } + + struct mloc + { + double val; + int rank; + }; + + mloc *IN, *OUT; + IN = new mloc[num_var]; + OUT = new mloc[num_var]; + for (int i = 0; i < num_var; i++) + { + IN[i].val = shellf[i]; + IN[i].rank = myrank; + } + + MPI_Allreduce(IN, OUT, num_var, MPI_DOUBLE_INT, MPI_MAXLOC, MPI_COMM_WORLD); + + for (int i = 0; i < num_var; i++) + { + Shellf[i] = OUT[i].val; + if (myrank != OUT[i].rank) + for (int k = 0; k < 3; k++) + xx[3 * i + k] = 0; + } + + MPI_Allreduce(xx, XX, dim * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + delete[] IN; + delete[] OUT; + delete[] shellf; + delete[] xx; + delete[] DH; + delete[] llb; + delete[] uub; +} +void Patch::Find_Maximum(MyList *VarList, double *XX, + double *Shellf, MPI_Comm Comm_here) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf, *xx; + shellf = new double[num_var]; + xx = new double[dim * num_var]; + memset(shellf, 0, sizeof(double) * num_var); + memset(xx, 0, sizeof(double) * dim * num_var); + + double *DH; + int *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + + llb = new int[dim]; + uub = new int[dim]; + + MyList *Bp = blb; + while (Bp) // run along Blocks + { + Block *BP = Bp->data; + + if (myrank == BP->rank) + { + + for (int i = 0; i < dim; i++) + { + llb[i] = (feq(BP->bbox[i], bbox[i], DH[i] / 2)) ? lli[i] : ghost_width; + uub[i] = (feq(BP->bbox[dim + i], bbox[dim + i], DH[i] / 2)) ? uui[i] : ghost_width; + } + + varl = VarList; + int k = 0; + double tmp, tmpx[dim]; + while (varl) // run along variables + { + f_find_maximum(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], tmp, tmpx, llb, uub); + if (tmp > shellf[k]) + { + shellf[k] = tmp; + for (int i = 0; i < dim; i++) + xx[dim * k + i] = tmpx[i]; + } + varl = varl->next; + k++; + } + } + + if (Bp == ble) + break; + Bp = Bp->next; + } + + struct mloc + { + double val; + int rank; + }; + + mloc *IN, *OUT; + IN = new mloc[num_var]; + OUT = new mloc[num_var]; + for (int i = 0; i < num_var; i++) + { + IN[i].val = shellf[i]; + IN[i].rank = myrank; + } + + MPI_Allreduce(IN, OUT, num_var, MPI_DOUBLE_INT, MPI_MAXLOC, Comm_here); + + for (int i = 0; i < num_var; i++) + { + Shellf[i] = OUT[i].val; + if (myrank != OUT[i].rank) + for (int k = 0; k < 3; k++) + xx[3 * i + k] = 0; + } + + MPI_Allreduce(xx, XX, dim * num_var, MPI_DOUBLE, MPI_SUM, Comm_here); + + delete[] IN; + delete[] OUT; + delete[] shellf; + delete[] xx; + delete[] DH; + delete[] llb; + delete[] uub; +} +// if the given point locates in the present Patch return true +// otherwise return false +bool Patch::Find_Point(double *XX) +{ + double *DH; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + + for (int i = 0; i < dim; i++) + { + // has excluded the buffer points + if (XX[i] < bbox[i] + lli[i] * DH[i] - DH[i] / 100 || XX[i] > bbox[dim + i] - uui[i] * DH[i] + DH[i] / 100) + { + delete[] DH; + return false; // out of current patch, + // remember to delete the allocated arrays before return!!! + } + } + + delete[] DH; + + return true; +} diff --git a/AMSS_NCKU_source/MPatch.h b/AMSS_NCKU_source/MPatch.h new file mode 100644 index 0000000..ca19ca5 --- /dev/null +++ b/AMSS_NCKU_source/MPatch.h @@ -0,0 +1,51 @@ + +#ifndef PATCH_H +#define PATCH_H + +#include +#include "MyList.h" +#include "Block.h" +#include "var.h" +#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width + +class Patch +{ + +public: + int lev; + int shape[dim]; + double bbox[2 * dim]; // this bbox includes buffer points + MyList *blb, *ble; + int lli[dim], uui[dim]; // denote the buffer points on each boundary + +public: + Patch() {}; + Patch(int DIM, int *shapei, double *bboxi, int levi, bool buflog, int Symmetry); + + ~Patch(); + + void checkPatch(bool buflog); + void checkPatch(bool buflog, const int out_rank); + void checkBlock(); + void Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry); + bool Interp_ONE_Point(MyList *VarList, double *XX, + double *Shellf, int Symmetry); + double getdX(int dir); + + void Find_Maximum(MyList *VarList, double *XX, + double *Shellf); + + bool Find_Point(double *XX); + + void Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here); + bool Interp_ONE_Point(MyList *VarList, double *XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here); + void Find_Maximum(MyList *VarList, double *XX, + double *Shellf, MPI_Comm Comm_here); +}; + +#endif /* PATCH_H */ diff --git a/AMSS_NCKU_source/MyList.h b/AMSS_NCKU_source/MyList.h new file mode 100644 index 0000000..d6eea77 --- /dev/null +++ b/AMSS_NCKU_source/MyList.h @@ -0,0 +1,109 @@ + +#ifndef MYLIST_H +#define MYLIST_H + +// Note: There is never an implementation file (*.C) for a template class + +template +class MyList +{ + +public: + MyList *next; + T *data; + +public: + MyList(); + MyList(T *p); + ~MyList(); + void insert(T *p); + void clearList(); + void destroyList(); + void catList(MyList *p); + void CloneList(MyList *p); +}; + +template +MyList::MyList() +{ + data = 0; + next = 0; +} +template +MyList::MyList(T *p) +{ + data = p; + next = 0; +} + +template +MyList::~MyList() +{ +} +template +void MyList::insert(T *p) +{ + MyList *ct = this; + if (data == 0) + { + data = p; + } + else + { + while (ct->next) + { + ct = ct->next; + } + ct->next = new MyList(p); + ct = ct->next; + ct->next = 0; + } +} +template +void MyList::clearList() +{ + MyList *ct = this, *n; + while (ct) + { + n = ct->next; + delete ct; + ct = n; + } +} +template +void MyList::destroyList() +{ + MyList *ct = this, *n; + while (ct) + { + n = ct->next; + delete ct->data; + delete ct; + ct = n; + } +} +template +void MyList::catList(MyList *p) +{ + MyList *ct = this; + while (ct->next) + { + ct = ct->next; + } + ct->next = p; +} +template +void MyList::CloneList(MyList *p) +{ + MyList *ct = this; + p = 0; + while (ct) + { + if (!p) + p = new MyList(ct->data); + else + p->insert(ct->data); + ct = ct->next; + } +} +#endif /* MyList_H */ diff --git a/AMSS_NCKU_source/Newton.C b/AMSS_NCKU_source/Newton.C new file mode 100644 index 0000000..5e93014 --- /dev/null +++ b/AMSS_NCKU_source/Newton.C @@ -0,0 +1,555 @@ +//$Id: Newton.C,v 1.1 2012/04/03 10:49:44 zjcao Exp $ + +#include "macrodef.h" +#ifdef With_AHF + +#include +#include +#include +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" +#include "driver.h" +#include "myglobal.h" + +namespace AHFinderDirect +{ + extern struct state state; + using jtutil::error_exit; + + void recentering(patch_system &ps, double max_x, double max_y, double max_z, + double min_x, double min_y, double min_z, + double centroid_x, double centroid_y, double centroid_z) + { + fp ox = ps.origin_x(); + fp oy = ps.origin_y(); + fp oz = ps.origin_z(); + + const fp CTR_TOLERENCE = .45; + bool center = (abs(max_x + min_x - 2.0 * ox) < CTR_TOLERENCE * (max_x - min_x)) && + (abs(max_y + min_y - 2.0 * oy) < CTR_TOLERENCE * (max_y - min_y)) && + (abs(max_z + min_z - 2.0 * oz) < CTR_TOLERENCE * (max_z - min_z)); + + if (!center) + { + + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) + { + + p.ghosted_gridfn(gfns::gfn__h, irho, isigma) = + sqrt(jtutil::pow2(p.gridfn(gfns::gfn__global_x, irho, isigma) - centroid_x) + + jtutil::pow2(p.gridfn(gfns::gfn__global_y, irho, isigma) - centroid_y) + + jtutil::pow2(p.gridfn(gfns::gfn__global_z, irho, isigma) - centroid_z)); + } + } + + ps.recentering(centroid_x, centroid_y, centroid_z); + } + } + + namespace + { + bool broadcast_status(int N_procs, int N_active_procs, + int my_proc, bool my_active_flag, + int hn, int iteration, + enum expansion_status expansion_status, + fp mean_horizon_radius, fp infinity_norm, + bool found_this_horizon, bool I_need_more_iterations, + struct iteration_status_buffers &isb); + + void Newton_step(patch_system &ps, + fp mean_horizon_radius, fp max_allowable_Delta_h_over_h); + + void save_oldh(patch_system &ps); + + int interpolate_alsh(patch_system *ps_ptr) + { + int status = 1; + +#define CAST_PTR_OR_NULL(type_, ptr_) \ + (ps_ptr == NULL) ? NULL : static_cast(ptr_) + + // + // ***** interpolation points ***** + // + const int N_interp_points = (ps_ptr == NULL) ? 0 : ps_ptr->N_grid_points(); + double *interp_coords[3] = { + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_x)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_y)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_z)), + }; + + double *const output_arrays[] = { + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_xx)), // Lapse-1 + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_xy)), // Sfx + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_xz)), // Sfy + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_yy)), // Sfz + }; + + const int N_output_arrays_dim = sizeof(output_arrays) / sizeof(output_arrays[0]); + const int N_output_arrays_use = N_output_arrays_dim; + + double *Data, *oX, *oY, *oZ; + + int s; + int Npts = 0; + for (int ncpu = 0; ncpu < state.N_procs; ncpu++) + { + + if (state.my_proc == ncpu) + Npts = N_interp_points; + + MPI_Bcast(&Npts, 1, MPI_INT, ncpu, MPI_COMM_WORLD); + + if (Npts != 0) + { + Data = new double[Npts * N_output_arrays_use]; + + oX = new double[Npts]; + oY = new double[Npts]; + oZ = new double[Npts]; + if (state.my_proc == ncpu) + { + memcpy(oX, interp_coords[0], Npts * sizeof(double)); + memcpy(oY, interp_coords[1], Npts * sizeof(double)); + memcpy(oZ, interp_coords[2], Npts * sizeof(double)); + } + MPI_Bcast(oX, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + MPI_Bcast(oY, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + MPI_Bcast(oZ, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + + // each cpu calls interpolator + s = globalInterpGFLlash( + oX, oY, oZ, Npts, + Data); // 1 succuss; 0 fail + + if (state.my_proc == ncpu) + { + status = s; + + if (status == 1) + { + for (int ngf = 0; ngf < N_output_arrays_use; ngf++) + { + memcpy(output_arrays[ngf], Data + ngf * N_interp_points, + sizeof(double) * N_interp_points); + } + } + } + + delete[] oX; + delete[] oY; + delete[] oZ; + delete[] Data; + } + } + + return status; + } + + } + + //****************************************************************************** + void Newton(int N_procs, int N_active_procs, int my_proc, + horizon_sequence &hs, struct AH_data *const AH_data_array[], + struct iteration_status_buffers &isb, int *dumpid, double *dT) + { + const bool my_active_flag = hs.has_genuine_horizons(); + const int N_horizons = hs.N_horizons(); + + for (int hn = hs.init_hn();; hn = hs.next_hn()) // hn always =0 for cpu who has no patch_system + { + bool horizon_is_genuine = hs.is_genuine(); + const bool there_is_another_genuine_horizon = hs.is_next_genuine(); + + struct AH_data *AH_data_ptr = horizon_is_genuine ? AH_data_array[hn] : NULL; + + horizon_is_genuine = horizon_is_genuine && AH_data_ptr->find_trigger && !AH_data_ptr->stop_finding; + if (horizon_is_genuine) + cout << "being finding horizon #" << hn << endl; + patch_system *const ps_ptr = horizon_is_genuine ? AH_data_ptr->ps_ptr : NULL; + Jacobian *const Jac_ptr = horizon_is_genuine ? AH_data_ptr->Jac_ptr : NULL; + const double add_to_expansion = horizon_is_genuine ? -AH_data_ptr->surface_expansion : 0.0; + const int max_iterations = horizon_is_genuine + ? (AH_data_ptr->initial_find_flag ? 80 : 20) + : INT_MAX; + + if (horizon_is_genuine) + save_oldh(*ps_ptr); + + for (int iteration = 1;; ++iteration) + { + if (horizon_is_genuine && iteration == max_iterations) + cout << "AHfinder: fail to find horizon #" << hn + << " with Newton iteration " << iteration << " steps!!!" << endl; + jtutil::norm Theta_norms; + + const enum expansion_status raw_expansion_status = expansion(ps_ptr, add_to_expansion, + (iteration == 1), true, &Theta_norms); + + const bool Theta_is_ok = (raw_expansion_status == expansion_success); + const bool norms_are_ok = horizon_is_genuine && Theta_is_ok; + + // + // have we found this horizon? + // if so, compute and output BH diagnostics + // + const bool found_this_horizon = norms_are_ok && (Theta_norms.infinity_norm() <= 1e-11); + + if (horizon_is_genuine) + AH_data_ptr->found_flag = found_this_horizon; + + if (horizon_is_genuine && found_this_horizon) + cout << "found horizon #" << hn << " with " << iteration << " steps!!!" << endl; + // + // see if the expansion is too big + // (if so, we'll give up on this horizon) + // + const bool expansion_is_too_large = norms_are_ok && (Theta_norms.infinity_norm() > 1e10); + + // + // compute the mean horizon radius, and if it's too large, + // then pretend expansion() returned a "surface too large" error status + // + jtutil::norm h_norms; + if (horizon_is_genuine) + then ps_ptr->ghosted_gridfn_norms(gfns::gfn__h, h_norms); + const fp mean_horizon_radius = horizon_is_genuine ? h_norms.mean() + : 0.0; + const bool horizon_is_too_large = (mean_horizon_radius > 1e10); + + const enum expansion_status effective_expansion_status = horizon_is_too_large ? expansion_failure__surface_too_large + : raw_expansion_status; + + // + // see if we need more iterations (either on this or another horizon) + // + + // does *this* horizon need more iterations? + // i.e. has this horizon's Newton iteration not yet converged? + const bool this_horizon_needs_more_iterations = horizon_is_genuine && Theta_is_ok && !found_this_horizon && !expansion_is_too_large && !horizon_is_too_large && (iteration < max_iterations); + + // do I (this processor) need to do more iterations + // on this or a following horizon? + const bool I_need_more_iterations = this_horizon_needs_more_iterations || there_is_another_genuine_horizon; + + // + // broadcast iteration status from each active processor + // to all processors, and inclusive-or the "we need more iterations" + // flags to see if *any* (active) processor needs more iterations + // + const bool any_proc_needs_more_iterations = broadcast_status(N_procs, N_active_procs, + my_proc, my_active_flag, + hn, iteration, effective_expansion_status, + mean_horizon_radius, + (norms_are_ok ? Theta_norms.infinity_norm() : 0.0), + found_this_horizon, I_need_more_iterations, + isb); + // set found-this-horizon flags + // for all active processors' non-dummy horizons + for (int found_proc = 0; found_proc < N_active_procs; ++found_proc) + { + const int found_hn = isb.hn_buffer[found_proc]; + if (found_hn > 0) + AH_data_array[found_hn]->found_flag = isb.found_horizon_buffer[found_proc]; + } + + // + // prepare lapse and shift + { + int ff = 0, fft = 0; + if (found_this_horizon && dumpid[hn - 1] > 0 && dT[hn - 1] > 0) + fft = 1; + MPI_Allreduce(&fft, &ff, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + if (ff) + { + if ((interpolate_alsh(ps_ptr) == 0) && (state.my_proc == 0)) + cout << "interpolation of lapse and shift for AH failed." << endl; + } + } + + if (found_this_horizon) + { + struct BH_diagnostics &BH_diagnostics = AH_data_ptr->BH_diagnostics; + // output data + if (dumpid[hn - 1] > 0) + { + char filename[100]; + sprintf(filename, "ah%02d_%05d.dat", hn, dumpid[hn - 1]); + if (dT[hn - 1] > 0) + { + // gridfunction xx,xy,xz,yy,yz,zz will be used as temp storage + BH_diagnostics.compute_signature(*ps_ptr, dT[hn - 1]); + ps_ptr->print_gridfn_with_xyz(gfns::gfn__global_zz, true, gfns::gfn__h, filename); + } + else + ps_ptr->print_ghosted_gridfn_with_xyz(gfns::gfn__h, true, gfns::gfn__h, filename, false); + } + + BH_diagnostics.compute(*ps_ptr); // gridfunction xx,xy,xz,yy,yz,zz changed + + if (AH_data_ptr->BH_diagnostics_fileptr == NULL) + AH_data_ptr->BH_diagnostics_fileptr = BH_diagnostics.setup_output_file(N_horizons, hn); + BH_diagnostics.output(AH_data_ptr->BH_diagnostics_fileptr, (*state.PhysTime)); + + // recentering + recentering(*ps_ptr, (AH_data_ptr->BH_diagnostics).max_x, (AH_data_ptr->BH_diagnostics).max_y, (AH_data_ptr->BH_diagnostics).max_z, + (AH_data_ptr->BH_diagnostics).min_x, (AH_data_ptr->BH_diagnostics).min_y, (AH_data_ptr->BH_diagnostics).min_z, + (AH_data_ptr->BH_diagnostics).centroid_x, (AH_data_ptr->BH_diagnostics).centroid_y, (AH_data_ptr->BH_diagnostics).centroid_z); + AH_data_ptr->recentering_flag = true; + } + + // + // are all processors done with all their genuine horizons? + // or if this is a single-processor run, are we done with this horizon? + // + if (!any_proc_needs_more_iterations) + return; // *** NORMAL RETURN *** + + // + // compute the Jacobian matrix + // *** this is a synchronous operation across all processors *** + // + + const enum expansion_status + Jacobian_status = expansion_Jacobian(this_horizon_needs_more_iterations ? ps_ptr : NULL, + this_horizon_needs_more_iterations ? Jac_ptr : NULL, + add_to_expansion, + (iteration == 1), + false); + const bool Jacobian_is_ok = (Jacobian_status == expansion_success); + + // + // skip to the next horizon unless + // this is a genuine Jacobian computation, and it went ok + // + if (!(this_horizon_needs_more_iterations && Jacobian_is_ok)) + break; // *** LOOP EXIT *** + + // + // compute the Newton step + // + Jac_ptr->solve_linear_system(gfns::gfn__Theta, gfns::gfn__Delta_h, false); + + Newton_step(*ps_ptr, mean_horizon_radius, 0.1); + + // end of this Newton iteration + } + + // end of this horizon + } + + // we should never get to here + assert(false); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + namespace + { + bool broadcast_status(int N_procs, int N_active_procs, + int my_proc, bool my_active_flag, + int hn, int iteration, + enum expansion_status effective_expansion_status, + fp mean_horizon_radius, fp infinity_norm, + bool found_this_horizon, bool I_need_more_iterations, + struct iteration_status_buffers &isb) + { + assert(my_proc >= 0); + assert(my_proc < N_procs); + + enum + { + buffer_var__hn = 0, // also encodes found_this_horizon flag + // in sign: +=true, -=false + buffer_var__iteration, // also encodes I_need_more_iterations flag + // in sign: +=true, -=false + buffer_var__expansion_status, + buffer_var__mean_horizon_radius, + buffer_var__Theta_infinity_norm, + N_buffer_vars // no comma + }; + + // + // allocate buffers if this is the first use + // + if (isb.hn_buffer == NULL) + then + { + isb.hn_buffer = new int[N_active_procs]; + isb.iteration_buffer = new int[N_active_procs]; + isb.expansion_status_buffer = new enum expansion_status[N_active_procs]; + isb.mean_horizon_radius_buffer = new fp[N_active_procs]; + isb.Theta_infinity_norm_buffer = new fp[N_active_procs]; + isb.found_horizon_buffer = new bool[N_active_procs]; + + isb.send_buffer_ptr = new jtutil::array2d(0, N_active_procs - 1, + 0, N_buffer_vars - 1); + isb.receive_buffer_ptr = new jtutil::array2d(0, N_active_procs - 1, + 0, N_buffer_vars - 1); + } + jtutil::array2d &send_buffer = *isb.send_buffer_ptr; + jtutil::array2d &receive_buffer = *isb.receive_buffer_ptr; + + // + // pack this processor's values into the reduction buffer + // + jtutil::zero_C_array(send_buffer.N_array(), send_buffer.data_array()); + if (my_active_flag) + then + { + assert(send_buffer.is_valid_i(my_proc)); + assert(hn >= 0); // encoding scheme assumes this + assert(iteration > 0); // encoding scheme assumes this + send_buffer(my_proc, buffer_var__hn) = found_this_horizon ? +hn : -hn; + send_buffer(my_proc, buffer_var__iteration) = I_need_more_iterations ? +iteration : -iteration; + send_buffer(my_proc, buffer_var__expansion_status) = int(effective_expansion_status); + send_buffer(my_proc, buffer_var__mean_horizon_radius) = mean_horizon_radius; + send_buffer(my_proc, buffer_var__Theta_infinity_norm) = infinity_norm; + } + + const int reduction_status = MPI_Allreduce(static_cast(send_buffer.data_array()), + static_cast(receive_buffer.data_array()), + send_buffer.N_array(), + MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD); + + // if (reduction_status < 0) + if (reduction_status != MPI_SUCCESS) + then CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING, + "broadcast_status(): error status %d from reduction!", + reduction_status); /*NOTREACHED*/ + + // + // unpack the reduction buffer back to the high-level result buffers and + // compute the inclusive-or of the broadcast I_need_more_iterations flags + // + bool any_proc_needs_more_iterations = false; + for (int proc = 0; proc < N_active_procs; ++proc) + { + const int hn_temp = static_cast( + receive_buffer(proc, buffer_var__hn)); + isb.hn_buffer[proc] = jtutil::abs(hn_temp); + isb.found_horizon_buffer[proc] = (hn_temp > 0); + + const int iteration_temp = static_cast( + receive_buffer(proc, buffer_var__iteration)); + isb.iteration_buffer[proc] = jtutil::abs(iteration_temp); + const bool proc_needs_more_iterations = (iteration_temp > 0); + any_proc_needs_more_iterations |= proc_needs_more_iterations; + + isb.expansion_status_buffer[proc] = static_cast( + static_cast( + receive_buffer(proc, buffer_var__expansion_status))); + + isb.mean_horizon_radius_buffer[proc] = receive_buffer(proc, buffer_var__mean_horizon_radius); + isb.Theta_infinity_norm_buffer[proc] = receive_buffer(proc, buffer_var__Theta_infinity_norm); + } + + return any_proc_needs_more_iterations; + } + } + // + // This function takes the Newton step, scaling it down if it's too large. + // + // Arguments: + // ps = The patch system containing the gridfns h and Delta_h. + // mean_horizon_radius = ||h||_mean + // max_allowable_Delta_h_over_h = The maximum allowable + // ||Delta_h||_infinity / ||h||_mean + // Any step over this is internally clamped + // (scaled down) to this size. + // + namespace + { + void Newton_step(patch_system &ps, + fp mean_horizon_radius, fp max_allowable_Delta_h_over_h) + { + // + // compute scale factor (1 for small steps, <1 for large steps) + // + + const fp max_allowable_Delta_h = max_allowable_Delta_h_over_h * mean_horizon_radius; + + jtutil::norm Delta_h_norms; + ps.gridfn_norms(gfns::gfn__Delta_h, Delta_h_norms); + const fp max_Delta_h = Delta_h_norms.infinity_norm(); + + const fp scale = (max_Delta_h <= max_allowable_Delta_h) + ? 1.0 + : max_allowable_Delta_h / max_Delta_h; + + // + // take the Newton step (scaled if necessary) + // + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + p.ghosted_gridfn(gfns::gfn__h, irho, isigma) -= scale * p.gridfn(gfns::gfn__Delta_h, irho, isigma); + } + } + } + } + void save_oldh(patch_system &ps) + { + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + p.gridfn(gfns::gfn__oldh, irho, isigma) = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + } + } + } + } + } + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif diff --git a/AMSS_NCKU_source/NullEvol.f90 b/AMSS_NCKU_source/NullEvol.f90 new file mode 100644 index 0000000..5f826b2 --- /dev/null +++ b/AMSS_NCKU_source/NullEvol.f90 @@ -0,0 +1,4026 @@ + + +#include "macrodef.fh" + +!#define OLD + +! 0: rk4, 1: Adams-Moulton + +#define RKorAM 0 + +function beta_rhs(xx,CJx,Kx) result(gont) + implicit none + double complex,intent(in) :: CJx + real*8,intent(in) :: xx,Kx + + real*8 :: gont + + gont = xx*(1.d0-xx)/8.d0*(dreal(CJx*dconjg(CJx))-Kx*Kx) + + return + +end function beta_rhs + +function Q_rhs(xx,CJ,CJx,DCJx,KK,Ck,Ckx,Cnux,KKx,CBx,Cnu,DCJ,CB,CQ) result(gont) + implicit none + double complex,intent(in) :: CJ,CJx,DCJx,Ck,Ckx,Cnux,CBx,Cnu,DCJ,CB,CQ + real*8,intent(in) :: xx,KK,KKx + + double complex :: gont + + gont = -KK*(Ckx+Cnux)+Cnu*KKx+CJ*dconjg(Ckx)+2.d0*CBx & + +dconjg(Cnu)*CJx+dconjg(CJ)*DCJx-dconjg(Ck)*CJx & + +(dconjg(Cnu)*(CJx-CJ*CJ*dconjg(CJx)) & + +DCJ*(dconjg(CJx)-dconjg(CJ*CJ)*CJx)/2.d0/KK/KK) & + -2.d0*(2.d0*CB+CQ)/xx/(1.d0-xx) + + return + +end function Q_rhs + +function U_rhs(xx,Rmin,beta,KK,CQ,CJ) result(gont) + implicit none + double complex,intent(in) :: CQ,CJ + real*8,intent(in) :: xx,Rmin,beta,KK + + double complex :: gont + +#if 1 + gont = dexp(2.d0*beta)/Rmin/xx/xx*(KK*CQ-CJ*dconjg(CQ)) +#else + gont = CQ/Rmin/xx/xx +#endif + +#if 0 + if(cdabs(gont)>1)then + write(*,*)beta,KK,CQ,CJ + stop + endif +#endif + + return + +end function U_rhs + +function W_rhs(xx,Rmin,beta,KK,DCB,CB,CJ,Cnu,Ck,W, & + CQ,bDCk,bDCnu,bDCB,bDCU,bDCUx,DCJ) result(gont) + implicit none + double complex,intent(in) :: DCB,CB,CJ,Cnu,Ck,CQ,bDCk,bDCnu,bDCB,bDCU,bDCUx,DCJ + real*8,intent(in) :: xx,Rmin,beta,KK,W + + real*8 :: Ric,gont + + Ric = dreal(2.d0*KK+bDCnu-bDCk+(DCJ*dconjg(DCJ)-Cnu*dconjg(Cnu))/4.d0/KK) + + gont = dreal(dexp(2.d0*beta)*(Ric/2.d0-KK*(bDCB+CB*dconjg(CB))+dconjg(CJ)*(bDCB+CB*CB) & + +(Cnu-Ck)*dconjg(CB))-1.d0+2.d0*Rmin*xx/(1.d0-xx)*(bDCU-W) & + +Rmin*xx*xx/2.d0*bDCUx-dexp(2.d0*beta)/4.d0* & + (KK*KK-CJ*dconjg(CJ))*(KK*dconjg(CQ)-dconjg(CJ)*CQ)*CQ) + + gont = gont/Rmin/xx/xx + + return + +end function W_rhs + +function Theta_rhs(xx,Rmin,beta,betax,KK,KKx,CU,CUx,DCUx,bDCU,bDCUx,DCU,CB,DCB,W,Wx,CJ,DCJ,CJx,CJxx, & + DCJx,bDCB,Cnu,Cnux,Ck,Theta) result(gont) + implicit none + double complex,intent(in) :: CU,CUx,DCUx,bDCU,bDCUx,DCU,CB,DCB,CJ,DCJ,CJx,CJxx,DCJx + double complex,intent(in) :: bDCB,Cnu,Cnux,Ck,Theta + real*8,intent(in) :: xx,Rmin,beta,betax,KK,KKx,W,Wx + + double complex :: JH,II,gont + real*8 :: V,Vx,Pu + + II = dcmplx(0.d0,1.d0) + + V = xx*Rmin/(1.d0-xx)*(1.d0+xx*Rmin/(1.d0-xx)*W) + + Vx = Rmin/(1.d0-xx)**2+2.d0*xx*Rmin*Rmin/(1.d0-xx)**3*W+xx*xx*Rmin*Rmin/(1.d0-xx)**2*Wx + + Pu = 2.d0*xx*(1.d0-xx)/KK*dreal(Theta*(dconjg(CJx)*KK-dconjg(CJ)*KKx)) + + JH = (1.d0-xx)/xx/Rmin*dexp(2.d0*beta)*(-KK*DCJ*dconjg(CB)+ & + (KK*Cnu+(KK*KK-1.d0)*DCJ-2.d0*KK*Ck)*CB+CJ* & + ((2.d0*Ck-Cnu)*dconjg(CB)-2.d0*KK*(bDCB+CB*dconjg(CB))+ & + 2.d0*dreal((Cnu-Ck)*dconjg(CB)+dconjg(CJ)*(DCB+CB*CB)))) & + +0.5d0*Rmin*xx**3*(1.d0-xx)*dexp(-2.d0*beta)* & + ((KK*CUx+CJ*dconjg(CUx))**2- & + CJ*dreal(dconjg(CUx)*(KK*CUx+CJ*dconjg(CUx)))) & + -0.5d0*(Cnu*(xx*(1.d0-xx)*CUx+2.d0*CU)+DCJ*(xx*(1.d0-xx)*dconjg(CUx)+ & + 2.d0*dconjg(CU)))+CJ*II*dimag(xx*(1.d0-xx)*bDCUx+2.d0*bDCU) & + -xx*(1.d0-xx)*CJx*dreal(bDCU) & + +xx*(1.d0-xx)*(dconjg(CU)*DCJ+CU*Cnu)*II*dimag(CJ*dconjg(CJx)) & + -xx*(1.d0-xx)*(dconjg(CU)*DCJx+CU*Cnux) & + -2.d0*xx*(1.d0-xx)*(CJ*KKx-KK*CJx)*(dreal(dconjg(CU)*Ck)+ & + II*dimag(KK*bDCU-dconjg(CJ)*DCU)) & + -8.d0*CJ*((1.d0-xx)**2/Rmin+xx*(1.d0-xx)*W)*betax + + gont = -KK*(xx*(1-xx)*DCUx+2.d0*DCU)+2.d0*(1.d0-xx)/xx/Rmin*dexp(2.d0*beta)*(DCB+CB*CB) & + -(xx*(1.d0-xx)*Wx+W)*CJ+JH+CJ*Pu-2.d0*Theta & + -(1.d0-xx)*(1.d0-xx)/xx/xx/Rmin/Rmin*V*(CJ+xx*(1.d0-xx)*CJx) & + +(1.d0-xx)*(1.d0-xx)*(1.d0-xx)/xx/Rmin/Rmin*Vx*(CJ+xx*(1.d0-xx)*CJx) & + +(1.d0-xx)**4/xx/Rmin/Rmin*V*(2.d0*CJx+xx*CJxx) +#if 0 + gont = -(xx*(1-xx)*DCUx+2.d0*DCU)+2.d0*(1.d0-xx)/xx/Rmin*DCB & + -2.d0*Theta & + +(1.d0-xx)**3/Rmin*(2.d0*CJx+xx*CJxx) +#endif + + gont = gont/2.d0/xx/(1.d0-xx) + + return + +end function Theta_rhs +!/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +subroutine fake_Theta_rhs(lx,X,rhs,Theta) + implicit none + integer,intent(in) :: lx + double complex,dimension(lx),intent(in) :: Theta + double complex,dimension(lx),intent(out) :: rhs + real*8,dimension(lx),intent(in) :: X + + call cderivs_x(lx,X,Theta,rhs) + + return + +end subroutine fake_Theta_rhs +!/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +! try other guy's old method +function Theta_rhs_o(xx,Rmin,beta,betax,KK,KKx,CU,CUx,DCUx,bDCU,bDCUx,DCU,CB,DCB,W,Wx,CJ,DCJ,CJx,CJxx, & + DCJx,bDCB,Cnu,Cnux,Ck,Theta) result(gont) + implicit none + double complex,intent(in) :: CU,CUx,DCUx,bDCU,bDCUx,DCU,CB,DCB,CJ,DCJ,CJx,CJxx,DCJx + double complex,intent(in) :: Cnu,Cnux,Ck,bDCB,Theta + real*8,intent(in) :: xx,Rmin,beta,betax,KK,KKx,W,Wx + + double complex :: JH,II,gont + real*8 :: V,Vx,Pu + + II = dcmplx(0.d0,1.d0) + + V = xx*Rmin/(1.d0-xx)*(1.d0+xx*Rmin/(1.d0-xx)*W) + + Vx = Rmin/(1.d0-xx)**2+2.d0*xx*Rmin*Rmin/(1.d0-xx)**3*W+xx*xx*Rmin*Rmin/(1.d0-xx)**2*Wx + + Pu = 2.d0*xx*(1.d0-xx)/KK*dreal(Theta*(dconjg(CJx)*KK-dconjg(CJ)*KKx)) + + JH = (1.d0-xx)/xx/Rmin*dexp(2.d0*beta)*(-KK*DCJ*dconjg(CB)+ & + (KK*Cnu+(KK*KK-1.d0)*DCJ-2.d0*KK*Ck)*CB+CJ* & + ((2.d0*Ck-Cnu)*dconjg(CB)-2.d0*KK*(bDCB+CB*dconjg(CB))+ & + 2.d0*dreal((Cnu-Ck)*dconjg(CB)+dconjg(CJ)*(DCB+CB*CB)))) & + +0.5d0*Rmin*xx**3*(1.d0-xx)*dexp(-2.d0*beta)* & + ((KK*CUx+CJ*dconjg(CUx))**2- & + CJ*dreal(dconjg(CUx)*(KK*CUx+CJ*dconjg(CUx)))) & + -0.5d0*(Cnu*(xx*(1.d0-xx)*CUx+2.d0*CU)+DCJ*(xx*(1.d0-xx)*dconjg(CUx)+ & + 2.d0*dconjg(CU)))+CJ*II*dimag(xx*(1.d0-xx)*bDCUx+2.d0*bDCU) & + -xx*(1.d0-xx)*CJx*dreal(bDCU) & + +xx*(1.d0-xx)*(dconjg(CU)*DCJ+CU*Cnu)*II*dimag(CJ*dconjg(CJx)) & + -xx*(1.d0-xx)*(dconjg(CU)*DCJx+CU*Cnux) & + -2.d0*xx*(1.d0-xx)*(CJ*KKx-KK*CJx)*(dreal(dconjg(CU)*Ck)+ & + II*dimag(KK*bDCU-dconjg(CJ)*DCU)) & + -8.d0*CJ*((1.d0-xx)**2/Rmin+xx*(1.d0-xx)*W)*betax + + gont = -KK*(xx*(1-xx)*DCUx+2.d0*DCU)+2.d0*(1.d0-xx)/xx/Rmin*dexp(2.d0*beta)*(DCB+CB*CB) & + -(xx*(1.d0-xx)*Wx+W)*CJ+JH+CJ*Pu & + -(1.d0-xx)*(1.d0-xx)/xx/xx/Rmin/Rmin*V*(CJ+xx*(1.d0-xx)*CJx) & + +(1.d0-xx)*(1.d0-xx)*(1.d0-xx)/xx/Rmin/Rmin*Vx*(CJ+xx*(1.d0-xx)*CJx) & + +(1.d0-xx)**4/xx/Rmin/Rmin*V*(2.d0*CJx+xx*CJxx) + + return + +end function Theta_rhs_o + +#if (RKorAM == 0) + +!-------------------------------------------------------------------- +! this R is indeed x +function NullEvol_Theta_o(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex :: CTheta0,CTheta,CTheta1,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(3)) :: Cnu,Ck,HCnu,HCk,HCU,HDCU,CUx,HCUx,DCUx,HDCUx,HbDCU,bDCUx,HbDCUx + double complex,dimension(ex(3)) :: Cnux,HCnux,HCJ,HDCJ,CJx,HCJx,CJxx,HCJxx,DCJx,HDCJx,HCB,HDCB,HbDCB + real*8,dimension(ex(3)) :: KK,KKx,HKK,HKKx,Hbeta,betax,Hbetax,HW,Wx,HWx + double complex :: Theta_rhs_o + real*8 :: dR + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + CTheta0 = dcmplx(RTheta(i,j,1),ITheta(i,j,1)) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) + call cget_half_x(ex(3),CB(i,j,:),HCB) + call cget_half_x(ex(3),DCB(i,j,:),HDCB) + call cget_half_x(ex(3),bDCB(i,j,:),HbDCB) + call cget_half_x(ex(3),Cnu,HCnu) + call cderivs_x(ex(3),R,Cnu,Cnux) + call cget_half_x(ex(3),Cnux,HCnux) + call cget_half_x(ex(3),Ck,HCk) + call rget_half_x(ex(3),beta(i,j,:),Hbeta) + call rderivs_x(ex(3),R,beta(i,j,:),betax) + call rget_half_x(ex(3),betax,Hbetax) + KK = dsqrt(1.d0+RJ(i,j,:)*RJ(i,j,:)+IJ(i,j,:)*IJ(i,j,:)) + call rget_half_x(ex(3),KK,HKK) + call rderivs_x(ex(3),R,KK,KKx) + call rget_half_x(ex(3),KKx,HKKx) + call rderivs_x(ex(3),R,W,Wx) + call rget_half_x(ex(3),Wx,HWx) + call rget_half_x(ex(3),W(i,j,:),HW) + call cget_half_x(ex(3),CU(i,j,:),HCU) + call cderivs_x(ex(3),R,DCU(i,j,:),DCUx) + call cderivs_x(ex(3),R,CU(i,j,:),CUx) + call cget_half_x(ex(3),DCUx,HDCUx) + call cget_half_x(ex(3),CUx,HCUx) + call cget_half_x(ex(3),DCU(i,j,:),HDCU) + call cderivs_x(ex(3),R,bDCU(i,j,:),bDCUx) + call cget_half_x(ex(3),bDCUx,HbDCUx) + call cget_half_x(ex(3),bDCU(i,j,:),HbDCU) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cdderivs_x(ex(3),R,CJ(i,j,:),CJxx) + call cget_half_x(ex(3),CJx,HCJx) + call cget_half_x(ex(3),CJxx,HCJxx) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) + call cget_half_x(ex(3),DCJx,HDCJx) + do k=1,ex(3)-1 + RHS = Theta_rhs_o(R(k)+dR/2.d0,Rmin,Hbeta(k),betax(k),HKK(k),KKx(k),HCU(k),CUx(k),DCUx(k),HbDCU(k),bDCUx(k), & + HDCU(k),HCB(k),HDCB(k),HW(k),Wx(k),HCJ(k),HDCJ(k), & + CJx(k),CJxx(k),DCJx(k),HbDCB(k),HCnu(k),Cnux(k),HCk(k),CTheta0) + CTheta1 = RHS-(1-2.d0*(R(k)+dR/2.d0)*(1.d0-R(k)-dR/2.d0)/dR)*CTheta0 + CTheta1 = CTheta1/(1+2.d0*(R(k)+dR/2.d0)*(1.d0-R(k)-dR/2.d0)/dR) + CTheta0 = CTheta1 + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta_o +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_beta(ex,crho,sigma,R,RJ,IJ,beta,KKx,HKKx) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,KKx,HKKx +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + double complex, dimension(ex(3)):: CJ,CJx,HCJx + real*8 :: betah0,betah1,betah,rhs + integer :: i,j,k,RK4 + real*8 :: beta_rhs + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(beta)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_beta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_beta: find NaN in IJ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_beta: find NaN in beta" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_beta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_beta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + betah0 = beta(i,j,1) + CJ = dcmplx(RJ(i,j,:),IJ(i,j,:)) + call cderivs_x(ex(3),R,CJ,CJx) + call cget_half_x(ex(3),CJx,HCJx) +#ifdef OLD + do k = 1,ex(3)-1 +! note our CJx(ex(3)) = (CJ(ex(3))-CJ(ex(3)-1))/dR +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + rhs = beta_rhs(R(k)+dR/2.d0,CJx(k+1),KKx(i,j,k+1)) + beta(i,j,k+1) = beta(i,j,k) + rhs*dR + enddo +#else + do k=1,ex(3)-1 + RK4 = 0 + rhs = beta_rhs(R(k),CJx(k),KKx(i,j,k)) + call rungekutta4_scalar(dR,betah0,betah,rhs,RK4) + + RK4 = 1 + betah1 = beta_rhs(R(k)+dR/2.d0,HCJx(k),HKKx(i,j,k)) + call rungekutta4_scalar(dR,betah0,betah1,rhs,RK4) + call rswap(betah,betah1) + + RK4 = 2 + betah1 = beta_rhs(R(k)+dR/2.d0,HCJx(k),HKKx(i,j,k)) + call rungekutta4_scalar(dR,betah0,betah1,rhs,RK4) + call rswap(betah,betah1) + + RK4 = 3 + betah1 = beta_rhs(R(k+1),CJx(k+1),KKx(i,j,k+1)) + call rungekutta4_scalar(dR,betah0,betah1,rhs,RK4) + call rswap(betah0,betah1) + + beta(i,j,k+1) = betah0 + enddo +! above k takes ex(3)-1 then do not need this closing step +#if 1 +! closing step + k = ex(3)-1 +! note our CJx(ex(3)) = (CJ(ex(3))-CJ(ex(3)-1))/dR +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + rhs = beta_rhs(R(k)+dR/2.d0,CJx(k+1),KKx(i,j,k+1)) + beta(i,j,k+1) = beta(i,j,k) + rhs*dR +#endif + +#endif + enddo + enddo + + gont = 0 + + return + +end function NullEvol_beta +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_Q(ex,crho,sigma,R,RJ,IJ,Rk,Ik,Rnu,Inu,RB,IB,RQ,IQ,KK,Hkk,KKx,HKKx, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RQ,IQ + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,KK,Hkk,KKx,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rk,Ik,Rnu,Inu,RB,IB + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: xx,dR + + double complex :: CQ0,CQ,CQ1,RHS + double complex,dimension(ex(3)) :: CJx,HCJx,DCJx,HDCJx,Ck,Ckx,HCkx,Cnu,Cnux,HCnux,CB,CBx,HCBx + double complex,dimension(ex(3)) :: HCJ,HCk,HCnu,HCB,HDCJ + double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,DCJ + integer :: i,j,k,RK4 + double complex :: Q_rhs + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RQ)+sum(IQ) & + +sum(RK)+sum(IK)+sum(Rnu)+sum(Inu)+sum(RB)+sum(IB) & + +sum(KK)+sum(HKK)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Q: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Q: find NaN in IJ" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_Q: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_Q: find NaN in IQ" + if(sum(RK).ne.sum(RK))write(*,*)"NullEvol_Q: find NaN in RK" + if(sum(IK).ne.sum(IK))write(*,*)"NullEvol_Q: find NaN in IK" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Q: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Q: find NaN in Inu" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Q: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Q: find NaN in IB" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Q: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_Q: find NaN in HKK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Q: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_Q: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CJ = dcmplx(RJ,IJ) + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + do j=1,ex(2) + do i=1,ex(1) + CQ0 = dcmplx(RQ(i,j,1),IQ(i,j,1)) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cget_half_x(ex(3),CJx,HCJx) + call cget_half_x(ex(3),CJ,HCJ) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) + call cget_half_x(ex(3),DCJx,HDCJx) + call cget_half_x(ex(3),DCJ,HDCJ) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) + call cderivs_x(ex(3),R,Ck,Ckx) + call cget_half_x(ex(3),Ckx,HCkx) + call cget_half_x(ex(3),Ck,HCk) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + call cderivs_x(ex(3),R,Cnu,Cnux) + call cget_half_x(ex(3),Cnux,HCnux) + call cget_half_x(ex(3),Cnu,HCnu) + CB = dcmplx(RB(i,j,:),IB(i,j,:)) + call cderivs_x(ex(3),R,CB,CBx) + call cget_half_x(ex(3),CBx,HCBx) + call cget_half_x(ex(3),CB,HCB) +#ifdef OLD + do k = 1,ex(3)-1 + xx = R(k)+dR/2.d0 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + RHS = Q_rhs(xx,HCJ(k),CJx(k+1),DCJx(k+1),HKK(i,j,k),HCk(k),Ckx(k+1),Cnux(k+1),KKx(i,j,k+1),CBx(k+1),HCnu(k),HDCJ(k),HCB(k),0) + RHS = RHS+CQ0*(1.d0/dR-1.d0/xx/(1.d0-xx)) + CQ0 = RHS/(1.d0/dR+1.d0/xx/(1.d0-xx)) + RQ(i,j,k+1) = dreal(CQ0) + IQ(i,j,k+1) = dimag(CQ0) + enddo +#else + do k=1,ex(3)-2 + RK4 = 0 + RHS = Q_rhs(R(k),CJ(i,j,k),CJx(k),DCJx(k),KK(i,j,k),Ck(k),Ckx(k),Cnux(k),KKx(i,j,k),CBx(k),Cnu(k),DCJ(i,j,k),CB(k),CQ0) + call rungekutta4_cplxscalar(dR,CQ0,CQ,RHS,RK4) + + RK4 = 1 + CQ1 = Q_rhs(R(k)+dR/2.d0,HCJ(k),HCJx(k),HDCJx(k),HKK(i,j,k),HCk(k),HCkx(k),HCnux(k),HKKx(i,j,k), & + HCBx(k),HCnu(k),HDCJ(k),HCB(k),CQ) + call rungekutta4_cplxscalar(dR,CQ0,CQ1,RHS,RK4) + call cswap(CQ,CQ1) + + RK4 = 2 + CQ1 = Q_rhs(R(k)+dR/2.d0,HCJ(k),HCJx(k),HDCJx(k),HKK(i,j,k),HCk(k),HCkx(k),HCnux(k),HKKx(i,j,k), & + HCBx(k),HCnu(k),HDCJ(k),HCB(k),CQ) + call rungekutta4_cplxscalar(dR,CQ0,CQ1,RHS,RK4) + call cswap(CQ,CQ1) + + RK4 = 3 + CQ1 = Q_rhs(R(k+1),CJ(i,j,k+1),CJx(k+1),DCJx(k+1),KK(i,j,k+1),Ck(k+1),Ckx(k+1),Cnux(k+1),KKx(i,j,k+1), & + CBx(k+1),Cnu(k+1),DCJ(i,j,k+1),CB(k+1),CQ) + call rungekutta4_cplxscalar(dR,CQ0,CQ1,RHS,RK4) + call cswap(CQ0,CQ1) + + RQ(i,j,k+1) = dreal(CQ0) + IQ(i,j,k+1) = dimag(CQ0) + enddo +#if 0 + k = ex(3) + CQ0 = -2*CB(k) + RQ(i,j,k+1) = dreal(CQ0) + IQ(i,j,k+1) = dimag(CQ0) +#else +! closing step + k = ex(3)-1 + CQ0 = dcmplx(RQ(i,j,k),IQ(i,j,k)) + xx = R(k)+dR/2.d0 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + RHS = Q_rhs(xx,HCJ(k),CJx(k+1),DCJx(k+1),HKK(i,j,k), & + HCk(k),Ckx(k+1),Cnux(k+1),KKx(i,j,k+1),CBx(k+1),HCnu(k),HDCJ(k),HCB(k),dcmplx(0.d0,0.d0)) + RHS = RHS+CQ0*(1.d0/dR-1.d0/xx/(1.d0-xx)) + CQ0 = RHS/(1.d0/dR+1.d0/xx/(1.d0-xx)) + RQ(i,j,k+1) = dreal(CQ0) + IQ(i,j,k+1) = dimag(CQ0) +#endif + +#endif + enddo + enddo + + gont = 0 + return + +end function NullEvol_Q +!-------------------------------------------------------------------- +! this R is indeed x +function NullEvol_U(ex,crho,sigma,R,RJ,IJ,RQ,IQ,KK,HKK,beta,RU,IU, & + Rmin) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RQ,IQ,beta,KK,HKK + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RU,IU + real*8,intent(in) :: Rmin +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + double complex :: CU0,CU,CU1,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(3)) :: CJ,CQ,HCJ,HCQ + real*8,dimension(ex(3)) :: Hbeta + double complex :: U_rhs + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RQ)+sum(IQ)+sum(beta)+sum(RU)+sum(IU)+sum(KK)+sum(HKK) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_U: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_U: find NaN in IJ" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_U: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_U: find NaN in IQ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_U: find NaN in beta" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_U: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_U: find NaN in IU" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_U: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_U: find NaN in HKK" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + CU0 = dcmplx(RU(i,j,1),IU(i,j,1)) + CJ = dcmplx(RJ(i,j,:),IJ(i,j,:)) + CQ = dcmplx(RQ(i,j,:),IQ(i,j,:)) + call cget_half_x(ex(3),CJ,HCJ) + call cget_half_x(ex(3),CQ,HCQ) + call rget_half_x(ex(3),beta(i,j,:),Hbeta) +#ifdef OLD + do k = 1,ex(3)-1 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + RHS = U_rhs(R(k)+dR/2,Rmin,Hbeta(k),HKK(i,j,k),HCQ(k),HCJ(k)) + CU0 = CU0+RHS*dR + RU(i,j,k+1) = dreal(CU0) + IU(i,j,k+1) = dimag(CU0) + enddo +#else + + do k=1,ex(3)-2 + + RK4 = 0 + RHS = U_rhs(R(k),Rmin,beta(i,j,k),KK(i,j,k),CQ(k),CJ(k)) + call rungekutta4_cplxscalar(dR,CU0,CU,RHS,RK4) + + RK4 = 1 + CU1 = U_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),HKK(i,j,k),HCQ(k),HCJ(k)) + call rungekutta4_cplxscalar(dR,CU0,CU1,RHS,RK4) + call cswap(CU,CU1) + + RK4 = 2 + CU1 = U_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),HKK(i,j,k),HCQ(k),HCJ(k)) + call rungekutta4_cplxscalar(dR,CU0,CU1,RHS,RK4) + call cswap(CU,CU1) + + RK4 = 3 + CU1 = U_rhs(R(k+1),Rmin,beta(i,j,k+1),KK(i,j,k+1),CQ(k+1),CJ(k+1)) + call rungekutta4_cplxscalar(dR,CU0,CU1,RHS,RK4) + call cswap(CU0,CU1) + + RU(i,j,k+1) = dreal(CU0) + IU(i,j,k+1) = dimag(CU0) + + enddo +! above k takes ex(3)-1 then do not need closing step +#if 1 +! closing step + k = ex(3)-1 + CU0 = dcmplx(RU(i,j,k),IU(i,j,k)) +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + RHS = U_rhs(R(k)+dR/2,Rmin,Hbeta(k),HKK(i,j,k),HCQ(k),HCJ(k)) + CU0 = CU0+RHS*dR + RU(i,j,k+1) = dreal(CU0) + IU(i,j,k+1) = dimag(CU0) +#endif + +#endif + enddo + enddo + + gont = 0 + return + +end function NullEvol_U +!---------------------------------------------------------------------------------------- +! this R is indeed x +function NullEvol_W(ex,crho,sigma,R,RJ,IJ,RB,IB,Rnu,Inu,Rk,Ik, & + RU,IU,RQ,IQ,W,beta,KK,HKK,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: W + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,RB,IB + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RU,IU,RQ,IQ,beta,KK,HKK + real*8,intent(in ) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + real*8, dimension(ex(3)) :: Hbeta + double complex, dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU + double complex, dimension(ex(1),ex(2),ex(3)) :: CB,DCB,bDCB,CJ,DCJ,Cnu,bDCnu,Ck,bDCk + double complex, dimension(ex(3)) :: HCB,HDCB,HbDCB,HCJ,HDCJ,HCnu,HbDCnu,HCk,HbDCk + double complex, dimension(ex(3)) :: HbDCU,bDCUx,HbDCUx,CQ,HCQ + real*8 :: Wh0,Wh1,Wh,rhs + integer :: i,j,k,RK4 + real*8 :: xx,W_rhs + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(beta)+sum(RB)+sum(IB)+sum(Rnu)+sum(Inu) & + +sum(Rk)+sum(Ik)+sum(W)+sum(RU)+sum(IU)+sum(RQ)+sum(IQ)& + +sum(KK)+sum(HKK) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_W: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_W: find NaN in IJ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_W: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_W: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_W: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_W: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_W: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_W: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_W: find NaN in Ik" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_W: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_W: find NaN in IU" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_W: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_W: find NaN in IQ" + if(sum(W).ne.sum(W))write(*,*)"NullEvol_W: find NaN in W" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_W: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_W: find NaN in HKK" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CB = dcmplx(RB,IB) + CU = dcmplx(RU,IU) + Ck = dcmplx(Rk,Ik) + Cnu = dcmplx(Rnu,Inu) + CJ = dcmplx(RJ,IJ) + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,Ck(:,:,k),bDCk(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,Cnu(:,:,k),bDCnu(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + Wh0 = W(i,j,1) + call rget_half_x(ex(3),beta(i,j,:),Hbeta) + call cderivs_x(ex(3),R,bDCU,bDCUx) + call cget_half_x(ex(3),bDCUx,HbDCUx) + call cget_half_x(ex(3),bDCU,HbDCU) + call cget_half_x(ex(3),DCJ,HDCJ) + call cget_half_x(ex(3),DCB,HDCB) + call cget_half_x(ex(3),bDCB,HbDCB) + call cget_half_x(ex(3),CB,HCB) + call cget_half_x(ex(3),CJ,HCJ) + call cget_half_x(ex(3),Cnu,HCnu) + call cget_half_x(ex(3),Ck,HCk) + CQ = dcmplx(RQ(i,j,:),IQ(i,j,:)) + call cget_half_x(ex(3),CQ,HCQ) + call cget_half_x(ex(3),bDCk,HbDCk) + call cget_half_x(ex(3),bDCnu,HbDCnu) +#ifdef OLD + do k = 1,ex(3)-1 + xx = R(k)+dR/2 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + rhs = W_rhs(xx,Rmin,Hbeta(k),HKK(i,j,k),HDCB(k),HCB(k),HCJ(k),HCnu(k),HCk(k),0, & + HCQ(k),HbDCk(k),HbDCnu(k),HbDCB(k),HbDCU(k),bDCUx(k+1),HDCJ(k)) + rhs = rhs+Wh0*(1.d0/dR-1.d0/xx/(1.d0-xx)) + W(i,j,k+1) = rhs/(1.d0/dR+1.d0/xx/(1.d0-xx)) + enddo +#else + do k=1,ex(3)-2 + RK4 = 0 + rhs = W_rhs(R(k),Rmin,beta(i,j,k),KK(i,j,k),DCB(i,j,k),CB(i,j,k),CJ(i,j,k),Cnu(i,j,k),Ck(i,j,k),Wh0, & + CQ(k),bDCk(i,j,k),bDCnu(i,j,k),bDCB(i,j,k),bDCU(i,j,k),bDCUx(k),DCJ(i,j,k)) + call rungekutta4_scalar(dR,Wh0,Wh,rhs,RK4) + + RK4 = 1 + Wh1 = W_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),HKK(i,j,k),HDCB(k),HCB(k),HCJ(k),HCnu(k),HCk(k),Wh, & + HCQ(k),HbDCk(k),HbDCnu(k),HbDCB(k),HbDCU(k),HbDCUx(k),HDCJ(k)) + call rungekutta4_scalar(dR,Wh0,Wh1,rhs,RK4) + call rswap(Wh,Wh1) + + RK4 = 2 + Wh1 = W_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),HKK(i,j,k),HDCB(k),HCB(k),HCJ(k),HCnu(k),HCk(k),Wh, & + HCQ(k),HbDCk(k),HbDCnu(k),HbDCB(k),HbDCU(k),HbDCUx(k),HDCJ(k)) + call rungekutta4_scalar(dR,Wh0,Wh1,rhs,RK4) + call rswap(Wh,Wh1) + + RK4 = 3 + Wh1 = W_rhs(R(k+1),Rmin,beta(i,j,k+1),KK(i,j,k+1),DCB(i,j,k+1),CB(i,j,k+1),CJ(i,j,k+1),Cnu(i,j,k+1),Ck(i,j,k+1),Wh, & + CQ(k+1),bDCk(i,j,k+1),bDCnu(i,j,k+1),bDCB(i,j,k+1),bDCU(i,j,k+1),bDCUx(k+1),DCJ(i,j,k+1)) + call rungekutta4_scalar(dR,Wh0,Wh1,rhs,RK4) + call rswap(Wh0,Wh1) + + W(i,j,k+1) = Wh0 + enddo +#if 0 + k = ex(3) + W(i,j,k) = dreal(bDCU(i,j,k)) +#else +! closing step + k = ex(3)-1 + Wh0 = W(i,j,k) + xx = R(k)+dR/2 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR + rhs = W_rhs(xx,Rmin,Hbeta(k),HKK(i,j,k),HDCB(k),HCB(k),HCJ(k),HCnu(k),HCk(k),0.d0, & + HCQ(k),HbDCk(k),HbDCnu(k),HbDCB(k),HbDCU(k),bDCUx(k+1),HDCJ(k)) + rhs = rhs+Wh0*(1.d0/dR-1.d0/xx/(1.d0-xx)) + W(i,j,k+1) = rhs/(1.d0/dR+1.d0/xx/(1.d0-xx)) +#endif + +#endif + enddo + enddo + + gont = 0 + return + +end function NullEvol_W +!----------------------------------------------------------------------------------------------- +! given exact Theta_x +! this R is indeed x +function NullEvol_Theta_givenx(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,KK,HKK,KKx,HKKx,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,sst) result(gont) + implicit none + integer,intent(in ):: ex(1:3),sst + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W,KK,HKK,KKx,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin,T + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI +! gont = 0: success; gont = 1: something wrong + integer::gont + + real*8,dimension(ex(3))::HR + real*8,dimension(ex(1),ex(2),ex(3)) :: RThetax,IThetax,HRThetax,HIThetax + double complex,dimension(ex(3)) :: fRHS,HfRHS + real*8 :: xx,dR + integer :: i,j,k,RK4 + double complex :: CTheta0,CTheta,CTheta1,RHS + integer,parameter :: ks=1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + & + sum(KK)+sum(HKK)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Theta: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_Theta: find NaN in HKK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Theta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_Theta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + HR = R+dR/2 + + call get_exact_null_theta_x(ex,crho,sigma,R,RThetax,IThetax,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + call get_exact_null_theta_x(ex,crho,sigma,HR,HRThetax,HIThetax,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + do j=1,ex(2) + do i=1,ex(1) + CTheta0 = dcmplx(RTheta(i,j,ks),ITheta(i,j,ks)) + fRHS = dcmplx(RThetax(i,j,:),IThetax(i,j,:)) + HfRHS = dcmplx(HRThetax(i,j,:),HIThetax(i,j,:)) + ! call cget_half_x(ex(3),fRHS,HfRHS) + + do k=ks,ex(3)-1 + RK4 = 0 + RHS = fRHS(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta,RHS,RK4) + + RK4 = 1 + CTheta1 = HfRHS(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 2 + CTheta1 = HfRHS(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 3 + CTheta1 = fRHS(k+1) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta0,CTheta1) + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo + +#if 0 +! closing step + k = ex(3)-1 + RHS = fRHS(k) + CTheta0 = dcmplx(RTheta(i,j,k),ITheta(i,j,k))+RHS*dR + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) +#endif + + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta_givenx +!----------------------------------------------------------------------------------------------- +#if 1 +! real evolve +! for eth_x, eth first, _x later +! this R is indeed x +function NullEvol_Theta(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,KK,HKK,KKx,HKKx,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W,KK,HKK,KKx,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex :: CTheta0,CTheta,CTheta1,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(3)) :: Cnu,Ck,HCnu,HCk,HCU,HDCU,CUx,HCUx,DCUx,HDCUx,HbDCU,bDCUx,HbDCUx + double complex,dimension(ex(3)) :: Cnux,HCnux,HCJ,HDCJ,CJx,HCJx,CJxx,HCJxx,DCJx,HDCJx,HCB,HDCB,HbDCB + real*8,dimension(ex(3)) :: Hbeta,betax,Hbetax,HW,Wx,HWx + double complex :: Theta_rhs,Theta_rhs_o + real*8 :: xx,dR + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + & + sum(KK)+sum(HKK)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Theta: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_Theta: find NaN in HKK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Theta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_Theta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + CTheta0 = dcmplx(RTheta(i,j,1),ITheta(i,j,1)) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) + call cget_half_x(ex(3),CB(i,j,:),HCB) + call cget_half_x(ex(3),DCB(i,j,:),HDCB) + call cget_half_x(ex(3),bDCB(i,j,:),HbDCB) + call cget_half_x(ex(3),Cnu,HCnu) + call cderivs_x(ex(3),R,Cnu,Cnux) + call cget_half_x(ex(3),Cnux,HCnux) + call cget_half_x(ex(3),Ck,HCk) + call rget_half_x(ex(3),beta(i,j,:),Hbeta) + call rderivs_x(ex(3),R,beta(i,j,:),betax) + call rget_half_x(ex(3),betax,Hbetax) + call rderivs_x(ex(3),R,W,Wx) + call rget_half_x(ex(3),Wx,HWx) + call rget_half_x(ex(3),W(i,j,:),HW) + call cget_half_x(ex(3),CU(i,j,:),HCU) + call cderivs_x(ex(3),R,DCU(i,j,:),DCUx) + call cderivs_x(ex(3),R,CU(i,j,:),CUx) + call cget_half_x(ex(3),DCUx,HDCUx) + call cget_half_x(ex(3),CUx,HCUx) + call cget_half_x(ex(3),DCU(i,j,:),HDCU) + call cderivs_x(ex(3),R,bDCU(i,j,:),bDCUx) + call cget_half_x(ex(3),bDCUx,HbDCUx) + call cget_half_x(ex(3),bDCU(i,j,:),HbDCU) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cdderivs_x(ex(3),R,CJ(i,j,:),CJxx) + call cget_half_x(ex(3),CJx,HCJx) + call cget_half_x(ex(3),CJxx,HCJxx) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) + call cget_half_x(ex(3),DCJx,HDCJx) +! old type code: PRD 54, 6153, Eq.(32) etc. +#if 0 +! start up part + k = 1 + RHS = Theta_rhs_o(R(k)+dR/2.d0,Rmin,Hbeta(k),betax(k),HKK(i,j,k),KKx(i,j,k),HCU(k),CUx(k),DCUx(k),HbDCU(k),bDCUx(k), & + HDCU(k),HCB(k),HDCB(k),HW(k),Wx(k),HCJ(k),HDCJ(k), & + CJx(k),CJxx(k),DCJx(k),HbDCB(k),HCnu(k),Cnux(k),HCk(k),CTheta0) + CTheta1 = RHS-(1-2.d0*(R(k)+dR/2.d0)*(1.d0-R(k)-dR/2.d0)/dR)*CTheta0 + CTheta0 = CTheta1/(1+2.d0*(R(k)+dR/2.d0)*(1.d0-R(k)-dR/2.d0)/dR) + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + + do k=1,ex(3)-2 + RHS = Theta_rhs_o(R(k+1),Rmin,beta(i,j,k+1),betax(k+1),KK(i,j,k+1),KKx(i,j,k+1),CU(i,j,k+1),CUx(k+1),DCUx(k+1),bDCU(i,j,k+1),bDCUx(k+1), & + DCU(i,j,k+1),CB(i,j,k+1),DCB(i,j,k+1),W(i,j,k+1),Wx(k+1),CJ(i,j,k+1),DCJ(i,j,k+1), & + CJx(k+1),CJxx(k+1),DCJx(k+1),bDCB(i,j,k+1),Cnu(k+1),Cnux(k+1),Ck(k+1),CTheta0) + CTheta1 = RHS-(1-R(k+1)*(1.d0-R(k+1))/dR)*(dcmplx(RTheta(i,j,k),ITheta(i,j,k))) + CTheta0 = CTheta1/(1+R(k+1)*(1.d0-R(k+1))/dR) + + RTheta(i,j,k+2) = dreal(CTheta0) + ITheta(i,j,k+2) = dimag(CTheta0) + enddo +#endif + +#ifdef OLD + do k = 1,ex(3)-1 + xx = R(k)+dR/2 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR +! note our fxx(ex(3)) = (f(ex(3))-2.d0*f(ex(3)-1)+f(ex(3)-2))/dR + RHS = Theta_rhs(xx,Rmin,Hbeta(k),betax(k+1),HKK(i,j,k),KKx(i,j,k+1),HCU(k),CUx(k+1),DCUx(k+1),HbDCU(k),bDCUx(k+1), & + HDCU(k),HCB(k),HDCB(k),HW(k),Wx(k+1),HCJ(k),HDCJ(k), & + CJx(k+1),CJxx(k+1),DCJx(k+1),HbDCB(k),HCnu(k),Cnux(k+1),HCk(k),0) + RHS = RHS+CTheta0*(1.d0/dR-0.5d0/xx/(1.d0-xx)) + CTheta0 = RHS/(1.d0/dR+0.5d0/xx/(1.d0-xx)) + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo +#else + do k=1,ex(3)-2 + RK4 = 0 + RHS = Theta_rhs(R(k),Rmin,beta(i,j,k),betax(k),KK(i,j,k),KKx(i,j,k),CU(i,j,k),CUx(k),DCUx(k),bDCU(i,j,k),bDCUx(k), & + DCU(i,j,k),CB(i,j,k),DCB(i,j,k),W(i,j,k),Wx(k),CJ(i,j,k),DCJ(i,j,k), & + CJx(k),CJxx(k),DCJx(k),bDCB(i,j,k),Cnu(k),Cnux(k),Ck(k),CTheta0) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta,RHS,RK4) + + RK4 = 1 + CTheta1 = Theta_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),Hbetax(k),HKK(i,j,k),HKKx(i,j,k), & + HCU(k),HCUx(k),HDCUx(k),HbDCU(k),HbDCUx(k), & + HDCU(k),HCB(k),HDCB(k),HW(k),HWx(k),HCJ(k),HDCJ(k), & + HCJx(k),HCJxx(k),HDCJx(k),HbDCB(k),HCnu(k),HCnux(k),HCk(k),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 2 + CTheta1 = Theta_rhs(R(k)+dR/2.d0,Rmin,Hbeta(k),Hbetax(k),HKK(i,j,k),HKKx(i,j,k), & + HCU(k),HCUx(k),HDCUx(k),HbDCU(k),HbDCUx(k), & + HDCU(k),HCB(k),HDCB(k),HW(k),HWx(k),HCJ(k),HDCJ(k), & + HCJx(k),HCJxx(k),HDCJx(k),HbDCB(k),HCnu(k),HCnux(k),HCk(k),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 3 + CTheta1 = Theta_rhs(R(k+1),Rmin,beta(i,j,k+1),betax(k+1),KK(i,j,k+1),KKx(i,j,k+1), & + CU(i,j,k+1),CUx(k+1),DCUx(k+1),bDCU(i,j,k+1),bDCUx(k+1), & + DCU(i,j,k+1),CB(i,j,k+1),DCB(i,j,k+1),W(i,j,k+1),Wx(k+1),CJ(i,j,k+1),DCJ(i,j,k+1), & + CJx(k+1),CJxx(k+1),DCJx(k+1),bDCB(i,j,k+1),Cnu(k+1),Cnux(k+1),Ck(k+1),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta0,CTheta1) + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo +#if 0 + k = ex(3) + CTheta0 = -KK(i,j,k)*DCU(i,j,k)-(CU(i,j,k)*Cnu(k)+dconjg(CU(i,j,k))*DCJ(i,j,k))/2 & + +CJ(i,j,k)*(bDCU(i,j,k)-dconjg(bDCU(i,j,k)))/2 - W(i,j,k)*CJ(i,j,k)/2 + + RTheta(i,j,k) = dreal(CTheta0) + ITheta(i,j,k) = dimag(CTheta0) +#else +! closing step + k = ex(3)-1 + CTheta0 = dcmplx(RTheta(i,j,k),ITheta(i,j,k)) + xx = R(k)+dR/2 +! note our HCJ(ex(3)-1) = (CJ(ex(3))+CJ(ex(3)-1))/2 +! note our KKx(ex(3)) = (KK(ex(3))-KK(ex(3)-1))/dR +! note our fxx(ex(3)) = (f(ex(3))-2.d0*f(ex(3)-1)+f(ex(3)-2))/dR + RHS = Theta_rhs(xx,Rmin,Hbeta(k),betax(k+1),HKK(i,j,k),KKx(i,j,k+1),HCU(k),CUx(k+1),DCUx(k+1),HbDCU(k),bDCUx(k+1), & + HDCU(k),HCB(k),HDCB(k),HW(k),Wx(k+1),HCJ(k),HDCJ(k), & + CJx(k+1),CJxx(k+1),DCJx(k+1),HbDCB(k),HCnu(k),Cnux(k+1),HCk(k),dcmplx(0.d0,0.d0)) + RHS = RHS+CTheta0*(1.d0/dR-0.5d0/xx/(1.d0-xx)) + CTheta0 = RHS/(1.d0/dR+0.5d0/xx/(1.d0-xx)) + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) +#endif + +#endif + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta +!-------------------------------------------------------------------- +! check with fake_Theta_rhs +#elif 0 +! this R is indeed x +function NullEvol_Theta(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,KK,HKK,KKx,HKKx,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W,KK,HKK,KKx,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex :: CTheta0,CTheta,CTheta1,RHS + integer :: i,j,k,RK4 + integer,parameter :: ks=1 + double complex,dimension(ex(3)) :: Cnu,Ck,HCnu,HCk,HCU,HDCU,CUx,HCUx,DCUx,HDCUx,HbDCU,bDCUx,HbDCUx + double complex,dimension(ex(3)) :: Cnux,HCnux,HCJ,HDCJ,CJx,HCJx,CJxx,HCJxx,DCJx,HDCJx,HCB,HDCB,HbDCB + real*8,dimension(ex(3)) :: Hbeta,betax,Hbetax,HW,Wx,HWx + double complex :: Theta_rhs,Theta_rhs_o + real*8 :: xx,dR + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + & + sum(KK)+sum(HKK)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Theta: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_Theta: find NaN in HKK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Theta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_Theta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + CTheta0 = dcmplx(RTheta(i,j,ks),ITheta(i,j,ks)) + Cnu = dcmplx(RTheta(i,j,:),ITheta(i,j,:)) + call fake_Theta_rhs(ex(3),R,Ck,Cnu) + call cget_half_x(ex(3),Ck,HCk) + + do k=ks,ex(3)-1 + RK4 = 0 + RHS = Ck(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta,RHS,RK4) + + RK4 = 1 + CTheta1 = HCk(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 2 + CTheta1 = HCk(k) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 3 + CTheta1 = Ck(k+1) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta0,CTheta1) + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo + + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta + +#else +! for eth_x, _x first, eth second +! this R is indeed x +function NullEvol_Theta(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,KK,HKK,KKx,HKKx,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W,KK,HKK,KKx,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex :: CTheta0,CTheta,CTheta1,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(1),ex(2),ex(3)) :: Cnu,Ck,HCnu,HCk,HCU,HDCU,CUx,HCUx,DCUx,HDCUx,HbDCU,bDCUx,HbDCUx + double complex,dimension(ex(1),ex(2),ex(3)) :: Cnux,HCnux,HCJ,HDCJ,CJx,HCJx,CJxx,HCJxx,DCJx,HDCJx,HCB,HDCB,HbDCB + real*8,dimension(ex(1),ex(2),ex(3)) :: Hbeta,betax,Hbetax,HW,Wx,HWx + double complex :: Theta_rhs + real*8 :: xx,dR + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + & + sum(KK)+sum(HKK)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Theta: find NaN in KK" + if(sum(HKK).ne.sum(HKK))write(*,*)"NullEvol_Theta: find NaN in HKK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Theta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_Theta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + Cnu = dcmplx(Rnu,Inu) + Ck = dcmplx(Rk,Ik) + + do j=1,ex(2) + do i=1,ex(1) + call cderivs_x(ex(3),R,Cnu(i,j,:),Cnux(i,j,:)) + call rderivs_x(ex(3),R,beta(i,j,:),betax(i,j,:)) + call rderivs_x(ex(3),R,W(i,j,:),Wx(i,j,:)) + call cderivs_x(ex(3),R,CU(i,j,:),CUx(i,j,:)) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx(i,j,:)) + call cdderivs_x(ex(3),R,CJ(i,j,:),CJxx(i,j,:)) + enddo + enddo + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CUx(:,:,k),DCUx(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CUx(:,:,k),bDCUx(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJx(:,:,k),DCJx(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + call cget_half_x(ex(3),CB(i,j,:),HCB(i,j,:)) + call cget_half_x(ex(3),DCB(i,j,:),HDCB(i,j,:)) + call cget_half_x(ex(3),bDCB(i,j,:),HbDCB(i,j,:)) + call cget_half_x(ex(3),Cnu(i,j,:),HCnu(i,j,:)) + call cget_half_x(ex(3),Cnux(i,j,:),HCnux(i,j,:)) + call cget_half_x(ex(3),Ck(i,j,:),HCk(i,j,:)) + call rget_half_x(ex(3),beta(i,j,:),Hbeta(i,j,:)) + call rget_half_x(ex(3),betax(i,j,:),Hbetax(i,j,:)) + call rget_half_x(ex(3),Wx(i,j,:),HWx(i,j,:)) + call rget_half_x(ex(3),W(i,j,:),HW(i,j,:)) + call cget_half_x(ex(3),CU(i,j,:),HCU(i,j,:)) + call cget_half_x(ex(3),DCUx(i,j,:),HDCUx(i,j,:)) + call cget_half_x(ex(3),CUx(i,j,:),HCUx(i,j,:)) + call cget_half_x(ex(3),DCU(i,j,:),HDCU(i,j,:)) + call cget_half_x(ex(3),bDCUx(i,j,:),HbDCUx(i,j,:)) + call cget_half_x(ex(3),bDCU(i,j,:),HbDCU(i,j,:)) + call cget_half_x(ex(3),CJx(i,j,:),HCJx(i,j,:)) + call cget_half_x(ex(3),CJxx(i,j,:),HCJxx(i,j,:)) + call cget_half_x(ex(3),DCJx(i,j,:),HDCJx(i,j,:)) + enddo + enddo + + do j=1,ex(2) + do i=1,ex(1) + CTheta0 = dcmplx(RTheta(i,j,1),ITheta(i,j,1)) + + do k=1,ex(3)-2 + RK4 = 0 + RHS = Theta_rhs(R(k),Rmin,beta(i,j,k),betax(i,j,k),KK(i,j,k),KKx(i,j,k),CU(i,j,k),CUx(i,j,k),DCUx(i,j,k),bDCU(i,j,k),bDCUx(i,j,k), & + DCU(i,j,k),CB(i,j,k),DCB(i,j,k),W(i,j,k),Wx(i,j,k),CJ(i,j,k),DCJ(i,j,k), & + CJx(i,j,k),CJxx(i,j,k),DCJx(i,j,k),bDCB(i,j,k),Cnu(i,j,k),Cnux(i,j,k),Ck(i,j,k),CTheta0) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta,RHS,RK4) + + RK4 = 1 + CTheta1 = Theta_rhs(R(k)+dR/2.d0,Rmin,Hbeta(i,j,k),Hbetax(i,j,k),HKK(i,j,k),HKKx(i,j,k), & + HCU(i,j,k),HCUx(i,j,k),HDCUx(i,j,k),HbDCU(i,j,k),HbDCUx(i,j,k), & + HDCU(i,j,k),HCB(i,j,k),HDCB(i,j,k),HW(i,j,k),HWx(i,j,k),HCJ(i,j,k),HDCJ(i,j,k), & + HCJx(i,j,k),HCJxx(i,j,k),HDCJx(i,j,k),HbDCB(i,j,k),HCnu(i,j,k),HCnux(i,j,k),HCk(i,j,k),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 2 + CTheta1 = Theta_rhs(R(k)+dR/2.d0,Rmin,Hbeta(i,j,k),Hbetax(i,j,k),HKK(i,j,k),HKKx(i,j,k), & + HCU(i,j,k),HCUx(i,j,k),HDCUx(i,j,k),HbDCU(i,j,k),HbDCUx(i,j,k), & + HDCU(i,j,k),HCB(i,j,k),HDCB(i,j,k),HW(i,j,k),HWx(i,j,k),HCJ(i,j,k),HDCJ(i,j,k), & + HCJx(i,j,k),HCJxx(i,j,k),HDCJx(i,j,k),HbDCB(i,j,k),HCnu(i,j,k),HCnux(i,j,k),HCk(i,j,k),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta,CTheta1) + + RK4 = 3 + CTheta1 = Theta_rhs(R(k+1),Rmin,beta(i,j,k+1),betax(i,j,k+1),KK(i,j,k+1), & + KKx(i,j,k+1),CU(i,j,k+1),CUx(i,j,k+1),DCUx(i,j,k+1),bDCU(i,j,k+1),bDCUx(i,j,k+1), & + DCU(i,j,k+1),CB(i,j,k+1),DCB(i,j,k+1),W(i,j,k+1),Wx(i,j,k+1),CJ(i,j,k+1),DCJ(i,j,k+1), & + CJx(i,j,k+1),CJxx(i,j,k+1),DCJx(i,j,k+1),bDCB(i,j,k+1),Cnu(i,j,k+1),Cnux(i,j,k+1),Ck(i,j,k+1),CTheta) + call rungekutta4_cplxscalar(dR,CTheta0,CTheta1,RHS,RK4) + call cswap(CTheta0,CTheta1) + + RTheta(i,j,k+1) = dreal(CTheta0) + ITheta(i,j,k+1) = dimag(CTheta0) + enddo + + k = ex(3) + CTheta0 = -KK(i,j,k)*DCU(i,j,k)-(CU(i,j,k)*Cnu(i,j,k)+dconjg(CU(i,j,k))*DCJ(i,j,k))/2 & + +CJ(i,j,k)*(bDCU(i,j,k)-dconjg(bDCU(i,j,k)))/2 - W(i,j,k)*CJ(i,j,k)/2 + + RTheta(i,j,k) = dreal(CTheta0) + ITheta(i,j,k) = dimag(CTheta0) + + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta +#endif + +#elif (RKorAM == 1) +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_beta(ex,crho,sigma,R,RJ,IJ,beta,KKx,HKKx) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,KKx,HKKx +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR,beta_rhs + + double complex, dimension(ex(3)):: CJ,CJx + real*8, dimension(ex(3)) :: rhs + integer :: i,j,k + + real*8,parameter :: F5o12=2.d0/1.2d1,F2o3=2.d0/3.d0,F1o12=1.d0/1.2d1 + real*8,parameter :: F3o8=3.d0/8.d0,F19o24=1.9d1/2.4d1,F5o24=5.d0/2.4d1,F1o24=1.d0/2.4d1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(beta)+sum(KKx)+sum(HKKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_beta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_beta: find NaN in IJ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_beta: find NaN in beta" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_beta: find NaN in KKx" + if(sum(HKKx).ne.sum(HKKx))write(*,*)"NullEvol_beta: find NaN in HKKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + CJ = dcmplx(RJ(i,j,:),IJ(i,j,:)) +#if 0 + call cderivs_sw_x(ex(3),R,CJ,CJx) +#else + call cderivs_x(ex(3),R,CJ,CJx) +#endif + + do k=1,ex(3) + rhs(k) = beta_rhs(R(k),CJx(k),KKx(i,j,k)) + enddo + + k = 1 + beta(i,j,k+1) = beta(i,j,k) + (rhs(k+1)+rhs(k))*dR/2 + + k = 2 + beta(i,j,k+1) = beta(i,j,k) + (F5o12*rhs(k+1) + F2o3*rhs(k) - F1o12*rhs(k-1))*dR + + do k=3,ex(3)-1 + beta(i,j,k+1) = beta(i,j,k) + (F3o8*rhs(k+1) + F19o24*rhs(k) - F5o24*rhs(k-1) + F1o24*rhs(k-2))*dR + enddo + + enddo + enddo + + gont = 0 + + return + +end function NullEvol_beta +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_Q(ex,crho,sigma,R,RJ,IJ,Rk,Ik,Rnu,Inu,RB,IB,RQ,IQ,KK,Hkk,KKx,HKKx, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RQ,IQ + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,KK,KKx,HKK,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rk,Ik,Rnu,Inu,RB,IB + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: xx,dR + + double complex,dimension(ex(3)) :: CQ,RHS + real*8, dimension(ex(3)) :: gunc + double complex,dimension(ex(3)) :: CJx,DCJx,Ck,Ckx,Cnu,Cnux,CB,CBx + double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,DCJ + integer :: i,j,k + double complex :: ZEO,Q_rhs + + real*8,parameter :: F5o12=2.d0/1.2d1,F2o3=2.d0/3.d0,F1o12=1.d0/1.2d1 + real*8,parameter :: F3o8=3.d0/8.d0,F19o24=1.9d1/2.4d1,F5o24=5.d0/2.4d1,F1o24=1.d0/2.4d1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RQ)+sum(IQ) & + +sum(RK)+sum(IK)+sum(Rnu)+sum(Inu)+sum(RB)+sum(IB) & + +sum(KK)+sum(KKx) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Q: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Q: find NaN in IJ" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_Q: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_Q: find NaN in IQ" + if(sum(RK).ne.sum(RK))write(*,*)"NullEvol_Q: find NaN in RK" + if(sum(IK).ne.sum(IK))write(*,*)"NullEvol_Q: find NaN in IK" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Q: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Q: find NaN in Inu" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Q: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Q: find NaN in IB" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Q: find NaN in KK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Q: find NaN in KKx" + gont = 1 + return + endif + + dR = R(2) - R(1) + ZEO = dcmplx(0.d0,0.d0) + + CJ = dcmplx(RJ,IJ) + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + do j=1,ex(2) + do i=1,ex(1) + + CQ(1) = dcmplx(RQ(i,j,1),IQ(i,j,1)) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + CB = dcmplx(RB(i,j,:),IB(i,j,:)) +#if 0 + call cderivs_sw_x(ex(3),R,CJ(i,j,:),CJx) + call cderivs_sw_x(ex(3),R,DCJ(i,j,:),DCJx) + call cderivs_sw_x(ex(3),R,Ck,Ckx) + call cderivs_sw_x(ex(3),R,Cnu,Cnux) + call cderivs_sw_x(ex(3),R,CB,CBx) +#else + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) + call cderivs_x(ex(3),R,Ck,Ckx) + call cderivs_x(ex(3),R,Cnu,Cnux) + call cderivs_x(ex(3),R,CB,CBx) +#endif + + do k = 1,ex(3) + RHS(k) = Q_rhs(R(k),CJ(i,j,k),CJx(k),DCJx(k),KK(i,j,k),Ck(k),Ckx(k),Cnux(k),KKx(i,j,k),CBx(k),Cnu(k),DCJ(i,j,k),CB(k),ZEO) + gunc(k) = -2/R(k)/(1-R(k)) + enddo + + k = 1 + CQ(k+1) = CQ(k) + (RHS(k+1)+RHS(k)+CQ(k)*gunc(k))*dR/2 + CQ(k+1) = CQ(k+1)/(1-0.5*dR*gunc(k+1)) + + k = 2 + CQ(k+1) = CQ(k) + (F5o12*RHS(k+1) + F2o3*(RHS(k)+CQ(k)*gunc(k)) - F1o12*(RHS(k-1)+CQ(k-1)*gunc(k-1)))*dR + CQ(k+1) = CQ(k+1)/(1-F5o12*dR*gunc(k+1)) + + do k=3,ex(3)-2 + CQ(k+1) = CQ(k) + (F3o8*RHS(k+1) + F19o24*(RHS(k)+CQ(k)*gunc(k)) - F5o24*(RHS(k-1)+CQ(k-1)*gunc(k-1)) & + + F1o24*(RHS(k-2)+CQ(k-2)*gunc(k-2)))*dR + CQ(k+1) = CQ(k+1)/(1-F3o8*dR*gunc(k+1)) + enddo + + k = ex(3) + CQ(k) = -2*CB(k) + + RQ(i,j,:) = dreal(CQ) + IQ(i,j,:) = dimag(CQ) + + enddo + enddo + + gont = 0 + + return + +end function NullEvol_Q +!-------------------------------------------------------------------- +! this R is indeed x +function NullEvol_U(ex,crho,sigma,R,RJ,IJ,RQ,IQ,KK,HKK,beta,RU,IU, & + Rmin) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RQ,IQ,beta,KK,HKK + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RU,IU + real*8,intent(in) :: Rmin +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + double complex,dimension(ex(3)) :: CU0,RHS + integer :: i,j,k + double complex :: U_rhs + double complex,dimension(ex(3)) :: CJ,CQ + + real*8,parameter :: F5o12=2.d0/1.2d1,F2o3=2.d0/3.d0,F1o12=1.d0/1.2d1 + real*8,parameter :: F3o8=3.d0/8.d0,F19o24=1.9d1/2.4d1,F5o24=5.d0/2.4d1,F1o24=1.d0/2.4d1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RQ)+sum(IQ)+sum(beta)+sum(RU)+sum(IU)+sum(KK) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_U: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_U: find NaN in IJ" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_U: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_U: find NaN in IQ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_U: find NaN in beta" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_U: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_U: find NaN in IU" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_U: find NaN in KK" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + CU0(1) = dcmplx(RU(i,j,1),IU(i,j,1)) + CJ = dcmplx(RJ(i,j,:),IJ(i,j,:)) + CQ = dcmplx(RQ(i,j,:),IQ(i,j,:)) + + do k = 1,ex(3) + RHS(k) = U_rhs(R(k),Rmin,beta(i,j,k),KK(i,j,k),CQ(k),CJ(k)) + enddo + + k = 1 + CU0(k+1) = CU0(k) + (RHS(k+1)+RHS(k))*dR/2 + + k = 2 + CU0(k+1) = CU0(k) + (F5o12*RHS(k+1) + F2o3*RHS(k) - F1o12*RHS(k-1))*dR + + do k=3,ex(3)-1 + CU0(k+1) = CU0(k) + (F3o8*RHS(k+1) + F19o24*RHS(k) - F5o24*RHS(k-1) & + + F1o24*RHS(k-2))*dR + enddo + + RU(i,j,:) = dreal(CU0) + IU(i,j,:) = dimag(CU0) + + enddo + enddo + + gont = 0 + return + +end function NullEvol_U +!---------------------------------------------------------------------------------------- +! this R is indeed x +function NullEvol_W(ex,crho,sigma,R,RJ,IJ,RB,IB,Rnu,Inu,Rk,Ik, & + RU,IU,RQ,IQ,W,beta,KK,HKK,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: W + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RJ,IJ,RB,IB + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RU,IU,RQ,IQ,beta,KK,HKK + real*8,intent(in ) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + double complex, dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU + double complex, dimension(ex(1),ex(2),ex(3)) :: CB,DCB,bDCB,CJ,DCJ,Cnu,bDCnu,Ck,bDCk + double complex, dimension(ex(3)) :: bDCUx,CQ + integer :: i,j,k + real*8, dimension(ex(3)) :: rhs,gunc + real*8 :: zeo,W_rhs + + real*8,parameter :: F5o12=2.d0/1.2d1,F2o3=2.d0/3.d0,F1o12=1.d0/1.2d1 + real*8,parameter :: F3o8=3.d0/8.d0,F19o24=1.9d1/2.4d1,F5o24=5.d0/2.4d1,F1o24=1.d0/2.4d1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(beta)+sum(RB)+sum(IB)+sum(Rnu)+sum(Inu) & + +sum(Rk)+sum(Ik)+sum(W)+sum(RU)+sum(IU)+sum(RQ)+sum(IQ)& + +sum(KK) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_W: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_W: find NaN in IJ" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_W: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_W: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_W: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_W: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_W: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_W: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_W: find NaN in Ik" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_W: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_W: find NaN in IU" + if(sum(RQ).ne.sum(RQ))write(*,*)"NullEvol_W: find NaN in RQ" + if(sum(IQ).ne.sum(IQ))write(*,*)"NullEvol_W: find NaN in IQ" + if(sum(W).ne.sum(W))write(*,*)"NullEvol_W: find NaN in W" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_W: find NaN in KK" + gont = 1 + return + endif + + dR = R(2) - R(1) + zeo = 0.d0 + + CB = dcmplx(RB,IB) + CU = dcmplx(RU,IU) + Ck = dcmplx(Rk,Ik) + Cnu = dcmplx(Rnu,Inu) + CJ = dcmplx(RJ,IJ) + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,Ck(:,:,k),bDCk(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,Cnu(:,:,k),bDCnu(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) +#if 0 + call cderivs_sw_x(ex(3),R,bDCU,bDCUx) +#else + call cderivs_x(ex(3),R,bDCU,bDCUx) +#endif + + CQ = dcmplx(RQ(i,j,:),IQ(i,j,:)) + + do k = 1,ex(3) + rhs(k) = W_rhs(R(k),Rmin,beta(i,j,k),KK(i,j,k),DCB(i,j,k),CB(i,j,k),CJ(i,j,k),Cnu(i,j,k),Ck(i,j,k),zeo, & + CQ(k),bDCk(i,j,k),bDCnu(i,j,k),bDCB(i,j,k),bDCU(i,j,k),bDCUx(k),DCJ(i,j,k)) + gunc(k) = -2/R(k)/(1-R(k)) + enddo + + k = 1 + W(i,j,k+1) = W(i,j,k) + (rhs(k+1)+rhs(k)+W(i,j,k)*gunc(k))*dR/2 + W(i,j,k+1) = W(i,j,k+1)/(1-0.5*dR*gunc(k+1)) + + k = 2 + W(i,j,k+1) = W(i,j,k) + (F5o12*rhs(k+1) + F2o3*(rhs(k)+W(i,j,k)*gunc(k)) - F1o12*(rhs(k-1)+W(i,j,k-1)*gunc(k-1)))*dR + W(i,j,k+1) = W(i,j,k+1)/(1-F5o12*dR*gunc(k+1)) + + do k=3,ex(3)-2 + W(i,j,k+1) = W(i,j,k) + (F3o8*rhs(k+1) + F19o24*(rhs(k)+W(i,j,k)*gunc(k)) - F5o24*(rhs(k-1)+W(i,j,k-1)*gunc(k-1)) & + + F1o24*(rhs(k-2)+W(i,j,k-2)*gunc(k-2)))*dR + W(i,j,k+1) = W(i,j,k+1)/(1-F3o8*dR*gunc(k+1)) + enddo + + k = ex(3) + W(i,j,k) = dreal(bDCU(i,j,k)) + + enddo + enddo + + gont = 0 + return + +end function NullEvol_W +!-------------------------------------------------------------------- +! this R is indeed x +function NullEvol_Theta(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,KK,HKK,KKx,HKKx,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: beta,W,KK,KKx,HKK,HKKx + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex,dimension(ex(3)) :: CTheta0,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(3)) :: Cnu,Ck,CUx,DCUx,bDCUx + double complex,dimension(ex(3)) :: Cnux,CJx,CJxx,DCJx + real*8,dimension(ex(3)) :: betax,Wx,gunc + double complex :: Theta_rhs,ZEO + real*8 :: dR + + real*8,parameter :: F5o12=2.d0/1.2d1,F2o3=2.d0/3.d0,F1o12=1.d0/1.2d1 + real*8,parameter :: F3o8=3.d0/8.d0,F19o24=1.9d1/2.4d1,F5o24=5.d0/2.4d1,F1o24=1.d0/2.4d1 + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + & + sum(KK)+sum(KKx)+sum(W) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + if(sum(KK).ne.sum(KK))write(*,*)"NullEvol_Theta: find NaN in KK" + if(sum(KKx).ne.sum(KKx))write(*,*)"NullEvol_Theta: find NaN in KKx" + if(sum(W).ne.sum(W))write(*,*)"NullEvol_Theta: find NaN in W" + gont = 1 + return + endif + + dR = R(2) - R(1) + ZEO = dcmplx(0.d0,0.d0) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=1,ex(2) + do i=1,ex(1) + CTheta0(1) = dcmplx(RTheta(i,j,1),ITheta(i,j,1)) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) +#if 0 + call cderivs_sw_x(ex(3),R,Cnu,Cnux) + call rderivs_sw_x(ex(3),R,beta(i,j,:),betax) + call rderivs_sw_x(ex(3),R,W,Wx) + call cderivs_sw_x(ex(3),R,DCU(i,j,:),DCUx) + call cderivs_sw_x(ex(3),R,CU(i,j,:),CUx) + call cderivs_sw_x(ex(3),R,bDCU(i,j,:),bDCUx) + call cderivs_sw_x(ex(3),R,CJ(i,j,:),CJx) + call cdderivs_sw_x(ex(3),R,CJ(i,j,:),CJxx) + call cderivs_sw_x(ex(3),R,DCJ(i,j,:),DCJx) +#else + call cderivs_x(ex(3),R,Cnu,Cnux) + call rderivs_x(ex(3),R,beta(i,j,:),betax) + call rderivs_x(ex(3),R,W,Wx) + call cderivs_x(ex(3),R,DCU(i,j,:),DCUx) + call cderivs_x(ex(3),R,CU(i,j,:),CUx) + call cderivs_x(ex(3),R,bDCU(i,j,:),bDCUx) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cdderivs_x(ex(3),R,CJ(i,j,:),CJxx) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) +#endif + do k = 1,ex(3) + rhs(k) = Theta_rhs(R(k),Rmin,beta(i,j,k),betax(k),KK(i,j,k),KKx(i,j,k),CU(i,j,k),CUx(k),DCUx(k),bDCU(i,j,k),bDCUx(k), & + DCU(i,j,k),CB(i,j,k),DCB(i,j,k),W(i,j,k),Wx(k),CJ(i,j,k),DCJ(i,j,k), & + CJx(k),CJxx(k),DCJx(k),bDCB(i,j,k),Cnu(k),Cnux(k),Ck(k),ZEO) + gunc(k) = -1/R(k)/(1-R(k)) + enddo + + k = 1 + CTheta0(k+1) = CTheta0(k) + (RHS(k+1)+RHS(k)+CTheta0(k)*gunc(k))*dR/2 + CTheta0(k+1) = CTheta0(k+1)/(1-0.5*dR*gunc(k+1)) + + k = 2 + CTheta0(k+1) = CTheta0(k) + (F5o12*RHS(k+1) + F2o3*(RHS(k)+CTheta0(k)*gunc(k)) - F1o12*(RHS(k-1)+CTheta0(k-1)*gunc(k-1)))*dR + CTheta0(k+1) = CTheta0(k+1)/(1-F5o12*dR*gunc(k+1)) + + do k=3,ex(3)-2 + CTheta0(k+1) = CTheta0(k) + (F3o8*RHS(k+1) + F19o24*(RHS(k)+CTheta0(k)*gunc(k)) - F5o24*(RHS(k-1)+CTheta0(k-1)*gunc(k-1)) & + + F1o24*(RHS(k-2)+CTheta0(k-2)*gunc(k-2)))*dR + CTheta0(k+1) = CTheta0(k+1)/(1-F3o8*dR*gunc(k+1)) + enddo + + k = ex(3) + CTheta0(k) = -KK(i,j,k)*DCU(i,j,k)-(CU(i,j,k)*Cnu(k)+dconjg(CU(i,j,k))*DCJ(i,j,k))/2 & + +CJ(i,j,k)*(bDCU(i,j,k)-dconjg(bDCU(i,j,k)))/2 - W(i,j,k)*CJ(i,j,k)/2 + + RTheta(i,j,:) = dreal(CTheta0) + ITheta(i,j,:) = dimag(CTheta0) + enddo + enddo + + gont = 0 + return + +end function NullEvol_Theta + +#else +#error "not recognized RKorAM" +#endif + +!===================================================================================================================================== +! basic tool routines + subroutine rswap(r1,r2) + + implicit none + +!~~~~~~% Input parameters: + + real*8,intent(inout) :: r1,r2 + + real*8 :: r + + r = r1 + r1= r2 + r2= r + + return + + end subroutine rswap +!---- + subroutine cswap(r1,r2) + + implicit none + +!~~~~~~% Input parameters: + + double complex,intent(inout) :: r1,r2 + + double complex :: r + + r = r1 + r1= r2 + r2= r + + return + + end subroutine cswap + +! center type finite difference +!==================================================================================== +!---- + subroutine rderivs_x(lx,X,f,fx) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx + real*8,intent(in),dimension(lx) :: X + real*8,intent(in),dimension(lx) :: f + real*8,intent(out),dimension(lx) :: fx + + real*8 :: dX + + dX = X(2)-X(1) + +#ifdef OLD + fx(1:lx-1) = (f(2:lx)-f(1:lx-1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#else + +#if (ghost_width == 2) + fx(2:lx-1) = (f(3:lx)-f(1:lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#elif (ghost_width == 3) + fx(3:lx-2) = (f(1:lx-4)-8.d0*f(2:lx-3)+8.d0*f(4:lx-1)-f(5:lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +! fx(1) =-(2.5d1*f(1)-4.8d1*f(2)+3.6d1*f(3)-1.6d1*f(4)+3.d0*f(5))/1.2d1/dX +! fx(2) =-(3.d0*f(1)+1.d1*f(2)-1.8d1*f(3)+6.d0*f(4)-f(5))/1.2d1/dX +#elif (ghost_width == 4) + fx(4:lx-3) = (-f(1:lx-6)+9.d0*f(2:lx-5)-4.5d1*f(3:lx-4)+4.5d1*f(5:lx-2)-9.d0*f(6:lx-1)+f(7:lx))/6.d1/dX + fx(3) = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + fx(lx-2) = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#elif (ghost_width == 5) + fx(5:lx-4) = (3.d0*f(1:lx-8)-3.2d1*f(2:lx-7)+1.68d2*f(3:lx-6)-6.72d2*f(4:lx-5)+ & + 6.72d2*f(6:lx-3)-1.68d2*f(7:lx-2)+3.2d1*f(8:lx-1)-3.d0*f(9:lx))/8.4d2/dX + fx(4) = (-f(1)+9.d0*f(2)-4.5d1*f(3)+4.5d1*f(5)-9.d0*f(6)+f(7))/6.d1/dX + fx(lx-3) = (-f(lx-6)+9.d0*f(lx-5)-4.5d1*f(lx-4)+4.5d1*f(lx-2)-9.d0*f(lx-1)+f(lx))/6.d1/dX + fx(3) = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + fx(lx-2) = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#endif + +#endif + return + + end subroutine rderivs_x +!---- + subroutine rderivs_x_point(lx,X,f,fx,k) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx,k + real*8,intent(in),dimension(lx) :: X + real*8,intent(in),dimension(lx) :: f + real*8,intent(out) :: fx + + real*8 :: dX + + dX = X(2)-X(1) + +#ifdef OLD + if(k .eq. lx)then + fx = (f(lx)-f(lx-1))/dX + else + fx = (f(k+1)-f(k))/dX + endif +#else + +#if (ghost_width == 2) + if(k .gt. 1 .and. k .lt. lx) then + fx = (f(k+1)-f(k-1))/2.d0/dX + elseif(k.eq.1) then + fx = (f(2)-f(1))/dX + elseif(k.eq.lx) then + fx = (f(lx)-f(lx-1))/dX + endif +#elif (ghost_width == 3) + if(k .gt. 2 .and. k .lt. lx-1) then + fx = (f(k-2)-8.d0*f(k-1)+8.d0*f(k+1)-f(k+2))/1.2d1/dX + elseif(k.eq.1) then + fx = (f(2)-f(1))/dX + elseif(k.eq.lx) then + fx = (f(lx)-f(lx-1))/dX + elseif(k.eq.2) then + fx = (f(3)-f(1))/2.d0/dX + elseif(k.eq.lx-1) then + fx = (f(lx)-f(lx-2))/2.d0/dX + endif +#elif (ghost_width == 4) + if(k .gt. 3 .and. k .lt. lx-2) then + fx = (-f(k-3)+9.d0*f(k-2)-4.5d1*f(k-1)+4.5d1*f(k+1)-9.d0*f(k+2)+f(k+3))/6.d1/dX + elseif(k.eq.1) then + fx = (f(2)-f(1))/dX + elseif(k.eq.lx) then + fx = (f(lx)-f(lx-1))/dX + elseif(k.eq.2) then + fx = (f(3)-f(1))/2.d0/dX + elseif(k.eq.lx-1) then + fx = (f(lx)-f(lx-2))/2.d0/dX + elseif(k.eq.3) then + fx = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + elseif(k.eq.lx-2) then + fx = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + endif +#elif (ghost_width == 5) + if(k .gt. 4 .and. k .lt. lx-3) then + fx = (3.d0*f(k-4)-3.2d1*f(k-3)+1.68d2*f(k-2)-6.72d2*f(k-1)+ & + 6.72d2*f(k+1)-1.68d2*f(k+2)+3.2d1*f(k+3)-3.d0*f(k+4))/8.4d2/dX + elseif(k.eq.1) then + fx = (f(2)-f(1))/dX + elseif(k.eq.lx) then + fx = (f(lx)-f(lx-1))/dX + elseif(k.eq.2) then + fx = (f(3)-f(1))/2.d0/dX + elseif(k.eq.lx-1) then + fx = (f(lx)-f(lx-2))/2.d0/dX + elseif(k.eq.3) then + fx = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + elseif(k.eq.lx-2) then + fx = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + elseif(k.eq.4) then + fx = (-f(1)+9.d0*f(2)-4.5d1*f(3)+4.5d1*f(5)-9.d0*f(6)+f(7))/6.d1/dX + elseif(k.eq.lx-3) then + fx = (-f(lx-6)+9.d0*f(lx-5)-4.5d1*f(lx-4)+4.5d1*f(lx-2)-9.d0*f(lx-1)+f(lx))/6.d1/dX + endif +#endif + +#endif + return + + end subroutine rderivs_x_point +!---- + subroutine cderivs_x(lx,X,f,fx) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx + real*8,intent(in),dimension(lx) :: X + double complex,intent(in),dimension(lx) :: f + double complex,intent(out),dimension(lx) :: fx + + real*8 :: dX + + dX = X(2)-X(1) + +#ifdef OLD + fx(1:lx-1) = (f(2:lx)-f(1:lx-1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#else + +#if (ghost_width == 2) + fx(2:lx-1) = (f(3:lx)-f(1:lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#elif (ghost_width == 3) + fx(3:lx-2) = (f(1:lx-4)-8.d0*f(2:lx-3)+8.d0*f(4:lx-1)-f(5:lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +! fx(1) =-(2.5d1*f(1)-4.8d1*f(2)+3.6d1*f(3)-1.6d1*f(4)+3.d0*f(5))/1.2d1/dX +! fx(2) =-(3.d0*f(1)+1.d1*f(2)-1.8d1*f(3)+6.d0*f(4)-f(5))/1.2d1/dX +#elif (ghost_width == 4) + fx(4:lx-3) = (-f(1:lx-6)+9.d0*f(2:lx-5)-4.5d1*f(3:lx-4)+4.5d1*f(5:lx-2)-9.d0*f(6:lx-1)+f(7:lx))/6.d1/dX + fx(3) = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + fx(lx-2) = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#elif (ghost_width == 5) + fx(5:lx-4) = (3.d0*f(1:lx-8)-3.2d1*f(2:lx-7)+1.68d2*f(3:lx-6)-6.72d2*f(4:lx-5)+ & + 6.72d2*f(6:lx-3)-1.68d2*f(7:lx-2)+3.2d1*f(8:lx-1)-3.d0*f(9:lx))/8.4d2/dX + fx(4) = (-f(1)+9.d0*f(2)-4.5d1*f(3)+4.5d1*f(5)-9.d0*f(6)+f(7))/6.d1/dX + fx(lx-3) = (-f(lx-6)+9.d0*f(lx-5)-4.5d1*f(lx-4)+4.5d1*f(lx-2)-9.d0*f(lx-1)+f(lx))/6.d1/dX + fx(3) = (f(1)-8.d0*f(2)+8.d0*f(4)-f(5))/1.2d1/dX + fx(lx-2) = (f(lx-4)-8.d0*f(lx-3)+8.d0*f(lx-1)-f(lx))/1.2d1/dX + fx(2) = (f(3)-f(1))/2.d0/dX + fx(lx-1) = (f(lx)-f(lx-2))/2.d0/dX + fx(1) = (f(2)-f(1))/dX + fx(lx) = (f(lx)-f(lx-1))/dX +#endif + +#endif + + return + + end subroutine cderivs_x +!---- + subroutine cdderivs_x(lx,X,f,fxx) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx + real*8,intent(in),dimension(lx) :: X + double complex,intent(in),dimension(lx) :: f + double complex,intent(out),dimension(lx) :: fxx + + real*8 :: dX + + dX = X(2)-X(1) + dX = dX*dX + +#ifdef OLD + fxx(1:lx-2) = (f(3:lx)-2.0*f(2:lx-1)+f(1:lx-2))/dX + fxx(lx-1) = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX + fxx(lx ) = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX +#else + +#if (ghost_width == 2) + fxx(2:lx-1) = (f(3:lx)-2.d0*f(2:lx-1)+f(1:lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 3) + fxx(3:lx-2) = (-f(1:lx-4)+1.6d1*f(2:lx-3)-3.d1*f(3:lx-2)+1.6d1*f(4:lx-1)-f(5:lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 4) + fxx(4:lx-3) = (2.d0*f(1:lx-6)-2.7d1*f(2:lx-5)+2.7d2*f(3:lx-4)-4.9d2*f(4:lx-3) & + +2.7d2*f(5:lx-2)-2.7d1*f(6:lx-1)+2.d0*f(7:lx))/1.8d2/dX + fxx(3) = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + fxx(lx-2) = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 5) + fxx(5:lx-4) = (-9.d0*f(1:lx-8)+1.28d2*f(2:lx-7)-1.008d3*f(3:lx-6)+8.064d3*f(4:lx-5)-1.435d4*f(5:lx-4) & + +8.064d3*f(6:lx-3)-1.008d3*f(7:lx-2)+1.28d2*f(8:lx-1)-9.d0*f(9:lx))/5.04d3/dX + fxx(4) = (2.d0*f(1)-2.7d1*f(2)+2.7d2*f(3)-4.9d2*f(4) & + +2.7d2*f(5)-2.7d1*f(6)+2.d0*f(7))/1.8d2/dX + fxx(lx-3) = (2.d0*f(lx-6)-2.7d1*f(lx-5)+2.7d2*f(lx-4)-4.9d2*f(lx-3) & + +2.7d2*f(lx-2)-2.7d1*f(lx-1)+2.d0*f(lx))/1.8d2/dX + fxx(3) = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + fxx(lx-2) = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#endif + +#endif + + return + + end subroutine cdderivs_x +!---- + subroutine rdderivs_x(lx,X,f,fxx) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx + real*8,intent(in),dimension(lx) :: X + real*8,intent(in),dimension(lx) :: f + real*8,intent(out),dimension(lx) :: fxx + + real*8 :: dX + + dX = X(2)-X(1) + dX = dX*dX + +#ifdef OLD + fxx(1:lx-2) = (f(3:lx)-2.0*f(2:lx-1)+f(1:lx-2))/dX + fxx(lx-1) = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX + fxx(lx ) = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX +#else + +#if (ghost_width == 2) + fxx(2:lx-1) = (f(3:lx)-2.d0*f(2:lx-1)+f(1:lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 3) + fxx(3:lx-2) = (-f(1:lx-4)+1.6d1*f(2:lx-3)-3.d1*f(3:lx-2)+1.6d1*f(4:lx-1)-f(5:lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 4) + fxx(4:lx-3) = (2.d0*f(1:lx-6)-2.7d1*f(2:lx-5)+2.7d2*f(3:lx-4)-4.9d2*f(4:lx-3) & + +2.7d2*f(5:lx-2)-2.7d1*f(6:lx-1)+2.d0*f(7:lx))/1.8d2/dX + fxx(3) = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + fxx(lx-2) = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#elif (ghost_width == 5) + fxx(5:lx-4) = (-9.d0*f(1:lx-8)+1.28d2*f(2:lx-7)-1.008d3*f(3:lx-6)+8.064d3*f(4:lx-5)-1.435d4*f(5:lx-4) & + +8.064d3*f(6:lx-3)-1.008d3*f(7:lx-2)+1.28d2*f(8:lx-1)-9.d0*f(9:lx))/5.04d3/dX + fxx(4) = (2.d0*f(1)-2.7d1*f(2)+2.7d2*f(3)-4.9d2*f(4) & + +2.7d2*f(5)-2.7d1*f(6)+2.d0*f(7))/1.8d2/dX + fxx(lx-3) = (2.d0*f(lx-6)-2.7d1*f(lx-5)+2.7d2*f(lx-4)-4.9d2*f(lx-3) & + +2.7d2*f(lx-2)-2.7d1*f(lx-1)+2.d0*f(lx))/1.8d2/dX + fxx(3) = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + fxx(lx-2) = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + fxx(2) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx-1) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + fxx(1) = (f(3)-2.d0*f(2)+f(1))/dX + fxx(lx) = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX +#endif + +#endif + + return + + end subroutine rdderivs_x +!---- + subroutine rdderivs_x_point(lx,X,f,fxx,k) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx,k + real*8,intent(in),dimension(lx) :: X + real*8,intent(in),dimension(lx) :: f + real*8,intent(out) :: fxx + + real*8 :: dX + + dX = X(2)-X(1) + dX = dX*dX + +#ifdef OLD + if(k.lt.lx-1) then + fxx = (f(k+2)-2.0*f(k+1)+f(k))/dX + elseif(k.eq.lx-1) then + fxx = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.lx) then + fxx = (f(lx)-2.0*f(lx-1)+f(lx-2))/dX + endif +#else + +#if (ghost_width == 2) + if(k.gt.1 .and. k.lt.lx) then + fxx = (f(k+1)-2.d0*f(k)+f(k-1))/dX + elseif(k.eq.1) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + endif +#elif (ghost_width == 3) + if(k.gt.2 .and. k.lt.lx-1) then + fxx = (-f(k-2)+1.6d1*f(k-1)-3.d1*f(k)+1.6d1*f(k+1)-f(k+2))/1.2d1/dX + elseif(k.eq.1) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.2) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx-1) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + endif +#elif (ghost_width == 4) + if(k.gt.3 .and. k.lt.lx-2)then + fxx = (2.d0*f(k-3)-2.7d1*f(k-2)+2.7d2*f(k-1)-4.9d2*f(k) & + +2.7d2*f(k+1)-2.7d1*f(k+2)+2.d0*f(k+3))/1.8d2/dX + elseif(k.eq.1) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.2) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx-1) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.3) then + fxx = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + elseif(k.eq.lx-2) then + fxx = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + endif +#elif (ghost_width == 5) + if(k.gt.4 .and. k.lt.lx-3) then + fxx = (-9.d0*f(k-4)+1.28d2*f(k-3)-1.008d3*f(k-2)+8.064d3*f(k-1)-1.435d4*f(k) & + +8.064d3*f(k+1)-1.008d3*f(k+2)+1.28d2*f(k+3)-9.d0*f(k+4))/5.04d3/dX + elseif(k.eq.1) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.2) then + fxx = (f(3)-2.d0*f(2)+f(1))/dX + elseif(k.eq.lx-1) then + fxx = (f(lx)-2.d0*f(lx-1)+f(lx-2))/dX + elseif(k.eq.3) then + fxx = (-f(1)+1.6d1*f(2)-3.d1*f(3)+1.6d1*f(4)-f(5))/1.2d1/dX + elseif(k.eq.lx-2) then + fxx = (-f(lx-4)+1.6d1*f(lx-3)-3.d1*f(lx-2)+1.6d1*f(lx-1)-f(lx))/1.2d1/dX + elseif(k.eq.4) then + fxx = (2.d0*f(1)-2.7d1*f(2)+2.7d2*f(3)-4.9d2*f(4) & + +2.7d2*f(5)-2.7d1*f(6)+2.d0*f(7))/1.8d2/dX + elseif(k.eq.lx-3) then + fxx = (2.d0*f(lx-6)-2.7d1*f(lx-5)+2.7d2*f(lx-4)-4.9d2*f(lx-3) & + +2.7d2*f(lx-2)-2.7d1*f(lx-1)+2.d0*f(lx))/1.8d2/dX + endif +#endif + +#endif + + return + + end subroutine rdderivs_x_point +!---- + subroutine rdderivs_xy_point(lx,ly,X,Y,f,fxy,i,j) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: lx,ly,i,j + real*8,intent(in),dimension(lx) :: X + real*8,intent(in),dimension(ly) :: Y + real*8,intent(in),dimension(lx,ly) :: f + real*8,intent(out) :: fxy + + real*8 :: dX,dY + + dX = X(2)-X(1) + dY = Y(2)-Y(1) +!! we only consider inner points +#if (ghost_width == 2) + if(i>1 .and. j>1.and.i2 .and. j>2.and.i3 .and. j>3.and.i4 .and. j>4.and.ieps) write(*,*) f + +return + +end subroutine check_daxiao +subroutine check_factor(T,crho,sigma,R,sst,Rmin) +implicit none +integer,intent(in) :: sst +real*8,intent(in) :: T,crho,sigma,R,Rmin + +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + + hgr = R*Rmin/(1.d0-R) + tgrho = dtan(crho) + tgsigma = dtan(sigma) + tc = dsqrt((1.d0-dsin(crho)*dsin(sigma))/2.d0) + ts = dsqrt((1.d0+dsin(crho)*dsin(sigma))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + write(*,*) dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,0,gt,gp)*swtf**2 + + return + + end subroutine check_factor + +subroutine getdxs(T,crho,sigma,R,betax,KKx,CUx,DCUx,bDCUx,Wx,CJx,CJxx,DCJx,Cnux,CThetax,sst,Rmin) +implicit none +integer,intent(in) :: sst +real*8,intent(in) :: T,crho,sigma,R,Rmin +real*8,intent(out) :: betax,KKx,Wx +double complex,intent(out) :: CUx,DCUx,bDCUx,CJx,CJxx,DCJx,Cnux,CThetax + +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + hgr = R*Rmin/(1.d0-R) + tgrho = dtan(crho) + tgsigma = dtan(sigma) + tc = dsqrt((1.d0-dsin(crho)*dsin(sigma))/2.d0) + ts = dsqrt((1.d0+dsin(crho)*dsin(sigma))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + betax = 0.d0 + + Jr = -(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0/hgr**2& + +2.d0*nu*nu*C2/hgr**3-3.d0*II*nu*C2/hgr**4-2.d0*C2/hgr**5 + Wx = dreal(Yslm(0,2,m,gt,gp))*dreal(Jr*cdexp(II*nu*T))*(Rmin+hgr)**2/Rmin +! Wx = dreal(Jr*cdexp(II*nu*T))*(Rmin+hgr)**2/Rmin + KKx = 0.d0 + + Jr = -2.d0*beta0/hgr/hgr-C1/hgr**3-II*nu*C2/hgr**4-C2/hgr**5 + rf = dreal(Jr*cdexp(II*nu*T)) + CUx = dsqrt(dble(2*(2+1)))*Yslm(1,2,m,gt,gp)*swtf*rf*(Rmin+hgr)**2/Rmin +! CUx = rf*(Rmin+hgr)**2/Rmin + DCUx = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf*(Rmin+hgr)**2/Rmin +! DCUx = rf*(Rmin+hgr)**2/Rmin + bDCUx =-dble(2*(2+1))*Yslm(0,2,m,gt,gp)*rf*(Rmin+hgr)**2/Rmin +! bDCUx = rf*(Rmin+hgr)**2/Rmin + + Jr = -C1/4.d0/hgr**2+C2/4.d0/hgr**4 + rf = dreal(Jr*cdexp(II*nu*T)) + CJx = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf*(Rmin+hgr)**2/Rmin +! CJx = rf*(Rmin+hgr)**2/Rmin + Cnux =-dble((2-1)*(2+2))*dsqrt(dble(2*(2+1)))*Yslm(1,2,m,gt,gp)*swtf*rf*(Rmin+hgr)**2/Rmin +! Cnux = rf*(Rmin+hgr)**2/Rmin + DCJx = 0.d0 + rf = dreal(Jr*II*nu*cdexp(II*nu*T)) + CThetax = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf*(Rmin+hgr)**2/Rmin +! CThetax = rf*(Rmin+hgr)**2/Rmin + Jr = C1/2.d0/hgr**3-C2/hgr**5 + rf = dreal(Jr*cdexp(II*nu*T)) + CJxx = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf*(Rmin+hgr)**4/Rmin**2+2.d0*(Rmin+hgr)/Rmin*CJx +! CJxx = rf*(Rmin+hgr)**4/Rmin**2+2.d0*(Rmin+hgr)/Rmin*CJx + +#if 0 + DCUx = DCUx*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 + CJx = CJx*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 + CJxx = CJxx*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 + CThetax = CThetax*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 +#endif + return + + end subroutine getdxs + +subroutine getndxs(T,crho,sigma,R,beta,KK,CU,bDCU,DCU,CB,DCB,W,CJ,DCJ,bDCB,Cnu,Ck,CTheta,sst,Rmin) +implicit none +integer,intent(in) :: sst +real*8,intent(in) :: T,crho,sigma,R,Rmin +real*8,intent(out) :: beta,KK,W +double complex,intent(out) :: CU,bDCU,DCU,CB,DCB,CJ,DCJ,bDCB,Cnu,Ck,CTheta + +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + hgr = R*Rmin/(1.d0-R) + tgrho = dtan(crho) + tgsigma = dtan(sigma) + tc = dsqrt((1.d0-dsin(crho)*dsin(sigma))/2.d0) + ts = dsqrt((1.d0+dsin(crho)*dsin(sigma))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + beta = dreal(Yslm(0,2,m,gt,gp))*dreal(beta0*cdexp(II*nu*T)) +! beta = dreal(beta0*cdexp(II*nu*T)) + CB = dsqrt(dble(2*(2+1)))*Yslm(1,2,m,gt,gp)*swtf*dreal(beta0*cdexp(II*nu*T)) +! CB = dreal(beta0*cdexp(II*nu*T)) + DCB = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*dreal(beta0*cdexp(II*nu*T)) +! DCB = dreal(beta0*cdexp(II*nu*T)) + bDCB =-dble(2*(2+1))*Yslm(0,2,m,gt,gp)*dreal(beta0*cdexp(II*nu*T)) +! bDCB = dreal(beta0*cdexp(II*nu*T)) + + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0/hgr& + -nu*nu*C2/hgr/hgr+II*nu*C2/hgr**3+C2/2.d0/hgr**4 + W = dreal(Yslm(0,2,m,gt,gp))*dreal(Jr*cdexp(II*nu*T)) +! W = dreal(Jr*cdexp(II*nu*T)) + + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0/hgr-C2/1.2d1/hgr**3 + rf = dreal(Jr*cdexp(II*nu*T)) + CJ = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf +! CJ = rf + DCJ = 0.d0 + Cnu =-dsqrt(dble((2+2)*(2-2+1)*(2-1)*2*(2+1)*(2+2)))*Yslm(1,2,m,gt,gp)*swtf*rf +! Cnu = rf + KK = dsqrt(1.d0+cdabs(CJ)**2) + Ck = 0.d0 + rf = dreal(Jr*II*nu*cdexp(II*nu*T)) + CTheta = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf +! CTheta = rf + + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0/hgr& + +C1/2.d0/hgr/hgr+II*nu*C2/3.d0/hgr**3+C2/4.d0/hgr**4 + rf = dreal(Jr*cdexp(II*nu*T)) + CU = dsqrt(dble(2*(2+1)))*Yslm(1,2,m,gt,gp)*swtf*rf +! CU = rf + DCU = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2*rf +! DCU = rf + bDCU =-dble(2*(2+1))*Yslm(0,2,m,gt,gp)*rf +! bDCU = rf + +#if 0 + DCU = DCU*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 + DCB = DCB*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 + CTheta = CTheta*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*Yslm(2,2,m,gt,gp)*swtf**2 +#endif + return + + end subroutine getndxs +!-------------------------------------------------------------------- +! this R is indeed x +function Eq_Theta_2(ex,crho,sigma,R,RJ,IJ,RU,IU,beta,RB,IB, & + Rnu,Inu,Rk,Ik,RTheta,ITheta,W,Rmin, & + qlR1,qlR2,qlI1,qlI2,quR1,quR2,quI1,quI2,gR,gI, & + T,sst) result(gont) + implicit none + integer,intent(in ):: ex(1:3),sst + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,W + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RJ,IJ,RU,IU,RB,IB,Rnu,Inu,Rk,Ik + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: RTheta,ITheta + real*8,intent(in) :: Rmin,T + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex,dimension(ex(1),ex(2),ex(3)) :: CU,DCU,bDCU,CB,DCB,bDCB,CJ,DCJ + double complex :: CTheta0,CTheta,CTheta1,RHS + integer :: i,j,k,RK4 + double complex,dimension(ex(3)) :: Cnu,Ck,HCnu,HCk,HCU,HDCU,CUx,HCUx,DCUx,HDCUx,HbDCU,bDCUx,HbDCUx + double complex,dimension(ex(3)) :: Cnux,HCnux,HCJ,HDCJ,CJx,HCJx,CJxx,HCJxx,DCJx,HDCJx,HCB,HDCB,HbDCB + double complex,dimension(ex(3)) :: fCTheta,CThetax + real*8,dimension(ex(3)) :: KK,KKx,HKK,HKKx,Hbeta,betax,Hbetax,HW,Wx,HWx + double complex :: Theta_rhs,Theta_rhs_o + real*8 :: dR + +!!! sanity check + dR = sum(RJ)+sum(IJ)+sum(RU)+sum(IU)+sum(beta)+sum(RB)+sum(IB) + & + sum(Rnu)+sum(Inu)+sum(Rk)+sum(Ik)+sum(RTheta)+sum(ITheta) + if(dR.ne.dR) then + if(sum(RJ).ne.sum(RJ))write(*,*)"NullEvol_Theta: find NaN in RJ" + if(sum(IJ).ne.sum(IJ))write(*,*)"NullEvol_Theta: find NaN in IJ" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_Theta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_Theta: find NaN in IU" + if(sum(beta).ne.sum(beta))write(*,*)"NullEvol_Theta: find NaN in beta" + if(sum(RB).ne.sum(RB))write(*,*)"NullEvol_Theta: find NaN in RB" + if(sum(IB).ne.sum(IB))write(*,*)"NullEvol_Theta: find NaN in IB" + if(sum(Rnu).ne.sum(Rnu))write(*,*)"NullEvol_Theta: find NaN in Rnu" + if(sum(Inu).ne.sum(Inu))write(*,*)"NullEvol_Theta: find NaN in Inu" + if(sum(Rk).ne.sum(Rk))write(*,*)"NullEvol_Theta: find NaN in Rk" + if(sum(Ik).ne.sum(Ik))write(*,*)"NullEvol_Theta: find NaN in Ik" + if(sum(RTheta).ne.sum(RTheta))write(*,*)"NullEvol_Theta: find NaN in RTheta" + if(sum(ITheta).ne.sum(ITheta))write(*,*)"NullEvol_Theta: find NaN in ITheta" + gont = 1 + return + endif + + dR = R(2) - R(1) + + CU = dcmplx(RU,IU) + CB = dcmplx(RB,IB) + CJ = dcmplx(RJ,IJ) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),DCU(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CU(:,:,k),bDCU(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),DCB(:,:,k),1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CB(:,:,k),bDCB(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,CJ(:,:,k),DCJ(:,:,k),2,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + + do j=ghost_width+1,ex(2)-ghost_width + do i=ghost_width+1,ex(1)-ghost_width + CTheta0 = dcmplx(RTheta(i,j,1),ITheta(i,j,1)) + fCTheta = dcmplx(RTheta(i,j,:),ITheta(i,j,:)) + call cderivs_x(ex(3),R,fCTheta,CThetax) + Cnu = dcmplx(Rnu(i,j,:),Inu(i,j,:)) + Ck = dcmplx(Rk(i,j,:),Ik(i,j,:)) + call cget_half_x(ex(3),CB(i,j,:),HCB) + call cget_half_x(ex(3),DCB(i,j,:),HDCB) + call cget_half_x(ex(3),bDCB(i,j,:),HbDCB) + call cget_half_x(ex(3),Cnu,HCnu) + call cderivs_x(ex(3),R,Cnu,Cnux) + call cget_half_x(ex(3),Cnux,HCnux) + call cget_half_x(ex(3),Ck,HCk) + call rget_half_x(ex(3),beta(i,j,:),Hbeta) + call rderivs_x(ex(3),R,beta(i,j,:),betax) + call rget_half_x(ex(3),betax,Hbetax) + KK = dsqrt(1.d0+RJ(i,j,:)*RJ(i,j,:)+IJ(i,j,:)*IJ(i,j,:)) + call rget_half_x(ex(3),KK,HKK) + call rderivs_x(ex(3),R,KK,KKx) + call rget_half_x(ex(3),KKx,HKKx) + call rderivs_x(ex(3),R,W,Wx) + call rget_half_x(ex(3),Wx,HWx) + call rget_half_x(ex(3),W(i,j,:),HW) + call cget_half_x(ex(3),CU(i,j,:),HCU) + call cderivs_x(ex(3),R,DCU(i,j,:),DCUx) + call cderivs_x(ex(3),R,CU(i,j,:),CUx) + call cget_half_x(ex(3),DCUx,HDCUx) + call cget_half_x(ex(3),CUx,HCUx) + call cget_half_x(ex(3),DCU(i,j,:),HDCU) + call cderivs_x(ex(3),R,bDCU(i,j,:),bDCUx) + call cget_half_x(ex(3),bDCUx,HbDCUx) + call cget_half_x(ex(3),bDCU(i,j,:),HbDCU) + call cderivs_x(ex(3),R,CJ(i,j,:),CJx) + call cdderivs_x(ex(3),R,CJ(i,j,:),CJxx) + call cget_half_x(ex(3),CJx,HCJx) + call cget_half_x(ex(3),CJxx,HCJxx) + call cderivs_x(ex(3),R,DCJ(i,j,:),DCJx) + call cget_half_x(ex(3),DCJx,HDCJx) + + RTheta(i,j,1) = 0.d0 + ITheta(i,j,1) = 0.d0 + do k=1,ex(3)-1 +! call getndxs(T,crho(i),sigma(j),R(k),beta(i,j,k),KK(k),CU(i,j,k),bDCU(i,j,k),DCU(i,j,k), & +! CB(i,j,k),DCB(i,j,k),W(i,j,k),CJ(i,j,k),DCJ(i,j,k),bDCB(i,j,k),Cnu(k),Ck(k),fCTheta(k),sst,Rmin) +! call getdxs(T,crho(i),sigma(j),R(k),betax(k),KKx(k),CUx(k),DCUx(k),bDCUx(k), & +! Wx(k),CJx(k),CJxx(k),DCJx(k),Cnux(k),CThetax(k),sst,Rmin) + RHS = Theta_rhs(R(k),Rmin,beta(i,j,k),betax(k),KK(k),KKx(k),CU(i,j,k),CUx(k),DCUx(k),bDCU(i,j,k),bDCUx(k), & + DCU(i,j,k),CB(i,j,k),DCB(i,j,k),W(i,j,k),Wx(k),CJ(i,j,k),DCJ(i,j,k), & + CJx(k),CJxx(k),DCJx(k),bDCB(i,j,k),Cnu(k),Cnux(k),Ck(k),fCTheta(k)) + RHS = RHS - CThetax(k) +#if 0 + if(cdabs(RHS)>1.d-9)then +#if 0 + write(*,*)beta(i,j,k),KK(k),CU(i,j,k),bDCU(i,j,k),DCU(i,j,k),CB(i,j,k),DCB(i,j,k) + write(*,*)W(i,j,k),CJ(i,j,k),DCJ(i,j,k),bDCB(i,j,k),Cnu(k),Ck(k),fCTheta(k) + call getndxs(T,crho(i),sigma(j),R(k),beta(i,j,k),KK(k),CU(i,j,k),bDCU(i,j,k),DCU(i,j,k), & + CB(i,j,k),DCB(i,j,k),W(i,j,k),CJ(i,j,k),DCJ(i,j,k),bDCB(i,j,k),Cnu(k),Ck(k),fCTheta(k),sst,Rmin) + write(*,*)"VS" + write(*,*)beta(i,j,k),KK(k),CU(i,j,k),bDCU(i,j,k),DCU(i,j,k),CB(i,j,k),DCB(i,j,k) + write(*,*)W(i,j,k),CJ(i,j,k),DCJ(i,j,k),bDCB(i,j,k),Cnu(k),Ck(k),fCTheta(k) +#endif + write(*,*)betax(k),KKx(k),CUx(k),DCUx(k),bDCUx(k) + write(*,*)Wx(k),CJx(k),CJxx(k),DCJx(k),Cnux(k),CThetax(k) + call getdxs(T,crho(i),sigma(j),R(k),betax(k),KKx(k),CUx(k),DCUx(k),bDCUx(k), & + Wx(k),CJx(k),CJxx(k),DCJx(k),Cnux(k),CThetax(k),sst,Rmin) + write(*,*)"VS" + write(*,*)betax(k),KKx(k),CUx(k),DCUx(k),bDCUx(k) + write(*,*)Wx(k),CJx(k),CJxx(k),DCJx(k),Cnux(k),CThetax(k) +! write(*,*)RHS +! call check_factor(T,crho(i),sigma(j),R(k),sst,Rmin) + stop + endif +#endif + RTheta(i,j,k+1) = dreal(RHS) + ITheta(i,j,k+1) = dimag(RHS) + enddo + enddo + enddo + + gont = 0 + return + +end function Eq_Theta_2 diff --git a/AMSS_NCKU_source/NullEvol.h b/AMSS_NCKU_source/NullEvol.h new file mode 100644 index 0000000..65a799d --- /dev/null +++ b/AMSS_NCKU_source/NullEvol.h @@ -0,0 +1,225 @@ + +#ifndef NULLEVOL_H +#define NULLEVOL_H + +#ifdef fortran1 +#define f_setup_dyad setup_dyad +#define f_eth_derivs eth_derivs +#define f_eth_dderivs eth_dderivs +#define f_fill_symmetric_boundarybuffer fill_symmetric_boundarybuffer +#define f_fill_symmetric_boundarybuffer2 fill_symmetric_boundarybuffer2 +#define f_calculate_K calculate_k +#define f_NullEvol_beta nullevol_beta +#define f_NullEvol_Q nullevol_q +#define f_NullEvol_U nullevol_u +#define f_NullEvol_W nullevol_w +#define f_NullEvol_Theta nullevol_theta +#define f_NullEvol_Theta_givenx nullevol_theta_givenx +#define f_Eq_Theta eq_theta +#define f_Eq_Theta_2 eq_theta_2 +#define f_NullEvol_g01 nullevol_g01 +#define f_NullEvol_pg0A nullevol_pg0a +#define f_NullEvol_Theta2 nullevol_theta2 +#define f_NullEvol_Thetag00 nullevol_thetag00 +#endif +#ifdef fortran2 +#define f_setup_dyad SETUP_DYAD +#define f_eth_derivs ETH_DERIVS +#define f_eth_dderivs ETH_DDERIVS +#define f_fill_symmetric_boundarybuffer FILL_SYMMETRIC_BOUNDARYBUFFER +#define f_fill_symmetric_boundarybuffer2 FILL_SYMMETRIC_BOUNDARYBUFFER2 +#define f_calculate_K CALCULATE_K +#define f_NullEvol_beta NULLEVOL_BETA +#define f_NullEvol_Q NULLEVOL_Q +#define f_NullEvol_U NULLEVOL_U +#define f_NullEvol_W NULLEVOL_W +#define f_NullEvol_Theta NULLEVOL_THETA +#define f_NullEvol_Theta_givenx NULLEVOL_THETA_GIVENX +#define f_Eq_Theta EQ_THETA +#define f_Eq_Theta_2 EQ_THETA_2 +#define f_NullEvol_g01 NULLEVOL_G01 +#define f_NullEvol_pg0A NULLEVOL_PG0A +#define f_NullEvol_Theta2 NULLEVOL_THETA2 +#define f_NullEvol_Thetag00 NULLEVOL_THETAG00 +#endif +#ifdef fortran3 +#define f_setup_dyad setup_dyad_ +#define f_eth_derivs eth_derivs_ +#define f_eth_dderivs eth_dderivs_ +#define f_fill_symmetric_boundarybuffer fill_symmetric_boundarybuffer_ +#define f_fill_symmetric_boundarybuffer2 fill_symmetric_boundarybuffer2_ +#define f_calculate_K calculate_k_ +#define f_NullEvol_beta nullevol_beta_ +#define f_NullEvol_Q nullevol_q_ +#define f_NullEvol_U nullevol_u_ +#define f_NullEvol_W nullevol_w_ +#define f_NullEvol_Theta nullevol_theta_ +#define f_NullEvol_Theta_givenx nullevol_theta_givenx_ +#define f_Eq_Theta eq_theta_ +#define f_Eq_Theta_2 eq_theta_2_ +#define f_NullEvol_g01 nullevol_g01_ +#define f_NullEvol_pg0A nullevol_pg0a_ +#define f_NullEvol_Theta2 nullevol_theta2_ +#define f_NullEvol_Thetag00 nullevol_thetag00_ +#endif + +extern "C" +{ + void f_setup_dyad(int *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + int &, double &); +} + +extern "C" +{ + void f_eth_derivs(int *, double *, double *, + double *, double *, + double *, double *, + int &, int &, + double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_eth_dderivs(int *, double *, double *, + double *, double *, + double *, double *, + int &, int &, int &, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + void f_fill_symmetric_boundarybuffer(int *, double *, double *, double *, + double &, double &, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, int &, int &, int &); +} + +extern "C" +{ + void f_fill_symmetric_boundarybuffer2(int *, double *, double *, double *, + double &, double &, + double *, int &, int &, double *); +} + +extern "C" +{ + void f_calculate_K(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + int f_NullEvol_beta(int *, double *, double *, double *, + double *, double *, double *, double *, double *); +} + +extern "C" +{ + int f_NullEvol_Q(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + int f_NullEvol_U(int *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double &); +} + +extern "C" +{ + int f_NullEvol_W(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, double &, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + int f_NullEvol_Theta(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double &, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + int f_NullEvol_Theta_givenx(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double &, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double &, int &); +} + +extern "C" +{ + int f_Eq_Theta(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double &, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + int f_Eq_Theta_2(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double &, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double &, int &); +} + +extern "C" +{ + int f_NullEvol_g01(int *, double *, double *, double *, + double *, double *, double *, double *, + double &); +} + +extern "C" +{ + int f_NullEvol_pg0A(int *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double &); +} + +extern "C" +{ + int f_NullEvol_Theta2(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double &); +} + +extern "C" +{ + int f_NullEvol_Thetag00(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double &); +} +#endif /* NULLEVOL_H */ diff --git a/AMSS_NCKU_source/NullEvol2.f90 b/AMSS_NCKU_source/NullEvol2.f90 new file mode 100644 index 0000000..8cd8cb8 --- /dev/null +++ b/AMSS_NCKU_source/NullEvol2.f90 @@ -0,0 +1,4449 @@ + + +#include "macrodef.fh" + +!--------------------------------------------------------------------------------- +! fill symmetric boundary buffer points +!--------------------------------------------------------------------------------- +subroutine fill_symmetric_boundarybuffer2(ex,crho,sigma,R,drho,dsigma, & + var,Symmetry,sst,AoS) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in),dimension(3) :: ex + integer,intent(in) :: Symmetry,sst + real*8,dimension(3) :: AoS + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8,intent(in) :: drho,dsigma + real*8,intent(inout),dimension(ex(1),ex(2),ex(3)) :: var + + integer :: i,j,k,t + + select case (Symmetry) + case (0) + return + case (1) + if((sst==2.or.sst==4).and.dabs(sigma(1)+ghost_width*dsigma) < dsigma/2.d0)then + do k=1,ex(3) + do j=1,ghost_width + do i=1,ex(1) +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+2-j +#endif +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+1-j +#endif + var(i,j,k) = AoS(2)*var(i,t,k) + enddo + enddo + enddo + endif + if((sst==3.or.sst==5).and.dabs(sigma(ex(2))-ghost_width*dsigma) < dsigma/2.d0)then + do k=1,ex(3) + do j=ex(2)-ghost_width+1,ex(2) + do i=1,ex(1) + t = ex(2)-j+1 +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + t = ex(2)-2*ghost_width-1+t +#endif +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + t = ex(2)-2*ghost_width+t +#endif + var(i,j,k) = AoS(2)*var(i,t,k) + enddo + enddo + enddo + endif + case (2) + if(dabs(crho(1)+ghost_width*drho) < drho/2.d0)then + if(dabs(sigma(1)+ghost_width*dsigma) < dsigma/2.d0)then + do k=1,ex(3) + do j=1,ghost_width + do i=ghost_width+1,ex(1) +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+2-j +#endif +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+1-j +#endif + var(i,j,k) = AoS(2)*var(i,t,k) + enddo + enddo + enddo + endif + do k=1,ex(3) + do j=1,ex(2) + do i=1,ghost_width +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+2-i +#endif +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+1-i +#endif + var(i,j,k) = AoS(1)*var(t,j,k) + enddo + enddo + enddo + else + if(dabs(sigma(1)+ghost_width*dsigma) < dsigma/2.d0)then + do k=1,ex(3) + do j=1,ghost_width + do i=1,ex(1) +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+2-j +#endif +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + t = 2*ghost_width+1-j +#endif + var(i,j,k) = AoS(2)*var(i,t,k) + enddo + enddo + enddo + endif + endif + end select + + return + + end subroutine fill_symmetric_boundarybuffer2 +!--------------------------------------------------------------------------------- +!!!! using r^2g_AB instead of g_AB +!!!! using r^2g_0A instead of g_0A +!!!! using r^2g_00 instead of g_00 +!!!! using x in the metric form directly instead of r +!--------------------------------------------------------------------------------- +! this R is indeed x +function NullEvol_g01(ex,crho,sigma,R, & + g22,g23,g33,g01,Rmin) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in ):: Rmin + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: g01 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: g22,g23,g33 +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + real*8, dimension(ex(3)):: dg22,dg23,dg33,ddg22,ddg23,ddg33 + real*8, dimension(ex(3)):: Hg22,Hg23,Hg33 + real*8, dimension(ex(3)):: Hdg22,Hdg23,Hdg33,Hddg22,Hddg23,Hddg33 + real*8 :: g010,g011,g01h,rhs + integer :: i,j,k,RK4 + +!!! sanity check + dR = sum(g22)+sum(g23)+sum(g33)+sum(g01) + if(dR.ne.dR) then + if(sum(g22).ne.sum(g22))write(*,*)"NullEvol_g01: find NaN in g22" + if(sum(g23).ne.sum(g23))write(*,*)"NullEvol_g01: find NaN in g23" + if(sum(g33).ne.sum(g33))write(*,*)"NullEvol_g01: find NaN in g33" + if(sum(g01).ne.sum(g01))write(*,*)"NullEvol_g01: find NaN in g01" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + g010 = g01(i,j,1) + + call rderivs_x(ex(3),R,g22(i,j,:),dg22) + call rderivs_x(ex(3),R,g23(i,j,:),dg23) + call rderivs_x(ex(3),R,g33(i,j,:),dg33) + call rdderivs_x(ex(3),R,g22(i,j,:),ddg22) + call rdderivs_x(ex(3),R,g23(i,j,:),ddg23) + call rdderivs_x(ex(3),R,g33(i,j,:),ddg33) + + call rget_half_x(ex(3),g22(i,j,:),Hg22) + call rget_half_x(ex(3),g23(i,j,:),Hg23) + call rget_half_x(ex(3),g33(i,j,:),Hg33) + + call rget_half_x(ex(3),dg22,Hdg22) + call rget_half_x(ex(3),dg23,Hdg23) + call rget_half_x(ex(3),dg33,Hdg33) + + call rget_half_x(ex(3),ddg22,Hddg22) + call rget_half_x(ex(3),ddg23,Hddg23) + call rget_half_x(ex(3),ddg33,Hddg33) + + do k=1,ex(3)-2 + RK4 = 0 + call get_g01_rhs(R(k),g22(i,j,k),g23(i,j,k),g33(i,j,k),dg22(k),dg23(k), & + dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k),rhs) + call rungekutta4_scalar(dR,g010,g01h,rhs,RK4) + + RK4 = 1 + call get_g01_rhs(R(k)+dR/2,Hg22(k),Hg23(k),Hg33(k),Hdg22(k),Hdg23(k), & + Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),g01h,g011) + call rungekutta4_scalar(dR,g010,g011,rhs,RK4) + call rswap(g01h,g011) + + RK4 = 2 + call get_g01_rhs(R(k)+dR/2,Hg22(k),Hg23(k),Hg33(k),Hdg22(k),Hdg23(k), & + Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),g01h,g011) + call rungekutta4_scalar(dR,g010,g011,rhs,RK4) + call rswap(g01h,g011) + + RK4 = 3 + call get_g01_rhs(R(k+1),g22(i,j,k+1),g23(i,j,k+1),g33(i,j,k+1),dg22(k+1),dg23(k+1), & + dg33(k+1),ddg22(k+1),ddg23(k+1),ddg33(k+1),g01h,g011) + call rungekutta4_scalar(dR,g010,g011,rhs,RK4) + call rswap(g010,g011) + + g01(i,j,k+1) = g010 + enddo +! closing step + k = ex(3)-1 + call get_g01_rhs(R(k),g22(i,j,k),g23(i,j,k),g33(i,j,k),dg22(k),dg23(k), & + dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k),rhs) + g01(i,j,k+1) = g01(i,j,k) + rhs*dR + + enddo + enddo + + gont = 0 + + return + +end function NullEvol_g01 +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_pg0a(ex,crho,sigma,R, & + g22,g23,g33,g01,p02,p03,g02,g03,Rmin) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in ):: Rmin + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: p02,p03,g02,g03 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: g22,g23,g33,g01 +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + real*8, dimension(ex(3)) :: Hg01 + real*8, dimension(ex(3)) :: Hg22,Hg23,Hg33 + + real*8, dimension(ex(3)) :: dg01,dg02,dg03 + real*8, dimension(ex(3)) :: dgx01,dgx22,dgx23,dgx33 + real*8, dimension(ex(3)) :: dgy01,dgy22,dgy23,dgy33 + real*8, dimension(ex(3)) :: ddgxr01,ddgxr22,ddgxr23,ddgxr33 + real*8, dimension(ex(3)) :: ddgyr01,ddgyr22,ddgyr23,ddgyr33 + real*8, dimension(ex(3)) :: dg22,dg23,dg33,ddg22,ddg23,ddg33 + real*8, dimension(ex(3)) :: Hdg01,Hdg02,Hdg03 + real*8, dimension(ex(3)) :: Hdgx01,Hdgx22,Hdgx23,Hdgx33 + real*8, dimension(ex(3)) :: Hdgy01,Hdgy22,Hdgy23,Hdgy33 + real*8, dimension(ex(3)) :: Hddgxr01,Hddgxr22,Hddgxr23,Hddgxr33 + real*8, dimension(ex(3)) :: Hddgyr01,Hddgyr22,Hddgyr23,Hddgyr33 + real*8, dimension(ex(3)) :: Hdg22,Hdg23,Hdg33,Hddg22,Hddg23,Hddg33 + + real*8 :: p020,p021,p02h,p02_rhs + real*8 :: p030,p031,p03h,p03_rhs + real*8 :: g020,g021,g02h,g02_rhs + real*8 :: g030,g031,g03h,g03_rhs + integer :: i,j,k,RK4 + +!!! sanity check + dR = sum(g22)+sum(g23)+sum(g33)+sum(g01) & + +sum(p02)+sum(p03)+sum(g02)+sum(g03) + if(dR.ne.dR) then + if(sum(g22).ne.sum(g22))write(*,*)"NullEvol_pg0a: find NaN in g22" + if(sum(g23).ne.sum(g23))write(*,*)"NullEvol_pg0a: find NaN in g23" + if(sum(g33).ne.sum(g33))write(*,*)"NullEvol_pg0a: find NaN in g33" + if(sum(g01).ne.sum(g01))write(*,*)"NullEvol_pg0a: find NaN in g01" + if(sum(p02).ne.sum(p02))write(*,*)"NullEvol_pg0a: find NaN in p02" + if(sum(p03).ne.sum(p03))write(*,*)"NullEvol_pg0a: find NaN in p03" + if(sum(g02).ne.sum(g02))write(*,*)"NullEvol_pg0a: find NaN in g02" + if(sum(g03).ne.sum(g03))write(*,*)"NullEvol_pg0a: find NaN in g03" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + + call rderivs_x(ex(3),R,g01(i,j,:),dg01) + dg02 = p02(i,j,:) + dg03 = p03(i,j,:) + call rderivs_x(ex(3),R,g22(i,j,:),dg22) + call rderivs_x(ex(3),R,g23(i,j,:),dg23) + call rderivs_x(ex(3),R,g33(i,j,:),dg33) + call rdderivs_x(ex(3),R,g22(i,j,:),ddg22) + call rdderivs_x(ex(3),R,g23(i,j,:),ddg23) + call rdderivs_x(ex(3),R,g33(i,j,:),ddg33) + + do k=1,ex(3) + call rderivs_x_point(ex(1),crho,g01(:,j,k),dgx01(k),i) + call rderivs_x_point(ex(1),crho,g22(:,j,k),dgx22(k),i) + call rderivs_x_point(ex(1),crho,g23(:,j,k),dgx23(k),i) + call rderivs_x_point(ex(1),crho,g33(:,j,k),dgx33(k),i) + + call rderivs_x_point(ex(2),sigma,g01(i,:,k),dgy01(k),j) + call rderivs_x_point(ex(2),sigma,g22(i,:,k),dgy22(k),j) + call rderivs_x_point(ex(2),sigma,g23(i,:,k),dgy23(k),j) + call rderivs_x_point(ex(2),sigma,g33(i,:,k),dgy33(k),j) + + call rdderivs_xy_point(ex(1),ex(3),crho,R,g01(:,j,:),ddgxr01(k),i,k) + call rdderivs_xy_point(ex(1),ex(3),crho,R,g22(:,j,:),ddgxr22(k),i,k) + call rdderivs_xy_point(ex(1),ex(3),crho,R,g23(:,j,:),ddgxr23(k),i,k) + call rdderivs_xy_point(ex(1),ex(3),crho,R,g33(:,j,:),ddgxr33(k),i,k) + + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g01(i,:,:),ddgyr01(k),j,k) + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g22(i,:,:),ddgyr22(k),j,k) + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g23(i,:,:),ddgyr23(k),j,k) + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g33(i,:,:),ddgyr33(k),j,k) + enddo + + call rget_half_x(ex(3),g01(i,j,:),Hg01) + call rget_half_x(ex(3),g22(i,j,:),Hg22) + call rget_half_x(ex(3),g23(i,j,:),Hg23) + call rget_half_x(ex(3),g33(i,j,:),Hg33) + + call rget_half_x(ex(3),dg01,Hdg01) + call rget_half_x(ex(3),dg02,Hdg02) + call rget_half_x(ex(3),dg03,Hdg03) + + call rget_half_x(ex(3),dgx01,Hdgx01) + call rget_half_x(ex(3),dgy01,Hdgy01) + + call rget_half_x(ex(3),dgx22,Hdgx22) + call rget_half_x(ex(3),dgx23,Hdgx23) + call rget_half_x(ex(3),dgx33,Hdgx33) + call rget_half_x(ex(3),dgy22,Hdgy22) + call rget_half_x(ex(3),dgy23,Hdgy23) + call rget_half_x(ex(3),dgy33,Hdgy33) + + call rget_half_x(ex(3),ddgxr01,Hddgxr01) + call rget_half_x(ex(3),ddgyr01,Hddgyr01) + + call rget_half_x(ex(3),ddgxr22,Hddgxr22) + call rget_half_x(ex(3),ddgxr23,Hddgxr23) + call rget_half_x(ex(3),ddgxr33,Hddgxr33) + call rget_half_x(ex(3),ddgyr22,Hddgyr22) + call rget_half_x(ex(3),ddgyr23,Hddgyr23) + call rget_half_x(ex(3),ddgyr33,Hddgyr33) + + call rget_half_x(ex(3),dg22,Hdg22) + call rget_half_x(ex(3),dg23,Hdg23) + call rget_half_x(ex(3),dg33,Hdg33) + call rget_half_x(ex(3),ddg22,Hddg22) + call rget_half_x(ex(3),ddg23,Hddg23) + call rget_half_x(ex(3),ddg33,Hddg33) + +#if 0 + g020 = g02(i,j,1) + g030 = g03(i,j,1) + p020 = p02(i,j,1) + p030 = p03(i,j,1) + + do k=1,ex(3)-2 + RK4 = 0 + call pg0a_rhs(Rmin,R(k),p020,p030,g020,g030,g22(i,j,k),g23(i,j,k),g33(i,j,k),dg22(k),dg23(k), & + dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k), & + dg01(k),dg02(k),dg03(k), & + dgx01(k),dgx22(k),dgx23(k),dgx33(k), & + dgy01(k),dgy22(k),dgy23(k),dgy33(k), & + ddgxr01(k),ddgxr22(k),ddgxr23(k),ddgxr33(k), & + ddgyr01(k),ddgyr22(k),ddgyr23(k),ddgyr33(k), & + g02_rhs,g03_rhs,p02_rhs,p03_rhs) + call rungekutta4_scalar(dR,g020,g02h,g02_rhs,RK4) + call rungekutta4_scalar(dR,g030,g03h,g03_rhs,RK4) + call rungekutta4_scalar(dR,p020,p02h,p02_rhs,RK4) + call rungekutta4_scalar(dR,p030,p03h,p03_rhs,RK4) + + RK4 = 1 + call pg0a_rhs(Rmin,R(k)+dR/2,p02h,p03h,g02h,g03h,Hg22(k),Hg23(k),Hg33(k),Hdg22(k),Hdg23(k), & + Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),Hg01(k), & + Hdg01(k),Hdg02(k),Hdg03(k), & + Hdgx01(k),Hdgx22(k),Hdgx23(k),Hdgx33(k), & + Hdgy01(k),Hdgy22(k),Hdgy23(k),Hdgy33(k), & + Hddgxr01(k),Hddgxr22(k),Hddgxr23(k),Hddgxr33(k), & + Hddgyr01(k),Hddgyr22(k),Hddgyr23(k),Hddgyr33(k), & + g021,g031,p021,p031) + call rungekutta4_scalar(dR,g020,g021,g02_rhs,RK4) + call rungekutta4_scalar(dR,g030,g031,g03_rhs,RK4) + call rungekutta4_scalar(dR,p020,p021,p02_rhs,RK4) + call rungekutta4_scalar(dR,p030,p031,p03_rhs,RK4) + call rswap(g02h,g021) + call rswap(g03h,g031) + call rswap(p02h,p021) + call rswap(p03h,p031) + + RK4 = 2 + call pg0a_rhs(Rmin,R(k)+dR/2,p02h,p03h,g02h,g03h,Hg22(k),Hg23(k),Hg33(k),Hdg22(k),Hdg23(k), & + Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),Hg01(k), & + Hdg01(k),Hdg02(k),Hdg03(k), & + Hdgx01(k),Hdgx22(k),Hdgx23(k),Hdgx33(k), & + Hdgy01(k),Hdgy22(k),Hdgy23(k),Hdgy33(k), & + Hddgxr01(k),Hddgxr22(k),Hddgxr23(k),Hddgxr33(k), & + Hddgyr01(k),Hddgyr22(k),Hddgyr23(k),Hddgyr33(k), & + g021,g031,p021,p031) + call rungekutta4_scalar(dR,g020,g021,g02_rhs,RK4) + call rungekutta4_scalar(dR,g030,g031,g03_rhs,RK4) + call rungekutta4_scalar(dR,p020,p021,p02_rhs,RK4) + call rungekutta4_scalar(dR,p030,p031,p03_rhs,RK4) + call rswap(g02h,g021) + call rswap(g03h,g031) + call rswap(p02h,p021) + call rswap(p03h,p031) + + RK4 = 3 + call pg0a_rhs(Rmin,R(k+1),p02h,p03h,g02h,g03h,Hg22(k+1),Hg23(k+1),Hg33(k+1),Hdg22(k+1),Hdg23(k+1), & + Hdg33(k+1),Hddg22(k+1),Hddg23(k+1),Hddg33(k+1),Hg01(k+1), & + Hdg01(k+1),Hdg02(k+1),Hdg03(k+1), & + Hdgx01(k+1),Hdgx22(k+1),Hdgx23(k+1),Hdgx33(k+1), & + Hdgy01(k+1),Hdgy22(k+1),Hdgy23(k+1),Hdgy33(k+1), & + Hddgxr01(k+1),Hddgxr22(k+1),Hddgxr23(k+1),Hddgxr33(k+1), & + Hddgyr01(k+1),Hddgyr22(k+1),Hddgyr23(k+1),Hddgyr33(k+1), & + g021,g031,p021,p031) + call rungekutta4_scalar(dR,g020,g021,g02_rhs,RK4) + call rungekutta4_scalar(dR,g030,g031,g03_rhs,RK4) + call rungekutta4_scalar(dR,p020,p021,p02_rhs,RK4) + call rungekutta4_scalar(dR,p030,p031,p03_rhs,RK4) + call rswap(g020,g021) + call rswap(g030,g031) + call rswap(p020,p021) + call rswap(p030,p031) + + g02(i,j,k+1) = g020 + g03(i,j,k+1) = g030 + p02(i,j,k+1) = p020 + p03(i,j,k+1) = p030 + + enddo + k=ex(3)-1 +! closing step + call pg0a_rhs(Rmin,R(k),p020,p030,g020,g030,g22(i,j,k),g23(i,j,k),g33(i,j,k),dg22(k),dg23(k), & + dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k), & + dg01(k),dg02(k),dg03(k), & + dgx01(k),dgx22(k),dgx23(k),dgx33(k), & + dgy01(k),dgy22(k),dgy23(k),dgy33(k), & + ddgxr01(k),ddgxr22(k),ddgxr23(k),ddgxr33(k), & + ddgyr01(k),ddgyr22(k),ddgyr23(k),ddgyr33(k), & + g02_rhs,g03_rhs,p02_rhs,p03_rhs) + g02(i,j,k+1) = g02(i,j,k) + g02_rhs*dR + g03(i,j,k+1) = g03(i,j,k) + g03_rhs*dR + p02(i,j,k+1) = p02(i,j,k) + p02_rhs*dR + p03(i,j,k+1) = p03(i,j,k) + p03_rhs*dR +#endif + + enddo + enddo + + gont = 0 + + return + +end function NullEvol_pg0a +!------------------------------------------------------------------------------ +! this R is indeed x +function NullEvol_Theta2(ex,crho,sigma,R, & + g22,g23,g33,g00,g01,g02,g03,p02,p03, & + Theta22,Theta23,Theta33,Rmin) result(gont) + implicit none + integer,intent(in ):: ex(1:3) + real*8,intent(in ):: Rmin + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: g00 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: g02,g03,p02,p03 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: g22,g23,g33,g01 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Theta22,Theta23,Theta33 +! gont = 0: success; gont = 1: something wrong + integer::gont + real*8 :: dR + + real*8,dimension(ex(3)) :: dg22,dg23,dg33,ddg22,ddg23,ddg33 + real*8,dimension(ex(3)) :: dg00,dg01,dg02,dg03 + real*8,dimension(ex(3)) :: dgx01,dgx02,dgx03 + real*8,dimension(ex(3)) :: dgy01,dgy02,dgy03 + real*8,dimension(ex(3)) :: dgx22,dgx23,dgx33 + real*8,dimension(ex(3)) :: dgy22,dgy23,dgy33 + real*8,dimension(ex(3)) :: ddgxx01,ddgxx33,ddgyy01,ddgyy22,ddgxy23 + real*8,dimension(ex(3)) :: ddgxy01,ddgxr02,ddgxr03,ddgyr02,ddgyr03 + real*8,dimension(ex(3)) :: ddgxr22,ddgxr23,ddgxr33,ddgyr22,ddgyr23,ddgyr33 + + real*8,dimension(ex(3)) :: Hdg22,Hdg23,Hdg33,Hddg22,Hddg23,Hddg33 + real*8,dimension(ex(3)) :: Hdg00,Hdg01,Hdg02,Hdg03 + real*8,dimension(ex(3)) :: Hdgx01,Hdgx02,Hdgx03 + real*8,dimension(ex(3)) :: Hdgy01,Hdgy02,Hdgy03 + real*8,dimension(ex(3)) :: Hdgx22,Hdgx23,Hdgx33 + real*8,dimension(ex(3)) :: Hdgy22,Hdgy23,Hdgy33 + real*8,dimension(ex(3)) :: Hddgxx01,Hddgxx33,Hddgyy01,Hddgyy22,Hddgxy23 + real*8,dimension(ex(3)) :: Hddgxy01,Hddgxr02,Hddgxr03,Hddgyr02,Hddgyr03 + real*8,dimension(ex(3)) :: Hddgxr22,Hddgxr23,Hddgxr33,Hddgyr22,Hddgyr23,Hddgyr33 + + real*8,dimension(ex(3)) :: Hg00,Hg01,Hg02,Hg03,Hg22,Hg23,Hg33 + real*8,dimension(ex(3)) :: HTheta22,HTheta23,HTheta33 + + real*8 :: Theta220,Theta221,Theta22h,Theta22_rhs + real*8 :: Theta230,Theta231,Theta23h,Theta23_rhs + real*8 :: Theta330,Theta331,Theta33h,Theta33_rhs + integer :: i,j,k,RK4 + +!!! sanity check + dR = sum(g22)+sum(g23)+sum(g33)+sum(g01) & + +sum(g00)+sum(g02)+sum(g03) & + +sum(Theta22)+sum(Theta23)+sum(Theta33) + if(dR.ne.dR) then + if(sum(g22).ne.sum(g22))write(*,*)"NullEvol_Theta: find NaN in g22" + if(sum(g23).ne.sum(g23))write(*,*)"NullEvol_Theta: find NaN in g23" + if(sum(g33).ne.sum(g33))write(*,*)"NullEvol_Theta: find NaN in g33" + if(sum(g01).ne.sum(g01))write(*,*)"NullEvol_Theta: find NaN in g01" + if(sum(g00).ne.sum(g00))write(*,*)"NullEvol_Theta: find NaN in g00" + if(sum(g02).ne.sum(g02))write(*,*)"NullEvol_Theta: find NaN in g02" + if(sum(g03).ne.sum(g03))write(*,*)"NullEvol_Theta: find NaN in g03" + if(sum(Theta22).ne.sum(Theta22))write(*,*)"NullEvol_Theta: find NaN in Theta22" + if(sum(Theta23).ne.sum(Theta23))write(*,*)"NullEvol_Theta: find NaN in Theta23" + if(sum(Theta33).ne.sum(Theta33))write(*,*)"NullEvol_Theta: find NaN in Theta33" + gont = 1 + return + endif + + dR = R(2) - R(1) + + do j=1,ex(2) + do i=1,ex(1) + call rderivs_x(ex(3),R,g00(i,j,:),dg00) + call rderivs_x(ex(3),R,g01(i,j,:),dg01) + dg02 = p02(i,j,:) + dg03 = p03(i,j,:) + + call rderivs_x(ex(3),R,g22(i,j,:),dg22) + call rderivs_x(ex(3),R,g23(i,j,:),dg23) + call rderivs_x(ex(3),R,g33(i,j,:),dg33) + call rdderivs_x(ex(3),R,g22(i,j,:),ddg22) + call rdderivs_x(ex(3),R,g23(i,j,:),ddg23) + call rdderivs_x(ex(3),R,g33(i,j,:),ddg33) + + do k=1,ex(3) + call rderivs_x_point(ex(1),crho,g01(:,j,k),dgx01(k),i) + call rderivs_x_point(ex(1),crho,g02(:,j,k),dgx02(k),i) + call rderivs_x_point(ex(1),crho,g03(:,j,k),dgx03(k),i) + + call rderivs_x_point(ex(2),sigma,g01(i,:,k),dgy01(k),j) + call rderivs_x_point(ex(2),sigma,g02(i,:,k),dgy02(k),j) + call rderivs_x_point(ex(2),sigma,g03(i,:,k),dgy03(k),j) + + call rderivs_x_point(ex(1),crho,g22(:,j,k),dgx22(k),i) + call rderivs_x_point(ex(1),crho,g23(:,j,k),dgx23(k),i) + call rderivs_x_point(ex(1),crho,g33(:,j,k),dgx33(k),i) + + call rderivs_x_point(ex(2),sigma,g22(i,:,k),dgy22(k),j) + call rderivs_x_point(ex(2),sigma,g23(i,:,k),dgy23(k),j) + call rderivs_x_point(ex(2),sigma,g33(i,:,k),dgy33(k),j) + + call rdderivs_x_point(ex(1),crho,g01(:,j,k),ddgxx01(k),i) + call rdderivs_x_point(ex(1),crho,g33(:,j,k),ddgxx33(k),i) + + call rdderivs_x_point(ex(2),sigma,g01(i,:,k),ddgyy01(k),j) + call rdderivs_x_point(ex(2),sigma,g22(i,:,k),ddgyy22(k),j) + + call rderivs_x_point(ex(1),crho,p02(:,j,k),ddgxr02(k),i) + call rderivs_x_point(ex(1),crho,p03(:,j,k),ddgxr03(k),i) + + call rderivs_x_point(ex(2),sigma,p02(i,:,k),ddgyr02(k),j) + call rderivs_x_point(ex(2),sigma,p03(i,:,k),ddgyr03(k),j) + + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,g01(:,:,k),ddgxy01(k),i,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,g23(:,:,k),ddgxy23(k),i,j) + + call rdderivs_xy_point(ex(1),ex(3),crho,R,g22(:,j,:),ddgxr22(k),i,k) + call rdderivs_xy_point(ex(1),ex(3),crho,R,g23(:,j,:),ddgxr23(k),i,k) + call rdderivs_xy_point(ex(1),ex(3),crho,R,g33(:,j,:),ddgxr33(k),i,k) + + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g22(i,:,:),ddgyr22(k),j,k) + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g23(i,:,:),ddgyr23(k),j,k) + call rdderivs_xy_point(ex(2),ex(3),sigma,R,g33(i,:,:),ddgyr33(k),j,k) + enddo + + call rget_half_x(ex(3),g00(i,j,:),Hg00) + call rget_half_x(ex(3),g01(i,j,:),Hg01) + call rget_half_x(ex(3),g02(i,j,:),Hg02) + call rget_half_x(ex(3),g03(i,j,:),Hg03) + call rget_half_x(ex(3),g22(i,j,:),Hg22) + call rget_half_x(ex(3),g23(i,j,:),Hg23) + call rget_half_x(ex(3),g33(i,j,:),Hg33) + call rget_half_x(ex(3),Theta22(i,j,:),HTheta22) + call rget_half_x(ex(3),Theta23(i,j,:),HTheta23) + call rget_half_x(ex(3),Theta33(i,j,:),HTheta33) + + call rget_half_x(ex(3),dg22,Hdg22) + call rget_half_x(ex(3),dg23,Hdg23) + call rget_half_x(ex(3),dg33,Hdg33) + call rget_half_x(ex(3),ddg22,Hddg22) + call rget_half_x(ex(3),ddg23,Hddg23) + call rget_half_x(ex(3),ddg33,Hddg33) + call rget_half_x(ex(3),dg00,Hdg00) + call rget_half_x(ex(3),dg01,Hdg01) + call rget_half_x(ex(3),dg02,Hdg02) + call rget_half_x(ex(3),dg03,Hdg03) + call rget_half_x(ex(3),dgx01,Hdgx01) + call rget_half_x(ex(3),dgx02,Hdgx02) + call rget_half_x(ex(3),dgx03,Hdgx03) + call rget_half_x(ex(3),dgy01,Hdgy01) + call rget_half_x(ex(3),dgy02,Hdgy02) + call rget_half_x(ex(3),dgy03,Hdgy03) + call rget_half_x(ex(3),dgx22,Hdgx22) + call rget_half_x(ex(3),dgx23,Hdgx23) + call rget_half_x(ex(3),dgx33,Hdgx33) + call rget_half_x(ex(3),dgy22,Hdgy22) + call rget_half_x(ex(3),dgy23,Hdgy23) + call rget_half_x(ex(3),dgy33,Hdgy33) + call rget_half_x(ex(3),ddgxx01,Hddgxx01) + call rget_half_x(ex(3),ddgxx33,Hddgxx33) + call rget_half_x(ex(3),ddgyy01,Hddgyy01) + call rget_half_x(ex(3),ddgyy22,Hddgyy22) + call rget_half_x(ex(3),ddgxy23,Hddgxy23) + call rget_half_x(ex(3),ddgxy01,Hddgxy01) + call rget_half_x(ex(3),ddgxr02,Hddgxr02) + call rget_half_x(ex(3),ddgxr03,Hddgxr03) + call rget_half_x(ex(3),ddgyr02,Hddgyr02) + call rget_half_x(ex(3),ddgyr03,Hddgyr03) + call rget_half_x(ex(3),ddgxr22,Hddgxr22) + call rget_half_x(ex(3),ddgxr23,Hddgxr23) + call rget_half_x(ex(3),ddgxr33,Hddgxr33) + call rget_half_x(ex(3),ddgyr22,Hddgyr22) + call rget_half_x(ex(3),ddgyr23,Hddgyr23) + call rget_half_x(ex(3),ddgyr33,Hddgyr33) + +#if 0 + Theta220 = Theta22(i,j,1) + Theta230 = Theta23(i,j,1) + Theta330 = Theta33(i,j,1) + + do k=1,ex(3)-2 + RK4 = 0 + call Theta_rhs2(Rmin,R(k),g00(i,j,k),g02(i,j,k),g03(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), & + dg22(k),dg23(k),dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k), & + Theta220,Theta230,Theta330, & + dg01(k),dg02(k),dg03(k), & + dgx01(k),dgx02(k),dgx03(k), & + dgy01(k),dgy02(k),dgy03(k), & + dgx22(k),dgx23(k),dgx33(k), & + dgy22(k),dgy23(k),dgy33(k), & + dg00(k), & + ddgxx01(k), & + ddgxx33(k), & + ddgyy01(k), & + ddgyy22(k), & + ddgxy23(k), & + ddgxy01(k), & + ddgxr02(k),ddgxr03(k), & + ddgyr02(k),ddgyr03(k), & + ddgxr22(k),ddgxr23(k),ddgxr33(k), & + ddgyr22(k),ddgyr23(k),ddgyr33(k), & + Theta22_rhs,Theta23_rhs,Theta33_rhs) + call rungekutta4_scalar(dR,Theta220,Theta22h,Theta22_rhs,RK4) + call rungekutta4_scalar(dR,Theta230,Theta23h,Theta23_rhs,RK4) + call rungekutta4_scalar(dR,Theta330,Theta33h,Theta33_rhs,RK4) + + RK4 = 1 + + call Theta_rhs2(Rmin,R(k)+dR/2,Hg00(k),Hg02(k),Hg03(k),Hg22(k),Hg23(k),Hg33(k), & + Hdg22(k),Hdg23(k),Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),Hg01(k), & + Theta22h,Theta23h,Theta33h, & + Hdg01(k),Hdg02(k),Hdg03(k), & + Hdgx01(k),Hdgx02(k),Hdgx03(k), & + Hdgy01(k),Hdgy02(k),Hdgy03(k), & + Hdgx22(k),Hdgx23(k),Hdgx33(k), & + Hdgy22(k),Hdgy23(k),Hdgy33(k), & + Hdg00(k), & + Hddgxx01(k), & + Hddgxx33(k), & + Hddgyy01(k), & + Hddgyy22(k), & + Hddgxy23(k), & + Hddgxy01(k), & + Hddgxr02(k),Hddgxr03(k), & + Hddgyr02(k),Hddgyr03(k), & + Hddgxr22(k),Hddgxr23(k),Hddgxr33(k), & + Hddgyr22(k),Hddgyr23(k),Hddgyr33(k), & + Theta221,Theta231,Theta331) + + call rungekutta4_scalar(dR,Theta220,Theta221,Theta22_rhs,RK4) + call rungekutta4_scalar(dR,Theta230,Theta231,Theta23_rhs,RK4) + call rungekutta4_scalar(dR,Theta330,Theta331,Theta33_rhs,RK4) + call rswap(Theta22h,Theta221) + call rswap(Theta23h,Theta231) + call rswap(Theta33h,Theta331) + + RK4 = 2 + call Theta_rhs2(Rmin,R(k)+dR/2,Hg00(k),Hg02(k),Hg03(k),Hg22(k),Hg23(k),Hg33(k), & + Hdg22(k),Hdg23(k),Hdg33(k),Hddg22(k),Hddg23(k),Hddg33(k),Hg01(k), & + Theta22h,Theta23h,Theta33h, & + Hdg01(k),Hdg02(k),Hdg03(k), & + Hdgx01(k),Hdgx02(k),Hdgx03(k), & + Hdgy01(k),Hdgy02(k),Hdgy03(k), & + Hdgx22(k),Hdgx23(k),Hdgx33(k), & + Hdgy22(k),Hdgy23(k),Hdgy33(k), & + Hdg00(k), & + Hddgxx01(k), & + Hddgxx33(k), & + Hddgyy01(k), & + Hddgyy22(k), & + Hddgxy23(k), & + Hddgxy01(k), & + Hddgxr02(k),Hddgxr03(k), & + Hddgyr02(k),Hddgyr03(k), & + Hddgxr22(k),Hddgxr23(k),Hddgxr33(k), & + Hddgyr22(k),Hddgyr23(k),Hddgyr33(k), & + Theta221,Theta231,Theta331) + + call rungekutta4_scalar(dR,Theta220,Theta221,Theta22_rhs,RK4) + call rungekutta4_scalar(dR,Theta230,Theta231,Theta23_rhs,RK4) + call rungekutta4_scalar(dR,Theta330,Theta331,Theta33_rhs,RK4) + call rswap(Theta22h,Theta221) + call rswap(Theta23h,Theta231) + call rswap(Theta33h,Theta331) + + RK4 = 3 + call Theta_rhs2(Rmin,R(k+1),g00(i,j,k+1),g02(i,j,k+1),g03(i,j,k+1),g22(i,j,k+1),g23(i,j,k+1),g33(i,j,k+1), & + dg22(k+1),dg23(k+1),dg33(k+1),ddg22(k+1),ddg23(k+1),ddg33(k+1),g01(i,j,k+1), & + Theta22h,Theta23h,Theta33h, & + dg01(k+1),dg02(k+1),dg03(k+1), & + dgx01(k+1),dgx02(k+1),dgx03(k+1), & + dgy01(k+1),dgy02(k+1),dgy03(k+1), & + dgx22(k+1),dgx23(k+1),dgx33(k+1), & + dgy22(k+1),dgy23(k+1),dgy33(k+1), & + dg00(k+1), & + ddgxx01(k+1), & + ddgxx33(k+1), & + ddgyy01(k+1), & + ddgyy22(k+1), & + ddgxy23(k+1), & + ddgxy01(k+1), & + ddgxr02(k+1),ddgxr03(k+1), & + ddgyr02(k+1),ddgyr03(k+1), & + ddgxr22(k+1),ddgxr23(k+1),ddgxr33(k+1), & + ddgyr22(k+1),ddgyr23(k+1),ddgyr33(k+1), & + Theta221,Theta231,Theta331) + + call rungekutta4_scalar(dR,Theta220,Theta221,Theta22_rhs,RK4) + call rungekutta4_scalar(dR,Theta230,Theta231,Theta23_rhs,RK4) + call rungekutta4_scalar(dR,Theta330,Theta331,Theta33_rhs,RK4) + call rswap(Theta220,Theta221) + call rswap(Theta230,Theta231) + call rswap(Theta330,Theta331) + + Theta22(i,j,k+1) = Theta220 + Theta23(i,j,k+1) = Theta230 + Theta33(i,j,k+1) = Theta330 + enddo + + k=ex(3)-1 +! closing step + + call Theta_rhs2(Rmin,R(k),g00(i,j,k),g02(i,j,k),g03(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), & + dg22(k),dg23(k),dg33(k),ddg22(k),ddg23(k),ddg33(k),g01(i,j,k), & + Theta22(i,j,k),Theta23(i,j,k),Theta33(i,j,k), & + dg01(k),dg02(k),dg03(k), & + dgx01(k),dgx02(k),dgx03(k), & + dgy01(k),dgy02(k),dgy03(k), & + dgx22(k),dgx23(k),dgx33(k), & + dgy22(k),dgy23(k),dgy33(k), & + dg00(k), & + ddgxx01(k), & + ddgxx33(k), & + ddgyy01(k), & + ddgyy22(k), & + ddgxy23(k), & + ddgxy01(k), & + ddgxr02(k),ddgxr03(k), & + ddgyr02(k),ddgyr03(k), & + ddgxr22(k),ddgxr23(k),ddgxr33(k), & + ddgyr22(k),ddgyr23(k),ddgyr33(k), & + Theta22_rhs,Theta23_rhs,Theta33_rhs) + + Theta22(i,j,k+1) = Theta22(i,j,k) + Theta22_rhs*dR + Theta23(i,j,k+1) = Theta23(i,j,k) + Theta23_rhs*dR + Theta33(i,j,k+1) = Theta33(i,j,k) + Theta33_rhs*dR + +#endif + enddo + enddo + + gont = 0 + + return + +end function NullEvol_Theta2 +!--------------------------------------------------------------------------------- +subroutine Theta_rhs2(Rmin,r,g00,g02,g03,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01, & + Theta22,Theta23,Theta33, & + dg01,dg02,dg03, & + dgx01,dgx02,dgx03, & + dgy01,dgy02,dgy03, & + dgx22,dgx23,dgx33, & + dgy22,dgy23,dgy33, & + dg00, & + ddgxx01, & + ddgxx33, & + ddgyy01, & + ddgyy22, & + ddgxy23, & + ddgxy01, & + ddgxr02,ddgxr03, & + ddgyr02,ddgyr03, & + ddgxr22,ddgxr23,ddgxr33, & + ddgyr22,ddgyr23,ddgyr33, & + Theta22_rhs,Theta23_rhs,Theta33_rhs) + + implicit none + +!~~~~~~% Input parameters: + real*8,intent(in) :: Rmin,r,g00,g02,g03,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01 + real*8,intent(in) :: Theta22,Theta23,Theta33,dg01,dg02,dg03 + real*8,intent(in) :: dgx01,dgx02,dgx03,dgx22,dgx23,dgx33 + real*8,intent(in) :: dgy01,dgy02,dgy03,dgy22,dgy23,dgy33 + real*8,intent(in) :: dg00 + real*8,intent(out) :: Theta22_rhs,Theta23_rhs,Theta33_rhs + real*8,intent(in) :: ddgxx01 + real*8,intent(in) :: ddgxx33 + real*8,intent(in) :: ddgyy01 + real*8,intent(in) :: ddgyy22 + real*8,intent(in) :: ddgxy23 + real*8,intent(in) :: ddgxy01 + real*8,intent(in) :: ddgxr02,ddgxr03 + real*8,intent(in) :: ddgyr02,ddgyr03 + real*8,intent(in) :: ddgxr22,ddgxr23,ddgxr33,ddgyr22,ddgyr23,ddgyr33 + + real*8 :: t1; + real*8 :: t100; + real*8 :: t1001; + real*8 :: t1009; + real*8 :: t1010; + real*8 :: t1011; + real*8 :: t1015; + real*8 :: t1019; + real*8 :: t1023; + real*8 :: t1037; + real*8 :: t104; + real*8 :: t1041; + real*8 :: t1042; + real*8 :: t1049; + real*8 :: t1065; + real*8 :: t1070; + real*8 :: t1090; + real*8 :: t1094; + real*8 :: t1099; + real*8 :: t11; + real*8 :: t111; + real*8 :: t1113; + real*8 :: t112; + real*8 :: t1123; + real*8 :: t1126; + real*8 :: t1130; + real*8 :: t1134; + real*8 :: t1160; + real*8 :: t1173; + real*8 :: t1174; + real*8 :: t1180; + real*8 :: t12; + real*8 :: t1207; + real*8 :: t1211; + real*8 :: t1218; + real*8 :: t1222; + real*8 :: t1223; + real*8 :: t1226; + real*8 :: t1227; + real*8 :: t1230; + real*8 :: t1231; + real*8 :: t1234; + real*8 :: t1240; + real*8 :: t1242; + real*8 :: t1245; + real*8 :: t1248; + real*8 :: t125; + real*8 :: t1250; + real*8 :: t1254; + real*8 :: t1265; + real*8 :: t1272; + real*8 :: t1277; + real*8 :: t1281; + real*8 :: t1282; + real*8 :: t1287; + real*8 :: t1296; + real*8 :: t13; + real*8 :: t1301; + real*8 :: t1308; + real*8 :: t1311; + real*8 :: t1325; + real*8 :: t1326; + real*8 :: t1330; + real*8 :: t1334; + real*8 :: t1335; + real*8 :: t1338; + real*8 :: t1348; + real*8 :: t1351; + real*8 :: t1354; + real*8 :: t1386; + real*8 :: t1398; + real*8 :: t1411; + real*8 :: t142; + real*8 :: t1426; + real*8 :: t143; + real*8 :: t1432; + real*8 :: t1437; + real*8 :: t144; + real*8 :: t1441; + real*8 :: t1449; + real*8 :: t1475; + real*8 :: t148; + real*8 :: t1483; + real*8 :: t1496; + real*8 :: t1506; + real*8 :: t152; + real*8 :: t1522; + real*8 :: t1523; + real*8 :: t1526; + real*8 :: t1529; + real*8 :: t1532; + real*8 :: t1535; + real*8 :: t1536; + real*8 :: t1539; + real*8 :: t1540; + real*8 :: t1543; + real*8 :: t1547; + real*8 :: t1556; + real*8 :: t1592; + real*8 :: t1598; + real*8 :: t1601; + real*8 :: t1604; + real*8 :: t162; + real*8 :: t1629; + real*8 :: t1636; + real*8 :: t1641; + real*8 :: t1646; + real*8 :: t1647; + real*8 :: t1652; + real*8 :: t1653; + real*8 :: t1654; + real*8 :: t1668; + real*8 :: t1673; + real*8 :: t1674; + real*8 :: t1678; + real*8 :: t1682; + real*8 :: t1686; + real*8 :: t1691; + real*8 :: t1694; + real*8 :: t1695; + real*8 :: t1697; + real*8 :: t17; + real*8 :: t170; + real*8 :: t1700; + real*8 :: t1701; + real*8 :: t1703; + real*8 :: t1706; + real*8 :: t1707; + real*8 :: t1710; + real*8 :: t1711; + real*8 :: t1712; + real*8 :: t1716; + real*8 :: t1717; + real*8 :: t1718; + real*8 :: t1720; + real*8 :: t1727; + real*8 :: t1728; + real*8 :: t1731; + real*8 :: t1733; + real*8 :: t1737; + real*8 :: t1740; + real*8 :: t1744; + real*8 :: t1747; + real*8 :: t1760; + real*8 :: t1764; + real*8 :: t1768; + real*8 :: t177; + real*8 :: t1787; + real*8 :: t18; + real*8 :: t1813; + real*8 :: t1817; + real*8 :: t1820; + real*8 :: t1822; + real*8 :: t1825; + real*8 :: t1828; + real*8 :: t1833; + real*8 :: t1847; + real*8 :: t185; + real*8 :: t1873; + real*8 :: t1876; + real*8 :: t1882; + real*8 :: t1884; + real*8 :: t1887; + real*8 :: t1891; + real*8 :: t1896; + real*8 :: t1897; + real*8 :: t19; + real*8 :: t1901; + real*8 :: t1904; + real*8 :: t1906; + real*8 :: t1909; + real*8 :: t1910; + real*8 :: t1914; + real*8 :: t192; + real*8 :: t1932; + real*8 :: t1934; + real*8 :: t1935; + real*8 :: t1936; + real*8 :: t1939; + real*8 :: t1942; + real*8 :: t1943; + real*8 :: t1946; + real*8 :: t1949; + real*8 :: t197; + real*8 :: t1973; + real*8 :: t198; + real*8 :: t1982; + real*8 :: t199; + real*8 :: t1995; + real*8 :: t1998; + real*8 :: t20; + real*8 :: t201; + real*8 :: t202; + real*8 :: t2035; + real*8 :: t205; + real*8 :: t207; + real*8 :: t211; + real*8 :: t22; + real*8 :: t234; + real*8 :: t249; + real*8 :: t25; + real*8 :: t265; + real*8 :: t266; + real*8 :: t267; + real*8 :: t27; + real*8 :: t270; + real*8 :: t273; + real*8 :: t274; + real*8 :: t277; + real*8 :: t278; + real*8 :: t279; + real*8 :: t285; + real*8 :: t3; + real*8 :: t301; + real*8 :: t304; + real*8 :: t305; + real*8 :: t306; + real*8 :: t31; + real*8 :: t315; + real*8 :: t320; + real*8 :: t321; + real*8 :: t325; + real*8 :: t326; + real*8 :: t327; + real*8 :: t329; + real*8 :: t333; + real*8 :: t336; + real*8 :: t337; + real*8 :: t338; + real*8 :: t339; + real*8 :: t341; + real*8 :: t348; + real*8 :: t35; + real*8 :: t355; + real*8 :: t364; + real*8 :: t365; + real*8 :: t366; + real*8 :: t367; + real*8 :: t368; + real*8 :: t371; + real*8 :: t372; + real*8 :: t373; + real*8 :: t377; + real*8 :: t378; + real*8 :: t382; + real*8 :: t385; + real*8 :: t386; + real*8 :: t387; + real*8 :: t388; + real*8 :: t39; + real*8 :: t392; + real*8 :: t393; + real*8 :: t397; + real*8 :: t4; + real*8 :: t401; + real*8 :: t402; + real*8 :: t406; + real*8 :: t407; + real*8 :: t408; + real*8 :: t411; + real*8 :: t412; + real*8 :: t415; + real*8 :: t416; + real*8 :: t417; + real*8 :: t42; + real*8 :: t420; + real*8 :: t421; + real*8 :: t422; + real*8 :: t426; + real*8 :: t427; + real*8 :: t43; + real*8 :: t430; + real*8 :: t431; + real*8 :: t432; + real*8 :: t435; + real*8 :: t436; + real*8 :: t437; + real*8 :: t440; + real*8 :: t441; + real*8 :: t444; + real*8 :: t448; + real*8 :: t449; + real*8 :: t453; + real*8 :: t454; + real*8 :: t455; + real*8 :: t458; + real*8 :: t461; + real*8 :: t462; + real*8 :: t465; + real*8 :: t466; + real*8 :: t469; + real*8 :: t470; + real*8 :: t473; + real*8 :: t474; + real*8 :: t477; + real*8 :: t479; + real*8 :: t48; + real*8 :: t480; + real*8 :: t483; + real*8 :: t484; + real*8 :: t487; + real*8 :: t488; + real*8 :: t491; + real*8 :: t495; + real*8 :: t496; + real*8 :: t5; + real*8 :: t500; + real*8 :: t501; + real*8 :: t504; + real*8 :: t505; + real*8 :: t508; + real*8 :: t509; + real*8 :: t510; + real*8 :: t516; + real*8 :: t519; + real*8 :: t52; + real*8 :: t522; + real*8 :: t523; + real*8 :: t524; + real*8 :: t525; + real*8 :: t528; + real*8 :: t529; + real*8 :: t532; + real*8 :: t535; + real*8 :: t541; + real*8 :: t549; + real*8 :: t55; + real*8 :: t552; + real*8 :: t553; + real*8 :: t56; + real*8 :: t561; + real*8 :: t564; + real*8 :: t569; + real*8 :: t57; + real*8 :: t572; + real*8 :: t575; + real*8 :: t576; + real*8 :: t577; + real*8 :: t579; + real*8 :: t582; + real*8 :: t586; + real*8 :: t589; + real*8 :: t590; + real*8 :: t591; + real*8 :: t594; + real*8 :: t595; + real*8 :: t6; + real*8 :: t605; + real*8 :: t61; + real*8 :: t610; + real*8 :: t611; + real*8 :: t618; + real*8 :: t622; + real*8 :: t623; + real*8 :: t624; + real*8 :: t627; + real*8 :: t631; + real*8 :: t634; + real*8 :: t638; + real*8 :: t639; + real*8 :: t640; + real*8 :: t643; + real*8 :: t644; + real*8 :: t645; + real*8 :: t648; + real*8 :: t649; + real*8 :: t658; + real*8 :: t659; + real*8 :: t660; + real*8 :: t663; + real*8 :: t664; + real*8 :: t668; + real*8 :: t671; + real*8 :: t686; + real*8 :: t7; + real*8 :: t70; + real*8 :: t706; + real*8 :: t710; + real*8 :: t713; + real*8 :: t717; + real*8 :: t723; + real*8 :: t725; + real*8 :: t728; + real*8 :: t731; + real*8 :: t733; + real*8 :: t738; + real*8 :: t741; + real*8 :: t742; + real*8 :: t746; + real*8 :: t749; + real*8 :: t750; + real*8 :: t751; + real*8 :: t754; + real*8 :: t755; + real*8 :: t758; + real*8 :: t77; + real*8 :: t775; + real*8 :: t780; + real*8 :: t782; + real*8 :: t783; + real*8 :: t786; + real*8 :: t787; + real*8 :: t788; + real*8 :: t792; + real*8 :: t796; + real*8 :: t799; + real*8 :: t800; + real*8 :: t804; + real*8 :: t811; + real*8 :: t812; + real*8 :: t822; + real*8 :: t831; + real*8 :: t832; + real*8 :: t835; + real*8 :: t836; + real*8 :: t837; + real*8 :: t84; + real*8 :: t850; + real*8 :: t855; + real*8 :: t856; + real*8 :: t857; + real*8 :: t860; + real*8 :: t862; + real*8 :: t865; + real*8 :: t871; + real*8 :: t876; + real*8 :: t88; + real*8 :: t880; + real*8 :: t884; + real*8 :: t888; + real*8 :: t889; + real*8 :: t892; + real*8 :: t895; + real*8 :: t898; + real*8 :: t901; + real*8 :: t904; + real*8 :: t92; + real*8 :: t922; + real*8 :: t925; + real*8 :: t928; + real*8 :: t929; + real*8 :: t93; + real*8 :: t932; + real*8 :: t935; + real*8 :: t938; + real*8 :: t956; + real*8 :: t959; + real*8 :: t960; + real*8 :: t963; + real*8 :: t970; + real*8 :: t975; + real*8 :: t979; + real*8 :: t980; + real*8 :: t983; + real*8 :: t985; + real*8 :: t991; + real*8 :: t996; + + real*8 :: t10; + real*8 :: t1006; + real*8 :: t1007; + real*8 :: t1012; + real*8 :: t1030; + real*8 :: t1039; + real*8 :: t1044; + real*8 :: t1067; + real*8 :: t1084; + real*8 :: t1092; + real*8 :: t1100; + real*8 :: t1112; + real*8 :: t1117; + real*8 :: t1121; + real*8 :: t1122; + real*8 :: t1127; + real*8 :: t1131; + real*8 :: t1133; + real*8 :: t1138; + real*8 :: t1141; + real*8 :: t1142; + real*8 :: t1143; + real*8 :: t1144; + real*8 :: t1148; + real*8 :: t1166; + real*8 :: t1177; + real*8 :: t1181; + real*8 :: t1191; + real*8 :: t120; + real*8 :: t1203; + real*8 :: t1204; + real*8 :: t121; + real*8 :: t1212; + real*8 :: t1235; + real*8 :: t1239; + real*8 :: t124; + real*8 :: t1249; + real*8 :: t1252; + real*8 :: t1253; + real*8 :: t1256; + real*8 :: t128; + real*8 :: t1289; + real*8 :: t129; + real*8 :: t1291; + real*8 :: t1293; + real*8 :: t130; + real*8 :: t131; + real*8 :: t1313; + real*8 :: t1314; + real*8 :: t1317; + real*8 :: t132; + real*8 :: t1320; + real*8 :: t1322; + real*8 :: t133; + real*8 :: t1331; + real*8 :: t1332; + real*8 :: t1342; + real*8 :: t1355; + real*8 :: t1357; + real*8 :: t1359; + real*8 :: t136; + real*8 :: t1362; + real*8 :: t1366; + real*8 :: t137; + real*8 :: t1374; + real*8 :: t1379; + real*8 :: t138; + real*8 :: t1380; + real*8 :: t1381; + real*8 :: t1384; + real*8 :: t1385; + real*8 :: t1388; + real*8 :: t139; + real*8 :: t1391; + real*8 :: t1392; + real*8 :: t140; + real*8 :: t1405; + real*8 :: t1406; + real*8 :: t1409; + real*8 :: t1410; + real*8 :: t1413; + real*8 :: t1416; + real*8 :: t1417; + real*8 :: t1419; + real*8 :: t1421; + real*8 :: t1428; + real*8 :: t1434; + real*8 :: t1440; + real*8 :: t1444; + real*8 :: t145; + real*8 :: t1450; + real*8 :: t1454; + real*8 :: t1457; + real*8 :: t1473; + real*8 :: t1476; + real*8 :: t1488; + real*8 :: t1490; + real*8 :: t1501; + real*8 :: t1505; + real*8 :: t1510; + real*8 :: t1516; + real*8 :: t1577; + real*8 :: t1612; + real*8 :: t1615; + real*8 :: t1619; + real*8 :: t1624; + real*8 :: t1625; + real*8 :: t163; + real*8 :: t1634; + real*8 :: t1640; + real*8 :: t1644; + real*8 :: t1648; + real*8 :: t1651; + real*8 :: t1655; + real*8 :: t1660; + real*8 :: t1663; + real*8 :: t1664; + real*8 :: t168; + real*8 :: t1689; + real*8 :: t169; + real*8 :: t1690; + real*8 :: t1693; + real*8 :: t1696; + real*8 :: t1708; + real*8 :: t171; + real*8 :: t1724; + real*8 :: t174; + real*8 :: t1741; + real*8 :: t175; + real*8 :: t1752; + real*8 :: t176; + real*8 :: t1775; + real*8 :: t1783; + real*8 :: t1788; + real*8 :: t1791; + real*8 :: t1795; + real*8 :: t181; + real*8 :: t1823; + real*8 :: t1824; + real*8 :: t183; + real*8 :: t1836; + real*8 :: t1842; + real*8 :: t1852; + real*8 :: t1856; + real*8 :: t1859; + real*8 :: t186; + real*8 :: t1863; + real*8 :: t187; + real*8 :: t1875; + real*8 :: t1878; + real*8 :: t1883; + real*8 :: t189; + real*8 :: t1890; + real*8 :: t191; + real*8 :: t1918; + real*8 :: t1921; + real*8 :: t1927; + real*8 :: t1931; + real*8 :: t194; + real*8 :: t1952; + real*8 :: t196; + real*8 :: t1970; + real*8 :: t200; + real*8 :: t2003; + real*8 :: t2004; + real*8 :: t2008; + real*8 :: t2017; + real*8 :: t2024; + real*8 :: t2032; + real*8 :: t204; + real*8 :: t206; + real*8 :: t2065; + real*8 :: t208; + real*8 :: t2085; + real*8 :: t209; + real*8 :: t2091; + real*8 :: t2093; + real*8 :: t21; + real*8 :: t212; + real*8 :: t2122; + real*8 :: t213; + real*8 :: t2133; + real*8 :: t2138; + real*8 :: t214; + real*8 :: t215; + real*8 :: t2166; + real*8 :: t219; + real*8 :: t2192; + real*8 :: t2201; + real*8 :: t222; + real*8 :: t226; + real*8 :: t23; + real*8 :: t233; + real*8 :: t236; + real*8 :: t237; + real*8 :: t238; + real*8 :: t239; + real*8 :: t24; + real*8 :: t247; + real*8 :: t248; + real*8 :: t251; + real*8 :: t252; + real*8 :: t255; + real*8 :: t258; + real*8 :: t259; + real*8 :: t268; + real*8 :: t28; + real*8 :: t282; + real*8 :: t283; + real*8 :: t287; + real*8 :: t29; + real*8 :: t290; + real*8 :: t293; + real*8 :: t296; + real*8 :: t297; + real*8 :: t298; + real*8 :: t302; + real*8 :: t310; + real*8 :: t311; + real*8 :: t316; + real*8 :: t317; + real*8 :: t32; + real*8 :: t322; + real*8 :: t323; + real*8 :: t324; + real*8 :: t33; + real*8 :: t330; + real*8 :: t34; + real*8 :: t344; + real*8 :: t376; + real*8 :: t384; + real*8 :: t389; + real*8 :: t394; + real*8 :: t399; + real*8 :: t40; + real*8 :: t404; + real*8 :: t41; + real*8 :: t419; + real*8 :: t438; + real*8 :: t439; + real*8 :: t443; + real*8 :: t445; + real*8 :: t450; + real*8 :: t451; + real*8 :: t459; + real*8 :: t46; + real*8 :: t460; + real*8 :: t463; + real*8 :: t464; + real*8 :: t47; + real*8 :: t478; + real*8 :: t482; + real*8 :: t49; + real*8 :: t492; + real*8 :: t50; + real*8 :: t503; + real*8 :: t507; + real*8 :: t511; + real*8 :: t514; + real*8 :: t515; + real*8 :: t517; + real*8 :: t518; + real*8 :: t520; + real*8 :: t533; + real*8 :: t537; + real*8 :: t538; + real*8 :: t54; + real*8 :: t544; + real*8 :: t545; + real*8 :: t548; + real*8 :: t551; + real*8 :: t555; + real*8 :: t556; + real*8 :: t560; + real*8 :: t563; + real*8 :: t566; + real*8 :: t574; + real*8 :: t59; + real*8 :: t597; + real*8 :: t599; + real*8 :: t600; + real*8 :: t603; + real*8 :: t606; + real*8 :: t609; + real*8 :: t614; + real*8 :: t616; + real*8 :: t617; + real*8 :: t620; + real*8 :: t621; + real*8 :: t625; + real*8 :: t63; + real*8 :: t64; + real*8 :: t646; + real*8 :: t655; + real*8 :: t662; + real*8 :: t667; + real*8 :: t672; + real*8 :: t676; + real*8 :: t677; + real*8 :: t68; + real*8 :: t680; + real*8 :: t683; + real*8 :: t696; + real*8 :: t72; + real*8 :: t739; + real*8 :: t740; + real*8 :: t743; + real*8 :: t744; + real*8 :: t745; + real*8 :: t748; + real*8 :: t752; + real*8 :: t756; + real*8 :: t76; + real*8 :: t766; + real*8 :: t769; + real*8 :: t770; + real*8 :: t771; + real*8 :: t774; + real*8 :: t778; + real*8 :: t785; + real*8 :: t789; + real*8 :: t793; + real*8 :: t798; + real*8 :: t8; + real*8 :: t801; + real*8 :: t803; + real*8 :: t806; + real*8 :: t808; + real*8 :: t813; + real*8 :: t816; + real*8 :: t817; + real*8 :: t818; + real*8 :: t823; + real*8 :: t824; + real*8 :: t838; + real*8 :: t842; + real*8 :: t843; + real*8 :: t844; + real*8 :: t849; + real*8 :: t868; + real*8 :: t873; + real*8 :: t874; + real*8 :: t877; + real*8 :: t878; + real*8 :: t881; + real*8 :: t882; + real*8 :: t885; + real*8 :: t89; + real*8 :: t9; + real*8 :: t900; + real*8 :: t902; + real*8 :: t913; + real*8 :: t915; + real*8 :: t919; + real*8 :: t921; + real*8 :: t923; + real*8 :: t941; + real*8 :: t944; + real*8 :: t946; + real*8 :: t949; + real*8 :: t953; + real*8 :: t958; + real*8 :: t96; + real*8 :: t968; + real*8 :: t969; + real*8 :: t973; + real*8 :: t978; + real*8 :: t990; + real*8 :: t995; + real*8 :: t998; + + real*8 :: t1004; + real*8 :: t1005; + real*8 :: t1008; + real*8 :: t1020; + real*8 :: t103; + real*8 :: t105; + real*8 :: t1051; + real*8 :: t1057; + real*8 :: t1064; + real*8 :: t107; + real*8 :: t1072; + real*8 :: t1077; + real*8 :: t108; + real*8 :: t1086; + real*8 :: t1111; + real*8 :: t1115; + real*8 :: t1119; + real*8 :: t1125; + real*8 :: t1128; + real*8 :: t113; + real*8 :: t1136; + real*8 :: t1139; + real*8 :: t1146; + real*8 :: t1149; + real*8 :: t1151; + real*8 :: t1154; + real*8 :: t1158; + real*8 :: t1164; + real*8 :: t1168; + real*8 :: t117; + real*8 :: t1175; + real*8 :: t1185; + real*8 :: t1186; + real*8 :: t1208; + real*8 :: t1216; + real*8 :: t1232; + real*8 :: t1276; + real*8 :: t1284; + real*8 :: t1286; + real*8 :: t1290; + real*8 :: t1295; + real*8 :: t1298; + real*8 :: t1299; + real*8 :: t1302; + real*8 :: t1305; + real*8 :: t1309; + real*8 :: t1323; + real*8 :: t1324; + real*8 :: t1328; + real*8 :: t1333; + real*8 :: t1336; + real*8 :: t1337; + real*8 :: t1340; + real*8 :: t1341; + real*8 :: t1344; + real*8 :: t1365; + real*8 :: t1382; + real*8 :: t1389; + real*8 :: t1390; + real*8 :: t1393; + real*8 :: t1396; + real*8 :: t1397; + real*8 :: t14; + real*8 :: t1400; + real*8 :: t1401; + real*8 :: t1404; + real*8 :: t1408; + real*8 :: t1412; + real*8 :: t1415; + real*8 :: t1418; + real*8 :: t1424; + real*8 :: t1427; + real*8 :: t1430; + real*8 :: t1436; + real*8 :: t1439; + real*8 :: t1442; + real*8 :: t1445; + real*8 :: t1448; + real*8 :: t1453; + real*8 :: t1456; + real*8 :: t1471; + real*8 :: t1477; + real*8 :: t1481; + real*8 :: t1485; + real*8 :: t1487; + real*8 :: t1493; + real*8 :: t15; + real*8 :: t1500; + real*8 :: t1504; + real*8 :: t1507; + real*8 :: t1509; + real*8 :: t151; + real*8 :: t1513; + real*8 :: t1517; + real*8 :: t1521; + real*8 :: t1527; + real*8 :: t1541; + real*8 :: t1550; + real*8 :: t1553; + real*8 :: t1557; + real*8 :: t1558; + real*8 :: t1578; + real*8 :: t1579; + real*8 :: t158; + real*8 :: t1582; + real*8 :: t1583; + real*8 :: t1587; + real*8 :: t1595; + real*8 :: t1600; + real*8 :: t1603; + real*8 :: t1608; + real*8 :: t161; + real*8 :: t1620; + real*8 :: t1626; + real*8 :: t165; + real*8 :: t1656; + real*8 :: t1661; + real*8 :: t1662; + real*8 :: t1665; + real*8 :: t1666; + real*8 :: t1677; + real*8 :: t1681; + real*8 :: t1685; + real*8 :: t1692; + real*8 :: t1721; + real*8 :: t1722; + real*8 :: t1726; + real*8 :: t173; + real*8 :: t1730; + real*8 :: t1743; + real*8 :: t1745; + real*8 :: t1756; + real*8 :: t1761; + real*8 :: t1780; + real*8 :: t1807; + real*8 :: t1812; + real*8 :: t1845; + real*8 :: t1846; + real*8 :: t1854; + real*8 :: t1855; + real*8 :: t1860; + real*8 :: t1864; + real*8 :: t1869; + real*8 :: t188; + real*8 :: t1888; + real*8 :: t1894; + real*8 :: t1944; + real*8 :: t195; + real*8 :: t1956; + real*8 :: t1988; + real*8 :: t1997; + real*8 :: t2038; + real*8 :: t225; + real*8 :: t227; + real*8 :: t228; + real*8 :: t230; + real*8 :: t235; + real*8 :: t240; + real*8 :: t241; + real*8 :: t243; + real*8 :: t246; + real*8 :: t250; + real*8 :: t253; + real*8 :: t254; + real*8 :: t256; + real*8 :: t257; + real*8 :: t260; + real*8 :: t261; + real*8 :: t262; + real*8 :: t263; + real*8 :: t276; + real*8 :: t280; + real*8 :: t284; + real*8 :: t288; + real*8 :: t291; + real*8 :: t292; + real*8 :: t294; + real*8 :: t295; + real*8 :: t299; + real*8 :: t307; + real*8 :: t308; + real*8 :: t312; + real*8 :: t314; + real*8 :: t319; + real*8 :: t328; + real*8 :: t331; + real*8 :: t334; + real*8 :: t345; + real*8 :: t347; + real*8 :: t349; + real*8 :: t352; + real*8 :: t353; + real*8 :: t356; + real*8 :: t357; + real*8 :: t358; + real*8 :: t36; + real*8 :: t363; + real*8 :: t369; + real*8 :: t381; + real*8 :: t403; + real*8 :: t405; + real*8 :: t409; + real*8 :: t410; + real*8 :: t428; + real*8 :: t433; + real*8 :: t442; + real*8 :: t45; + real*8 :: t456; + real*8 :: t481; + real*8 :: t539; + real*8 :: t540; + real*8 :: t570; + real*8 :: t58; + real*8 :: t613; + real*8 :: t615; + real*8 :: t619; + real*8 :: t629; + real*8 :: t630; + real*8 :: t633; + real*8 :: t656; + real*8 :: t669; + real*8 :: t682; + real*8 :: t685; + real*8 :: t732; + real*8 :: t737; + real*8 :: t747; + real*8 :: t764; + real*8 :: t765; + real*8 :: t772; + real*8 :: t776; + real*8 :: t78; + real*8 :: t781; + real*8 :: t79; + real*8 :: t790; + real*8 :: t807; + real*8 :: t809; + real*8 :: t819; + real*8 :: t820; + real*8 :: t821; + real*8 :: t825; + real*8 :: t826; + real*8 :: t829; + real*8 :: t83; + real*8 :: t830; + real*8 :: t833; + real*8 :: t851; + real*8 :: t853; + real*8 :: t859; + real*8 :: t864; + real*8 :: t869; + real*8 :: t87; + real*8 :: t872; + real*8 :: t875; + real*8 :: t883; + real*8 :: t886; + real*8 :: t887; + real*8 :: t891; + real*8 :: t896; + real*8 :: t910; + real*8 :: t911; + real*8 :: t924; + real*8 :: t937; + real*8 :: t940; + real*8 :: t95; + real*8 :: t952; + real*8 :: t961; + real*8 :: t971; + real*8 :: t981; + real*8 :: t988; + real*8 :: t994; + real*8 :: t997; + real*8 :: t999; + + t1 = g01*g01; + t3 = g22*g22; + t4 = g01*t3; + t5 = g33*g33; + t6 = dgx01*dgx01; + t7 = t5*t6; + t11 = g01*g22; + t12 = g23*g23; + t13 = g33*t12; + t17 = t12*t12; + t18 = t1*t17; + t19 = r*r; + t20 = t19*t19; + t22 = ddgxr02*t20*Rmin; + t25 = t19*r; + t27 = ddgxr02*t25*Rmin; + t31 = ddgxr02*t19*Rmin; + t35 = Theta22*t19*Rmin; + t39 = dgx02*t19*Rmin; + t42 = t1*t3; + t43 = t5*ddgxx01; + t48 = Theta22*r*Rmin; + t52 = dgx02*r*Rmin; + t55 = t1*g01; + t56 = t3*t55; + t57 = dgy33*dgx23; + t61 = dgy33*dgy22; + t70 = g33*ddgxy23; + t77 = g33*ddgyy22; + t84 = g33*ddgxx33; + t88 = -4.0*t4*t7*r-4.0*t11*t13*t6+4.0*t18*t22-8.0*t18*t27+4.0*t18*t31+4.0*t18*t35 & + -8.0*t18*t39-4.0*t42*t43*t19-4.0*t18*t48+8.0*t18*t52-2.0*t56*t57*t19 & + +t56*t61*t19+4.0*t56*t57*r-2.0*t56*t61*r+4.0*t56*t70*t19-8.0*t56*t70*r & + -2.0*t56*t77*t19+4.0*t56*t77*r-2.0*t56*t84*t19; + t92 = g22*t55; + t93 = t12*ddgxy23; + t100 = t12*ddgyy22; + t104 = t12*ddgxx33; + t111 = dgy22*dgy22; + t112 = g33*t111; + t125 = g23*dgx33; + t142 = t12*g23; + t143 = t1*t142; + t144 = dgx01*dgx23; + t148 = dgx01*dgy22; + t152 = dgy01*dgx22; + t162 = 4.0*t56*t84*r-4.0*t92*t93*t19+8.0*t92*t93*r-4.0*t92*t100*r+2.0*t92*t104*t19 & + -4.0*t92*t104*r+t92*t112*t19-2.0*t92*t112*r+t92*g33*dgx33*dgx22-2.0*t92*g33*dgy23*dgx22 & + -t92*t125*dgy22+t92*g23*dgy33*dgx22-2.0*t92*t125*dgx23+4.0*t92*g23*dgx23*dgy23 & + -2.0*t92*g23*dgy23*dgy22+4.0*t143*t144*t19-2.0*t143*t148*t19+2.0*t143*t152*t19+8.0*t42*t43*r-8.0*t143*t144*r; + t170 = g33*dgy01; + t177 = t1*g22; + t185 = t12*dgy01; + t192 = t1*g33; + t197 = g01*t17; + t198 = dg02*dg02; + t199 = t20*t19; + t201 = Rmin*Rmin; + t202 = t198*t199*t201; + t205 = t20*r; + t207 = t198*t205*t201; + t211 = t198*t20*t201; + t234 = 4.0*t143*t148*r-4.0*t143*t152*r+4.0*t42*t170*dgx23-2.0*t42*t170*dgy22 & + +2.0*t177*t5*dgx01*dgx22+8.0*t177*t13*ddgxx01-4.0*t177*t185*dgx23+2.0*t177*t185*dgy22 & + -2.0*t192*t12*dgx01*dgx22-2.0*t197*t202+4.0*t197*t207-2.0*t197*t211+2.0*t4*t7*t19 & + +2.0*t92*t100*t19-4.0*t18*ddgxx01*t19+8.0*t18*ddgxx01*r & + -4.0*t42*t43+4.0*t143*t144-2.0*t143*t148+2.0*t143*t152; + t249 = dgx33*dgx33; + t265 = t201*t20; + t266 = t265*t11; + t267 = g03*dg33; + t270 = t267*dg22*g23*g02; + t273 = t201*t199; + t274 = t273*t11; + t277 = g33*g23; + t278 = t11*t277; + t279 = g02*dg02; + t285 = g02*dg22; + t301 = 2.0*t197*t6*t19-4.0*t197*t6*r+2.0*t4*t7+4.0*t56*t70-2.0*t56*t77-2.0*t56*t84+t56*t249*t19 & + -2.0*t56*t249*r-2.0*t56*t57+t56*t61-4.0*t92*t93+2.0*t92*t100+2.0*t92*t104+t92*t112-2.0*t266*t270 & + -2.0*t274*t270-4.0*t278*t279*dg23*t199*t201+4.0*t278*t285*dg03*t199*t201 & + +8.0*t278*t279*dg23*t205*t201-8.0*t278*t285*dg03*t205*t201; + t304 = g02*g03; + t305 = dg22*t20; + t306 = t305*t201; + t315 = dg03*t20; + t320 = dg22*t25; + t321 = t320*t201; + t325 = t205*t201; + t326 = t325*t11; + t327 = g00*dg23; + t329 = t277*t327*dg22; + t333 = t277*t304*ddg22; + t336 = g22*g33; + t337 = t325*t336; + t338 = g23*g02; + t339 = g03*dg01; + t341 = t338*t339*dg22; + t348 = t265*t336; + t355 = t273*t336; + t364 = t273*g22; + t365 = g02*g02; + t366 = t5*t365; + t367 = dg01*dg22; + t368 = t366*t367; + t371 = g03*g03; + t372 = t12*t371; + t373 = t372*t367; + t377 = t12*t365; + t378 = t377*t367; + t382 = t304*t367; + t385 = -20.0*t278*t304*t306-4.0*t278*t279*dg23*t20*t201+4.0*t278*t285*t315*t201+12.0*t278*t304*t321 & + -4.0*t326*t329-8.0*t326*t333+8.0*t337*t341+2.0*t266*t329+4.0*t266*t333-4.0*t348*t341+2.0*t274*t329+4.0*t274*t333 & + -4.0*t355*t341+8.0*t326*t277*t304*dg22+4.0*t326*t270+2.0*t364*t368-2.0*t364*t373-2.0*t273*g33*t378+4.0*t273*t142*t382; + t386 = t177*g33; + t387 = t12*dgx02; + t388 = r*Rmin; + t392 = g23*dgx01; + t393 = dgx23*t19; + t397 = dgy22*t19; + t401 = g23*dgy01; + t402 = dgx22*t19; + t406 = t177*t12; + t407 = g03*dgx23; + t408 = t407*t388; + t411 = g03*dgy22; + t412 = t411*t388; + t415 = t192*t12; + t416 = g02*dgx22; + t417 = t416*t388; + t420 = t4*g33; + t421 = t12*dg00; + t422 = t25*t201; + t426 = t371*dg22; + t427 = t426*t422; + t430 = t4*t12; + t431 = g03*dg03; + t432 = t431*t422; + t435 = t11*t142; + t436 = g02*dg03; + t437 = t436*t422; + t440 = g03*dg02; + t441 = t440*t422; + t444 = t11*t12; + t448 = g01*t142*g02; + t449 = g03*dg22; + t453 = t42*g33; + t454 = t19*Rmin; + t455 = t407*t454; + t458 = t411*t454; + t461 = Theta23*dg23; + t462 = t461*t454; + t465 = dg23*dgy02; + t466 = t465*t454; + t469 = dgx23*dg03; + t470 = t469*t454; + t473 = dgy22*dg03; + t474 = t473*t454; + t477 = -20.0*t386*t387*t388-4.0*t386*t392*t393+2.0*t386*t392*t397-2.0*t386*t401*t402+8.0*t406*t408 & + -8.0*t406*t412+4.0*t415*t417-8.0*t420*t421*t422-10.0*t420*t427 & + +8.0*t430*t432-8.0*t435*t437-8.0*t435*t441+12.0*t444*t427 & + -16.0*t448*t449*t422+12.0*t453*t455-6.0*t453*t458+4.0*t453*t462-4.0*t453*t466-4.0*t453*t470+2.0*t453*t474; + t479 = t177*t5; + t480 = t416*t454; + t483 = dg02*dgx22; + t484 = t483*t454; + t487 = Theta22*dg22; + t488 = t487*t454; + t491 = t12*ddgxr02; + t495 = t11*g33; + t496 = t12*t198; + t500 = dg02*dg23; + t501 = t500*t273; + t504 = dg22*dg03; + t505 = t504*t273; + t508 = t4*t5; + t509 = dg00*dg22; + t510 = t509*t325; + t516 = t500*t325; + t519 = t504*t325; + t522 = t3*g22; + t523 = g01*t522; + t524 = t523*g33; + t525 = t431*t265; + t528 = g00*dg22; + t529 = t528*t265; + t532 = t279*t265; + t535 = t509*t265; + t541 = t426*t265; + t549 = t436*t265; + t552 = 6.0*t479*t480-2.0*t479*t484+2.0*t479*t488-8.0*t386*t491*t454+4.0*t495*t496*t273+4.0*t448*t501 & + -4.0*t448*t505-4.0*t508*t510-8.0*t495*t496*t325-8.0*t448*t516+8.0*t448*t519+8.0*t524*t525-14.0*t508*t529 & + +8.0*t508*t532+2.0*t508*t535+8.0*t420*t421*t265+14.0*t420*t541-8.0*t430*t525+4.0*t495*t496*t265+8.0*t435*t549; + t553 = t440*t265; + t561 = t500*t265; + t564 = t504*t265; + t569 = t528*t422; + t572 = t279*t422; + t575 = Rmin*t25; + t576 = t575*t1; + t577 = t3*g33; + t579 = t577*ddgxr23*g03; + t582 = t454*t1; + t586 = t12*dgx33*t285; + t589 = t12*dg23; + t590 = dgx23*g02; + t591 = t589*t590; + t594 = dgy22*g02; + t595 = t589*t594; + t605 = t12*dg33*t416; + t610 = t325*g01; + t611 = t3*t5; + t618 = 8.0*t435*t553-16.0*t444*t541+24.0*t448*t449*t265+4.0*t448*t561-4.0*t448*t564-8.0*t524*t432 & + +10.0*t508*t569-8.0*t508*t572+8.0*t576*t579-4.0*t582*t579+4.0*t576*t586 & + -8.0*t576*t591+8.0*t576*t595-2.0*t582*t586+4.0*t582*t591 & + -4.0*t582*t595-4.0*t576*t605+2.0*t582*t605+4.0*t610*t611*t528-4.0*t610*t577*t426; + t622 = g22*t5; + t623 = t365*dg22; + t624 = t622*t623; + t627 = g22*t12; + t631 = t13*t623; + t634 = t142*g02; + t638 = t273*g01; + t639 = g00*ddg22; + t640 = t611*t639; + t643 = dg23*dg23; + t644 = g00*t643; + t645 = t577*t644; + t648 = t371*ddg22; + t649 = t577*t648; + t658 = dg22*dg22; + t659 = g00*t658; + t660 = t622*t659; + t663 = t365*ddg22; + t664 = t622*t663; + t668 = t336*t365*t643; + t671 = t12*Theta22; + t686 = -4.0*t610*t624+4.0*t610*t627*t426+4.0*t610*t631-8.0*t610*t634*t449+2.0*t638*t640-2.0*t638*t645-2.0*t638*t649 & + -4.0*t610*t640+4.0*t610*t645+4.0*t610*t649+2.0*t610*t660+4.0*t610*t664 & + -4.0*t610*t668-10.0*t386*t671*t454+20.0*t386*t387*t454 & + -8.0*t406*t455+8.0*t406*t458-4.0*t406*t462+4.0*t406*t466; + t706 = t19*t201; + t710 = t304*t706; + t713 = t12*g00; + t717 = t265*g01; + t723 = t336*t371*t658; + t725 = t627*t644; + t728 = t627*t648; + t731 = t13*t659; + t733 = t13*t663; + t738 = 4.0*t406*t470-2.0*t406*t474-4.0*t415*t480+2.0*t415*t484-2.0*t415*t488-12.0*t453*t408+6.0*t453*t412 & + -6.0*t479*t417+10.0*t386*t671*t388+12.0*t495*t377*t706 & + -24.0*t435*t710-24.0*t420*t713*t706+10.0*t717*t624+2.0*t717*t668 & + +t717*t723+2.0*t717*t725+2.0*t717*t728+t717*t731+2.0*t717*t733-12.0*t717*t631; + t741 = dg23*dg22; + t742 = t142*g00*t741; + t746 = t634*g03*ddg22; + t749 = t265*t3; + t750 = t5*g00; + t751 = t750*t367; + t754 = g33*t371; + t755 = t754*t367; + t758 = t265*g22; + t775 = t273*t3; + t780 = t4*t25; + t782 = g00*dg33; + t783 = t201*t12*t782; + t786 = t177*Rmin; + t787 = t19*t12; + t788 = g02*dgx33; + t792 = r*t12; + t796 = dg33*Theta22; + t799 = t20*t12; + t800 = dg33*dgx02; + t804 = t25*t12; + t811 = -2.0*t717*t742-4.0*t717*t746-2.0*t749*t751+2.0*t749*t755+2.0*t758*t368-2.0*t758*t373 & + -2.0*t265*g33*t378+4.0*t265*t142*t382+2.0*t638*t733-2.0*t638*t742 & + -4.0*t638*t746-2.0*t775*t751+2.0*t775*t755-2.0*t780*t783+4.0*t786*t787*t788 & + -4.0*t786*t792*t788+t786*t787*t796-2.0*t786*t799*t800+4.0*t786*t804*t800-2.0*t786*t787*t800; + t812 = dg22*dgy03; + t822 = Theta33*dg22; + t831 = t201*g33; + t832 = t831*t782; + t835 = t4*t20; + t836 = t365*dg33; + t837 = t831*t836; + t850 = t422*g01; + t855 = t422*t3; + t856 = g00*dg01; + t857 = t13*t856; + t860 = t422*g22; + t862 = t13*t365*dg01; + t865 = t634*t339; + t871 = -2.0*t786*t799*t812+4.0*t786*t804*t812-2.0*t786*t787*t812+t786*t799*t822-2.0*t786*t804*t822+t786*t787*t822 & + -2.0*t523*t20*t832+2.0*t835*t837+2.0*t835*t783-2.0*t610*t723-4.0*t610*t725-4.0*t610*t728-2.0*t610*t731-6.0*t850*t624 & + +8.0*t850*t631+8.0*t855*t857-4.0*t860*t862+8.0*t860*t865-t638*t660-2.0*t638*t664; + t876 = dgx23*r; + t880 = dgy22*r; + t884 = dgx22*r; + t888 = t20*Rmin; + t889 = t461*t888; + t892 = t465*t888; + t895 = t469*t888; + t898 = t473*t888; + t901 = t483*t888; + t904 = t487*t888; + t922 = t461*t575; + t925 = t465*t575; + t928 = 2.0*t638*t668+8.0*t386*t392*t876-4.0*t386*t392*t880+4.0*t386*t401*t884+4.0*t453*t889-4.0*t453*t892 & + -4.0*t453*t895+2.0*t453*t898-2.0*t479*t901+2.0*t479*t904 & + -8.0*t386*t491*t888-4.0*t406*t889+4.0*t406*t892+4.0*t406*t895 & + -2.0*t406*t898+2.0*t415*t901-2.0*t415*t904-8.0*t453*t922+8.0*t453*t925; + t929 = t469*t575; + t932 = t473*t575; + t935 = t483*t575; + t938 = t487*t575; + t956 = t509*t273; + t959 = t3*dg33; + t960 = t959*t407; + t963 = t959*t411; + t970 = t577*ddgyr22*g03; + t975 = t888*t1; + t979 = dg33*dg22; + t980 = t3*t371*t979; + t983 = 8.0*t453*t929-4.0*t453*t932+4.0*t479*t935-4.0*t479*t938+16.0*t386*t491*t575+8.0*t406*t922-8.0*t406*t925 & + -8.0*t406*t929+4.0*t406*t932-4.0*t415*t935+4.0*t415*t938+2.0*t508*t956-4.0*t576*t960+2.0*t576*t963+2.0*t582*t960 & + -t582*t963-8.0*t576*t970+4.0*t582*t970+2.0*t975*t605-2.0*t610*t980; + t985 = t377*t979; + t991 = t627*t836; + t996 = t3*g23*t371*dg23; + t1001 = t201*t142*t327; + t1009 = t42*Rmin; + t1010 = r*g23; + t1011 = g02*dgy33; + t1015 = t20*g33; + t1019 = t25*g33; + t1023 = t19*g33; + t1037 = g02*dgy23; + t1041 = t19*g23; + t1042 = g03*dgx33; + t1049 = -4.0*t610*t985+t717*t980+2.0*t717*t985+4.0*t850*t991-4.0*t850*t996+4.0*t11*t25*t1001+t786*t799*t796 & + -2.0*t786*t804*t796+2.0*t1009*t1010*t1011+2.0*t1009*t1015*t812 & + -4.0*t1009*t1019*t812+2.0*t1009*t1023*t812-t1009*t1015*t822 & + +2.0*t1009*t1019*t822-t1009*t1023*t822-2.0*t1009*t1023*t788 & + +4.0*t1009*t1023*t1037-2.0*t1009*t1041*t1042+t638*t723+2.0*t638*t725; + t1065 = t325*t3; + t1070 = t325*g22; + t1090 = g03*dgy23; + t1094 = 2.0*t638*t728+t638*t731-8.0*t749*t857+4.0*t758*t862-8.0*t758*t865-4.0*t610*t733 & + +4.0*t610*t742+8.0*t610*t746+4.0*t1065*t751 & + -4.0*t1065*t755-4.0*t1070*t368+4.0*t1070*t373+4.0*t325*g33*t378 & + -8.0*t325*t142*t382+2.0*t717*t640-2.0*t717*t645-2.0*t717*t649 & + -t717*t660-2.0*t717*t664-4.0*t1009*t1041*t1090; + t1099 = r*g33; + t1113 = dgy33*dg22; + t1123 = t19*g03; + t1126 = g23*Theta23; + t1130 = g23*dgx03; + t1134 = g23*dgy02; + t1160 = 2.0*t1009*t1099*t788-4.0*t1009*t1099*t1037+2.0*t1009*t1010*t1042 & + +4.0*t1009*t1010*t1090-t1009*t20*g03*t1113+2.0*t1009*t25*g03*t1113 & + -2.0*t1009*t1041*t1011-t1009*t1123*t1113-4.0*t1009*t1023*t1126+4.0*t1009*t1023*t1130+4.0*t1009*t1023*t1134 & + +2.0*t1009*t1019*t796-t1009*t1023*t796+2.0*t1009*t1015*t800 & + -4.0*t1009*t1019*t800+2.0*t1009*t1023*t800-t1009*t1015*t796+4.0*t1009*t1099*t1126-4.0*t1009*t1099*t1130; + t1173 = g22*g03; + t1174 = t12*ddgyr22*t1173; + t1180 = t12*ddgxr23*t1173; + t1207 = -4.0*t1009*t1099*t1134+2.0*t523*t25*t832-2.0*t780*t837-4.0*t11*t20*t1001 & + +8.0*t576*t1174-4.0*t582*t1174-8.0*t576*t1180+4.0*t582*t1180-4.0*t975*t1174+4.0*t975*t1180+t638*t980 & + +2.0*t638*t985-4.0*t717*t991+4.0*t717*t996+2.0*t975*t960-t975*t963 & + +4.0*t975*t970-4.0*t975*t579-2.0*t975*t586+4.0*t975*t591; + t1211 = t143*g02; + t1218 = t143*g03; + t1222 = dgy01*dgx23; + t1223 = t1222*r; + t1226 = dgy01*dgy22; + t1227 = t1226*r; + t1230 = dgx01*dgx22; + t1231 = t1230*r; + t1234 = t12*ddgxx01; + t1240 = t11*t17; + t1242 = dg00*t25*t201; + t1245 = t197*g00; + t1248 = t523*t5; + t1250 = g00*t19*t201; + t1254 = t371*t19*t201; + t1265 = t12*t6; + t1272 = t143*dg02; + t1277 = t143*Theta23; + t1281 = -4.0*t975*t595-8.0*t1211*t876*Rmin+4.0*t1211*t880*Rmin-4.0*t1218*t884*Rmin & + -8.0*t453*t1223+4.0*t453*t1227-4.0*t479*t1231-16.0*t386*t1234*r+8.0*t406*t1223+4.0*t1240*t1242 & + +8.0*t1245*t321+12.0*t1248*t1250-12.0*t524*t1254-12.0*t508*t365*t19*t201 & + +12.0*t430*t1254+12.0*t1240*t1250-4.0*t495*t1265*t19+8.0*t495*t1265*r-4.0*t1272*dgy22*t25*Rmin-4.0*t1277*t320*Rmin; + t1282 = t143*dg23; + t1287 = t143*dg22; + t1296 = t143*dgx22; + t1301 = t42*t5; + t1308 = t393*Rmin; + t1311 = t397*Rmin; + t1325 = t92*g23; + t1326 = dgx23*dgy23; + t1330 = dgy23*dgy22; + t1334 = t92*g33; + t1335 = dgx33*dgx22; + t1338 = dgy23*dgx22; + t1348 = dgx33*dgy22; + t1351 = -4.0*t1282*Theta22*t25*Rmin-4.0*t1287*dgx03*t25*Rmin+4.0*t1287*dgy02*t25*Rmin & + +4.0*t1296*dg03*t25*Rmin+4.0*t1301*t31+6.0*t1301*t35-12.0*t1301*t39+8.0*t1211*t1308 & + -4.0*t1211*t1311+4.0*t1218*t402*Rmin-4.0*t1272*t1308 & + +2.0*t1272*t1311+2.0*t1277*dg22*t19*Rmin-8.0*t1325*t1326*r+4.0*t1325*t1330*r+t1334*t1335*t19 & + -2.0*t1334*t1338*t19-2.0*t1334*t1335*r+4.0*t1334*t1338*r-t1325*t1348*t19; + t1354 = dgy33*dgx22; + t1386 = t197*dg00; + t1398 = dg00*t20*t201; + t1411 = t1325*t1354*t19+2.0*t1325*t1348*r-2.0*t1325*t1354*r+2.0*t1282*Theta22*t20*Rmin & + +2.0*t1287*dgx03*t20*Rmin-2.0*t1287*dgy02*t20*Rmin-2.0*t1296*t315*Rmin-8.0*t1301*t27 & + +8.0*t1272*dgx23*t25*Rmin-2.0*t508*t202+2.0*t1386*dg22*t199*t201+4.0*t508*t207-4.0*t1386*dg22*t205*t201 & + -4.0*t1248*t1398-2.0*t508*t211-4.0*t1240*t1398-12.0*t1245*t306+2.0*t1386*t306+4.0*t1248*t1242; + t1426 = t142*ddgyr22*g02; + t1432 = t142*ddgxr23*g02; + t1437 = t377*t643; + t1441 = t522*t371*dg33; + t1449 = t522*t1*Rmin; + t1475 = 4.0*t1301*t22-4.0*t1272*dgx23*t20*Rmin+2.0*t1272*dgy22*t20*Rmin+2.0*t1277*t305*Rmin & + -8.0*t576*t1426+4.0*t582*t1426+8.0*t576*t1432-4.0*t582*t1432-2.0*t638*t1437-2.0*t717*t1441 & + +4.0*t975*t1426-4.0*t975*t1432+2.0*t1449*t1123*dgy33 & + -2.0*t1449*r*g03*dgy33-4.0*t1449*t1023*dgy03+4.0*t1009*t787*dgy03 & + +2.0*t1449*t1023*Theta33-2.0*t1009*t787*Theta33+4.0*t1449*t1099*dgy03-4.0*t1009*t792*dgy03; + t1483 = dgx33*dgx23; + t1496 = r*t142; + t1506 = t19*t142; + t1522 = t422*t522; + t1523 = t750*dg01; + t1526 = t754*dg01; + t1529 = t366*dg01; + t1532 = t372*dg01; + t1535 = t17*g00; + t1536 = t1535*dg01; + t1539 = -2.0*t1449*t1099*Theta33+2.0*t1009*t792*Theta33+4.0*t1325*t1483*r-2.0*t1325*t1483*t19+4.0*t1325*t1326*t19 & + -2.0*t1325*t1330*t19-4.0*t786*t1496*Theta23+4.0*t786*t1496*dgx03+4.0*t786*t1496*dgy02+4.0*t786*t1506*Theta23 & + -4.0*t786*t1506*dgx03-4.0*t786*t1506*dgy02+4.0*t610*t1437-2.0*t717*t1437+2.0*t850*t1441 & + -4.0*t1522*t1523+4.0*t1522*t1526+4.0*t855*t1529-4.0*t855*t1532-4.0*t860*t1536; + t1540 = t366*t658; + t1543 = t1535*ddg22; + t1547 = t856*dg22; + t1556 = t265*t522; + t1592 = -2.0*t610*t1540-4.0*t610*t1543+4.0*t325*t17*t1547+t717*t1540+2.0*t717*t1543 & + -2.0*t265*t17*t1547+4.0*t1556*t1523-4.0*t1556*t1526-4.0*t749*t1529+4.0*t749*t1532 & + +4.0*t758*t1536+t638*t1540+2.0*t638*t1543-2.0*t273*t17*t1547 & + +4.0*t610*t1535*dg22+2.0*t1282*t35+2.0*t1287*dgx03*t19*Rmin & + -2.0*t1287*dgy02*t19*Rmin-2.0*t1296*dg03*t19*Rmin-6.0*t1301*t48; + t1598 = t1222*t19; + t1601 = t1226*t19; + t1604 = t1230*t19; + t1629 = t11*t13; + t1636 = t365*dg23; + t1641 = t11*t12*g03; + t1646 = 12.0*t1301*t52+4.0*t453*t1598-2.0*t453*t1601+2.0*t479*t1604+8.0*t386*t1234*t19-4.0*t406*t1598 & + +2.0*t406*t1601-2.0*t415*t1604-4.0*t406*t1227+4.0*t415*t1231-4.0*t386*t392*dgx23 & + +2.0*t386*t392*dgy22-2.0*t386*t401*dgx22 & + +26.0*t1629*t529-8.0*t1629*t532-4.0*t1629*t535+4.0*t278*t1636*t265-4.0*t1641*t561+4.0*t1641*t564; + t1647 = t4*t277; + t1652 = g33*g02; + t1653 = t4*t1652; + t1654 = g03*dg23; + t1668 = t4*g33*g03; + t1673 = t177*t277; + t1674 = g03*dgx22; + t1678 = dg02*dgx23; + t1682 = dg02*dgy22; + t1686 = Theta23*dg22; + t1691 = g23*t371*t741; + t1694 = g01*g33; + t1695 = t325*t1694; + t1697 = g23*t365*t741; + t1700 = t1*g23; + t1701 = t454*t1700; + t1703 = dg23*dgx23*t1173; + t1706 = dg23*dgy22; + t1707 = t1706*t1173; + t1710 = t575*t1700; + t1711 = dg33*dgx22; + t1712 = t1711*t1173; + t1716 = t888*t1700; + t1717 = dgx33*dg22; + t1718 = t1717*t1173; + t1720 = 8.0*t1647*t437+8.0*t1647*t441+8.0*t1653*t1654*t422-18.0*t1629*t569+8.0*t1629*t572 & + -4.0*t278*t1636*t422+24.0*t1647*t710+4.0*t1668*t501 & + -4.0*t1668*t505+6.0*t1673*t1674*t388+4.0*t1673*t1678*t888-2.0*t1673*t1682*t888 & + -2.0*t1673*t1686*t888+4.0*t326*t1691+4.0*t1695*t1697-4.0*t1701*t1703 & + +2.0*t1701*t1707+2.0*t1710*t1712-t1701*t1712+t1716*t1718; + t1727 = t265*t4; + t1728 = t338*t267; + t1731 = t888*t177; + t1733 = dg33*dgx23*t338; + t1737 = dg33*dgy22*t338; + t1740 = g33*ddgyr22*t338; + t1744 = g33*ddgxr23*t338; + t1747 = dgx22*dg03; + t1760 = dg23*Theta22; + t1764 = dg22*dgx03; + t1768 = dg22*dgy02; + t1787 = -4.0*t1716*t1703+2.0*t1716*t1707-t1716*t1712+4.0*t1727*t1728-2.0*t1731*t1733+t1731*t1737 & + -4.0*t1731*t1740+4.0*t1731*t1744+2.0*t1673*t1747*t888-8.0*t1673*t1678*t575 & + +4.0*t1673*t1682*t575+4.0*t1673*t1686*t575+4.0*t1673*t1760*t575 & + +4.0*t1673*t1764*t575-4.0*t1673*t1768*t575-4.0*t1673*t1747*t575-12.0*t1673*t590*t454 & + +2.0*t1673*t594*t454-6.0*t1673*t1674*t454+4.0*t1673*t1678*t454; + t1813 = t338*t339; + t1817 = t338*g03*t658; + t1820 = g01*t12; + t1822 = t304*t741; + t1825 = t713*t367; + t1828 = t13*t639; + t1833 = t265*t1694; + t1847 = -2.0*t1673*t1682*t454-2.0*t1673*t1686*t454-2.0*t1673*t1760*t454-2.0*t1673*t1764*t454 & + +2.0*t1673*t1768*t454+2.0*t1673*t1747*t454+12.0*t1673*t590*t388-2.0*t1673*t594*t388 & + -8.0*t422*t577*t1813+4.0*t1695*t1817-8.0*t325*t1820*t1822 & + -8.0*t337*t1825-4.0*t266*t1828-2.0*t266*t1691-2.0*t1833*t1697-2.0*t1833*t1817 & + +4.0*t265*t1820*t1822+4.0*t348*t1825-4.0*t1629*t956-4.0*t1641*t501; + t1873 = t713*t979; + t1876 = g33*t365*t979; + t1882 = t1652*t1711; + t1884 = t177*t575; + t1887 = t177*t454; + t1891 = g33*g00*t979; + t1896 = 4.0*t1641*t505-8.0*t1668*t516+8.0*t1668*t519+8.0*t1629*t510+8.0*t1641*t516-8.0*t1641*t519-8.0*t1647*t549 & + -8.0*t1647*t553-8.0*t1653*t1654*t265+4.0*t1668*t561-4.0*t1668*t564-t274*t1873 & + +2.0*t326*t1876+2.0*t326*t1873-t266*t1876 & + -t1731*t1882+2.0*t1884*t1882-t1887*t1882+t4*t273*t1891-2.0*t4*t325*t1891; + t1897 = t277*t327; + t1901 = t4*t422; + t1904 = t1652*t1717; + t1906 = t1652*t1706; + t1909 = dgy23*dg22; + t1910 = t1652*t1909; + t1914 = g23*g03*t1909; + t1932 = t338*t1113; + t1934 = t888*t192; + t1935 = dg23*dgx22; + t1936 = t1935*t1173; + t1939 = t1935*t338; + t1942 = dg22*dgy22; + t1943 = t1942*t1173; + t1946 = t1942*t338; + t1949 = 4.0*t1727*t1897+t1727*t1891-4.0*t1901*t1897+t1731*t1904+2.0*t1731*t1906 & + -2.0*t1731*t1910+2.0*t1731*t1914-2.0*t1884*t1904-4.0*t1884*t1906 & + +4.0*t1884*t1910-4.0*t1884*t1914+t1887*t1904+2.0*t1887*t1906-2.0*t1887*t1910 & + +2.0*t1887*t1914+t1731*t1932+2.0*t1934*t1936-2.0*t1934*t1939-2.0*t1934*t1943+2.0*t1934*t1946; + t1973 = t575*t192; + t1982 = t454*t192; + t1995 = -4.0*t1901*t1728+4.0*t1884*t1733-2.0*t1884*t1737-2.0*t1887*t1733+t1887*t1737 & + +8.0*t1884*t1740-4.0*t1887*t1740-2.0*t1673*t1760*t888-2.0*t1673*t1764*t888 & + +2.0*t1673*t1768*t888-4.0*t1973*t1936+4.0*t1973*t1939+4.0*t1973*t1943-4.0*t1973*t1946 & + +2.0*t1982*t1936-2.0*t1982*t1939-2.0*t1982*t1943-t266*t1873+8.0*t265*t577*t1813-4.0*t274*t1828; + t1998 = t273*t1694; + t2035 = -2.0*t274*t1691-2.0*t1998*t1697+2.0*t1982*t1946-2.0*t1710*t1718+8.0*t1710*t1703 & + -4.0*t1710*t1707+t1701*t1718-8.0*t1884*t1744+4.0*t1887*t1744 & + -2.0*t1998*t1817+4.0*t273*t1820*t1822+4.0*t355*t1825-8.0*t326*t13*t528+8.0*t326*t1828 & + -2.0*t1884*t1932+t1887*t1932-t274*t1876+2.0*t197*t6-4.0*t18*ddgxx01+t56*t249; + Theta22_rhs = 1/t1*(t811+t738+t686+t618+t552+t477+t1720+t1646+t1592+t1539+t1475+t2035 & + +t385+t1995+t1411+t1351+t1281+t301+t1207+t1160+t1949+t1094+t1049+t983+t928 & + +t871+t1896+t1847+t1787+t234+t162+t88) & + /(-2.0*t627*g33-2.0*t17*r-2.0*t611*r+t17*t19+t611*t19-2.0*t627*t1023+4.0*t627*t1099+t17+t611)/Rmin/t19/4.0; + + t1 = g01*g01; + t3 = g23*g23; + t4 = t3*t3; + t5 = t1*t4; + t8 = t3*g23; + t9 = t1*g01; + t10 = t8*t9; + t17 = g01*g22; + t18 = t3*g33; + t19 = t17*t18; + t20 = dg00*dg23; + t21 = r*r; + t22 = t21*t21; + t23 = Rmin*Rmin; + t24 = t22*t23; + t25 = t20*t24; + t28 = dg02*dg03; + t29 = t28*t24; + t32 = g33*g23; + t33 = t17*t32; + t34 = g03*g03; + t35 = t34*dg22; + t39 = g01*g33; + t40 = t3*g02; + t41 = t39*t40; + t42 = g03*dg22; + t46 = t1*g22; + t47 = t46*t32; + t48 = dg23*dgx03; + t49 = t21*r; + t50 = t49*Rmin; + t54 = dg23*dgy02; + t59 = dgy22*dg03; + t63 = g02*dgx33; + t64 = t21*Rmin; + t68 = g03*dgy22; + t72 = dg02*dgx33; + t76 = Theta33*dg22; + t89 = r*Rmin; + t96 = t22*Rmin; + t100 = -2.0*t47*t48*t64-4.0*t47*t59*t50-2.0*t47*t54*t64+2.0*t47*t59*t64 & + -6.0*t47*t63*t64+6.0*t47*t63*t89-6.0*t47*t68*t64+2.0*t47*t72*t64-2.0*t47*t76*t64+6.0*t47*t68*t89+2.0*t47*t72*t96; + t120 = dg02*dg23; + t121 = t120*t24; + t124 = dg22*dg03; + t125 = t124*t24; + t128 = g22*g22; + t129 = g01*t128; + t130 = t129*t32; + t131 = g03*dg03; + t132 = t49*t23; + t133 = t131*t132; + t136 = g33*g33; + t137 = t136*g23; + t138 = t17*t137; + t139 = g02*dg02; + t140 = t139*t132; + t144 = g00*dg23; + t145 = t144*t132; + t148 = g02*dg03; + t152 = g03*dg02; + t162 = g02*g03; + t163 = t21*t23; + t168 = t17*t136*g02; + t169 = t22*t21; + t170 = t169*t23; + t171 = t120*t170; + t174 = t24*t17; + t175 = g33*ddg23; + t176 = g00*t3; + t177 = t175*t176; + t181 = dg33*dg23; + t183 = t181*g00*g33; + t185 = g02*g02; + t186 = t185*g33; + t187 = t181*t186; + t189 = t181*t176; + t191 = -20.0*t19*t145+8.0*t19*t148*t132+8.0*t19*t152*t132-2.0*t33*t35*t132-4.0*t41*t42*t132 & + +24.0*t19*t162*t163-2.0*t168*t171-4.0*t174*t177-t24*t129*t183+t174*t187+t174*t189; + t194 = g01*t136; + t196 = dg23*dg22; + t197 = g00*g22; + t198 = t196*t197; + t200 = t24*t39; + t201 = t34*g22; + t202 = t196*t201; + t204 = t196*t176; + t206 = g01*t3; + t208 = dg33*dg22; + t209 = t208*t162; + t212 = g22*g33; + t213 = t24*t212; + t214 = dg01*dg23; + t215 = t214*t176; + t219 = t3*dg01*t162; + t222 = t170*t17; + t226 = t170*t39; + t233 = t170*t212; + t236 = t22*r; + t237 = t236*t23; + t238 = t237*t17; + t239 = g33*dg23; + t247 = t1*t128; + t248 = t136*ddgxy01; + t251 = t1*t8; + t252 = dgx01*dgx33; + t255 = dgy01*dgy22; + t258 = g01*t4; + t259 = dgx01*dgy01; + t268 = 2.0*t170*t206*t209+4.0*t233*t215-8.0*t238*t239*t176-4.0*t222*t177 & + -t170*t129*t183-4.0*t247*t248+2.0*t251*t252+2.0*t251*t255+2.0*t258*t259-4.0*t10*ddgxy23*t21+8.0*t10*ddgxy23*r; + t282 = t3*t9; + t283 = dgx33*dgy22; + t285 = dgy33*dgx22; + t287 = dgx33*dgx23; + t290 = dgx23*dgy23; + t293 = dgy23*dgy22; + t296 = g23*t9; + t297 = dgy22*dgy22; + t298 = g33*t297; + t301 = dgx33*dgx33; + t302 = g22*t301; + t310 = dg33*t22; + t311 = t310*t23; + t315 = g02*dg23; + t316 = dg03*t22; + t317 = t316*t23; + t321 = t237*t212; + t322 = g23*g02; + t323 = t322*g03; + t324 = t214*t323; + t327 = t175*t323; + t330 = t181*t323; + t333 = t196*t323; + t336 = g01*g23; + t337 = t24*t336; + t339 = t208*t197*g33; + t344 = t296*t302-4.0*t5*ddgxy01*t21+8.0*t5*ddgxy01*r-2.0*t33*t139*t311+2.0*t33*t315*t317 & + +8.0*t321*t324+4.0*t174*t327-2.0*t174*t330-2.0*t200*t333+2.0*t337*t339-4.0*t213*t324; + t366 = t237*t39; + t373 = g03*dg33; + t376 = t373*dg22*g33*g02; + t384 = dg23*t169*t23; + t389 = dg03*t169*t23; + t394 = dg23*t236*t23; + t399 = dg03*t236*t23; + t404 = dg23*t22*t23; + t415 = dg23*t49*t23; + t419 = -2.0*t33*t42*t317-2.0*t33*t42*t389+4.0*t33*t42*t399+2.0*t33*t152*t384-4.0*t33*t152*t394 & + +2.0*t33*t152*t404-32.0*t33*t162*t404+24.0*t33*t162*t415-2.0*t174*t376-2.0*t222*t376+4.0*t238*t376; + t437 = g01*t8; + t438 = t437*g02; + t439 = dg23*dg03; + t440 = t439*t237; + t443 = t129*g33; + t444 = t34*dg23; + t445 = t444*t24; + t448 = t1*g33; + t449 = t448*t3; + t450 = dg22*dgy02; + t451 = t450*t64; + t453 = t247*g33; + t454 = g03*dgx33; + t455 = t454*t89; + t458 = t46*t136; + t459 = dgy22*g02; + t460 = t459*t89; + t463 = t46*g33; + t464 = t3*Theta23; + t469 = t3*dgx03; + t473 = t3*dgy02; + t477 = g23*dgx01; + t478 = dgx33*t21; + t482 = g23*dgy01; + t483 = dgy22*t21; + t487 = t46*t3; + t492 = dgx33*r; + t496 = dgy22*r; + t500 = Theta33*dg23; + t501 = t500*t96; + t503 = dgx33*dg03; + t504 = t503*t96; + t507 = dg02*dgy22; + t508 = t507*t96; + t511 = -12.0*t463*t469*t89-12.0*t463*t473*t89-2.0*t463*t477*t478-2.0*t463*t482*t483 & + +6.0*t487*t455+6.0*t449*t460+4.0*t463*t477*t492+4.0*t463*t482*t496+t453*t501-2.0*t453*t504-2.0*t458*t508; + t514 = Theta23*dg22; + t515 = t514*t96; + t517 = dg22*dgx03; + t518 = t517*t96; + t520 = t450*t96; + t522 = t3*ddgxr03; + t533 = t454*t64; + t537 = t129*t136; + t538 = t20*t237; + t541 = t28*t237; + t544 = t437*g03; + t545 = t120*t237; + t548 = t124*t237; + t551 = g23*dg00; + t555 = dg33*Theta23; + t556 = t555*t50; + t560 = t500*t50; + t563 = t503*t50; + t566 = t507*t50; + t569 = t514*t50; + t572 = -4.0*t537*t538+4.0*t537*t541+4.0*t544*t545-4.0*t544*t548-4.0*t537*t551*t24-2.0*t453*t556 & + -t449*t520-2.0*t453*t560+4.0*t453*t563+4.0*t458*t566-2.0*t458*t569; + t574 = t517*t50; + t577 = t450*t50; + t597 = t500*t64; + t599 = 8.0*t463*t522*t50-4.0*t449*t566+2.0*t449*t569-2.0*t449*t574+2.0*t449*t577+4.0*t453*t533+t453*t597 & + +2.0*t458*t574-2.0*t458*t577+2.0*t487*t560-4.0*t487*t563; + t600 = t503*t64; + t603 = t459*t64; + t606 = t507*t64; + t609 = t514*t64; + t611 = t517*t64; + t614 = t24*g01; + t616 = g00*dg22; + t617 = t8*dg33*t616; + t620 = dg23*dg23; + t621 = g23*t620; + t622 = t621*t201; + t625 = t621*t186; + t634 = -2.0*t453*t600+4.0*t458*t603-2.0*t458*t606+t458*t609-t458*t611+t458*t451 & + -2.0*t614*t617-2.0*t614*t622-2.0*t614*t625-4.0*t463*t522*t64-12.0*t463*t464*t64; + t645 = t17*g33; + t646 = t3*dgx01; + t655 = t144*t24; + t662 = t17*t136; + t663 = t185*dg23; + t664 = t663*t24; + t667 = t8*dg00; + t671 = t17*t8; + t672 = t131*t24; + t676 = t39*t8; + t677 = t139*t24; + t680 = t39*t3; + t683 = g03*dg23; + t696 = t663*t132; + t706 = -8.0*t676*t677-8.0*t680*t664+24.0*t438*t683*t24-2.0*t544*t121+2.0*t544*t125+4.0*t537*t551*t132 & + +8.0*t537*t145-8.0*t662*t696-8.0*t645*t667*t132+8.0*t671*t133+8.0*t676*t140; + t738 = t237*g01; + t739 = t128*dg33; + t740 = t739*t444; + t743 = t136*dg23; + t744 = dg22*t185; + t745 = t743*t744; + t748 = t3*ddg23; + t749 = t748*t201; + t752 = t748*t186; + t756 = t8*ddg23*t162; + t766 = t3*t620*t162; + t769 = t237*t128; + t770 = t136*dg01; + t771 = t770*t144; + t774 = -t449*t609+4.0*t738*t617+4.0*t738*t622+4.0*t738*t625-2.0*t738*t740-2.0*t738*t745 & + -4.0*t738*t749-4.0*t738*t752+8.0*t738*t756-4.0*t738*t766+4.0*t769*t771; + t778 = g33*dg01*t444; + t782 = t770*t663; + t785 = t237*t3; + t786 = t214*t201; + t789 = t214*t186; + t793 = t214*t162; + t796 = t128*t136; + t798 = t796*ddg23*g00; + t801 = t128*g33; + t803 = t801*ddg23*t34; + t806 = g22*t136; + t808 = t806*ddg23*t185; + t811 = t24*t128; + t812 = dg01*t34; + t813 = t32*t812; + t816 = t24*g22; + t817 = dg01*t185; + t818 = t137*t817; + t823 = g00*dg01; + t824 = g33*t8*t823; + t831 = dg02*dg33; + t832 = t831*t170; + t835 = t439*t170; + t838 = t831*t237; + t842 = t3*t1*Rmin; + t843 = r*g33; + t844 = dgx23*g02; + t849 = dgy23*dg22; + t857 = t17*t3; + t860 = -8.0*t816*t824+t614*t740+t614*t745+2.0*t614*t749+2.0*t438*t832-2.0*t438*t835 & + -4.0*t438*t838+4.0*t842*t843*t844+2.0*t842*t22*g03*t849-4.0*t842*t49*g03*t849-8.0*t857*t445; + t862 = t831*t24; + t865 = t439*t24; + t868 = t444*t132; + t873 = dg33*dgx03; + t874 = t873*t50; + t877 = dg33*dgy02; + t878 = t877*t50; + t881 = dg23*Theta22; + t882 = t881*t50; + t885 = t3*ddgyr02; + t895 = 2.0*t438*t862-2.0*t438*t865-8.0*t443*t868+4.0*t857*t868-2.0*t453*t874+2.0*t453*t878-2.0*t458*t882 & + +8.0*t463*t885*t50+2.0*t487*t556+2.0*t487*t874-2.0*t487*t878; + t898 = t555*t64; + t900 = t873*t64; + t902 = t877*t64; + t904 = t881*t64; + t913 = t555*t96; + t915 = -4.0*t463*t885*t64+2.0*t449*t882-t449*t904+t453*t898+t453*t900-t453*t902 & + +t453*t913+t458*t904-t487*t898-t487*t900+t487*t902; + t919 = t873*t96; + t921 = t877*t96; + t923 = t881*t96; + t932 = t20*t170; + t935 = t28*t170; + t941 = t124*t170; + t944 = t50*t1; + t946 = t806*ddgyr22*g02; + t949 = t64*t1; + t953 = t806*ddgxr23*g02; + t958 = g02*dgx22; + t959 = t743*t958; + t963 = t136*dg22*t459; + t968 = t3*dg23; + t969 = g03*dgx23; + t970 = t968*t969; + t973 = -2.0*t544*t171+2.0*t544*t941+4.0*t944*t946-4.0*t944*t953+2.0*t944*t959-2.0*t944*t963+4.0*t944*t970 & + -2.0*t949*t946+2.0*t949*t953-t949*t959+t949*t963; + t978 = g33*g02; + t979 = t3*ddgyr22*t978; + t985 = t3*ddgxr23*t978; + t990 = t137*t744; + t995 = t128*t34*dg33*g23; + t998 = t96*t1; + t1006 = t132*t128; + t1007 = t137*t823; + t1012 = t132*g22; + t1023 = t132*g01; + t1030 = t998*t963-4.0*t1006*t1007+4.0*t1006*t813+4.0*t1012*t818+8.0*t1012*t824+2.0*t614*t752-4.0*t614*t756 & + -2.0*t998*t985+2.0*t1023*t990+2.0*t1023*t995+2.0*t614*t766; + t1039 = t24*t3; + t1044 = t24*t8; + t1067 = t170*g01; + t1084 = 4.0*t738*t968*t186-8.0*t738*t8*dg23*t162+2.0*t1067*t798-2.0*t1067*t803-2.0*t1067*t808+t1067*t740+t1067*t745 & + +2.0*t1067*t749+2.0*t1067*t752-4.0*t1067*t756-2.0*t1067*t617; + t1092 = t170*t128; + t1100 = t170*t3; + t1112 = -2.0*t1067*t622-2.0*t1067*t625+2.0*t1067*t766-2.0*t1092*t771+2.0*t1092*t778+2.0*t170*g22*t782 & + -2.0*t1100*t786-2.0*t1100*t789+4.0*t170*t8*t793+4.0*t811*t1007-4.0*t738*t798; + t1117 = t21*g03; + t1121 = r*g22; + t1122 = g03*dgy23; + t1126 = t21*g22; + t1127 = g02*dgy33; + t1131 = t437*t49; + t1133 = g00*dg33; + t1134 = t23*g22*t1133; + t1138 = t23*g33*t616; + t1141 = t1*g23; + t1142 = t1141*Rmin; + t1143 = t21*t128; + t1144 = g03*dgy33; + t1148 = r*t128; + t1160 = 4.0*t738*t803+4.0*t738*t808+2.0*t842*t1117*t849+4.0*t842*t1121*t1122 & + -2.0*t842*t1126*t1127-2.0*t1131*t1134-2.0*t1131*t1138+2.0*t1142*t1143*t1144 & + -2.0*t1142*t1148*t1144+2.0*t1142*t21*t136*t958-2.0*t1142*r*t136*t958; + t1166 = t136*dgx02; + t1173 = t136*Theta22; + t1177 = g33*dgy03; + t1181 = g33*Theta33; + t1191 = t437*t22; + t1203 = t21*g33; + t1204 = g03*dgx22; + t1212 = dg33*dgx23; + t1231 = t128*dgy33*t683; + t1234 = g22*g03; + t1235 = t3*ddgyr23*t1234; + t1239 = t3*ddgxr33*t1234; + t1242 = 2.0*t842*t1121*t1127-2.0*t842*t1203*t1204+2.0*t842*t843*t1204+2.0*t842*t22*g02*t1212 & + -4.0*t842*t49*g02*t1212-4.0*t842*t1203*t844+2.0*t842*t21*g02*t1212 & + -4.0*t842*t1126*t1122-t998*t1231-2.0*t998*t1235+2.0*t998*t1239; + t1245 = t801*ddgyr23*g03; + t1249 = t801*ddgxr33*g03; + t1252 = g02*dgy23; + t1253 = t968*t1252; + t1256 = t739*t454; + t1289 = t96*t46; + t1291 = dg33*dgx33*t322; + t1293 = 2.0*t944*t1231-t949*t1231+4.0*t944*t1235-2.0*t949*t1235-4.0*t944*t1239 & + +2.0*t949*t1239-2.0*t944*t1256+t949*t1256-t1289*t1291-2.0*t998*t970+2.0*t998*t979; + t1313 = t1141*t64; + t1314 = t212*t1252; + t1317 = t1141*t89; + t1320 = t1141*t96; + t1322 = t212*dg33*dgx02; + t1326 = t1141*t50; + t1331 = t336*t132; + t1332 = t801*t1133; + t1335 = t806*t616; + t1342 = t212*t969; + t1348 = t212*dg22*dgy03; + t1355 = 2.0*t1313*t1322+4.0*t1313*t1342+2.0*t1313*t1348-4.0*t1317*t1342+2.0*t1320*t1348 & + -4.0*t1326*t1322-4.0*t1326*t1348+2.0*t1331*t1332+2.0*t1331*t1335-2.0*t337*t1332-2.0*t337*t1335; + t1357 = t50*t46; + t1359 = g33*ddgxr33*t322; + t1362 = t64*t46; + t1366 = dg23*dgy23*t1234; + t1374 = dgy33*dg23*t322; + t1379 = t50*t448; + t1380 = dgx33*dg22; + t1381 = t1380*t1234; + t1384 = dg23*dgy22; + t1385 = t1384*t1234; + t1388 = t849*t1234; + t1391 = 2.0*t1357*t1291-t1362*t1291+2.0*t1313*t1366-4.0*t1326*t1366-4.0*t1357*t1359-2.0*t1357*t1374 & + +2.0*t1362*t1359+t1362*t1374-2.0*t1379*t1381-2.0*t1379*t1385+4.0*t1379*t1388; + t1392 = t64*t448; + t1398 = g33*ddgyr23*t322; + t1405 = dgx33*dg23; + t1406 = t1405*t978; + t1409 = g23*g03; + t1410 = t1405*t1409; + t1413 = t1212*t978; + t1416 = dg33*dgy22; + t1417 = t1416*t978; + t1419 = t1416*t1409; + t1421 = t1392*t1381+t1392*t1385-2.0*t1392*t1388-2.0*t1289*t1398+2.0*t1289*t1359 & + +2.0*t1320*t1366-2.0*t1357*t1406+2.0*t1357*t1410-2.0*t1362*t1413+t1362*t1417-t1362*t1419; + t1428 = g33*ddgyr22*t1409; + t1434 = g33*ddgxr23*t1409; + t1440 = dg23*dgx22*t1409; + t1444 = dg22*dgy22*t1409; + t1450 = t1380*t978; + t1454 = dg23*dgx23*t978; + t1457 = t1384*t978; + t1473 = g03*t620*t978; + t1476 = 2.0*t237*t129*t183-t1313*t1450+2.0*t1313*t1454-t1313*t1457+2.0*t1326*t1450-4.0*t1326*t1454 & + +2.0*t1326*t1457+2.0*t222*t1473+8.0*t238*t177+t222*t187-2.0*t238*t187; + t1488 = t96*t448; + t1490 = dg33*Theta22; + t1501 = t185*dg33; + t1505 = t17*t40; + t1510 = t129*g33*g03; + t1516 = t17*t3*g03; + t1529 = -2.0*t33*t1501*t132-2.0*t47*t1490*t96-4.0*t1505*t373*t132+4.0*t1510*t440 & + +2.0*t1510*t832-2.0*t1510*t835-4.0*t1510*t838-4.0*t1516*t440-2.0*t1516*t832+2.0*t1516*t835+4.0*t1516*t838; + t1577 = 8.0*t19*t538-8.0*t19*t541-4.0*t41*t545+4.0*t41*t548-2.0*t41*t941-2.0*t168*t121+2.0*t168*t125 & + +8.0*t130*t672+8.0*t138*t677+4.0*t168*t545-4.0*t168*t548; + t1598 = 28.0*t19*t655-8.0*t19*t148*t24-8.0*t19*t152*t24+t1289*t1374+t1488*t1381+t1488*t1385 & + -2.0*t1488*t1388+4.0*t1357*t1398-2.0*t1362*t1398-t1488*t1444-t1320*t1450; + t1612 = t437*t185; + t1615 = dg33*t49; + t1619 = t251*dg23; + t1624 = t251*dgy22; + t1625 = dg03*t49; + t1629 = 2.0*t1320*t1454-t1320*t1457-4.0*t238*t1473+2.0*t174*t1473+4.0*t1357*t1413-2.0*t1357*t1417 & + +2.0*t1357*t1419-4.0*t1612*t311+4.0*t1612*t1615*t23-4.0*t1619*dgy02*t49*Rmin+4.0*t1624*t1625*Rmin; + t1634 = t247*t136; + t1636 = ddgxr03*t21*Rmin; + t1640 = Theta23*t21*Rmin; + t1644 = dgx03*t21*Rmin; + t1648 = dgy02*t21*Rmin; + t1651 = t251*g02; + t1652 = t478*Rmin; + t1655 = t251*g03; + t1660 = t251*dg02; + t1663 = t251*Theta33; + t1664 = dg22*t21; + t1678 = Theta23*r*Rmin; + t1682 = dgx03*r*Rmin; + t1686 = dgy02*r*Rmin; + t1689 = dgy01*dgx33; + t1690 = t1689*t21; + t1693 = t258*dg00; + t1696 = t258*dg02; + t1703 = t258*g00; + t1706 = 2.0*t1619*t1648-2.0*t1624*dg03*t21*Rmin-4.0*t1634*t1678+4.0*t1634*t1682+4.0*t1634*t1686 & + +2.0*t453*t1690+2.0*t1693*t384-2.0*t1696*t389-4.0*t1693*t394+4.0*t1696*t399-16.0*t1703*t404; + t1708 = t258*g02; + t1711 = t258*g03; + t1720 = dg01*g02*g03; + t1724 = ddgyr02*t21*Rmin; + t1727 = t251*dg33; + t1733 = ddgyr02*t22*Rmin; + t1741 = ddgyr02*t49*Rmin; + t1752 = dg22*t22; + t1768 = ddgxr03*t49*Rmin; + t1775 = dg22*t49; + t1783 = t251*Rmin; + t1788 = t8*ddgyr23*g02; + t1791 = 4.0*t282*t287*r+2.0*t1663*t1752*Rmin+2.0*t1619*dgx03*t22*Rmin+2.0*t1619*dgy02*t22*Rmin & + -2.0*t1624*t316*Rmin-4.0*t1634*t1768+4.0*t1660*dgx33*t49*Rmin & + -4.0*t1663*t1775*Rmin-4.0*t1619*dgx03*t49*Rmin-2.0*t1783*t1203*Theta22+2.0*t998*t1788; + t1795 = t8*ddgxr33*g02; + t1823 = t296*g33; + t1824 = dgy23*dgx22; + t1828 = dgx33*dgx22; + t1836 = t8*ddgyr22*g03; + t1842 = t8*ddgxr23*g03; + t1852 = t4*ddg23*g00; + t1856 = t214*g00; + t1859 = 4.0*t1823*t1824*r-2.0*t1823*t1828*r-2.0*t1823*t1824*t21+4.0*t237*t4*t1856+4.0*t944*t1836 & + -2.0*t949*t1836-2.0*t998*t1836-4.0*t944*t1842+2.0*t949*t1842+2.0*t998*t1842-4.0*t738*t1852; + t1863 = t24*t4; + t1875 = t812*g22; + t1878 = t817*g33; + t1883 = t132*t8; + t1890 = 2.0*t614*t1852-2.0*t1863*t1856+2.0*t1067*t1852-2.0*t170*t4*t1856 & + +4.0*t738*t4*dg23*g00+4.0*t1044*t1875+4.0*t1044*t1878 & + -8.0*t1863*t1720-4.0*t1883*t1875-4.0*t1883*t1878-2.0*t1696*t317; + t1891 = t437*t34; + t1918 = t259*t21; + t1921 = t259*r; + t1927 = -4.0*t1891*t1752*t23+12.0*t1703*t415-8.0*t1708*t1625*t23-8.0*t1711*dg02*t49*t23 & + +4.0*t1891*t1775*t23+12.0*t671*t34*t21*t23+12.0*t676*t185*t21*t23 & + -24.0*t1708*t1117*t23+2.0*t537*t1918-4.0*t537*t1921-4.0*t645*t646*dgy01; + t1931 = dgx01*dgy22; + t1932 = t1931*t21; + t1935 = t3*ddgxy01; + t1949 = t1689*r; + t1952 = t1931*r; + t1970 = ddgxr03*t22*Rmin; + t1995 = 4.0*t449*t1952-2.0*t463*t477*dgx33-2.0*t463*t482*dgy22+2.0*t1634*t1970-2.0*t1660*dgx33*t22*Rmin & + +2.0*t1783*t843*Theta22-2.0*t1783*t1752*dgy03 & + +4.0*t1783*t1126*dgy03+4.0*t1783*t1775*dgy03-2.0*t1783*t1664*dgy03-2.0*t1783*t1126*Theta33; + t2003 = t296*g22; + t2004 = dgy33*dgx23; + t2008 = dgy33*dgy22; + t2017 = g33*ddgxy23; + t2024 = g33*ddgyy22; + t2032 = g33*ddgxx33; + t2065 = -2.0*t2003*t2032*t21+4.0*t2003*t2032*r+t1823*t1828*t21+2.0*t282*t283*r & + -2.0*t282*t285*r-2.0*t282*t287*t21+4.0*t282*t290*t21-2.0*t282*t293*t21 & + +4.0*t296*t212*ddgxy23-2.0*t296*t212*ddgyy22-2.0*t296*t212*ddgxx33; + t2085 = g22*dgy33; + t2091 = t4*g23; + t2093 = t2091*dg01*g00; + t2122 = t136*dgx01; + t2133 = 8.0*t5*t1682+8.0*t5*t1686+2.0*t251*t252*t21+2.0*t251*t255*t21+8.0*t247*t248*r-4.0*t251*t252*r-4.0*t251*t255*r & + +2.0*t247*g33*dgy01*dgx33+2.0*t46*t2122*dgy22+8.0*t46*t18*ddgxy01-2.0*t46*t3*dgy01*dgx33; + t2138 = g01*t2091; + t2166 = -2.0*t448*t646*dgy22 & + -4.0*t2138*dg00*t22*t23+4.0*t2138*dg00*t49*t23+12.0*t2138*g00*t21*t23 & + +2.0*t258*t1918-4.0*t258*t1921+2.0*t129*t2122*dgy01+2.0*t5*t1733-4.0*t5*t1741+2.0*t5*t1724+2.0*t5*t1970; + t2192 = -4.0*t5*t1768+2.0*t5*t1636+8.0*t5*t1640-8.0*t5*t1644-8.0*t5*t1648-4.0*t247*t248*t21 & + -8.0*t5*t1678-8.0*t282*t290*r+4.0*t282*t293*r-t282*t283*t21+t282*t285*t21; + t2201 = t3*g22; + Theta23_rhs = 1/t1& + *(-12.0*t443*g23*t34*t163-12.0*t662*g23*t185*t163 & + -24.0*t645*t8*g00*t163+8.0*t1711*dg02*t22*t23 & + +2.0*t1727*Theta22*t21*Rmin+2.0*t1727*Theta22*t22*Rmin & + -4.0*t1727*Theta22*t49*Rmin-2.0*t1783*t21*dg33*dgx02 & + +t296*g33*dgx33*dgx22-2.0*t296*g33*dgy23*dgx22 & + -4.0*t645*t646*dgy01*t21+8.0*t645*t646*dgy01*r & + +12.0*t537*g23*g00*t163-2.0*t33*t139*dg33*t169*t23 & + +4.0*t33*t139*dg33*t236*t23 & + +t100+t344+t268+t191+t2133+t2065+t1927 & + +t706+t599+t634+t511+t572+t419+t1706+t1476 & + +t1629+t1421+t1598+t1391+t1355+t1529-4.0*t453*t455 & + +t1859+t1995+t1791+t2166+t2192+t1293+t1242 & + +t1890+t1112+t1160+t1084 & + -2.0*t1783*t310*dgx02+4.0*t1783*t1203*dgx02 & + +4.0*t1783*t1615*dgx02-4.0*t1783*t843*dgx02 & + +8.0*t463*t1935*t21-8.0*t1651*t492*Rmin & + -8.0*t1655*t496*Rmin-16.0*t463*t1935*r & + -4.0*t1783*t1121*dgy03+2.0*t1783*t1121*Theta33 & + -2.0*t2003*t2004*t21+t2003*t2008*t21+4.0*t2003*t2004*r & + -2.0*t2003*t2008*r+4.0*t2003*t2017*t21 & + -8.0*t2003*t2017*r-2.0*t2003*t2024*t21+4.0*t2003*t2024*r & + +t296*t298*t21-2.0*t296*t298*r+t296*t302*t21 & + -2.0*t296*t302*r-2.0*t296*t2085*dgx23+t296*t2085*dgy22 & + +4.0*t738*t968*t201-4.0*t1142*t1126*t1166 & + +4.0*t1142*t1121*t1166-2.0*t1142*t1121*t1173 & + -4.0*t1142*t1143*t1177+2.0*t1142*t1143*t1181 & + +4.0*t1142*t1148*t1177-2.0*t1142*t1148*t1181 & + +2.0*t1142*t1126*t1173-8.0*t132*t212*t219 & + +2.0*t237*t194*t198-4.0*t237*t206*t209+4.0*t47*t1490*t50 & + -2.0*t47*t1490*t64+2.0*t33*t1501*t24+4.0*t1505*t373*t24 & + +8.0*t1655*t483*Rmin+2.0*t1663*t1664*Rmin & + +8.0*t132*t4*t1720+2.0*t33*t315*t389-4.0*t33*t315*t399 & + +12.0*t463*t464*t89-4.0*t463*t522*t96+12.0*t463*t469*t64 & + +12.0*t463*t473*t64+8.0*t645*t667*t24-16.0*t438*t683*t132 & + -4.0*t237*g22*t782-8.0*t237*t8*t793-4.0*t463*t885*t96 & + +4.0*t738*t796*t144-4.0*t738*t801*t444-4.0*t738*t806*t663 & + -t24*t194*t198+2.0*t24*t206*t209-t170*t194*t198 & + +2.0*t10*ddgyy22*t21-4.0*t10*ddgyy22*r+2.0*t10*ddgxx33*t21 & + -4.0*t10*ddgxx33*r+8.0*t238*t239*t323+2.0*t170*t336*t339 & + -4.0*t237*t336*t339+2.0*t33*t35*t24 & + +4.0*t41*t42*t24+4.0*t47*t48*t50+4.0*t47*t54*t50 & + -2.0*t47*t76*t96-2.0*t47*t48*t96-2.0*t47*t54*t96 & + +2.0*t47*t59*t96-4.0*t47*t72*t50+4.0*t47*t76*t50+t1030+t973 & + +t915+t895+t774+t860+t1577+4.0*t785*t786+2.0*t1619*t1644 & + -4.0*t1634*t1648+8.0*t1651*t1652+t449*t611-2.0*t1660*t1652 & + +2.0*t1634*t1636+4.0*t1634*t1640-4.0*t1634*t1644 & + +2.0*t1516*t865+2.0*t168*t941-4.0*t19*t932+4.0*t19*t935 & + +2.0*t41*t171+2.0*t1510*t862-2.0*t1510*t865 & + -2.0*t1516*t862+4.0*t222*t327-2.0*t222*t330-2.0*t226*t333 & + -8.0*t238*t327+4.0*t238*t330+4.0*t366*t333-4.0*t233*t324 & + +t282*t285-2.0*t282*t287+4.0*t282*t290-2.0*t282*t293 & + +t296*t298-t282*t283+t222*t189+t226*t202+t226*t204 & + +4.0*t213*t215+8.0*t213*t219+t200*t204+t200*t202 & + +4.0*t24*t2093-4.0*t132*t2093-4.0*t453*t1949 & + -4.0*t458*t1952+4.0*t487*t1949+2.0*t458*t1932 & + -2.0*t487*t1690-2.0*t449*t1932-t487*t597 & + +2.0*t487*t600-6.0*t449*t603+2.0*t449*t606+4.0*t680*t696 & + -8.0*t671*t672-12.0*t537*t655+2.0*t537*t25-2.0*t537*t29 & + +12.0*t662*t664 & + +2.0*t449*t508-t449*t515+t449*t518-6.0*t487*t533 & + +t458*t515-t458*t518+t458*t520-t487*t501 & + +2.0*t487*t504-4.0*t458*t460+4.0*t438*t440 & + +12.0*t443*t445-t449*t451 & + -8.0*t138*t140-t1289*t1419+t1289*t1406-t1289*t1410 & + +2.0*t1289*t1428-2.0*t1289*t1434+t1488*t1440 & + -2.0*t1289*t1413+t1289*t1417+4.0*t1357*t1434 & + -2.0*t1362*t1434-2.0*t1379*t1440+2.0*t1379*t1444 & + +t1392*t1440-t1392*t1444+t1362*t1406-t1362*t1410 & + -4.0*t1357*t1428+2.0*t1362*t1428+2.0*t1320*t1322 & + -8.0*t321*t215+4.0*t1313*t1314 & + -4.0*t1317*t1314+2.0*t41*t121-2.0*t41*t125-8.0*t130*t133 & + -2.0*t998*t1795-4.0*t944*t1788 & + +2.0*t949*t1788+4.0*t944*t1795 & + -2.0*t949*t1795-2.0*t238*t189-2.0*t366*t202 & + -2.0*t366*t204-4.0*t944*t1245+2.0*t949*t1245+4.0*t944*t1249 & + -2.0*t949*t1249+4.0*t944*t1253-2.0*t949*t1253 & + +2.0*t998*t1245-2.0*t998*t1249-2.0*t998*t1253 & + +t998*t1256+2.0*t1191*t1134+2.0*t1191*t1138 & + -4.0*t5*ddgxy01-4.0*t10*ddgxy23 & + +2.0*t10*ddgyy22+2.0*t10*ddgxx33 & + -4.0*t19*t25+4.0*t19*t29+2.0*t816*t782-2.0*t1039*t786 & + -2.0*t1039*t789+4.0*t1044*t793+2.0*t1634*t1733 & + -4.0*t1634*t1741+8.0*t1708*t317+2.0*t1693*t404 & + +2.0*t1634*t1724-2.0*t811*t771+2.0*t811*t778-t998*t959 & + -4.0*t944*t979+2.0*t949*t979+4.0*t944*t985-2.0*t949*t985 & + -2.0*t614*t990-2.0*t614*t995-2.0*t998*t946+2.0*t998*t953 & + -2.0*t949*t970-t449*t923+2.0*t537*t932 & + -2.0*t537*t935+t453*t919-t453*t921+t458*t923-t487*t913 & + -t487*t919+t487*t921-4.0*t811*t813-4.0*t816*t818 & + +4.0*t785*t789+2.0*t614*t798-2.0*t614*t803-2.0*t614*t808 & + -4.0*t769*t778) & + /(-2.0*t2201*g33-2.0*t4*r-2.0*t796*r+t4*t21+t796*t21-2.0*t2201*t1203+4.0*t2201*t843+t4+t796)/Rmin/t21/4.0; + + t1 = g01*g01; + t3 = g23*g23; + t4 = t3*t3; + t5 = g01*t4; + t6 = dgy01*dgy01; + t9 = t1*t4; + t12 = g33*g33; + t13 = t1*g01; + t14 = t12*t13; + t15 = dgy22*dgy22; + t17 = g22*ddgxy23; + t18 = r*r; + t23 = ddgyr03*t18*Rmin; + t27 = Theta33*t18*Rmin; + t31 = dgy03*t18*Rmin; + t34 = g22*g22; + t35 = t1*t34; + t36 = t12*ddgyy01; + t41 = Theta33*r*Rmin; + t45 = dgy03*r*Rmin; + t48 = t3*g23; + t49 = t1*t48; + t50 = dgx01*dgy33; + t54 = dgy01*dgx33; + t58 = dgy01*dgy23; + t78 = t1*g22; + t79 = t12*dgx01; + t83 = 2.0*t5*t6-4.0*t9*ddgyy01+t14*t15+4.0*t14*t17*t18+4.0*t9*t23+4.0*t9*t27 & + -8.0*t9*t31-4.0*t35*t36*t18-4.0*t9*t41+8.0*t9*t45+2.0*t49*t50*t18 & + -2.0*t49*t54*t18+4.0*t49*t58*t18+8.0*t35*t36*r-4.0*t49*t50*r & + +4.0*t49*t54*r-8.0*t49*t58*r+2.0*t35*g33*dgy01*dgy33-2.0*t78*t79*dgx33; + t87 = t3*g33; + t95 = t1*g33; + t96 = t3*dgx01; + t103 = dg03*dg03; + t104 = t18*t18; + t105 = t104*t18; + t107 = Rmin*Rmin; + t108 = t103*t105*t107; + t111 = t104*r; + t113 = t103*t111*t107; + t117 = t103*t104*t107; + t120 = g01*t34; + t121 = t12*t6; + t128 = g01*g22; + t133 = ddgyr03*t104*Rmin; + t136 = t18*r; + t138 = ddgyr03*t136*Rmin; + t144 = g22*ddgyy22; + t151 = g22*ddgxx33; + t158 = dgx33*dgx22; + t161 = dgy23*dgx22; + t165 = 4.0*t78*t79*dgy23+8.0*t78*t87*ddgyy01-2.0*t78*t3*dgy01*dgy33+2.0*t95*t96*dgx33 & + -4.0*t95*t96*dgy23-2.0*t5*t108+4.0*t5*t113-2.0*t5*t117+2.0*t120*t121*t18 & + -4.0*t120*t121*r-4.0*t128*t87*t6+4.0*t9*t133-8.0*t9*t138-8.0*t14*t17*r & + -2.0*t14*t144*t18+4.0*t14*t144*r-2.0*t14*t151*t18+4.0*t14*t151*r+t14*t158*t18-2.0*t14*t161*t18; + t173 = g33*t13; + t174 = t3*ddgxy23; + t181 = t3*ddgyy22; + t188 = t3*ddgxx33; + t195 = g23*dgx33; + t212 = dgx33*dgx33; + t213 = g22*t212; + t219 = g22*dgy33; + t225 = t111*t107; + t226 = t225*t128; + t227 = g23*g02; + t228 = dg33*dg33; + t230 = t227*g03*t228; + t233 = g03*g03; + t235 = dg33*dg23; + t236 = g23*t233*t235; + t239 = g01*g33; + t240 = t225*t239; + t241 = g02*g02; + t243 = g23*t241*t235; + t246 = -2.0*t14*t158*r+4.0*t14*t161*r-4.0*t173*t174*t18+8.0*t173*t174*r+2.0*t173*t181*t18 & + -4.0*t173*t181*r+2.0*t173*t188*t18-4.0*t173*t188*r-t173*t195*dgy22 & + +t173*g23*dgy33*dgx22-2.0*t173*t195*dgx23+4.0*t173*g23*dgx23*dgy23-2.0*t173*g23*dgy23*dgy22+t173*t213*t18 & + -2.0*t173*t213*r-2.0*t173*t219*dgx23+t173*t219*dgy22+4.0*t226*t230+4.0*t226*t236+4.0*t240*t243; + t247 = g01*t3; + t249 = g02*g03; + t250 = t249*t235; + t253 = g22*g33; + t254 = t225*t253; + t255 = g00*t3; + t256 = dg01*dg33; + t257 = t255*t256; + t260 = t104*t107; + t261 = t260*t128; + t262 = g00*ddg33; + t263 = t87*t262; + t270 = t260*t239; + t276 = t260*t253; + t279 = t105*t107; + t280 = t279*t128; + t283 = t12*g01; + t284 = t136*t107; + t285 = t283*t284; + t287 = g00*dg23; + t288 = g22*g23*t287; + t291 = Rmin*t104; + t292 = t95*t291; + t293 = g22*g03; + t294 = dgx33*dg23; + t295 = t293*t294; + t298 = dgy33*dg22; + t299 = t293*t298; + t301 = Rmin*t136; + t302 = t95*t301; + t307 = Rmin*t18; + t308 = t95*t307; + t312 = t291*t78; + t314 = g23*g03; + t315 = g33*ddgyr23*t314; + t319 = g33*ddgxr33*t314; + t322 = t1*g23; + t323 = t291*t322; + t324 = g33*g02; + t325 = t294*t324; + t328 = dg33*dg22; + t329 = t255*t328; + t331 = -8.0*t225*t247*t250-8.0*t254*t257-4.0*t261*t263-2.0*t261*t230-2.0*t261*t236-2.0*t270*t243 & + +4.0*t260*t247*t250+4.0*t276*t257-4.0*t280*t263-4.0*t285*t288 & + +2.0*t292*t295-t292*t299-4.0*t302*t295+2.0*t302*t299+2.0*t308*t295-t308*t299 & + +4.0*t312*t315-4.0*t312*t319+2.0*t323*t325-t270*t329; + t334 = t239*t279; + t336 = g22*t233*t328; + t344 = dg33*dgx22; + t345 = t314*t344; + t347 = t128*t87; + t348 = g03*dg03; + t349 = t348*t260; + t352 = dg00*dg33; + t353 = t352*t260; + t356 = g33*g23; + t357 = t128*t356; + t358 = t233*dg23; + t363 = t239*t3*g02; + t364 = dg02*dg33; + t365 = t364*t260; + t368 = dg23*dg03; + t369 = t368*t260; + t372 = t78*t356; + t373 = dg02*dgy33; + t377 = Theta33*dg23; + t381 = dg33*Theta23; + t385 = dg33*dgx03; + t389 = dg33*dgy02; + t393 = dgx33*dg03; + t397 = dgy23*dg03; + t403 = -t334*t336-t334*t329+2.0*t240*t336+2.0*t240*t329-t270*t336+t292*t345 & + -8.0*t347*t349-4.0*t347*t353+4.0*t357*t358*t260+4.0*t363*t365-4.0*t363*t369 & + -4.0*t372*t373*t301+4.0*t372*t377*t301+4.0*t372*t381*t301-4.0*t372*t385*t301 & + +4.0*t372*t389*t301+4.0*t372*t393*t301-8.0*t372*t397*t301-2.0*t302*t345; + t405 = dg33*dgx23; + t406 = t293*t405; + t409 = dg33*dgy22; + t410 = t293*t409; + t412 = t227*t405; + t428 = g22*g00*t328; + t433 = t283*t260; + t437 = g02*dg22; + t438 = t437*t314; + t442 = dgx33*dg22*t314; + t445 = dgy23*dg22*t314; + t448 = t301*t78; + t451 = t307*t78; + t456 = t308*t345-2.0*t292*t406+t292*t410+2.0*t292*t412+4.0*t302*t406-2.0*t302*t410-4.0*t302*t412 & + -2.0*t308*t406+t308*t410+2.0*t308*t412+t283*t279*t428 & + -2.0*t283*t225*t428+4.0*t433*t288+t433*t428+4.0*t433*t438+t292*t442 & + -2.0*t292*t445-8.0*t448*t315+4.0*t451*t315+8.0*t448*t319; + t460 = t301*t322; + t463 = t298*t324; + t466 = t307*t322; + t470 = t409*t324; + t474 = dg23*dgy23*t324; + t480 = dg33*dgx33; + t481 = t480*t324; + t484 = t480*t314; + t487 = dgy33*dg23; + t488 = t487*t324; + t491 = t487*t314; + t508 = -4.0*t451*t319-4.0*t460*t325+2.0*t460*t463+2.0*t466*t325-t466*t463 & + -2.0*t460*t470+8.0*t460*t474+t466*t470-4.0*t466*t474+4.0*t448*t481-4.0*t448*t484 & + -4.0*t448*t488+4.0*t448*t491-2.0*t451*t481+2.0*t451*t484+2.0*t451*t488 & + -2.0*t451*t491-4.0*t285*t438-2.0*t302*t442+4.0*t302*t445; + t514 = g03*dgy23; + t539 = g02*dgy33; + t540 = r*Rmin; + t544 = g03*dgx33; + t563 = t279*t253; + t566 = t308*t442-2.0*t308*t445+8.0*t226*t263-12.0*t372*t514*t307+2.0*t372*t373*t307 & + -2.0*t372*t377*t307-2.0*t372*t381*t307+2.0*t372*t385*t307-2.0*t372*t389*t307 & + -2.0*t372*t393*t307+4.0*t372*t397*t307+6.0*t372*t539*t540-2.0*t372*t544*t540 & + +12.0*t372*t514*t540+2.0*t372*t373*t291-2.0*t280*t230-2.0*t280*t236 & + -2.0*t334*t243+4.0*t279*t247*t250+4.0*t563*t257; + t570 = g00*dg33; + t574 = g22*t12; + t576 = g03*dg01; + t577 = t227*t576; + t613 = t12*g23; + t614 = t128*t613; + t615 = g02*dg03; + t616 = t615*t284; + t619 = g03*dg02; + t620 = t619*t284; + t624 = t128*t12*g02; + t625 = g03*dg23; + t629 = -8.0*t226*t87*t570+8.0*t260*t574*t577-8.0*t284*t574*t577-t323*t463+t323*t470 & + -4.0*t323*t474-2.0*t312*t481+2.0*t312*t484+2.0*t312*t488-2.0*t312*t491 & + -2.0*t372*t377*t291-2.0*t372*t381*t291+2.0*t372*t385*t291-2.0*t372*t389*t291 & + -2.0*t372*t393*t291+4.0*t372*t397*t291+8.0*t614*t616+8.0*t614*t620+8.0*t624*t625*t284; + t630 = t570*t284; + t633 = t348*t284; + t639 = t18*t107; + t640 = t249*t639; + t643 = t364*t279; + t646 = t368*t279; + t649 = t352*t279; + t656 = t364*t225; + t659 = t368*t225; + t662 = t352*t225; + t669 = t615*t260; + t672 = t619*t260; + t682 = t570*t260; + t685 = -18.0*t347*t630+8.0*t347*t633-4.0*t357*t358*t284+24.0*t614*t640 & + -4.0*t624*t643+4.0*t624*t646-4.0*t347*t649+4.0*t363*t643-4.0*t363*t646+8.0*t624*t656 & + -8.0*t624*t659+8.0*t347*t662-8.0*t363*t656+8.0*t363*t659-8.0*t614*t669-8.0*t614*t672 & + -8.0*t624*t625*t260-4.0*t624*t365+4.0*t624*t369+26.0*t347*t682; + t732 = -6.0*t372*t539*t307+2.0*t372*t544*t307+8.0*t9*ddgyy01*r & + -4.0*t35*t36+2.0*t49*t50-2.0*t49*t54+4.0*t49*t58+2.0*t5*t6*t18-4.0*t5*t6*r+2.0*t120*t121 & + +4.0*t14*t17-2.0*t14*t144-2.0*t14*t151+t14*t15*t18-2.0*t14*t15*r+t14*t158 & + -2.0*t14*t161-4.0*t173*t174+2.0*t173*t181+2.0*t173*t188; + t737 = t78*t3; + t738 = dgy01*dgy33; + t739 = t738*r; + t742 = t95*t3; + t743 = dgx01*dgx33; + t744 = t743*r; + t747 = dgx01*dgy23; + t748 = t747*r; + t751 = t78*g33; + t752 = g23*dgx01; + t756 = g23*dgy01; + t764 = t12*t1*Rmin; + t765 = t18*t3; + t769 = t12*g33; + t771 = t769*t1*Rmin; + t772 = r*g22; + t776 = r*t3; + t781 = g00*dg01; + t782 = t781*dg33; + t785 = t260*g01; + t787 = t34*t233*t228; + t789 = t4*g00; + t790 = t789*ddg33; + t796 = t279*g01; + t803 = t225*g01; + t807 = t260*t34; + t809 = t769*g00*dg01; + t812 = t173*t213-4.0*t9*ddgyy01*t18+4.0*t737*t739-4.0*t742*t744+8.0*t742*t748 & + -2.0*t751*t752*dgy33+2.0*t751*t756*dgx33-4.0*t751*t756*dgy23+4.0*t764*t765*dgx02 & + +4.0*t771*t772*dgx02-4.0*t764*t776*dgx02+4.0*t225*t4*t782+t785*t787 & + +2.0*t785*t790-2.0*t260*t4*t782+t796*t787+2.0*t796*t790-2.0*t279*t4*t782+4.0*t803*t789*dg33+4.0*t807*t809; + t816 = t12*t233*dg01; + t819 = t260*g22; + t820 = t769*t241; + t821 = t820*dg01; + t825 = t3*t241; + t826 = t825*dg01; + t829 = t260*g33; + t830 = t789*dg01; + t833 = t284*t34; + t838 = dg33*t49; + t851 = t49*dgx33; + t853 = dg03*t18*Rmin; + t856 = t49*dgy23; + t859 = t35*t12; + t864 = t35*g33; + t865 = t738*t18; + t868 = t78*t12; + t869 = t743*t18; + t872 = t747*t18; + t875 = t3*ddgyy01; + t883 = -4.0*t807*t816-4.0*t819*t821+4.0*t260*t12*t826+4.0*t829*t830-4.0*t833*t809+4.0*t833*t816 & + +2.0*t838*Theta23*t18*Rmin-2.0*t838*dgx03*t18*Rmin & + +2.0*t838*dgy02*t18*Rmin+2.0*t851*t853-4.0*t856*t853-6.0*t859*t41+12.0*t859*t45+2.0*t864*t865 & + -2.0*t868*t869+4.0*t868*t872+8.0*t751*t875*t18-2.0*t737*t865+2.0*t742*t869; + t886 = t49*g02; + t887 = dgy33*r; + t891 = t49*g03; + t892 = dgx33*r; + t896 = dgy23*r; + t910 = t173*g23; + t911 = dgx33*dgx23; + t915 = dgx23*dgy23; + t919 = dgy23*dgy22; + t923 = t173*g22; + t924 = dgy33*dgx23; + t928 = dgy33*dgy22; + t937 = dgx33*dgy22; + t940 = dgy33*dgx22; + t952 = -4.0*t742*t872-4.0*t886*t887*Rmin+4.0*t891*t892*Rmin-8.0*t891*t896*Rmin & + -4.0*t864*t739+4.0*t868*t744-2.0*t771*t772*Theta22+2.0*t764*t776*Theta22 & + +4.0*t910*t911*r-8.0*t910*t915*r+4.0*t910*t919*r-2.0*t923*t924*t18+t923*t928*t18 & + +4.0*t923*t924*r-2.0*t923*t928*r-t910*t937*t18+t910*t940*t18+2.0*t910*t937*r & + -2.0*t910*t940*r-2.0*t910*t911*t18; + t960 = t95*Rmin; + t961 = r*t48; + t971 = t18*t48; + t981 = t18*g22; + t988 = t291*t1; + t990 = t48*ddgyr23*g03; + t994 = t48*ddgxr33*g03; + t997 = t3*t233; + t998 = dg23*dg23; + t999 = t997*t998; + t1004 = t284*g01; + t1005 = t820*dg22; + t1008 = t301*t1; + t1011 = t307*t1; + t1020 = 4.0*t910*t915*t18-2.0*t910*t919*t18-4.0*t960*t961*Theta23 & + +4.0*t960*t961*dgx03+4.0*t960*t961*dgy02+4.0*t960*t971*Theta23-4.0*t960*t971*dgx03 & + -4.0*t960*t971*dgy02+2.0*t771*t981*Theta22-2.0*t764*t765*Theta22 & + -4.0*t988*t990+4.0*t988*t994+4.0*t803*t999-2.0*t785*t999+2.0*t1004*t1005+8.0*t1008*t990 & + -4.0*t1011*t990-8.0*t1008*t994+4.0*t1011*t994-2.0*t796*t999; + t1023 = t18*g02; + t1051 = t284*g22; + t1057 = t284*g33; + t1064 = dg03*t104; + t1065 = t1064*Rmin; + t1072 = t49*dg02; + t1077 = t49*Theta33; + t1086 = -2.0*t785*t1005+2.0*t771*t1023*dgx22-2.0*t771*r*g02*dgx22-4.0*t771*t981*dgx02-8.0*t868*t748 & + -16.0*t751*t875*r+2.0*t838*Theta23*t104*Rmin & + -2.0*t838*dgx03*t104*Rmin+2.0*t838*dgy02*t104*Rmin & + +4.0*t1051*t821-4.0*t284*t12*t826-4.0*t1057*t830-2.0*t803*t787 & + -4.0*t803*t790+2.0*t851*t1065-4.0*t856*t1065 & + -8.0*t859*t138+4.0*t1072*dgy33*t136*Rmin-4.0*t1077*dg23*t136*Rmin-4.0*t838*Theta23*t136*Rmin; + t1100 = dg03*t136*Rmin; + t1111 = dgy33*t18; + t1112 = t1111*Rmin; + t1115 = dgx33*t18; + t1119 = dgy23*t18; + t1125 = t120*t12; + t1128 = t5*dg00; + t1130 = dg33*t105*t107; + t1136 = dg33*t111*t107; + t1139 = t120*t769; + t1141 = dg00*t104*t107; + t1146 = t239*t4; + t1149 = t5*g00; + t1151 = dg33*t104*t107; + t1154 = 4.0*t838*dgx03*t136*Rmin-4.0*t838*dgy02*t136*Rmin-4.0*t851*t1100+8.0*t856*t1100 & + +4.0*t859*t23+6.0*t859*t27-12.0*t859*t31+4.0*t886*t1112 & + -4.0*t891*t1115*Rmin+8.0*t891*t1119*Rmin-2.0*t1072*t1112-2.0*t1125*t108 & + +2.0*t1128*t1130+4.0*t1125*t113-4.0*t1128*t1136-4.0*t1139*t1141 & + -2.0*t1125*t117-4.0*t1146*t1141-12.0*t1149*t1151; + t1158 = dg00*t136*t107; + t1164 = dg33*t136*t107; + t1168 = g00*t18*t107; + t1175 = t128*t769; + t1177 = t241*t18*t107; + t1180 = t283*t3; + t1185 = t128*g33; + t1186 = t3*t6; + t1208 = t227*t576*dg33; + t1212 = t356*t570*dg23; + t1216 = t356*t249*ddg33; + t1223 = 2.0*t1128*t1151+4.0*t1139*t1158+4.0*t1146*t1158+8.0*t1149*t1164 & + +12.0*t1139*t1168-12.0*t1125*t233*t18*t107-12.0*t1175*t1177+12.0*t1180*t1177 & + +12.0*t1146*t1168-4.0*t1185*t1186*t18+8.0*t1185*t1186*r+2.0*t1077*dg23*t18*Rmin & + +4.0*t859*t133-2.0*t1072*dgy33*t104*Rmin+2.0*t1077*dg23*t104*Rmin & + +8.0*t254*t1208+2.0*t261*t1212+4.0*t261*t1216-4.0*t276*t1208+2.0*t280*t1212; + t1232 = g02*dg33*dg22*g23*g03; + t1276 = t241*ddg33; + t1277 = t87*t1276; + t1281 = t48*g00*t235; + t1284 = t48*g02; + t1286 = t1284*g03*ddg33; + t1290 = t12*g00*t256; + t1293 = 4.0*t280*t1216-4.0*t563*t1208+4.0*t240*t1232-2.0*t270*t1232-2.0*t334*t1232 & + +4.0*t357*t619*t1130-4.0*t357*t625*dg03*t105*t107-8.0*t357*t619*t1136 & + +8.0*t357*t625*dg03*t111*t107-20.0*t357*t249*t1151+4.0*t357*t619*t1151 & + -4.0*t357*t625*t1064*t107+12.0*t357*t249*t1164+8.0*t226*t356*t249*dg33-4.0*t226*t1212 & + -8.0*t226*t1216+2.0*t785*t1277-2.0*t785*t1281-4.0*t785*t1286-2.0*t807*t1290; + t1295 = g33*t233*t256; + t1298 = t12*t241; + t1299 = t1298*t256; + t1302 = t997*t256; + t1305 = t825*t256; + t1309 = t249*t256; + t1313 = t12*t3*t781; + t1317 = t87*t233*dg01; + t1320 = t1284*t576; + t1323 = t3*g22; + t1324 = t233*dg33; + t1325 = t1323*t1324; + t1328 = t241*dg33; + t1332 = g03*dgy33; + t1333 = t1332*t540; + t1336 = g02*dgx33; + t1337 = t1336*t540; + t1340 = g02*dgy23; + t1341 = t1340*t540; + t1344 = t3*Theta33; + t1348 = t3*dgy03; + t1365 = 2.0*t807*t1295+2.0*t819*t1299-2.0*t819*t1302-2.0*t829*t1305+4.0*t260*t48*t1309 & + -8.0*t819*t1313+4.0*t819*t1317-8.0*t829*t1320+4.0*t803*t1325 & + +4.0*t803*t87*t1328-6.0*t864*t1333+6.0*t868*t1337-12.0*t868*t1341+10.0*t751*t1344*t540 & + -20.0*t751*t1348*t540-2.0*t751*t752*t1111+2.0*t751*t756*t1115 & + -4.0*t751*t756*t1119+4.0*t737*t1333-8.0*t742*t1337; + t1381 = dgy33*dg03; + t1382 = t1381*t307; + t1385 = t3*ddgyr03; + t1389 = Theta33*dg33; + t1390 = t1389*t291; + t1393 = t1381*t291; + t1396 = dg02*dgx33; + t1397 = t1396*t291; + t1400 = dg02*dgy23; + t1401 = t1400*t291; + t1404 = Theta23*dg23; + t1405 = t1404*t291; + t1408 = dg23*dgx03; + t1409 = t1408*t291; + t1412 = t1389*t301; + t1415 = t1381*t301; + t1418 = t1396*t301; + t1421 = t1400*t301; + t1424 = t1404*t301; + t1427 = t1408*t301; + t1430 = 8.0*t742*t1341+4.0*t751*t752*t887-4.0*t751*t756*t892+8.0*t751*t756*t896 & + +2.0*t1125*t649+2.0*t737*t1382-8.0*t751*t1385*t291-2.0*t737*t1390+2.0*t737*t1393 & + -2.0*t742*t1397+4.0*t742*t1401-4.0*t742*t1405+4.0*t742*t1409-4.0*t864*t1412 & + +4.0*t864*t1415-4.0*t868*t1418+8.0*t868*t1421-8.0*t868*t1424+8.0*t868*t1427; + t1436 = t1336*t307; + t1439 = t1340*t307; + t1442 = t1396*t307; + t1445 = t1400*t307; + t1448 = t1404*t307; + t1453 = t1332*t307; + t1456 = t1389*t307; + t1471 = t1408*t307; + t1477 = g03*dgx23; + t1481 = g03*dgy22; + t1485 = 16.0*t751*t1385*t301+4.0*t737*t1412+8.0*t742*t1436-8.0*t742*t1439-2.0*t742*t1442 & + +4.0*t742*t1445-4.0*t742*t1448-8.0*t742*t1427+6.0*t864*t1453 & + +2.0*t864*t1456-2.0*t864*t1382-6.0*t868*t1436+12.0*t868*t1439 & + +2.0*t868*t1442-4.0*t868*t1445+4.0*t868*t1448-4.0*t868*t1471 & + -8.0*t751*t1385*t307-4.0*t764*t772*t1477+2.0*t764*t772*t1481; + t1487 = r*g23; + t1488 = dgx23*g02; + t1493 = t12*dgx33*t437; + t1496 = t12*dgy23*t437; + t1500 = t3*ddgyr23*t324; + t1504 = t3*ddgxr33*t324; + t1507 = t1298*t328; + t1509 = t997*t328; + t1513 = t613*t241*dg23; + t1516 = t233*dg22; + t1517 = t87*t1516; + t1521 = t574*ddgyr23*g02; + t1527 = t574*ddgxr33*g02; + t1540 = t34*g33; + t1541 = t1540*t1324; + t1550 = 4.0*t764*t1487*t1488-t988*t1493+2.0*t988*t1496+4.0*t988*t1500-4.0*t988*t1504+t796*t1507+2.0*t796*t1509 & + +4.0*t785*t1513-4.0*t785*t1517+8.0*t1008*t1521 & + -4.0*t1011*t1521-8.0*t1008*t1527-10.0*t751*t1344*t307+20.0*t751*t1348*t307-4.0*t737*t1453 & + -2.0*t737*t1456-6.0*t1004*t1541+8.0*t1004*t1325+8.0*t1051*t1313-4.0*t1051*t1317; + t1553 = t3*t103; + t1557 = g01*t48; + t1558 = t1557*g03; + t1578 = g02*dg02; + t1579 = t1578*t260; + t1582 = t128*t12; + t1583 = t3*dg00; + t1587 = t1328*t260; + t1595 = t239*t48; + t1600 = t239*t3; + t1603 = t1557*g02; + t1604 = g03*dg33; + t1608 = 8.0*t1057*t1320+4.0*t1185*t1553*t279-4.0*t1558*t643+4.0*t1558*t646-4.0*t1125*t662 & + -8.0*t1185*t1553*t225+8.0*t1558*t656-8.0*t1558*t659-14.0*t1125*t682 & + +8.0*t1125*t349+2.0*t1125*t353+8.0*t1175*t1579+8.0*t1582*t1583*t260+14.0*t1582*t1587 & + +4.0*t1185*t1553*t260-8.0*t1180*t1579+8.0*t1595*t669+8.0*t1595*t672-16.0*t1600*t1587+24.0*t1603*t1604*t260; + t1620 = t1578*t284; + t1626 = t1328*t284; + t1656 = -4.0*t1558*t365+4.0*t1558*t369+10.0*t1125*t630-8.0*t1125*t633-8.0*t1175*t1620-8.0*t1582*t1583*t284 & + -10.0*t1582*t1626+8.0*t1180*t1620-8.0*t1595*t616 & + -8.0*t1595*t620+12.0*t1600*t1626-16.0*t1603*t1604*t284-24.0*t1582*t255*t639 & + +12.0*t1185*t997*t639-24.0*t1595*t640+2.0*t864*t1390-2.0*t864*t1393+2.0*t868*t1397-4.0*t868*t1401; + t1661 = g00*t998; + t1662 = t87*t1661; + t1665 = t18*g23; + t1666 = dgy22*g02; + t1673 = g23*Theta23; + t1677 = g23*dgx03; + t1681 = g23*dgy02; + t1685 = g22*t136; + t1686 = dg33*Theta22; + t1692 = t104*g22; + t1693 = dg33*dgx02; + t1717 = t34*t12; + t1718 = t1717*t262; + t1721 = g00*t228; + t1722 = t1540*t1721; + t1724 = 4.0*t868*t1405-4.0*t868*t1409+2.0*t785*t1662-2.0*t764*t1665*t1666+2.0*t764*t1487*t1666 & + -4.0*t764*t981*t1673+4.0*t764*t981*t1677+4.0*t764*t981*t1681 & + +2.0*t764*t1685*t1686-t764*t981*t1686+2.0*t764*t1692*t1693-4.0*t764*t1685*t1693 & + +2.0*t764*t981*t1693-t764*t1692*t1686+4.0*t764*t772*t1673-4.0*t764*t772*t1677 & + -4.0*t764*t772*t1681-8.0*t803*t1284*t1604+2.0*t796*t1718-t796*t1722; + t1726 = t233*ddg33; + t1727 = t1540*t1726; + t1730 = t574*t1661; + t1733 = t574*t1276; + t1737 = t253*t241*t228; + t1740 = t253*t233*t998; + t1743 = t1323*t1721; + t1745 = t1323*t1726; + t1756 = t279*t34; + t1761 = t279*g22; + t1780 = -2.0*t796*t1727-2.0*t796*t1730-2.0*t796*t1733+t796*t1737+2.0*t796*t1740+t796*t1743 & + +2.0*t796*t1745+2.0*t796*t1662+2.0*t796*t1277-2.0*t796*t1281 & + -4.0*t796*t1286-2.0*t1756*t1290+2.0*t1756*t1295+2.0*t1761*t1299-2.0*t1761*t1302 & + -2.0*t279*g33*t1305+4.0*t279*t48*t1309+4.0*t803*t1717*t570-4.0*t803*t1541-4.0*t803*t574*t1328; + t1807 = t225*t34; + t1812 = t225*g22; + t1825 = -4.0*t803*t1718+2.0*t803*t1722+4.0*t803*t1727+4.0*t803*t1730+4.0*t803*t1733 & + -2.0*t803*t1737-4.0*t803*t1740-2.0*t803*t1743-4.0*t803*t1745-4.0*t803*t1662 & + -4.0*t803*t1277+4.0*t803*t1281+8.0*t803*t1286+4.0*t1807*t1290-4.0*t1807*t1295 & + -4.0*t1812*t1299+4.0*t1812*t1302+4.0*t225*g33*t1305-8.0*t225*t48*t1309+2.0*t785*t1718; + t1845 = t136*t3; + t1846 = Theta33*dg22; + t1852 = t769*g01; + t1854 = t107*g22; + t1855 = g00*dg22; + t1856 = t1854*t1855; + t1859 = t283*t104; + t1860 = t1854*t1516; + t1864 = t107*t3*t1855; + t1869 = t107*t48*t287; + t1875 = t104*t3; + t1888 = g03*dgx22; + t1894 = -4.0*t737*t1415+4.0*t742*t1418-8.0*t742*t1421+8.0*t742*t1424+4.0*t764*t981*t1477 & + -2.0*t764*t981*t1481-4.0*t764*t1665*t1488-2.0*t960*t1845*t1846 & + +t960*t765*t1846-2.0*t1852*t104*t1856+2.0*t1859*t1860+2.0*t1859*t1864 & + -4.0*t239*t104*t1869+4.0*t239*t136*t1869+t960*t1875*t1686-2.0*t960*t1845*t1686 & + -t764*t104*g02*t344+2.0*t764*t136*g02*t344-2.0*t764*t1665*t1888-t764*t1023*t344; + t1901 = t3*dgx33*t625; + t1906 = t3*dgy33*dg22*g03; + t1914 = t3*dg33*t1481; + t1918 = t3*dg23*t514; + t1944 = 2.0*t764*t1487*t1888+4.0*t1011*t1527+8.0*t1008*t1901-4.0*t1008*t1906 & + -4.0*t1011*t1901+2.0*t1011*t1906+4.0*t1008*t1914-8.0*t1008*t1918-2.0*t1011*t1914 & + +4.0*t1011*t1918+2.0*t1008*t1493-4.0*t1008*t1496-t1011*t1493+2.0*t1011*t1496 & + -8.0*t1008*t1500+4.0*t1011*t1500+8.0*t1008*t1504-4.0*t1011*t1504-2.0*t803*t1507-4.0*t803*t1509; + t1956 = t283*t136; + t1988 = t785*t1507+2.0*t785*t1509-4.0*t1004*t1513+4.0*t1004*t1517+2.0*t1852*t136*t1856 & + -2.0*t1956*t1860-2.0*t1956*t1864+4.0*t960*t765*t1481-4.0*t960*t776*t1481 & + -4.0*t988*t1521+4.0*t988*t1527-4.0*t988*t1901+2.0*t988*t1906-2.0*t988*t1914 & + +4.0*t988*t1918-t785*t1722-2.0*t785*t1727+10.0*t785*t1541-2.0*t785*t1730-2.0*t785*t1733; + t1997 = dg22*dgy03; + t2038 = t785*t1737+2.0*t785*t1740+t785*t1743+2.0*t785*t1745-12.0*t785*t1325+2.0*t764*t1692*t1997 & + -4.0*t764*t1685*t1997+2.0*t764*t981*t1997-t764*t1692*t1846 & + +2.0*t764*t1685*t1846-t764*t981*t1846+t960*t765*t1686-2.0*t960*t1875*t1693 & + +4.0*t960*t1845*t1693-2.0*t960*t765*t1693-2.0*t960*t1875*t1997+4.0*t960*t1845*t1997 & + -2.0*t960*t765*t1997+t960*t1875*t1846+4.0*t742*t1471; + Theta33_rhs = 1/t1 & + *(t2038+t83+t1988+t1944+t1894+t1825+t1430+t1365+t812+t566+t508+t1550+t685+t629 & + +t456+t403+t1086+t1020+t1223+t1154+t1485+t1293+t331+t246+t165 & + +t1780+t1608+t952+t883+t1724+t1656+t732) / & + (4.0*t1323*g33*r-2.0*t1323*g33*t18-2.0*t1323*g33-2.0*t4*r-2.0*t1717*r+t4*t18+t1717*t18+t4+t1717)/Rmin/t18/4.0; + + return + +end subroutine Theta_rhs2 +!--------------------------------------------------------------------------------- +subroutine pg0a_rhs(Rmin,r,p02,p03,g02,g03,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01, & + dg01,dg02,dg03, & + dgx01,dgx22,dgx23,dgx33, & + dgy01,dgy22,dgy23,dgy33, & + ddgxr01,ddgxr22,ddgxr23,ddgxr33, & + ddgyr01,ddgyr22,ddgyr23,ddgyr33, & + g02_rhs,g03_rhs,p02_rhs,p03_rhs) + + implicit none + +!~~~~~~% Input parameters: + real*8,intent(in) :: Rmin,r,p02,p03,g02,g03,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01 + real*8,intent(in) :: dg01,dg02,dg03 + real*8,intent(in) :: dgx01,dgx22,dgx23,dgx33 + real*8,intent(in) :: dgy01,dgy22,dgy23,dgy33 + real*8,intent(in) :: ddgxr01,ddgxr22,ddgxr23,ddgxr33 + real*8,intent(in) :: ddgyr01,ddgyr22,ddgyr23,ddgyr33 + real*8,intent(out) :: g02_rhs,g03_rhs,p02_rhs,p03_rhs + + real*8 :: t1; + real*8 :: t10; + real*8 :: t100; + real*8 :: t101; + real*8 :: t104; + real*8 :: t105; + real*8 :: t108; + real*8 :: t11; + real*8 :: t110; + real*8 :: t112; + real*8 :: t117; + real*8 :: t118; + real*8 :: t123; + real*8 :: t125; + real*8 :: t126; + real*8 :: t129; + real*8 :: t130; + real*8 :: t132; + real*8 :: t136; + real*8 :: t14; + real*8 :: t141; + real*8 :: t142; + real*8 :: t143; + real*8 :: t150; + real*8 :: t151; + real*8 :: t155; + real*8 :: t158; + real*8 :: t16; + real*8 :: t161; + real*8 :: t162; + real*8 :: t167; + real*8 :: t168; + real*8 :: t17; + real*8 :: t172; + real*8 :: t177; + real*8 :: t179; + real*8 :: t185; + real*8 :: t186; + real*8 :: t190; + real*8 :: t191; + real*8 :: t192; + real*8 :: t196; + real*8 :: t2; + real*8 :: t20; + real*8 :: t202; + real*8 :: t203; + real*8 :: t21; + real*8 :: t213; + real*8 :: t216; + real*8 :: t22; + real*8 :: t220; + real*8 :: t221; + real*8 :: t224; + real*8 :: t225; + real*8 :: t23; + real*8 :: t230; + real*8 :: t231; + real*8 :: t234; + real*8 :: t235; + real*8 :: t243; + real*8 :: t250; + real*8 :: t255; + real*8 :: t256; + real*8 :: t26; + real*8 :: t260; + real*8 :: t261; + real*8 :: t264; + real*8 :: t265; + real*8 :: t269; + real*8 :: t27; + real*8 :: t272; + real*8 :: t275; + real*8 :: t279; + real*8 :: t283; + real*8 :: t292; + real*8 :: t30; + real*8 :: t302; + real*8 :: t304; + real*8 :: t309; + real*8 :: t31; + real*8 :: t310; + real*8 :: t315; + real*8 :: t316; + real*8 :: t317; + real*8 :: t32; + real*8 :: t320; + real*8 :: t327; + real*8 :: t328; + real*8 :: t329; + real*8 :: t339; + real*8 :: t342; + real*8 :: t345; + real*8 :: t353; + real*8 :: t36; + real*8 :: t363; + real*8 :: t374; + real*8 :: t378; + real*8 :: t381; + real*8 :: t39; + real*8 :: t392; + real*8 :: t394; + real*8 :: t398; + real*8 :: t401; + real*8 :: t403; + real*8 :: t406; + real*8 :: t410; + real*8 :: t415; + real*8 :: t43; + real*8 :: t430; + real*8 :: t431; + real*8 :: t433; + real*8 :: t434; + real*8 :: t436; + real*8 :: t44; + real*8 :: t442; + real*8 :: t445; + real*8 :: t448; + real*8 :: t45; + real*8 :: t451; + real*8 :: t453; + real*8 :: t459; + real*8 :: t462; + real*8 :: t464; + real*8 :: t466; + real*8 :: t469; + real*8 :: t475; + real*8 :: t48; + real*8 :: t483; + real*8 :: t487; + real*8 :: t49; + real*8 :: t492; + real*8 :: t496; + real*8 :: t499; + real*8 :: t514; + real*8 :: t518; + real*8 :: t530; + real*8 :: t541; + real*8 :: t544; + real*8 :: t56; + real*8 :: t568; + real*8 :: t58; + real*8 :: t594; + real*8 :: t6; + real*8 :: t67; + real*8 :: t69; + real*8 :: t7; + real*8 :: t71; + real*8 :: t73; + real*8 :: t77; + real*8 :: t8; + real*8 :: t80; + real*8 :: t81; + real*8 :: t82; + real*8 :: t86; + real*8 :: t87; + real*8 :: t89; + real*8 :: t9; + real*8 :: t93; + real*8 :: t94; + real*8 :: t97; + real*8 :: t98; + real*8 :: t99; + + real*8 :: t111; + real*8 :: t115; + real*8 :: t12; + real*8 :: t121; + real*8 :: t13; + real*8 :: t133; + real*8 :: t134; + real*8 :: t137; + real*8 :: t139; + real*8 :: t140; + real*8 :: t144; + real*8 :: t147; + real*8 :: t148; + real*8 :: t15; + real*8 :: t153; + real*8 :: t164; + real*8 :: t170; + real*8 :: t18; + real*8 :: t182; + real*8 :: t188; + real*8 :: t19; + real*8 :: t193; + real*8 :: t197; + real*8 :: t206; + real*8 :: t215; + real*8 :: t222; + real*8 :: t227; + real*8 :: t238; + real*8 :: t239; + real*8 :: t24; + real*8 :: t240; + real*8 :: t241; + real*8 :: t244; + real*8 :: t245; + real*8 :: t249; + real*8 :: t25; + real*8 :: t252; + real*8 :: t257; + real*8 :: t259; + real*8 :: t263; + real*8 :: t266; + real*8 :: t270; + real*8 :: t274; + real*8 :: t288; + real*8 :: t29; + real*8 :: t293; + real*8 :: t294; + real*8 :: t301; + real*8 :: t323; + real*8 :: t326; + real*8 :: t330; + real*8 :: t331; + real*8 :: t334; + real*8 :: t335; + real*8 :: t338; + real*8 :: t343; + real*8 :: t35; + real*8 :: t350; + real*8 :: t351; + real*8 :: t356; + real*8 :: t357; + real*8 :: t361; + real*8 :: t375; + real*8 :: t38; + real*8 :: t385; + real*8 :: t388; + real*8 :: t389; + real*8 :: t40; + real*8 :: t407; + real*8 :: t41; + real*8 :: t411; + real*8 :: t419; + real*8 :: t422; + real*8 :: t428; + real*8 :: t443; + real*8 :: t450; + real*8 :: t456; + real*8 :: t46; + real*8 :: t465; + real*8 :: t471; + real*8 :: t481; + real*8 :: t486; + real*8 :: t50; + real*8 :: t504; + real*8 :: t51; + real*8 :: t534; + real*8 :: t547; + real*8 :: t55; + real*8 :: t562; + real*8 :: t592; + real*8 :: t62; + real*8 :: t63; + real*8 :: t66; + real*8 :: t70; + real*8 :: t72; + real*8 :: t76; + real*8 :: t84; + real*8 :: t92; + + t1 = r*r; + t2 = t1*r; + t6 = g22*g01; + t7 = t6*Rmin; + t8 = t1*t1; + t9 = t8*dg02; + t10 = g23*g23; + t11 = dg33*t10; + t14 = Rmin*t2; + t16 = t10*t10; + t17 = g01*dg02*t16; + t20 = g33*g33; + t21 = t20*g01; + t22 = t21*dgx01; + t23 = r*dg22; + t26 = g01*t1; + t27 = ddgxr01*t16; + t30 = t10*g23; + t31 = g01*g01; + t32 = t30*t31; + t36 = g01*r; + t39 = dgx01*t1; + t43 = dgx01*g01; + t44 = g22*g22; + t45 = t44*t20; + t48 = dgx01*dg01; + t49 = r*t16; + t56 = t14*g02; + t58 = t21*ddg22*g22; + t67 = t14*g03; + t69 = dg22*dg22; + t71 = g23*g33*g01*t69; + t73 = t30*g01; + t77 = t73*ddg22; + t80 = g23*t31; + t81 = t80*g22; + t82 = r*dg33; + t86 = g03*g23; + t87 = t14*t86; + t89 = g22*g33; + t93 = t10*t31; + t94 = dgx22*r; + t97 = Rmin*t8; + t98 = t97*g03; + t99 = t10*g01; + t100 = dg22*dg23; + t101 = t99*t100; + t104 = t30*dg01; + t105 = t104*dg22; + t108 = -2.0*t56*t58+2.0*t32*r*ddgyr22-2.0*t32*t1*ddgyr22-t67*t71+4.0*t67*t73*dg22-2.0*t67*t77 & + -2.0*t81*t82*dgx23-4.0*t87*g01*dg22*t89+t93*t94*dg33-2.0*t98*t101+2.0*t67*t105; + t110 = t80*r; + t112 = ddgyr22*g22*g33; + t117 = dg33*dg22; + t118 = Rmin*g02*t117; + t123 = g02*g33; + t125 = g23*g01; + t126 = t125*t100; + t129 = t97*g02; + t130 = g33*g01; + t132 = t130*ddg22*t10; + t136 = g01*ddg22*t89; + t141 = dg23*dg23; + t142 = g01*t141; + t143 = t89*t142; + t150 = dg22*g22; + t151 = t20*dg01*t150; + t155 = dg01*dg22*t89; + t158 = -2.0*t110*t112+2.0*t99*t2*t118+4.0*t43*t16+3.0*t97*t123*t126-2.0*t129*t132+2.0*t87*t136 & + +2.0*t67*t101+2.0*t56*t143-3.0*t14*t123*t126+2.0*t56*t151-2.0*t87*t155; + t161 = g22*t31; + t162 = t161*g33; + t167 = dg22*t10; + t168 = g33*dg01*t167; + t172 = g23*g22*t142; + t177 = t21*t69; + t179 = t97*t86; + t185 = t1*g03; + t186 = dg23*t10; + t190 = t44*g01; + t191 = t190*Rmin; + t192 = dg23*g33; + t196 = -2.0*t129*t143-2.0*t162*t23*dgy23+2.0*t129*t168-2.0*t67*t172+2.0*t98*t172-t129*t177 & + +2.0*t179*t155+t98*t71+2.0*t98*t77+8.0*t7*t185*t186-8.0*t191*t185*t192; + t202 = t130*Rmin; + t203 = t1*g02; + t213 = dgy33*t1; + t216 = t21*Rmin; + t220 = t44*t31; + t221 = dgy33*r; + t224 = r*dg23; + t225 = t224*dgy22; + t230 = t6*dgx01; + t231 = t1*dg33; + t234 = Rmin*t1; + t235 = t125*t234; + t243 = t2*dg02; + t250 = dg02*dg01*t16; + t255 = t125*dgx01; + t256 = t1*dg23; + t260 = dg01*t44; + t261 = t260*t20; + t264 = t73*Rmin; + t265 = t2*dg03; + t269 = t97*dg02; + t272 = t230*t231*t10+8.0*t235*g03*dg22*t89-2.0*t99*t8*t118-t216*t243*t150-2.0*t73*t39*dg23 & + +2.0*t97*t250+t202*t243*t167+2.0*t255*t256*t89-2.0*t39*t261-2.0*t264*t265*dg22+2.0*t269*t261; + t275 = r*t44*t20; + t279 = t89*t10; + t283 = ddgxr01*t44*t20; + t292 = t1*dg22; + t302 = t14*g01; + t304 = dg02*t44*t20; + t309 = 2.0*t48*t275+4.0*t36*ddgxr01*t279+2.0*t26*t283-8.0*t264*t203*dg23-8.0*t264*t185*dg22 & + -t22*t292*g22-2.0*t36*t283+4.0*t39*dg01*t279+8.0*t234*t17-4.0*t302*t304-t202*t9*t167; + t310 = t234*g01; + t315 = dg01*g22; + t316 = g33*t10; + t317 = t315*t316; + t320 = t8*dg03; + t327 = t125*t14; + t328 = g03*g22; + t329 = t328*t117; + t339 = t14*dg02; + t342 = t256*dgy22; + t345 = 8.0*t310*t304+t216*t9*t150-4.0*t269*t317+2.0*t191*t320*t192-2.0*t7*t320*t186-t327*t329 & + +2.0*t81*t231*dgx23-2.0*t14*t250-4.0*t26*ddgxr01*t279+4.0*t339*t317+2.0*t93*t342; + t353 = dg03*dg22*t89; + t363 = dg33*g33; + t374 = dgx33*t1; + t378 = dgx33*r; + t381 = r*ddgyr23; + t392 = t378*dg22; + t394 = t80*g33; + t398 = dgx22*t1; + t401 = t80*t1; + t403 = ddgxr23*g22*g33; + t406 = t130*dgx01; + t410 = dg02*g22*t316; + t415 = t220*t378*dg33-2.0*t161*t381*t10-2.0*t93*t256*dgx23+2.0*t73*dgx01*r*dg23-t93*t392 & + -t394*dgy22*t1*dg22-t93*t398*dg33-2.0*t401*t403-t406*t23*t10+8.0*t302*t410-16.0*t310*t410; + t430 = dg33*dg23; + t431 = t190*t430; + t433 = g02*g23; + t434 = t14*t433; + t436 = g01*ddg23*t89; + t442 = t104*dg23; + t445 = t73*ddg23; + t448 = t315*t186; + t451 = -t394*t94*dg23+t81*t374*dg23+8.0*t235*g02*dg23*t89+t81*t221*dg22+4.0*t67*t190*t192+t67*t431 & + +2.0*t434*t436-4.0*t67*t6*t186+2.0*t56*t442-2.0*t56*t445+2.0*t98*t448; + t453 = t6*ddg23*t10; + t459 = t260*t192; + t462 = t374*dg22; + t464 = t97*t433; + t466 = dg01*dg23*t89; + t469 = t1*ddgxr33; + t475 = r*ddgxr33; + t483 = t1*ddgyr23; + t487 = -2.0*t98*t453+4.0*t56*t73*dg23-2.0*t98*t459-t162*t462+2.0*t464*t466-2.0*t161*t469*t10 & + -2.0*t434*t466-2.0*t220*t475*g33-2.0*t129*t151-t191*t9*t363+2.0*t161*t483*t10; + t492 = t190*dgx01; + t496 = t190*ddg23*g33; + t499 = t6*t430; + t514 = t130*t100; + t518 = -t7*t243*t11+t492*t82*g33+2.0*t98*t496+t464*t499+2.0*t129*t445-4.0*t434*g01*dg23*t89 & + -t434*t499+2.0*t220*t469*g33-2.0*t67*t496+t14*t328*t514-t97*t328*t514; + t530 = t123*t117; + t541 = t125*t97; + t544 = 2.0*t67*t453+2.0*t67*t459-2.0*t464*t436-t98*t431+2.0*t220*t381*g33+t6*t97*t530 & + -2.0*t67*t448+t162*t392+2.0*t264*t320*dg22+2.0*t7*t265*t186-2.0*t541*t353; + t568 = -t81*t378*dg23-2.0*t93*t225+t93*t462+2.0*t110*t403-2.0*t81*t256*dgy23+2.0*t401*t112-t162*t342 & + +4.0*t56*t21*t150+t541*t329-2.0*t191*t265*t192-t6*t14*t530; + t594 = t56*t177-2.0*t129*t442-t492*t231*g33-t230*t82*t10+t394*dgy22*r*dg22-2.0*t220*t483*g33 & + +2.0*t161*t475*t10+2.0*t93*t224*dgx23+2.0*t129*t58+t406*t292*t10+t394*t398*dg23; + p02_rhs = 1/t2/g01*(2.0*t81*t224*dgy23-4.0*t48*r*t279+2.0*t32*t1*ddgxr23+8.0*t202*t203*t167-t81*t213*dg22 & + -8.0*t216*t203*t150-t220*t221*dg23+t7*t9*t11+t220*t213*dg23-t220*t374*dg33-2.0*t255*t224*t89 & + -2.0*t32*r*ddgxr23+t22*t23*g22+2.0*t162*t292*dgy23+t191*t243*t363-4.0*t56*t130*t167-2.0*t39*dg01*t16 & + +t108-2.0*t179*t136+2.0*t48*t49-2.0*t339*t261-2.0*t36*t27-4.0*t14*t17+4.0*t43*t45-2.0*t56*t168 & + -2.0*t98*t105+t162*t225+2.0*t56*t132+2.0*t26*t27-8.0*t43*t279+2.0*t327*t353+t345+t158+t196+t272 & + +t309+t415+t451+t487+t544+t518+t594+t568)/(-2.0*r*t10*t89-t16+t49+2.0*t279-t45+t275)/Rmin/2.0 +!!! + t1 = r*r; + t2 = t1*r; + t6 = dgy01*g01; + t7 = g23*g23; + t8 = t7*t7; + t11 = Rmin*t2; + t12 = g03*g23; + t13 = t11*t12; + t14 = g33*g01; + t15 = dg22*dg23; + t16 = t14*t15; + t18 = g22*g01; + t19 = dg33*dg23; + t20 = t18*t19; + t23 = g33*g33; + t24 = g01*g01; + t25 = t23*t24; + t29 = g33*t24; + t30 = t29*g22; + t31 = r*dg33; + t35 = dgx22*t1; + t38 = t1*t1; + t39 = Rmin*t38; + t40 = g02*g33; + t41 = t39*t40; + t43 = t11*g03; + t44 = t7*g23; + t45 = t44*g01; + t46 = t45*ddg23; + t49 = t11*g02; + t50 = t23*g01; + t51 = dg23*g22; + t55 = t11*t40; + t58 = dg23*t7; + t62 = g01*r; + t63 = ddgyr01*t8; + t66 = t29*g23; + t67 = dgx22*r; + t70 = t31*dgy22; + t72 = g22*g22; + t73 = t72*t23; + t76 = dgy01*t1; + t80 = t44*t24; + t84 = t50*t15; + t92 = t39*g02; + t94 = t50*ddg23*g22; + t97 = -4.0*t49*t14*t58-2.0*t62*t63+t66*t67*dg33+t30*t70+4.0*t6*t73-2.0*t76*dg01*t8+2.0*t80*t1*ddgyr23+t49*t84 & + -2.0*t80*t1*ddgxr33+2.0*t80*r*ddgxr33+2.0*t92*t94; + t99 = g23*g01; + t100 = dg33*dg22; + t101 = t99*t100; + t104 = g33*dg01*t58; + t108 = g01*t1; + t111 = dgy01*dg01; + t112 = r*t8; + t115 = t39*t12; + t117 = t1*ddgxr23; + t121 = t1*ddgyr22; + t126 = t23*dg01*t51; + t129 = dg01*t44; + t130 = t129*dg23; + t133 = t7*g01; + t134 = t133*t100; + t137 = -t55*t101+2.0*t92*t104+t41*t101+2.0*t108*t63+2.0*t111*t112+t115*t16+2.0*t29*t117*t7+2.0*t25*t121*g22 & + -2.0*t92*t126+2.0*t43*t130+2.0*t43*t134; + t139 = g22*g33; + t140 = g01*ddg23*t139; + t144 = dg01*dg23*t139; + t147 = g23*t24; + t148 = t147*r; + t150 = ddgyr23*g22*g33; + t153 = t147*t1; + t155 = ddgxr33*g22*g33; + t162 = dg23*dg23; + t164 = Rmin*g03*g22*t162; + t170 = t39*g03; + t179 = 2.0*t13*t140-2.0*t13*t144+2.0*t148*t150+2.0*t153*t155-2.0*t148*t155+2.0*t14*t2*t164+4.0*t43*t45*dg23 & + -2.0*t170*t134-2.0*t115*t140+3.0*t115*t20-2.0*t170*t130; + t182 = t133*t19; + t186 = dg33*dg33; + t188 = g23*g22*g01*t186; + t190 = g02*g23; + t191 = t39*t190; + t193 = g01*ddg33*t139; + t197 = dg01*dg33*t139; + t202 = g33*g23*g01*t162; + t206 = t14*ddg23*t7; + t215 = t147*g22; + t216 = dgy33*r; + t222 = t7*t24; + t224 = dgx33*t1; + t227 = dgy33*t1; + t230 = dgx33*r; + t231 = t230*dg23; + t234 = r*dg22; + t238 = t39*dg03; + t239 = dg01*g22; + t240 = g33*t7; + t241 = t239*t240; + t244 = dg01*t72; + t245 = t244*t23; + t249 = dg03*dg01*t8; + t252 = t11*dg03; + t257 = -2.0*t153*t150-t222*t70-t215*t224*dg33-t222*t227*dg22-2.0*t222*t231-2.0*t66*t234*dgy23-4.0*t238*t241 & + +2.0*t238*t245-2.0*t11*t249+4.0*t252*t241-2.0*t252*t245; + t259 = dg33*t7; + t260 = t239*t259; + t263 = t45*ddg33; + t266 = t129*dg33; + t269 = t1*dg33; + t270 = t269*dgy22; + t274 = t224*dg23; + t279 = t1*dg23; + t283 = r*dg23; + t288 = t1*dg22; + t292 = 2.0*t170*t260-2.0*t49*t263+2.0*t49*t266+t222*t270+t215*t230*dg33+2.0*t222*t274+t215*t227*dg23 & + -2.0*t222*t279*dgy23+2.0*t222*t283*dgy23-t92*t84+2.0*t66*t288*dgy23; + t293 = dg33*g33; + t294 = t244*t293; + t301 = dg02*dg33*t139; + t316 = t139*t7; + t323 = ddgyr01*t72*t23; + t326 = -2.0*t170*t294+t222*t216*dg22+2.0*t99*t11*t301+2.0*t170*t46-2.0*t49*t94+2.0*t49*t126-2.0*t49*t202 & + -4.0*t13*g01*dg23*t139-8.0*t6*t316+4.0*t62*ddgyr01*t316-2.0*t62*t323; + t330 = t18*Rmin; + t331 = t38*dg03; + t334 = t72*g01; + t335 = t334*Rmin; + t338 = t99*dgy01; + t342 = t45*Rmin; + t343 = t2*dg02; + t350 = Rmin*t1; + t351 = t350*g01; + t353 = dg03*g22*t240; + t356 = t14*Rmin; + t357 = t1*g02; + t361 = t50*Rmin; + t375 = r*t72*t23; + t381 = dg03*t72*t23; + t385 = g01*dg03*t8; + t388 = t2*dg03; + t389 = dg22*t7; + t392 = t14*dgy01; + t398 = r*ddgyr22; + t407 = -4.0*t111*r*t316+2.0*t111*t375+2.0*t39*t249+8.0*t351*t381-4.0*t11*t385-t356*t388*t389-t392*t234*t7 & + -2.0*t29*t121*t7+2.0*t29*t398*t7-t25*t67*dg23+2.0*t66*t283*dgx23; + t411 = g03*g22*t100; + t415 = t1*g03; + t419 = t18*dgy01; + t422 = t334*dgy01; + t428 = t99*t350; + t443 = t334*t186; + t445 = -t14*t11*t411+8.0*t350*t385-8.0*t335*t415*t293-t419*t31*t7+t422*t31*g33-8.0*t342*t415*dg23 & + +8.0*t428*g03*dg23*t139-8.0*t342*t357*dg33+8.0*t428*g02*dg33*t139-4.0*t108*ddgyr01*t316+t43*t443; + t450 = t334*ddg33*g33; + t456 = t18*ddg33*t7; + t465 = t11*g01; + t471 = t38*dg02; + t475 = -4.0*t43*t18*t259-2.0*t43*t450+2.0*t43*t294+2.0*t43*t456-2.0*t43*t260-t170*t443+2.0*t170*t450-t30*t274 & + -4.0*t465*t381-2.0*t45*t76*dg23-2.0*t356*t471*t58; + t481 = dg22*g22; + t486 = t50*dgy01; + t504 = 2.0*t361*t471*t51+t361*t388*t481+t356*t331*t389+t486*t234*g22+t14*t39*t411+t392*t288*t7+t30*t231 & + +4.0*t43*t334*t293+2.0*t108*t323-2.0*t80*r*ddgyr23-t66*t283*dgy22; + t530 = r*ddgxr23; + t534 = t419*t269*t7-t422*t269*g33+t330*t388*t259-t335*t388*t293+2.0*t45*dgy01*r*dg23-2.0*t338*t283*t139 & + -2.0*t92*t266+2.0*t92*t263-2.0*t25*t398*g22-2.0*t25*t117*g22+2.0*t25*t530*g22; + t547 = t11*t190; + t562 = -t361*t331*t481+8.0*t465*t353-t66*t35*dg33+t66*t279*dgy22-2.0*t29*t530*t7-4.0*t547*g01*dg33*t139 & + -t49*t188+2.0*t49*t182+4.0*t49*t45*dg33+2.0*t547*t193-2.0*t547*t197; + t592 = -2.0*t66*t279*dgx23-t486*t288*g22-2.0*t14*t38*t164-2.0*t170*t456+8.0*t330*t415*t259+2.0*t342*t471*dg33 & + +2.0*t356*t343*t58-2.0*t361*t343*t51+2.0*t30*t269*dgx23-t25*dgy22*t1*dg22-t30*t270; + p03_rhs = 1/t2/g01*(t504+t534+t562+t592+t137+t97+t257+t179+t326-2.0*t43*t46-2.0*t92*t206-t41*t20+2.0*t115*t144 & + -2.0*t49*t104+2.0*t49*t206-3.0*t13*t20-t13*t16+4.0*t6*t8-16.0*t351*t353+t55*t20-2.0*t76*t245+t292 & + +2.0*t191*t197-t330*t331*t259-2.0*t99*t39*t301+4.0*t76*dg01*t316-8.0*t361*t357*t51+8.0*t356*t357*t58 & + +4.0*t49*t50*t51+t25*t35*dg23+2.0*t338*t279*t139-t215*t216*dg23+t335*t331*t293-2.0*t342*t343*dg33 & + -2.0*t30*t31*dgx23+t92*t188-2.0*t92*t182+t25*dgy22*r*dg22-2.0*t191*t193+t475+t445+t407 & + +2.0*t92*t202)/(-2.0*r*t7*t139-t8+t112+2.0*t316-t73+t375)/Rmin/2.0 + + g02_rhs = p02 + g03_rhs = p03 + + return + +end subroutine pg0a_rhs +!------------------------------------------------------------------------------ +subroutine get_g01_rhs(r,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01,g01_rhs) + + implicit none + +!~~~~~~% Input parameters: + real*8,intent(in) :: r,g22,g23,g33,dg22,dg23,dg33,ddg22,ddg23,ddg33,g01 + real*8,intent(out) :: g01_rhs + + real*8 :: t107; + real*8 :: t11; + real*8 :: t110; + real*8 :: t14; + real*8 :: t19; + real*8 :: t2; + real*8 :: t23; + real*8 :: t25; + real*8 :: t28; + real*8 :: t3; + real*8 :: t33; + real*8 :: t34; + real*8 :: t40; + real*8 :: t45; + real*8 :: t49; + real*8 :: t54; + real*8 :: t6; + real*8 :: t7; + real*8 :: t73; + real*8 :: t76; + real*8 :: t81; + real*8 :: t89; + real*8 :: t98; + + t2 = g23*g23; + t3 = t2*g23; + t6 = g22*g33; + t7 = dg23*dg23; + t11 = t2*r; + t14 = g23*r; + t19 = g22*r; + t23 = g33*g33; + t25 = dg22*dg22; + t28 = r*dg22; + t33 = g22*g22; + t34 = t33*g33; + t40 = g33*r; + t45 = g22*t23; + t49 = r*dg33; + t54 = dg33*dg33; + t73 = 4.0*r*ddg23*t3-2.0*t6*r*t7-2.0*t11*t7-4.0*t14*ddg23*g22*g33-2.0*t19*ddg33*t2-t23*r*t25 & + +4.0*g33*g23*t28*dg23+2.0*r*ddg33*t34-2.0*t11*dg33*dg22-2.0*t40*ddg22*t2+2.0*r*ddg22*t45 & + +4.0*g23*g22*t49*dg23-t33*r*t54-4.0*g33*dg22*t2-4.0*g22*dg33*t2+4.0*dg33*t33*g33 & + +4.0*dg22*g22*t23-8.0*g23*dg23*t6+8.0*dg23*t3; + t76 = t2*t2; + t81 = r*r; + t89 = dg23*g22*g33; + t98 = dg33*t2; + t107 = dg22*t2; + t110 = -4.0*t76-2.0*r*dg23*t3+2.0*t81*dg23*t3+8.0*t6*t2-t28*t45+2.0*t14*t89-2.0*g23*t81*t89 & + +t81*dg33*t34-g22*t81*t98-t49*t34+t19*t98+t81*dg22*t45-4.0*t33*t23-g33*t81*t107+t40*t107; + g01_rhs = g01*t73*(-1.0+r)/t110/2.0 + + return + +end subroutine get_g01_rhs +!------------------------------------------------------------------------------ diff --git a/AMSS_NCKU_source/NullNews.f90 b/AMSS_NCKU_source/NullNews.f90 new file mode 100644 index 0000000..291c035 --- /dev/null +++ b/AMSS_NCKU_source/NullNews.f90 @@ -0,0 +1,688 @@ + + +#include "macrodef.fh" + +!------------------------------------------------------------------------------ +function omega_rhs(ex,crho,sigma,R,omega,RU,IU,omegarhs, & + quR1,quR2,quI1,quI2,gR,gI) result(gont) + + implicit none + + integer,intent(in) :: ex(3) + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: omega,RU,IU + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: omegarhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI +! gont = 0: success; gont = 1: something wrong + integer::gont + + double complex, dimension(ex(1),ex(2),ex(3)) :: comega,eth_omega,U,eth_Ub + real*8 :: dR + integer :: k + +!!! sanity check + dR = sum(omega)+sum(RU)+sum(IU) + if(dR.ne.dR) then + if(sum(omega).ne.sum(omega))write(*,*)"NullEvol_beta: find NaN in omega" + if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_beta: find NaN in RU" + if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_beta: find NaN in IU" + gont = 1 + return + endif + + comega = dcmplx(omega,0.d0) + U = dcmplx(RU,IU) + + do k=1,ex(3) + call derivs_eth(ex(1:2),crho,sigma,comega(:,:,k),eth_omega(:,:,k),0,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call derivs_eth(ex(1:2),crho,sigma,U(:,:,k),eth_Ub(:,:,k),1,-1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + enddo + +!!! The term * e^{-2beta} has been added so as to be consistent with HPN. Nigel + !omega_u = - dble(eth_omega * conjg(U) + 0.5d0 * omega * eth_Ub * exp(-2*beta)) + +!!! - update .. I thought this may have been wrong so I removed the +!!! e^{-2beta} for testing. Yosef +! omegarhs = - dreal(eth_omega * dconjg(U) + 0.5d0 * omega * eth_Ub) + + omegarhs = - 0.5d0*dreal(eth_Ub) + + gont = 0 + + return + +end function omega_rhs +!--------------------------------------------------------------------------------------------------------- +subroutine drive_null_news(ex,crho,sigma,R,RJ,IJ,RU,IU,RTheta,ITheta,omega,beta, & + qlR1,qlR2,qlI1,qlI2, & + quR1,quR2,quI1,quI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,RNews,INews,Rmin,sst) + + implicit none + + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: Rmin + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RTheta,ITheta,omega,beta + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dquR1,dquR2,dquI1,dquI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dgR,dgI,bdgR,bdgI + + integer :: i,j,k + double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,U,J_u,J_l,J_l_u,News +#if 0 + call get_fake_Ju(ex,crho,sigma,R,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +#endif + + CJ = dcmplx(RJ,IJ) + U = dcmplx(RU,IU) + J_u = dcmplx(RTheta,ITheta) + + do j=1,ex(2) + do i=1,ex(1) + call cderivs_x(ex(3),R,CJ(i,j,:),J_l(i,j,:)) + call cderivs_x(ex(3),R,J_u(i,j,:),J_l_u(i,j,:)) + J_l(i,j,:) = -J_l(i,j,:)*Rmin*R**2 + J_l_u(i,j,:) = -J_l_u(i,j,:)*Rmin*R**2 + enddo + enddo + +#if 0 +if(sst == 0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then + call get_exact_Jul(ex,crho,sigma,R,RNews,INews, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +write(*,*) J_u(ex(1)/2,ex(2)/2,ex(3)-1),J_u(ex(1)/2,ex(2)/2,ex(3)) +write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)) +write(*,*) J_l_u(ex(1)/2,ex(2)/2,ex(3)) +write(*,*)dcmplx(RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)))/J_l_u(ex(1)/2,ex(2)/2,ex(3)) +endif +stop +#endif + + do k=1,ex(3) + call get_null_news(ex(1:2),crho,sigma,CJ(:,:,k),U(:,:,k),J_u(:,:,k),J_l(:,:,k),J_l_u(:,:,k),omega(:,:,k),beta(:,:,k), & + qlR1(:,:,k),qlR2(:,:,k),qlI1(:,:,k),qlI2(:,:,k), & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k), & + gR(:,:,k),gI(:,:,k), & + dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), & + bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), & + dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k),News(:,:,k)) + enddo + + RNews = dreal(News) + INews = dimag(News) + +#if 0 +if(sst ==0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then + call get_exact_eth2omega(ex,crho,sigma,R,RNews,INews, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)) +endif +stop +#endif + +#if 0 +! check orthornormality + RNews = RJ + INews = IJ + + RNews = 0.5d0*dreal(J_l_u) + INews = 0.5d0*dimag(J_l_u) +#endif + + call six2spher(ex,crho,sigma,R,RNews,INews,2,Rmin,sst) + + return + +end subroutine drive_null_news +!--------------------------------------------------------------------------------------------------------- +subroutine drive_null_news_diff(ex,crho,sigma,R,RJ,IJ,RU,IU,RTheta,ITheta,omega,beta, & + qlR1,qlR2,qlI1,qlI2, & + quR1,quR2,quI1,quI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,RNews,INews,Rmin,sst,Time) + + implicit none + + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: Rmin,Time + real*8,intent(in),dimension(ex(1))::crho + real*8,intent(in),dimension(ex(2))::sigma + real*8,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RTheta,ITheta,omega,beta + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: qlR1,qlR2,qlI1,qlI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dquR1,dquR2,dquI1,dquI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dgR,dgI,bdgR,bdgI + + integer :: i,j,k + double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,U,J_u,J_l,J_l_u,News +#if 0 + call get_fake_Ju(ex,crho,sigma,R,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +#endif + + CJ = dcmplx(RJ,IJ) + U = dcmplx(RU,IU) + J_u = dcmplx(RTheta,ITheta) + + do j=1,ex(2) + do i=1,ex(1) + call cderivs_x(ex(3),R,CJ(i,j,:),J_l(i,j,:)) + call cderivs_x(ex(3),R,J_u(i,j,:),J_l_u(i,j,:)) + J_l(i,j,:) = -J_l(i,j,:)*Rmin*R**2 + J_l_u(i,j,:) = -J_l_u(i,j,:)*Rmin*R**2 + enddo + enddo + +#if 0 +if(sst == 0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then + call get_exact_Jul(ex,crho,sigma,R,RNews,INews, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +write(*,*) J_u(ex(1)/2,ex(2)/2,ex(3)-1),J_u(ex(1)/2,ex(2)/2,ex(3)) +write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)) +write(*,*) J_l_u(ex(1)/2,ex(2)/2,ex(3)) +write(*,*)dcmplx(RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)))/J_l_u(ex(1)/2,ex(2)/2,ex(3)) +endif +stop +#endif + + do k=1,ex(3) + call get_null_news(ex(1:2),crho,sigma,CJ(:,:,k),U(:,:,k),J_u(:,:,k),J_l(:,:,k),J_l_u(:,:,k),omega(:,:,k),beta(:,:,k), & + qlR1(:,:,k),qlR2(:,:,k),qlI1(:,:,k),qlI2(:,:,k), & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k), & + gR(:,:,k),gI(:,:,k), & + dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), & + bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), & + dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k),News(:,:,k)) + enddo + + call get_exact_news(ex,crho,sigma,R,RNews,INews,sst,Rmin,Time) + + RNews = dreal(News) - Rnews + INews = dimag(News) - INews + +!this part is nonsence + RNews(:,:,1:ex(3)-1) = 0.d0 + INews(:,:,1:ex(3)-1) = 0.d0 +#if 0 +if(sst ==0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then + call get_exact_eth2omega(ex,crho,sigma,R,RNews,INews, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst) +write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)) +endif +stop +#endif + +#if 0 +! check orthornormality + RNews = RJ + INews = IJ + + RNews = 0.5d0*dreal(J_l_u) + INews = 0.5d0*dimag(J_l_u) +#endif + + call six2spher(ex,crho,sigma,R,RNews,INews,2,Rmin,sst) + + return + +end subroutine drive_null_news_diff +!------------------------------------------------------------------------------------------------------------ +subroutine get_null_news(ex,crho,sigma,J,U,J_u,J_l,J_l_u,omega,beta, & + qlR1,qlR2,qlI1,qlI2, & + quR1,quR2,quI1,quI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,News) + +implicit none + +integer,intent(in) :: ex(2) +real*8,intent(in),dimension(ex(1))::crho +real*8,intent(in),dimension(ex(2))::sigma +double complex,dimension(ex(1),ex(2)),intent(in) :: J,U +double complex,dimension(ex(1),ex(2)),intent(in) :: J_u,J_l,J_l_u +real*8,dimension(ex(1),ex(2)),intent(in) :: omega,beta +real*8,dimension(ex(1),ex(2)),intent(in) :: qlR1,qlR2,qlI1,qlI2 +real*8,dimension(ex(1),ex(2)),intent(in) :: quR1,quR2,quI1,quI2 +real*8,dimension(ex(1),ex(2)),intent(in) :: gR,gI +real*8,dimension(ex(1),ex(2)),intent(in) :: dquR1,dquR2,dquI1,dquI2 +real*8,dimension(ex(1),ex(2)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,dimension(ex(1),ex(2)),intent(in) :: dgR,dgI,bdgR,bdgI +double complex,dimension(ex(1),ex(2)),intent(out) :: News + +! local variables +real*8,dimension(ex(1),ex(2)) :: K,K_u,K_l,K_l_u +real*8,dimension(ex(1),ex(2)) :: a +double complex,dimension(ex(1),ex(2)) :: Comega,Cbeta +double complex,dimension(ex(1),ex(2)) :: Jb,Ub +double complex,dimension(ex(1),ex(2)) :: eth_a,eth2_a,eth_ethb_a +double complex,dimension(ex(1),ex(2)) :: s1,s2,s3,s4,s5 +double complex,dimension(ex(1),ex(2)) :: eth_U,ethb_U,eth_J,ethb_J +double complex,dimension(ex(1),ex(2)) :: eth_J_l,ethb_J_l,eth_K_l,eth_K +double complex,dimension(ex(1),ex(2)) :: eth_omega,eth_beta +double complex,dimension(ex(1),ex(2)) :: eth2_omega,eth2_beta +double complex,dimension(ex(1),ex(2)) :: eth_ethb_omega,eth_ethb_beta + + Comega = dcmplx(omega,0.d0) + Cbeta = dcmplx(beta,0.d0) + call derivs_eth(ex,crho,sigma,Comega,eth_omega,0,1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,Cbeta,eth_beta,0,1,quR1,quR2,quI1,quI2,gR,gI) + call dderivs_eth(ex,crho,sigma,Comega,eth2_omega,0,1,1, & + quR1,quR2,quI1,quI2,gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + call dderivs_eth(ex,crho,sigma,Cbeta,eth2_beta,0,1,1, & + quR1,quR2,quI1,quI2,gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + call dderivs_eth(ex,crho,sigma,Comega,eth_ethb_omega,0,-1,1, & + quR1,quR2,quI1,quI2,gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + call dderivs_eth(ex,crho,sigma,Cbeta,eth_ethb_beta,0,-1,1, & + quR1,quR2,quI1,quI2,gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) + call derivs_eth(ex,crho,sigma,U,eth_U,1,1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,U,ethb_U,1,-1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,J,eth_J,2,1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,J,ethb_J,2,-1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,J_l,eth_J_l,2,1,quR1,quR2,quI1,quI2,gR,gI) + call derivs_eth(ex,crho,sigma,J_l,ethb_J_l,2,-1,quR1,quR2,quI1,quI2,gR,gI) + + Jb = dconjg(J) + Ub = dconjg(U) + K = dsqrt(1.0d0 + cdabs(J)**2) +! temp storage + Comega=dcmplx(K,0.d0) + call derivs_eth(ex,crho,sigma,Comega,eth_K,0,1,quR1,quR2,quI1,quI2,gR,gI) + + K_u = dreal( J_u * Jb ) / K + K_l = dreal( J_l * Jb ) / K +! temp storage + Comega=dcmplx(K_l,0.d0) + call derivs_eth(ex,crho,sigma,Comega,eth_K_l,0,1,quR1,quR2,quI1,quI2,gR,gI) + K_l_u = dreal( J_u * dconjg(J_l) + J_l_u * Jb )/ K - K_l * K_u / K + + a = omega * dexp(2.0d0 * beta) + + eth_a = dexp(2.0d0 * beta) * ( eth_omega + 2.0d0 * omega * eth_beta ) + + eth2_a = dexp(2.0d0 * beta) * ( 4.0d0 * eth_beta * eth_omega & + + 4.0d0 * omega * eth_beta**2 & + + eth2_omega + 2.0d0 * omega * eth2_beta ) + + eth_ethb_a = dexp(2.0d0 * beta) * ( 4.0d0 * dreal(eth_beta * dconjg(eth_omega)) & + + 4.0d0 * omega * eth_beta * dconjg(eth_beta) & + + eth_ethb_omega + 2.0d0 * omega * eth_ethb_beta ) + + s1 = ( -2.0d0 * K_l_u * J * (K + 1.0d0) + J_l_u * (K + 1.0d0)**2 & + + dconjg(J_l_u) * J**2 ) / (K + 1.0d0) + + s2 = 0.5d0 / ( K + 1.0d0) * ( & + (K + 1.0d0)* (eth_J_l *Ub * (K+1.0d0) - 2.0d0* eth_K_l * J *Ub ) & + + eth_U * (K+1.0d0)* ( -2.0d0 * J * dconjg(J_l) + K_l * 2.0d0 * (K+1.0d0) ) & + + dconjg(ethb_U) * (K+1.0d0) * ( -2.0d0* J * K_l + J_l * 2.0d0 * (K+1.0d0) ) & + + ethb_J_l * U * (K+1.0d0)**2 - dconjg(eth_K_l) * 2.0d0 * U * J * (K+1.0d0) & + + ethb_U * 2.0d0 * J * ( J * dconjg(J_l) - (K+1.0d0) * K_l) & + + J**2 * ( U * dconjg(eth_J_l) + dconjg(ethb_J_l * U) ) & + + J * 2.0d0 * dconjg(eth_U) * ( J * K_l - J_l * (K+1.0d0) ) ) + + s3 = ( J_l * (K + 1.0d0)**2 -2.0d0 * K_l * J * (K + 1.0d0) & + + dconjg(J_l) * J**2) / (K + 1.0d0) + + s4 = 0.5d0 / ( K + 1.0d0) * ( eth_a * eth_omega * (K + 1.0d0)**2 & + - (K+1.0d0) * J * 2.0d0* dreal( eth_a * dconjg(eth_omega) ) & + + J**2 * dconjg(eth_a * eth_omega) ) + + s5 = 0.25d0 / ( K + 1.0d0) * ( 2.0d0 * eth2_a * (K+1.0d0)**2 & + + 2.0d0 * J**2 * dconjg(eth2_a) & + - 4.0d0 * eth_ethb_a * J * (K+1.0d0) & + + Jb * eth_a * eth_J* (K+1.0d0)**2 & + + J * eth_a * dconjg(ethb_J) * (K+1.0d0)**2 & + - eth_a * eth_K * 2.0d0 * (K+1.0d0) * ( J*Jb + (K+1.0d0) ) & + + eth_a * ethb_J * (K+1.0d0) * ( -J*Jb + (K+1.0d0) ) & + - J**2 * eth_a * dconjg(eth_J) * K & + + J**2 * Jb * 2.0d0* eth_a * dconjg(eth_K) & + - dconjg(eth_a) * eth_J * (K+1.0d0) * ( J*Jb + K+1.0d0 ) & + - dconjg(ethb_J) * dconjg(eth_a) * J**2 * ( K + 2.0d0) & + + J * 2.0d0 * (K+1.0d0)**2 * eth_K * dconjg(eth_a) & + + J**2 * Jb * ethb_J * dconjg(eth_a) & + + J**3 * dconjg(eth_a * eth_J) & + - 2.0d0* J**2 *K*dconjg(eth_K * eth_a) ) + + ! News = 0.25d0 * ( s1 + s2 + 0.5d0 * dble(ethb_U) * s3 & + ! - 4.0d0 * s4 / omega**2 + 2.0d0 * s5 / omega ) / ( omega**2 * exp(2.0d0 * beta) ) + + ! change sign of s3 to compensate for a bug in Eqs. 30, 37, and 38 of + ! HPN +#if 1 + News = 0.25d0 * ( s1 + s2 - 0.5d0 * dreal(ethb_U) * s3 & + - 4.0d0 * s4 / omega**2 + 2.0d0 * s5 / omega ) / ( omega**2 * dexp(2.0d0 * beta) ) +#else +#if 0 +if(crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then +write(*,*) eth2_omega(ex(1)/2,ex(2)/2) +endif +#endif + News = 0.5d0*J_l_u+eth2_beta+0.5d0*eth2_omega ! if given omega error is about 6e-9 +! News = 0.5d0*J_l_u+eth2_beta-1.5d0*J ! error is about 6e-9 +#endif + return + +end subroutine get_null_news +!-------------------------------------------------------------------------------------------------- +! change spin weighted function from 6 patches to spherical coordinate + subroutine six2spher(ex,crho,sigma,R,RU,IU,spin,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst,spin + real*8,intent(in) :: Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: RU,IU + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: II,swtf,ff + + II = dcmplx(0.d0,1.d0) + hgr = 1.d0 + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! hgr = R(k)*Rmin/(1.d0-R(k)) R is not invovled indeed, to avoid NaN, we set +! it to 1 above + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "six2spher: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + ff=dcmplx(RU(i,j,k),IU(i,j,k))/swtf**spin + + RU(i,j,k) = dreal(ff) + IU(i,j,k) = dimag(ff) + enddo + enddo + enddo + + return + + end subroutine six2spher +!------------------------------------------------------------- +! Linear wave given in Eq.(27) of CQG 22, 2393 (2005) +!------------------------------------------------------------- +subroutine get_exact_omega(ex,crho,sigma,R,omega,sst,Rmin,T) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega + +integer :: i,j,k +real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +double complex :: swtf,ff + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_omega: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + gr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*gr-C2/1.2d1*gr**3 + gr = dreal(Jr*cdexp(II*nu*T)) + Jr = Yslm(0,2,m,gt,gp) + omega(i,j,k) = 1.d0-2.d0*(2+1)/2.d0*gr*dreal(Jr) + + enddo + enddo + enddo + +return + +end subroutine get_exact_omega +!------------------------------------------------------------- +! Linear wave given in Eq.(16) of CQG 24S327 +!------------------------------------------------------------- +subroutine get_exact_news(ex,crho,sigma,R,RNews,INews,sst,Rmin,Time) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,Time +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RNews,INews + +integer :: i,j,k +real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +double complex :: swtf,ff + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + Jr = II*nu**3*C2/dsqrt(2.4d1) + gr = dreal(Jr) + Jr = Yslm(2,2,m,gt,gp) + ff = gr*Jr*swtf**2 + RNews(i,j,k) = dreal(ff) + INews(i,j,k) = dimag(ff) + + enddo + enddo + enddo + +return + +end subroutine get_exact_news diff --git a/AMSS_NCKU_source/NullNews.h b/AMSS_NCKU_source/NullNews.h new file mode 100644 index 0000000..12b02cc --- /dev/null +++ b/AMSS_NCKU_source/NullNews.h @@ -0,0 +1,106 @@ + +#ifndef NULLNEWS_H +#define NULLNEWS_H + +#ifdef fortran1 +#define f_drive_null_news drive_null_news +#define f_get_null_news2 get_null_news2 +#define f_drive_null_news_diff drive_null_news_diff +#define f_omega_rhs omega_rhs +#define f_get_exact_omega get_exact_omega +#define f_get_omega_and_dtomega_pre get_omega_and_dtomega_pre +#define f_get_omega_and_dtomega_LN get_omega_and_dtomega_ln +#define f_get_dtomega get_dtomega +#endif +#ifdef fortran2 +#define f_drive_null_news DRIVE_NULL_NEWS +#define f_get_null_news2 GET_NULL_NEWS2 +#define f_drive_null_news_diff DRIVE_NULL_NEWS_DIFF +#define f_omega_rhs OMEGA_RHS +#define f_get_exact_omega GET_EXACT_OMEGA +#define f_get_omega_and_dtomega_pre GET_OMEGA_AND_DTOMEGA_PRE +#define f_get_omega_and_dtomega_LN GET_OMEGA_AND_DTOMEGA_LN +#define f_get_dtomega GET_DTOMEGA +#endif +#ifdef fortran3 +#define f_drive_null_news drive_null_news_ +#define f_get_null_news2 get_null_news2_ +#define f_drive_null_news_diff drive_null_news_diff_ +#define f_omega_rhs omega_rhs_ +#define f_get_exact_omega get_exact_omega_ +#define f_get_omega_and_dtomega_pre get_omega_and_dtomega_pre_ +#define f_get_omega_and_dtomega_LN get_omega_and_dtomega_ln_ +#define f_get_dtomega get_dtomega_ +#endif + +extern "C" +{ + void f_drive_null_news(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double &, int &); +} + +extern "C" +{ + void f_drive_null_news_diff(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double &, int &, double &); +} + +extern "C" +{ + void f_omega_rhs(int *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, double *, + double *, double *); +} + +extern "C" +{ + void f_get_exact_omega(int *, double *, double *, double *, + double *, + int &, double &, double &); +} + +extern "C" +{ + void f_get_null_news2(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double &, int &); +} + +extern "C" +{ + void f_get_omega_and_dtomega_pre(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double &); +} + +extern "C" +{ + void f_get_dtomega(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double &); +} + +extern "C" +{ + void f_get_omega_and_dtomega_LN(double &, int *, double *, double *, double *, + double *, double *, double &, int &); +} +#endif /* NULLNEWS_H */ diff --git a/AMSS_NCKU_source/NullNews2.f90 b/AMSS_NCKU_source/NullNews2.f90 new file mode 100644 index 0000000..084d6a1 --- /dev/null +++ b/AMSS_NCKU_source/NullNews2.f90 @@ -0,0 +1,588 @@ + + +#include "macrodef.fh" + +!------------------------------------------------------------------------------ +! input R is X indeed +! input g00 is g00/r^2 indeed +! input g0A is g0A/r^2 indeed +! input gAB is gAB/r^2 indeed +! output Gamma is Gamma of omega^2 g_{munu}/r^2 at r = infinity or to say X = 1 +! ** in coordinate (u,X,x,y) ** +subroutine get_christoffel(Rmin,g00,g01,g02,g03, & + g22,g23,g33, & + dgt22,dgt23,dgt33,& + dg22,dg23,dg33,& + dgx02,dgx03,dgx22,dgx23,dgx33,& + dgy02,dgy03,dgy22,dgy23,dgy33,& + omega,dtomega,dxomega,dyomega,& + Gamuxx,Gamuxy,Gamuyy, & + Gamrxx,Gamrxy,Gamryy, & + Gamxxx,Gamxxy,Gamxyy, & + Gamyxx,Gamyxy,Gamyyy) + + implicit none + + real*8,intent(in)::Rmin + real*8,intent(in)::g00,g01,g02,g03,g22,g23,g33 + real*8,intent(in)::dgt22,dgt23,dgt33 + real*8,intent(in)::dg22,dg23,dg33 + real*8,intent(in)::dgx02,dgx03,dgx22,dgx23,dgx33 + real*8,intent(in)::dgy02,dgy03,dgy22,dgy23,dgy33 + real*8,intent(in) :: omega,dtomega,dxomega,dyomega + real*8,intent(out) :: Gamuxx,Gamuxy,Gamuyy + real*8,intent(out) :: Gamrxx,Gamrxy,Gamryy + real*8,intent(out) :: Gamxxx,Gamxxy,Gamxyy + real*8,intent(out) :: Gamyxx,Gamyxy,Gamyyy + + real*8 :: t1; + real*8 :: t10; + real*8 :: t11; + real*8 :: t117; + real*8 :: t12; + real*8 :: t121; + real*8 :: t138; + real*8 :: t142; + real*8 :: t147; + real*8 :: t18; + real*8 :: t184; + real*8 :: t190; + real*8 :: t194; + real*8 :: t198; + real*8 :: t2; + real*8 :: t204; + real*8 :: t206; + real*8 :: t208; + real*8 :: t214; + real*8 :: t216; + real*8 :: t220; + real*8 :: t222; + real*8 :: t227; + real*8 :: t230; + real*8 :: t233; + real*8 :: t239; + real*8 :: t24; + real*8 :: t241; + real*8 :: t242; + real*8 :: t244; + real*8 :: t249; + real*8 :: t25; + real*8 :: t252; + real*8 :: t28; + real*8 :: t29; + real*8 :: t32; + real*8 :: t37; + real*8 :: t47; + real*8 :: t53; + real*8 :: t54; + real*8 :: t58; + real*8 :: t64; + real*8 :: t65; + real*8 :: t66; + real*8 :: t68; + real*8 :: t71; + real*8 :: t72; + real*8 :: t73; + real*8 :: t75; + real*8 :: t76; + real*8 :: t77; + real*8 :: t80; + real*8 :: t82; + real*8 :: t84; + real*8 :: t85; + real*8 :: t88; + real*8 :: t9; + real*8 :: t91; + + t1 = 1/g01; + t2 = Rmin*t1; + t9 = 1/omega; + t10 = Rmin*t9; + t11 = g01*omega; + t12 = g22*g03; + t18 = g23*g02; + t24 = g01*g22; + t25 = t18*dyomega; + t28 = g23*g03; + t29 = t28*dxomega; + t32 = g33*g02; + t37 = g22*g33; + t47 = g23*g23; + t53 = g22*g22; + t54 = g01*t53; + t58 = t47*dtomega; + t64 = Rmin*dg22; + t65 = t64*omega; + t66 = t37*g00; + t68 = t18*g03; + t71 = omega*g22; + t72 = g03*g03; + t73 = t71*t72; + t75 = omega*g33; + t76 = g02*g02; + t77 = t75*t76; + t80 = omega*t47*g00; + t82 = 2.0*t24*t32*dxomega-2.0*t11*t47*dgx02+t11*t47*dgt22-2.0*t54*g33*dtomega & + +2.0*t24*t58+2.0*t54*g03*dyomega+t65*t66+2.0*t65*t68-t64*t73-t64*t77-t64*t80; + t84 = g01*g01; + t85 = 1/t84; + t88 = 1/(t37-t47); + t91 = Rmin*dg23; + t117 = g01*g33; + t121 = g01*t47; + t138 = t91*omega; + t142 = -t11*t12*dgx33+t11*t18*dgx33+2.0*t117*t18*dxomega-2.0*t121*g03*dxomega & + -2.0*t121*g02*dyomega+t11*t47*dgt23-t11*t47*dgx03-t11*t47*dgy02+2.0*g01*t47*g23*dtomega+t138*t66+2.0*t138*t68; + t147 = Rmin*dg33; + t184 = g33*g33; + t190 = g01*t184; + t194 = t147*omega; + t198 = -2.0*t117*t25-2.0*t117*t29-t11*t12*dgy33+t11*t18*dgy33-2.0*t11*t47*dgy03+t11*t47*dgt33-2.0*t24*t184*dtomega & + +2.0*t117*t58+2.0*t190*g02*dxomega+t194*t66+2.0*t194*t68; + t204 = g02*dg22*Rmin; + t206 = omega*g23; + t208 = g03*dg22*Rmin; + t214 = 2.0*t24*g33*dxomega; + t216 = t11*g23*dgy22; + t220 = g23*dyomega; + t222 = 2.0*t24*t220; + t227 = t1*t88; + t230 = g02*dg23*Rmin; + t233 = g03*dg23*Rmin; + t239 = 2.0*t24*g33*dyomega; + t241 = t11*g23*dgx33; + t242 = g23*dxomega; + t244 = 2.0*t117*t242; + t249 = g02*dg33*Rmin; + t252 = g03*dg33*Rmin; + Gamuxx = -t2*dg22/2.0; + Gamuxy = -t2*dg23/2.0; + Gamuyy = -t2*dg33/2.0; + Gamrxx = t10*(-2.0*t11*t12*dgx23+t11*t12*dgy22+2.0*t11*t18*dgx23-t11*t18*dgy22+t11*t28*dgx22-t11*t32*dgx22 & + -t11*t37*dgt22+2.0*t11*t37*dgx02-2.0*t24*t25-2.0*t24*t29+t82)*t85*t88/2.0; + Gamrxy = t10*(-t91*t73-t91*t77-t91*t80-2.0*t24*g33*g23*dtomega-t11*t37*dgt23+t11*t37*dgx03+t11*t37*dgy02 & + -t11*t32*dgy22+t11*t28*dgy22+2.0*t24*t28*dyomega+t142)*t85*t88/2.0; + Gamryy = t10*(-t147*t73-t147*t77-t147*t80+2.0*t11*t37*dgy03-t11*t37*dgt33+2.0*t24*g33*g03*dyomega & + -2.0*t11*t32*dgy23+t11*t32*dgx33+2.0*t11*t28*dgy23-t11*t28*dgx33+t198)*t85*t88/2.0; + Gamxxx = t9*(-2.0*t11*g23*dgx23+t11*g33*dgx22+t75*t204-4.0*t121*dxomega-t206*t208+t214+t216+t222)*t227/2.0; + Gamxxy = t9*(t11*g33*dgy22+t75*t230-t206*t233+t239-t241-t244)*t227/2.0; + Gamxyy = t9*(-t11*g23*dgy33-t11*g33*dgx33+2.0*t11*g33*dgy23+t75*t249-2.0*t190*dxomega+2.0*t117*t220-t206*t252)*t227/2.0; + Gamyxx = -t9*(-2.0*t11*g22*dgx23+t11*g22*dgy22+t11*g23*dgx22-2.0*t24*t242+2.0*t54*dyomega-t71*t208+t206*t204)*t227/2.0; + Gamyxy = -(-t11*g22*dgx33-t71*t233+t206*t230-t214+t216+t222)*t9*t227/2.0; + Gamyyy = t9*(t11*g22*dgy33-2.0*t11*g23*dgy23+t71*t252-4.0*t121*dyomega-t206*t249+t239+t241+t244)*t227/2.0; + + return + +end subroutine get_christoffel +!!---------------------------------------------------------------------------------------- +subroutine get_News(crho,sigma,& + dxxomega,dxyomega,dyyomega,& + omega,dtomega,dxomega,dyomega,& + Gamuxx,Gamuxy,Gamuyy, & + Gamrxx,Gamrxy,Gamryy, & + Gamxxx,Gamxxy,Gamxyy, & + Gamyxx,Gamyxy,Gamyyy,RNew,INew,sst) + + implicit none + + integer,intent(in) :: sst + real*8,intent(in)::crho,sigma + real*8,intent(in) :: dxxomega,dxyomega,dyyomega + real*8,intent(in) :: omega,dtomega,dxomega,dyomega + real*8,intent(in) :: Gamuxx,Gamuxy,Gamuyy + real*8,intent(in) :: Gamrxx,Gamrxy,Gamryy + real*8,intent(in) :: Gamxxx,Gamxxy,Gamxyy + real*8,intent(in) :: Gamyxx,Gamyxy,Gamyyy + + real*8,intent(out) :: RNew,INew + + + real*8 :: cs,cr,ss,sr,tc,ts + real*8 :: WWxx,WWxy,WWyy + real*8 :: Rmmxx,Rmmxy,Rmmyy + real*8 :: Immxx,Immxy,Immyy + + real*8 :: gr,tgrho,tgsigma,x,y,z,gt,gp + + double complex :: swtf,II +write(*,*) Gamrxx,Gamrxy,Gamryy + WWxx = (dxxomega-(Gamuxx*dtomega+Gamxxx*dxomega+Gamyxx*dyomega))/omega/2 + WWxy = (dxyomega-(Gamuxy*dtomega+Gamxxy*dxomega+Gamyxy*dyomega))/omega/2 + WWyy = (dyyomega-(Gamuyy*dtomega+Gamxyy*dxomega+Gamyyy*dyomega))/omega/2 + + cs = dcos(sigma) + cr = dcos(crho) + ss = dsin(sigma) + sr = dsin(crho) + tc = dsqrt((1-sr*ss)/2) + ts = dsqrt((1+sr*ss)/2) + Rmmxx = 4*tc*tc*ts*ts*(ts*ts-tc*tc)/cs/cs + Rmmxy = 4*tc*tc*ts*ts*(ts*ts+tc*tc)/cs/cr + Rmmyy = 4*tc*tc*ts*ts*(ts*ts-tc*tc)/cr/cr + Immxx = 8*tc*tc*ts*ts*ts*tc/cs/cs + Immxy = 0 + Immyy = -8*tc*tc*ts*ts*ts*tc/cr/cr + + if(sst==1 .or. sst==3 .or. sst==4)then + Immxx = -Immxx + Immxy = -Immxy + Immyy = -Immyy + endif + + RNew = Rmmxx*WWxx+2*Rmmxy*WWxy+Rmmyy*WWyy + INew = Immxx*WWxx+2*Immxy*WWxy+Immyy*WWyy +!! change to tetrad theta phi +!fake global coordinate is enough here + + II = dcmplx(0.d0,1.d0) + gr = 1.d0 + tgrho = dtan(crho) + tgsigma = dtan(sigma) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_News: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + swtf = (RNew+II*INew)/swtf**2 + + RNew = dreal(swtf) + INew = dimag(swtf) + + return + +end subroutine get_News +!------------------------------------------------------------------------------------------------------------ +subroutine get_null_news2(ex,crho,sigma,R,omega,dtomega, & + g00,g01,g02,g03,g22,g23,g33, & + dtg22,dtg23,dtg33, & + RNews,INews,Rmin,sst) + +implicit none + +integer,intent(in) :: ex(3),sst +real*8,intent(in) :: Rmin +real*8,intent(in),dimension(ex(1))::crho +real*8,intent(in),dimension(ex(2))::sigma +real*8,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: omega,dtomega +real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: g00,g01,g02,g03,g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtg22,dtg23,dtg33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews + +real*8 :: Gamuxx,Gamuxy,Gamuyy +real*8 :: Gamrxx,Gamrxy,Gamryy +real*8 :: Gamxxx,Gamxxy,Gamxyy +real*8 :: Gamyxx,Gamyxy,Gamyyy +real*8 :: dg22,dg23,dg33 +real*8 :: dgx22,dgx23,dgx33 +real*8 :: dgx02,dgx03 +real*8 :: dgy22,dgy23,dgy33 +real*8 :: dgy02,dgy03 +real*8 :: dxomega,dyomega +real*8 :: dxxomega,dxyomega,dyyomega + +integer :: i,j,k + +k = ex(3) +do i=1,ex(1) +do j=1,ex(2) + call rderivs_x_point(ex(3),R,g22(i,j,:),dg22,k) + call rderivs_x_point(ex(3),R,g23(i,j,:),dg23,k) + call rderivs_x_point(ex(3),R,g33(i,j,:),dg33,k) + + call rderivs_x_point(ex(1),crho,g02(:,j,k),dgx02,i) + call rderivs_x_point(ex(1),crho,g03(:,j,k),dgx03,i) + call rderivs_x_point(ex(1),crho,g22(:,j,k),dgx22,i) + call rderivs_x_point(ex(1),crho,g23(:,j,k),dgx23,i) + call rderivs_x_point(ex(1),crho,g33(:,j,k),dgx33,i) + call rderivs_x_point(ex(1),crho,omega(:,j,k),dxomega,i) + + call rderivs_x_point(ex(2),sigma,g02(i,:,k),dgy02,j) + call rderivs_x_point(ex(2),sigma,g03(i,:,k),dgy03,j) + call rderivs_x_point(ex(2),sigma,g22(i,:,k),dgy22,j) + call rderivs_x_point(ex(2),sigma,g23(i,:,k),dgy23,j) + call rderivs_x_point(ex(2),sigma,g33(i,:,k),dgy33,j) + call rderivs_x_point(ex(2),sigma,omega(i,:,k),dyomega,j) + + call get_christoffel(Rmin,g00(i,j,k),g01(i,j,k),g02(i,j,k),g03(i,j,k), & + g22(i,j,k),g23(i,j,k),g33(i,j,k), & + dtg22(i,j,k),dtg23(i,j,k),dtg33(i,j,k),& + dg22,dg23,dg33,& + dgx02,dgx03,dgx22,dgx23,dgx33,& + dgy02,dgy03,dgy22,dgy23,dgy33,& + omega(i,j,k),dtomega(i,j,k),dxomega,dyomega,& + Gamuxx,Gamuxy,Gamuyy, & + Gamrxx,Gamrxy,Gamryy, & + Gamxxx,Gamxxy,Gamxyy, & + Gamyxx,Gamyxy,Gamyyy) + + call rdderivs_x_point(ex(1),crho,omega(:,j,k),dxxomega,i) + call rdderivs_x_point(ex(2),crho,omega(i,:,k),dyyomega,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,omega(:,:,k),dxyomega,i,j) + + call get_News(crho(i),sigma(j),& + dxxomega,dxyomega,dyyomega,& + omega(i,j,k),dtomega(i,j,k),dxomega,dyomega,& + Gamuxx,Gamuxy,Gamuyy, & + Gamrxx,Gamrxy,Gamryy, & + Gamxxx,Gamxxy,Gamxyy, & + Gamyxx,Gamyxy,Gamyyy,RNews(i,j,k),INews(i,j,k),sst) +enddo +enddo + + return + +end subroutine get_null_news2 +!!------------------------------------------------------------------------------------------------------------ +!! input g_AB and Theta_AB are divided by r^2 indeed +!! input g_00 is also divided by r^2 indeed +! the output g00 is K +subroutine get_omega_and_dtomega_pre(ex,crho,sigma,X,g22,g23,g33, & + omega,dtomega, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega,dtomega + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) +det = g22*g33-g23*g23 +gup22 = g33/det +gup23 = -g23/det +gup33 = g22/det + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + tg22 = 1-sr2*ss2 + tg22 = 1/tg22/tg22 + + tg23 = -sr*cr*ss*cs*tg22 + tg33 = cr2*tg22 + tg22 = cs2*tg22 + +! ghat/(g/r^4) indeed + det(i,j,k) = (tg22*tg33-tg23*tg23)/det(i,j,k) + enddo + enddo + enddo + + omega = dsqrt(det) + k = ex(3) + do i=1,ex(1) + do j=1,ex(2) + + call rderivs_x_point(ex(1),crho,det(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,det(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,det(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,det(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,det(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + KK(i,j,k) = dsqrt(det(i,j,k))*(1-0.25*covf/R(k)**2) + enddo + enddo + + dtomega = KK + + return + +end subroutine get_omega_and_dtomega_pre +!------------------------------------------------------------------------------------------------------ +subroutine get_dtomega(ex,crho,sigma,X,g22,g23,g33, & + omega,dtomega, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::omega,g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::dtomega + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + + KK = dtomega + + k = ex(3) + do i=1,ex(1) + do j=1,ex(2) + + call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + dtomega(i,j,k) = -covf*omega(i,j,k)**3/6/m0/2 + enddo + enddo + + return + +end subroutine get_dtomega +!!------------------------------------------------------------------------------------------------------------ +!! input g_AB and Theta_AB are divided by r^2 indeed +!! input g_00 is also divided by r^2 indeed +subroutine get_omega_and_dtomega_LN(time,ex,crho,sigma,XX, & + omega,dtomega, Rmin,sst) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: time,Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega,dtomega + +integer :: i,j,k +real*8 :: gr,gt,gp,tgrho,tgsigma,tc,ts,x,y,z + +double complex :: II,Jr,Jrt +double complex :: Zslm,z020 + +double complex :: beta0,C1,C2,mx,my,mlx,mly +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + +II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary3: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + z020 = Zslm(0,2,m,gt,gp) + + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1 + Jr = Jr*exp(II*nu*time) + Jrt = II*nu*Jr*exp(II*nu*time) + + Jr = dsqrt(dble((2-1)))*dreal(Jr)*z020 + Jrt = dsqrt(dble((2-1)))*dreal(Jrt)*z020 + + omega(i,j,k) = 1-dreal(Jr) + dtomega(i,j,k) = -dreal(Jrt) + + enddo + enddo + enddo + + return + +end subroutine get_omega_and_dtomega_LN diff --git a/AMSS_NCKU_source/NullShellPatch.C b/AMSS_NCKU_source/NullShellPatch.C new file mode 100644 index 0000000..266dab1 --- /dev/null +++ b/AMSS_NCKU_source/NullShellPatch.C @@ -0,0 +1,5812 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "NullShellPatch.h" +#include "Parallel.h" +#include "fmisc.h" +#include "misc.h" +#include "shellfunctions.h" +#include "NullEvol.h" +#include "NullNews.h" +#include "initial_null.h" +#include "rungekutta4_rout.h" +#include "kodiss.h" + +#define PI M_PI + +// x x x x x o * +// * o x x x x x +// each side contribute an overlap points +// so we need half of that +#define overghost ((ghost_width + 1) / 2 + ghost_width) + +NullShellPatch::NullShellPatch(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetryi, int myranki) : myrank(myranki), Rmin(Rmini), xmin(xmini), xmax(xmaxi), PatL(0), Symmetry(Symmetryi) +{ + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; +// we always assume the input parameter is in cell center style +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape[i] = shape[i] + 1; +#endif + } + + if (myrank == 0) + { + cout << " null shell's range: r = [" << xmin * Rmin / (1 - xmin) << ":"; + if (xmax == 1) + cout << " +Infty]" << endl; + else + cout << xmax * Rmin / (1 - xmax) << "]" << endl; + cout << " x = [" << xmin << ":" << xmax << "]" << endl + << " shape: " << shape[2] << endl + << " resolution: [" << getdX(0) << "," << getdX(1) << "," << getdX(2) << "]" << endl; + } +// in order to touch infinity, we always use vertex center in r direction +// for Cell center it is some fake as following +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + { + double ht = (xmax - xmin) / shape[2]; + xmax = xmax + ht / 2; + xmin = xmin - ht / 2; + shape[2] = shape[2] + 1; + } +#endif + + double bbox[2 * dim]; + int shape_here[dim]; + bbox[2] = xmin; + bbox[5] = xmax; + shape_here[2] = shape[2]; + + switch (Symmetry) + { + case 0: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 1: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + shape_here[0] = shape[0] + 2 * overghost; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape_here[1] = (shape[1] + 1) / 2 + overghost; +#else +#ifdef Cell + shape_here[1] = shape[1] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + bbox[0] = -PI / 4 - overghost * getdX(0); + shape_here[1] += ghost_width; + bbox[1] = -ghost_width * getdX(1); // buffer points method to deal with boundary + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL->insert(new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = ghost_width * getdX(1); // buffer points method to deal with boundary + PatL->insert(new xm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 2: +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int i = 0; i < 2; i++) + shape_here[i] = (shape[i] + 1) / 2 + overghost; +#else +#ifdef Cell + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + shape_here[0] += ghost_width; + shape_here[1] += ghost_width; + bbox[0] = -ghost_width * getdX(0); // buffer points method to deal with boundary + bbox[1] = -ghost_width * getdX(1); // buffer points method to deal with boundary + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + default: + cout << "not recognized Symmetry type" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int ngfs = 0; + FXZEO = new var("FXZEO", ngfs++, 1, 1, 1); + gx = new var("gx", ngfs++, 1, 1, 1); + gy = new var("gy", ngfs++, 1, 1, 1); + gz = new var("gz", ngfs++, 1, 1, 1); + // every thing is taken as scalar + beta = new var("beta", ngfs++, 1, 1, 1); + W = new var("W", ngfs++, 1, 1, 1); + KK = new var("KK", ngfs++, 1, 1, 1); + HKK = new var("HKK", ngfs++, 1, 1, 1); + KKx = new var("KKx", ngfs++, 1, 1, 1); + HKKx = new var("HKKx", ngfs++, 1, 1, 1); + Rnu = new var("Rnu", ngfs++, 1, 1, 1); + Inu = new var("Inu", ngfs++, 1, 1, 1); + Rk = new var("Rk", ngfs++, 1, 1, 1); + Ik = new var("Ik", ngfs++, 1, 1, 1); + RB = new var("RB", ngfs++, 1, 1, 1); + IB = new var("IB", ngfs++, 1, 1, 1); + RQ = new var("RQ", ngfs++, 1, 1, 1); + IQ = new var("IQ", ngfs++, 1, 1, 1); + RU = new var("RU", ngfs++, 1, 1, 1); + IU = new var("IU", ngfs++, 1, 1, 1); + RTheta = new var("RTheta", ngfs++, 1, 1, 1); + ITheta = new var("ITheta", ngfs++, 1, 1, 1); + RJo = new var("RJo", ngfs++, 1, 1, 1); + IJo = new var("IJo", ngfs++, 1, 1, 1); + omegao = new var("omegao", ngfs++, 1, 1, 1); + RJ0 = new var("RJ0", ngfs++, 1, 1, 1); + IJ0 = new var("IJ0", ngfs++, 1, 1, 1); + omega0 = new var("omega0", ngfs++, 1, 1, 1); + RJ = new var("RJ", ngfs++, 1, 1, 1); + IJ = new var("IJ", ngfs++, 1, 1, 1); + omega = new var("omega", ngfs++, 1, 1, 1); + RJ1 = new var("RJ1", ngfs++, 1, 1, 1); + IJ1 = new var("IJ1", ngfs++, 1, 1, 1); + omega1 = new var("omega1", ngfs++, 1, 1, 1); + RJ_rhs = new var("RJ_rhs", ngfs++, 1, 1, 1); + IJ_rhs = new var("IJ_rhs", ngfs++, 1, 1, 1); + omega_rhs = new var("omega_rhs", ngfs++, 1, 1, 1); + + quR1 = new var("quR1", ngfs++, 1, 1, 1); + quI1 = new var("quI1", ngfs++, 1, 1, 1); + quR2 = new var("quR2", ngfs++, 1, 1, 1); + quI2 = new var("quI2", ngfs++, 1, 1, 1); + qlR1 = new var("qlR1", ngfs++, 1, 1, 1); + qlI1 = new var("qlI1", ngfs++, 1, 1, 1); + qlR2 = new var("qlR2", ngfs++, 1, 1, 1); + qlI2 = new var("qlI2", ngfs++, 1, 1, 1); + gR = new var("gR", ngfs++, 1, 1, 1); + gI = new var("gI", ngfs++, 1, 1, 1); + + dquR1 = new var("dquR1", ngfs++, 1, 1, 1); + dquI1 = new var("dquI1", ngfs++, 1, 1, 1); + dquR2 = new var("dquR2", ngfs++, 1, 1, 1); + dquI2 = new var("dquI2", ngfs++, 1, 1, 1); + bdquR1 = new var("bdquR1", ngfs++, 1, 1, 1); + bdquI1 = new var("bdquI1", ngfs++, 1, 1, 1); + bdquR2 = new var("bdquR2", ngfs++, 1, 1, 1); + bdquI2 = new var("bdquI2", ngfs++, 1, 1, 1); + dgR = new var("dgR", ngfs++, 1, 1, 1); + dgI = new var("dgI", ngfs++, 1, 1, 1); + bdgR = new var("bdgR", ngfs++, 1, 1, 1); + bdgI = new var("bdgI", ngfs++, 1, 1, 1); + + RNews = new var("RNews", ngfs++, 1, 1, 1); + INews = new var("INews", ngfs++, 1, 1, 1); + + DumpList = new MyList(RJ0); + DumpList->insert(IJ0); + + betaList = new MyList(beta); + betaList->insert(beta); + betawt[0] = 0; + QUList = new MyList(RQ); + QUList->insert(IQ); + QUList->insert(RU); + QUList->insert(IU); + QUwt[0] = QUwt[1] = 1; + WTheList = new MyList(W); + WTheList->insert(W); + WTheList->insert(RTheta); + WTheList->insert(ITheta); + WThewt[0] = 0; + WThewt[1] = 2; + + TheList = new MyList(RTheta); + TheList->insert(ITheta); + + OldStateList = new MyList(RJo); + OldStateList->insert(IJo); + OldStateList->insert(omegao); + StateList = new MyList(RJ0); + StateList->insert(IJ0); + StateList->insert(omega0); + SynchList_pre = new MyList(RJ); + SynchList_pre->insert(IJ); + SynchList_pre->insert(omega); + RHSList = new MyList(RJ_rhs); + RHSList->insert(IJ_rhs); + RHSList->insert(omega_rhs); + SynchList_cor = new MyList(RJ1); + SynchList_cor->insert(IJ1); + SynchList_cor->insert(omega1); + + JrhsList = new MyList(RJ_rhs); + JrhsList->insert(IJ_rhs); + J1List = new MyList(RJ1); + J1List->insert(IJ1); + + ingfs = 0; + fngfs = ngfs; +} +NullShellPatch::~NullShellPatch() +{ + int nprocs = 1; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + for (int node = 0; node < nprocs; node++) + { + if (ss_src[node]) + destroypsuList(ss_src[node]); + if (ss_dst[node]) + destroypsuList(ss_dst[node]); + if (cs_src) + { + if (cs_src[node]) + destroypsuList(cs_src[node]); + if (cs_dst[node]) + destroypsuList(cs_dst[node]); + } + } + + delete[] ss_src; + delete[] ss_dst; + if (cs_src) + { + delete[] cs_src; + delete[] cs_dst; + } + + while (PatL) + { + ss_patch *sPp = PatL->data; + MyList *bg; + while (sPp->blb) + { + if (sPp->blb == sPp->ble) + break; + bg = (sPp->blb->next) ? sPp->blb->next : 0; + delete sPp->blb->data; + delete sPp->blb; + sPp->blb = bg; + } + if (sPp->ble) + { + delete sPp->ble->data; + delete sPp->ble; + } + sPp->blb = sPp->ble = 0; + PatL = PatL->next; + } + PatL->destroyList(); + + StateList->clearList(); + SynchList_pre->clearList(); + SynchList_cor->clearList(); + RHSList->clearList(); + OldStateList->clearList(); + DumpList->clearList(); + CheckList->clearList(); + betaList->clearList(); + QUList->clearList(); + WTheList->clearList(); + TheList->clearList(); + JrhsList->clearList(); + J1List->clearList(); + + delete FXZEO; + delete gx; + delete gy; + delete gz; + delete beta; + delete W; + delete Rnu; + delete Inu; + delete Rk; + delete Ik; + delete RB; + delete IB; + delete RQ; + delete IQ; + delete RU; + delete IU; + delete RTheta; + delete ITheta; + delete KK; + delete HKK; + delete KKx; + delete HKKx; + + delete RJo; + delete IJo; + delete omegao; + delete RJ0; + delete IJ0; + delete omega0; + delete RJ; + delete IJ; + delete omega; + delete RJ1; + delete IJ1; + delete omega1; + delete RJ_rhs; + delete IJ_rhs; + delete omega_rhs; + + delete quR1; + delete quR2; + delete quI1; + delete quI2; + delete qlR1; + delete qlR2; + delete qlI1; + delete qlI2; + delete gR; + delete gI; + delete dquR1; + delete dquR2; + delete dquI1; + delete dquI2; + delete bdquR1; + delete bdquR2; + delete bdquI1; + delete bdquI2; + delete dgR; + delete dgI; + delete bdgR; + delete bdgI; + + delete RNews; + delete INews; +} +void NullShellPatch::destroypsuList(MyList *ct) +{ + MyList *n; + while (ct) + { + n = ct->next; + if (ct->data->coef) + { + delete[] ct->data->coef; + delete[] ct->data->sind; + } + delete ct->data; + delete ct; + ct = n; + } +} +// the number of VarList = 2* the number of Varwt +void NullShellPatch::fill_symmetric_boundarybuffer(MyList *VarList, int *Varwt) +{ + MyList *varl; + int ind; + double drho = getdX(0), dsigma = getdX(1); + + if (Symmetry == 0) + return; + else + { + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + varl = VarList; + ind = 0; + while (varl) + { + f_fill_symmetric_boundarybuffer(cg->shape, cg->X[0], cg->X[1], cg->X[2], drho, dsigma, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl->next->data->sgfn], + Symmetry, Pp->data->sst, Varwt[ind]); + varl = varl->next; + varl = varl->next; + ind++; + } + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +} +MyList *NullShellPatch::compose_sh(int cpusize) +{ + if (dim != 3) + { + cout << "distrivute: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + // checkPatch(); + + MyList *BlL = 0; + + int split_size, min_size, block_size = 0; + + int min_width = 2 * Mymax(ghost_width, buffer_width); + int nxy[2], mmin_width[2], min_shape[2]; + + MyList *PLi = PatL; + for (int i = 0; i < 2; i++) + min_shape[i] = PLi->data->shape[i]; + PLi = PLi->next; + while (PLi) + { + ss_patch *PP = PLi->data; + for (int i = 0; i < 2; i++) + min_shape[i] = Mymin(min_shape[i], PP->shape[i]); + PLi = PLi->next; + } + + for (int i = 0; i < 2; i++) + mmin_width[i] = Mymin(min_width, min_shape[i]); + + min_size = mmin_width[0]; + for (int i = 1; i < 2; i++) + min_size = min_size * mmin_width[i]; + + PLi = PatL; + while (PLi) + { + ss_patch *PP = PLi->data; + // PP->checkPatch(true); + int bs = PP->shape[0]; + for (int i = 1; i < 2; i++) + bs = bs * PP->shape[i]; + block_size = block_size + bs; + PLi = PLi->next; + } + split_size = Mymax(min_size, block_size / cpusize); + split_size = Mymax(1, split_size); + + int n_rank = 0; + PLi = PatL; + int reacpu = 0; + while (PLi) + { + ss_patch *PP = PLi->data; + + reacpu += Parallel::partition2(nxy, split_size, mmin_width, cpusize, PP->shape); // r direction can not be splitted!! It's ode! + + Block *ng; + int shape_here[3], ibbox_here[2 * 2]; + double bbox_here[2 * 3], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxy[0]; i++) + for (int j = 0; j < nxy[1]; j++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxy[0]; + ibbox_here[2] = (PP->shape[0] * (i + 1)) / nxy[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxy[1]; + ibbox_here[3] = (PP->shape[1] * (j + 1)) / nxy[1] - 1; + + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[2] = Mymin(PP->shape[0] - 1, ibbox_here[2] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[1] - 1, ibbox_here[3] + ghost_width); + + shape_here[0] = ibbox_here[2] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[3] - ibbox_here[1] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[2] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[3] * dd; +#else +#ifdef Cell + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[2] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[3] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + shape_here[2] = PP->shape[2]; + bbox_here[2] = PP->bbox[2]; + bbox_here[5] = PP->bbox[5]; + ng = new Block(dim, shape_here, bbox_here, n_rank++, ingfs, fngfs, 0); // delete through KillBlocks + // ng->checkBlock(); + if (n_rank == cpusize) + n_rank = 0; + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + // set PP->blb + if (i == 0 && j == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < cpusize * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch::distribute CAUSTION: uses essencially " << reacpu << " processors vs " << cpusize << " cpus run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +int NullShellPatch::getdumydimension(int acsst, int posst) // -1 means no dumy dimension +{ + int dms; + if (acsst == -1 || posst == -1) + return -1; + switch (acsst) + { + case 0: + case 1: + switch (posst) + { + case 0: + case 1: + cout << "error in NullShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 2: + case 3: + return 0; + case 4: + case 5: + return 1; + default: + cout << "error in NullShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + case 2: + case 3: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + cout << "error in NullShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 4: + case 5: + return 0; + default: + cout << "error in NullShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + case 4: + case 5: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + return 0; + case 4: + case 5: + cout << "error in NullShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + default: + cout << "error in NullShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + default: + cout << "error in NullShellPatch::getdumydimension: acsst = " << acsst << endl; + return -1; + } +} +void NullShellPatch::Setup_dyad() +{ + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_setup_dyad(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + cg->fgfs[gx->sgfn], cg->fgfs[gy->sgfn], cg->fgfs[gz->sgfn], + Pp->data->sst, Rmin); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +} +void NullShellPatch::Setup_Initial_Data(bool checkrun, double PhysTime) +{ + if (checkrun) + { + } + else + { + double one = 1.0; + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], Pp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + // f_get_initial_null(cg->shape,cg->X[0],cg->X[1],cg->X[2], + // cg->fgfs[RJ0->sgfn],cg->fgfs[IJ0->sgfn],Pp->data->sst,Rmin); + // f_set_value(cg->shape,cg->fgfs[omega0->sgfn],one); + f_get_exact_omega(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega0->sgfn], Pp->data->sst, Rmin, PhysTime); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + int Varwt[1]; + MyList *DG_List; +#if 0 + eth_derivs(RJ0,IJ0,RJ1,IJ1,0,1); + Varwt[0]=1; + DG_List=new MyList(RJ1); DG_List->insert(IJ1); + Synch(DG_List,Symmetry,Varwt); + eth_derivs(RJ1,IJ1,RJ0,IJ0,1,1); + DG_List->clearList(); // after this DG_List = 0 +#elif 0 + eth_dderivs(RJ1, IJ1, RJ0, IJ0, 0, 1, 1); +#endif + DG_List = new MyList(RJ0); + DG_List->insert(IJ0); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + + Dump_Data(DG_List, 0, 0, 1); + DG_List->clearList(); + } +} +void NullShellPatch::eth_derivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e) +{ + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_eth_derivs(cg->shape, cg->X[0], cg->X[1], cg->fgfs[Rv->sgfn], cg->fgfs[Iv->sgfn], + cg->fgfs[ethRv->sgfn], cg->fgfs[ethIv->sgfn], s, e, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(ethRv); + DG_List->insert(ethIv); + Varwt[0] = s + e; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); +} +void NullShellPatch::eth_dderivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e1, int e2) +{ + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_eth_dderivs(cg->shape, cg->X[0], cg->X[1], cg->fgfs[Rv->sgfn], cg->fgfs[Iv->sgfn], + cg->fgfs[ethRv->sgfn], cg->fgfs[ethIv->sgfn], s, e1, e2, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(ethRv); + DG_List->insert(ethIv); + Varwt[0] = s + e1 + e2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); +} +// lz is x instead of r +void NullShellPatch::getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = r / (r + Rmin); + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch::getlocalpox should not come here, something wrong" << endl; + } +} +// lz is x instead of r +// using fake global coordinates to get local coordinate +void NullShellPatch::getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = r; + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch::getlocalpox should not come here, something wrong" << endl; + } +} +// lz is x instead of r +// specially for usage from shell to shell +void NullShellPatch::getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz) +{ + // fake global coordinate + double r = 1, x, y, z; + switch (isst) + { + case 0: + x = tan(ix); + y = tan(iy); + z = r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 1: + x = tan(ix); + y = tan(iy); + z = -r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 2: + y = tan(ix); + z = tan(iy); + x = r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 3: + y = tan(ix); + z = tan(iy); + x = -r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 4: + x = tan(ix); + z = tan(iy); + y = r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + case 5: + x = tan(ix); + z = tan(iy); + y = -r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + } + + // map with fake global coordinate + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch::getlocalpox should not come here, something wrong" << endl; + } + + lz = iz; + + // if(lx != lx) cout< NullShellPatch::get_swtf(double *pox, int tsst, int ssst) +{ + double rn = pox[0], sn = pox[1], ro, so; + double tcn, tsn, tco, tso; + tcn = sqrt((1 - sin(rn) * sin(sn)) / 2); + tsn = sqrt((1 + sin(rn) * sin(sn)) / 2); + // upper a + complex qan[2]; + qan[0] = complex(tsn, tcn); + qan[1] = complex(tsn, -tcn); + qan[0] = 2.0 * tcn * tsn / cos(sn) * qan[0]; + qan[1] = 2.0 * tcn * tsn / cos(rn) * qan[1]; + if (tsst == 1 || tsst == 3 || tsst == 4) + { + qan[0] = conj(qan[0]); + qan[1] = conj(qan[1]); + } + + complex qao[2]; + complex gont; + + double J[2][2]; + double cosro, sinro, cosso, sinso; + if (tsst == 0 || tsst == 1) // z + { + if (ssst == 2 || ssst == 3) // x + { + ro = atan(tan(sn) / tan(rn)); + so = atan(1 / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[1] = complex(tso, -tco); + qao[1] = 2.0 * tco * tso / cos(ro) * qao[1]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[1] = conj(qao[1]); + } + gont = -qan[0] / qao[1]; + } + else if (ssst == 4 || ssst == 5) // y + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[1] = complex(tso, -tco); + qao[1] = 2.0 * tco * tso / cos(ro) * qao[1]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[1] = conj(qao[1]); + } + gont = -qan[1] / qao[1]; + } + else + cout << "Error in NullShellPatch::get_swtf 1" << endl; + } + else if (tsst == 2 || tsst == 3) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(1 / tan(sn)); + so = atan(tan(rn) / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[0] = complex(tso, tco); + qao[0] = 2.0 * tco * tso / cos(so) * qao[0]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[0] = conj(qao[0]); + } + gont = -qan[1] / qao[0]; + } + else if (ssst == 4 || ssst == 5) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[0] = complex(tso, tco); + qao[0] = 2.0 * tco * tso / cos(so) * qao[0]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[0] = conj(qao[0]); + } + gont = -qan[0] / qao[0]; + } + else + cout << "Error in NullShellPatch::get_swtf 2" << endl; + } + else if (tsst == 4 || tsst == 5) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[1] = complex(tso, -tco); + qao[1] = 2.0 * tco * tso / cos(ro) * qao[1]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[1] = conj(qao[1]); + } + gont = -qan[1] / qao[1]; + } + else if (ssst == 2 || ssst == 3) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + // upper a + qao[0] = complex(tso, tco); + qao[0] = 2.0 * tco * tso / cos(so) * qao[0]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[0] = conj(qao[0]); + } + gont = -qan[0] / qao[0]; + } + else + cout << "Error in NullShellPatch::get_swtf 3" << endl; + } + + return gont; +} +#else +// #define DEBUG +complex NullShellPatch::get_swtf(double *pox, int tsst, int ssst) +{ + double rn = pox[0], sn = pox[1], ro, so; + double tcn, tsn, tco, tso; + tcn = sqrt((1 - sin(rn) * sin(sn)) / 2); + tsn = sqrt((1 + sin(rn) * sin(sn)) / 2); +#ifdef DEBUG + // upper a + complex qan[2]; + qan[0] = complex(tsn, tcn); + qan[1] = complex(tsn, -tcn); + qan[0] = 2.0 * tcn * tsn / cos(sn) * qan[0]; + qan[1] = 2.0 * tcn * tsn / cos(rn) * qan[1]; + if (tsst == 1 || tsst == 3 || tsst == 4) + { + qan[0] = conj(qan[0]); + qan[1] = conj(qan[1]); + } +#endif + // lower bar a + complex lan[2]; + lan[0] = complex(tcn, -tsn); + lan[1] = complex(tcn, tsn); + lan[0] = cos(sn) / 4.0 / tcn / tcn / tsn / tsn * lan[0]; + lan[1] = cos(rn) / 4.0 / tcn / tcn / tsn / tsn * lan[1]; + + if (tsst == 1 || tsst == 3 || tsst == 4) + { + lan[0] = conj(lan[0]); + lan[1] = conj(lan[1]); + } + + complex gont = complex(2, 0); + + double J[2][2]; + double cosro, sinro, cosso, sinso; + if (tsst == 0 || tsst == 1) // z + { + if (ssst == 2 || ssst == 3) // x + { + ro = atan(tan(sn) / tan(rn)); + so = atan(1 / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = 0; + J[0][1] = -1; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = -cosro * sinro / J[1][0]; + J[1][0] = cosso * sinso / J[1][0]; + } + else if (ssst == 4 || ssst == 5) // y + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = -cosro * sinro / J[0][0]; + J[0][0] = cosso * sinso / J[0][0]; + J[1][0] = 0; + J[1][1] = -1; + } + else + cout << "Error in NullShellPatch::get_swtf 1" << endl; + } + else if (tsst == 2 || tsst == 3) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(1 / tan(sn)); + so = atan(tan(rn) / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = cosro * sinro / J[0][0]; + J[0][0] = -cosso * sinso / J[0][0]; + J[1][0] = -1; + J[1][1] = 0; + } + else if (ssst == 4 || ssst == 5) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = -1; + J[0][1] = 0; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = cosro * sinro / J[1][0]; + J[1][0] = -cosso * sinso / J[1][0]; + } + else + cout << "Error in NullShellPatch::get_swtf 2" << endl; + } + else if (tsst == 4 || tsst == 5) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = -cosro * sinro / J[0][0]; + J[0][0] = cosso * sinso / J[0][0]; + J[1][0] = 0; + J[1][1] = -1; + } + else if (ssst == 2 || ssst == 3) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = -1; + J[0][1] = 0; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = cosro * sinro / J[1][0]; + J[1][0] = -cosso * sinso / J[1][0]; + } + else + cout << "Error in NullShellPatch::get_swtf 3" << endl; + } + tco = sqrt((1 - sin(ro) * sin(so)) / 2); + tso = sqrt((1 + sin(ro) * sin(so)) / 2); + + complex qao[2]; + // upper a + qao[0] = complex(tso, tco); + qao[1] = complex(tso, -tco); + qao[0] = 2.0 * tco * tso / cos(so) * qao[0]; + qao[1] = 2.0 * tco * tso / cos(ro) * qao[1]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + qao[0] = conj(qao[0]); + qao[1] = conj(qao[1]); + } + + gont /= J[0][0] * lan[0] * qao[0] + J[0][1] * lan[0] * qao[1] + J[1][0] * lan[1] * qao[0] + J[1][1] * lan[1] * qao[1]; + +#ifdef DEBUG + + complex lao[2]; + // lower bar a + lao[0] = complex(tco, -tso); + lao[1] = complex(tco, tso); + lao[0] = cos(so) / 4.0 / tco / tco / tso / tso * lao[0]; + lao[1] = cos(ro) / 4.0 / tco / tco / tso / tso * lao[1]; + if (ssst == 1 || ssst == 3 || ssst == 4) + { + lao[0] = conj(lao[0]); + lao[1] = conj(lao[1]); + } + + static bool f1 = true, f2 = true, f3 = true, f4 = true; + static bool f5 = true, f6 = true, f7 = true, f8 = true; + static bool f9 = true, f10 = true, f11 = true, f12 = true; + double hn11, hn12, hn22; + double ho11, ho12, ho22; + if (f1 && tsst == 0 && ssst == 2) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "x+ -> z+; g -> x+; g -> z+" << endl; + double the = atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f1 = false; + } + else if (f2 && tsst == 0 && ssst == 3) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "x- -> z+; g -> x-; g -> z+" << endl; + double the = atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f2 = false; + } + else if (f3 && tsst == 0 && ssst == 4) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "y+ -> z+; g -> y+; g -> z+" << endl; + double the = atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f3 = false; + } + else if (f4 && tsst == 0 && ssst == 5) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "y- -> z+; g -> y-; g -> z+" << endl; + double the = atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f4 = false; + } + else if (f5 && tsst == 1 && ssst == 2) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "x+ -> z-; g -> x+; g -> z-" << endl; + double the = PI - atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f5 = false; + } + else if (f6 && tsst == 1 && ssst == 3) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "x- -> z-; g -> x-; g -> z-" << endl; + double the = PI - atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f6 = false; + } + else if (f7 && tsst == 1 && ssst == 4) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "y+ -> z-; g -> y+; g -> z-" << endl; + double the = PI - atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f7 = false; + } + else if (f8 && tsst == 1 && ssst == 5) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "y- -> z-; g -> y-; g -> z-" << endl; + double the = PI - atan(sqrt(tan(rn) * tan(rn) + tan(sn) * tan(sn))), phi = atan2(tan(sn), tan(rn)); + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(cos(phi), sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(sin(phi), -cos(phi) * cos(the)) / (sin(phi) * sin(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f8 = false; + } + else if (f9 && tsst == 2 && ssst == 0) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << "z+ -> x+; g -> z+; g -> x+" << endl; + double the = atan(sqrt(tan(rn) * tan(rn) + 1) / tan(sn)), phi = rn; + if (the < 0) + the = PI + the; + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << "," + << complex(0, -1) / sin(the) / (J[0][0] * qao[0] + J[0][1] * qao[1]) << "," + << complex(0, -1) / sin(the) / qan[0] + << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << "," + << complex(-cos(phi), -sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / (J[1][0] * qao[0] + J[1][1] * qao[1]) << "," + << complex(-cos(phi), -sin(phi) * cos(the)) / (cos(phi) * cos(phi) * sin(the) * sin(the) + cos(the) * cos(the)) / qan[1] + << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f9 = false; + } + else if (f10 && tsst == 2 && ssst == 1) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f10 = false; + } + else if (f11 && tsst == 2 && ssst == 4) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f11 = false; + } + else if (f12 && tsst == 2 && ssst == 5) + { + cout << "tsst = " << tsst << ", ssst = " << ssst << endl; + cout << tan(rn) << "," << tan(sn) << "," << lan[0] * qan[0] + lan[1] * qan[1] << endl; + cout << tan(ro) << "," << tan(so) << "," << lao[0] * qao[0] + lao[1] * qao[1] << endl; + cout << (J[0][0] * qao[0] + J[0][1] * qao[1]) / qan[0] << endl; + cout << (J[1][0] * qao[0] + J[1][1] * qao[1]) / qan[1] << endl; + ho11 = pow(1 - sin(ro) * sin(ro) * sin(so) * sin(so), -2); + ho12 = -0.25 * sin(2 * ro) * sin(2 * so) * ho11; + ho22 = cos(ro) * cos(ro) * ho11; + ho11 = cos(so) * cos(so) * ho11; + hn11 = pow(1 - sin(rn) * sin(rn) * sin(sn) * sin(sn), -2); + hn12 = -0.25 * sin(2 * rn) * sin(2 * sn) * hn11; + hn22 = cos(rn) * cos(rn) * hn11; + hn11 = cos(sn) * cos(sn) * hn11; + cout << ho11 << "," << ho12 << "," << ho22 << endl; + cout << hn11 * J[0][0] * J[0][0] + hn12 * J[0][0] * J[1][0] + hn12 * J[1][0] * J[0][0] + hn22 * J[1][0] * J[1][0] << "," + << hn11 * J[0][0] * J[0][1] + hn12 * J[0][0] * J[1][1] + hn12 * J[1][0] * J[0][1] + hn22 * J[1][0] * J[1][1] << "," + << hn11 * J[0][1] * J[0][1] + hn12 * J[0][1] * J[1][1] + hn12 * J[1][1] * J[0][1] + hn22 * J[1][1] * J[1][1] << endl; + cout << "swtf = " << gont << endl; + f12 = false; + } + +#endif + + return gont; +} +#endif +// for check +// used by _dst construction, so these x,y,z must coinside with grid point +// we have considered ghost points now +void NullShellPatch::prolongpointstru(MyList *&psul, MyList *sPpi, double DH[dim], + MyList *Ppi, double CDH[dim], MyList *pss) +{ + int n_dst = 0; + MyList *sPp = sPpi; + MyList *Pp = Ppi; + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz, lsst; + + if (pss->data->tsst >= 0) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + if (lx != lx) + getlocalpoxsst_ss(pss->data->ssst, pss->data->lpox[0], pss->data->lpox[1], pss->data->lpox[2], + pss->data->tsst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == pss->data->tsst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * DH[0] && lx < uub[0] + 0.1 * DH[0] && + ly > llb[1] - 0.1 * DH[1] && ly < uub[1] + 0.1 * DH[1] && + lz > llb[2] - 0.1 * DH[2] && lz < uub[2] + 0.1 * DH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = sPp->data->sst; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = get_swtf(ps->data->lpox, ps->data->tsst, ps->data->ssst); + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + if (pss->data->tsst != -1) + cout << "somthing is wrong in NullShellPatch::prolongpointstru" << endl; + lx = pss->data->gpox[0]; + ly = pss->data->gpox[1]; + lz = pss->data->gpox[2]; + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * CDH[0] && lx < uub[0] + 0.1 * CDH[0] && + ly > llb[1] - 0.1 * CDH[1] && ly < uub[1] + 0.1 * CDH[1] && + lz > llb[2] - 0.1 * CDH[2] && lz < uub[2] + 0.1 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = -1; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = 1; + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + // if n_dst > 0, that's because of ghost_points then prolong source list + if (n_dst == 0) + { + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch::prolongpointstru fail to find target Block for pointstru:" << endl; + check_pointstrul(pss, true); + if (Pp == Ppi) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + if (myrank == 0) + cout << "sst = " << pss->data->tsst << ", lx,ly,lz = " << lx << "," << ly << "," << lz << endl; + checkBlock(pss->data->tsst); + } + else + { + Pp = Ppi; + while (Pp) + { + Pp->data->checkBlock(); + Pp = Pp->next; + } + } + if (myrank == 0) + MPI_Abort(MPI_COMM_WORLD, 1); + } + else + { + MyList *ts = 0; + for (int i = 1; i < n_dst; i++) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = (i == n_dst - 1) ? pss->next : 0; + for (int i = 0; i < dim; i++) + { + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[i] = pss->data->lpox[i]; + } + ps->data->ssst = pss->data->ssst; + ps->data->tsst = pss->data->tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->Bg = pss->data->Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = pss->data->swtf; + if (ts) + ts->catList(ps); + else + ts = ps; + } + if (ts) + pss->next = ts; + } +} +// used by _src construction, so these x,y,z do not coinside with grid point +bool NullShellPatch::prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in) +{ + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + if (ssyn) + { + int sst; + getlocalpox(x, y, z, sst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == sst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < 2; j++) + { + if (feq(Bg->bbox[j], -PI / 4 - overghost * DH[j], DH[j] / 2)) + llb[j] = -PI / 4; + else if (feq(Bg->bbox[j], sPp->data->bbox[j], DH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * DH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * DH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], PI / 4 + overghost * DH[j], DH[j] / 2)) + uub[j] = PI / 4; + else if (feq(Bg->bbox[dim + j], sPp->data->bbox[dim + j], DH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * DH[j]; + } + if (feq(Bg->bbox[2], sPp->data->bbox[2], DH[2] / 2)) + llb[2] = Bg->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[2] = Bg->bbox[2] + (ghost_width - 1) * DH[2]; +#else +#ifdef Cell + else + llb[2] = Bg->bbox[2] + ghost_width * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + 2], sPp->data->bbox[dim + 2], DH[2] / 2)) + uub[2] = Bg->bbox[dim + 2]; + else + uub[2] = Bg->bbox[dim + 2] - ghost_width * DH[2]; + if (lx > llb[0] - 0.0001 * DH[0] && lx < uub[0] + 0.0001 * DH[0] && + ly > llb[1] - 0.0001 * DH[1] && ly < uub[1] + 0.0001 * DH[1] && + lz > llb[2] - 0.0001 * DH[2] && lz < uub[2] + 0.0001 * DH[2]) // even ghost_width-1 the region is like |----|----| + // ^ + // so for ^ point may miss for vertext center, so we use 0.0001 + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = sPp->data->sst; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = 1; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < dim; j++) + { + if (feq(Bg->bbox[j], Pp->data->bbox[j], CDH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * CDH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * CDH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], Pp->data->bbox[dim + j], CDH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * CDH[j]; + } + if (x > llb[0] - 0.0001 * CDH[0] && x < uub[0] + 0.0001 * CDH[0] && + y > llb[1] - 0.0001 * CDH[1] && y < uub[1] + 0.0001 * CDH[1] && + z > llb[2] - 0.0001 * CDH[2] && z < uub[2] + 0.0001 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = x; + ps->data->lpox[1] = y; + ps->data->lpox[2] = z; + ps->data->ssst = -1; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = 1; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + + return false; +} +// used by _src construction, so these x,y,z do not coinside with grid point +// specially used from shell to shell +bool NullShellPatch::prolongpointstru_ss(MyList *&psul, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in) +{ + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + int sst; + getlocalpox_ss(tsst, x, y, z, sst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == sst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < 2; j++) + { + if (feq(Bg->bbox[j], -PI / 4 - overghost * DH[j], DH[j] / 2)) + llb[j] = -PI / 4; + else if (feq(Bg->bbox[j], sPp->data->bbox[j], DH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * DH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * DH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], PI / 4 + overghost * DH[j], DH[j] / 2)) + uub[j] = PI / 4; + else if (feq(Bg->bbox[dim + j], sPp->data->bbox[dim + j], DH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * DH[j]; + } + if (feq(Bg->bbox[2], sPp->data->bbox[2], DH[2] / 2)) + llb[2] = Bg->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[2] = Bg->bbox[2] + (ghost_width - 1) * DH[2]; +#else +#ifdef Cell + else + llb[2] = Bg->bbox[2] + ghost_width * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + 2], sPp->data->bbox[dim + 2], DH[2] / 2)) + uub[2] = Bg->bbox[dim + 2]; + else + uub[2] = Bg->bbox[dim + 2] - ghost_width * DH[2]; + if (lx > llb[0] - 0.0001 * DH[0] && lx < uub[0] + 0.0001 * DH[0] && + ly > llb[1] - 0.0001 * DH[1] && ly < uub[1] + 0.0001 * DH[1] && + lz > llb[2] - 0.0001 * DH[2] && lz < uub[2] + 0.0001 * DH[2]) // even ghost_width-1 the region is like |----|----| + // ^ + // so for ^ point may miss for vertext center, so we use 0.0001 + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = 0; // global coordinate is not valid for r=infinity + ps->data->gpox[1] = 0; + ps->data->gpox[2] = 0; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = sPp->data->sst; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->swtf = 1; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + + return false; +} +// setup interpatch interpolation stuffs +void NullShellPatch::setupintintstuff(int cpusize, MyList *CPatL, int Symmetry) +{ + const int hCS_width = 0; // do not input data from null shell to box + const int hSC_width = 1; // do input data from box to null shell + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch::setupintintstuff begines..." << endl; + + ss_src = new MyList *[cpusize]; + ss_dst = new MyList *[cpusize]; + + if (!CPatL) // if characteristic evolve alone + { + cs_src = 0; + cs_dst = 0; + } + else + { + cs_src = new MyList *[cpusize]; + cs_dst = new MyList *[cpusize]; + } + + MyList *ps, *ts; + MyList *sPp; + MyList *Bgl; + MyList *Pp; + Block *Bg; + double CDH[dim], DH[dim], llb[dim], uub[dim]; + double x, y, z; + + for (int i = 0; i < dim; i++) + { + if (CPatL) + CDH[i] = CPatL->data->getdX(i); + DH[i] = getdX(i); + } + + for (int i = 0; i < cpusize; i++) + { + ss_src[i] = 0; + ss_dst[i] = 0; + if (CPatL) + { + cs_src[i] = 0; + cs_dst[i] = 0; + } + } + + sPp = PatL; + while (sPp) + { + for (int iz = 0; iz < sPp->data->shape[2]; iz++) + for (int is = 0; is < sPp->data->shape[1]; is++) + for (int ir = 0; ir < sPp->data->shape[0]; ir++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = sPp->data->bbox[0] + ir * DH[0]; + y = sPp->data->bbox[1] + is * DH[1]; + z = sPp->data->bbox[2] + iz * DH[2]; +#else +#ifdef Cell + x = sPp->data->bbox[0] + (ir + 0.5) * DH[0]; + y = sPp->data->bbox[1] + (is + 0.5) * DH[1]; + z = sPp->data->bbox[2] + (iz + 0.5) * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (CPatL && z < sPp->data->bbox[2] + (hSC_width + 0.0001) * DH[2]) + { + double gx, gy, gz; + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = false; + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(cs_src[i], false, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + CPatL->data->checkBlock(); + if (myrank == 0) + { + cout << "ShellPatch::prolongpointstru fail to find cardisian source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + cout << "x,y,z = " << gx << "," << gy << "," << gz << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + if (x < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[0] || x > PI / 4 + (overghost - ghost_width - 0.0001) * DH[0] || + y < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[1] || y > PI / 4 + (overghost - ghost_width - 0.0001) * DH[1]) + { + double gx, gy, gz; + if (z < 1 - 0.0001 * DH[2]) + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = true; + if (flag) + { + flag = false; + for (int i = 0; i < cpusize; i++) + { + if (z < 1 - 0.0001 * DH[2]) + flag = prolongpointstru(ss_src[i], true, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i); + else + flag = prolongpointstru_ss(ss_src[i], sPp->data->sst, PatL, DH, CPatL, CDH, x, y, z, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + // if you used Vertex grid please note x=1, try 0.999999 instead + cout << "NullShellPatch::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + } + sPp = sPp->next; + } + if (myrank == 0) + cout << "NullShellPatch::setupintintstuff ss_src completes" << endl; + + Pp = CPatL; + while (Pp) + { + double llb[dim], uub[dim]; + if (Symmetry > 0) + llb[2] = Pp->data->bbox[2] - 0.0001 * CDH[2]; + else + llb[2] = Pp->data->bbox[2] + (hCS_width + 0.0001) * CDH[2]; + uub[2] = Pp->data->bbox[dim + 2] - (hCS_width + 0.0001) * CDH[2]; + for (int j = 0; j < 2; j++) + { + if (Symmetry > 1) + llb[j] = Pp->data->bbox[j] - 0.0001 * CDH[j]; + else + llb[j] = Pp->data->bbox[j] + (hCS_width + 0.0001) * CDH[j]; + uub[j] = Pp->data->bbox[dim + j] - (hCS_width + 0.0001) * CDH[j]; + } + for (int iz = 0; iz < Pp->data->shape[2]; iz++) + for (int iy = 0; iy < Pp->data->shape[1]; iy++) + for (int ix = 0; ix < Pp->data->shape[0]; ix++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = Pp->data->bbox[0] + ix * CDH[0]; + y = Pp->data->bbox[1] + iy * CDH[1]; + z = Pp->data->bbox[2] + iz * CDH[2]; +#else +#ifdef Cell + x = Pp->data->bbox[0] + (ix + 0.5) * CDH[0]; + y = Pp->data->bbox[1] + (iy + 0.5) * CDH[1]; + z = Pp->data->bbox[2] + (iz + 0.5) * CDH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (x < llb[0] || x > uub[0] || + y < llb[1] || y > uub[1] || + z < llb[2] || z > uub[2]) + { + int sst; + double lx, ly, lz; + bool flag = false; + getlocalpox(x, y, z, sst, lx, ly, lz); + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(cs_src[i], true, -1, PatL, DH, CPatL, CDH, x, y, z, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + cout << "ShellPatch::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = -1, x,y,z = " << x << "," << y << "," << z << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + Pp = Pp->next; + } + if (myrank == 0) + if (CPatL) + cout << "NullShellPatch::setupintintstuff cs_src completes" << endl; + else + cout << "NullShellPatch::no cs_src exists" << endl; + + for (int i = 0; i < cpusize; i++) + { + ps = ss_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(ss_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + + if (CPatL) + { + ps = cs_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(cs_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + } + } + if (myrank == 0) + cout << "NullShellPatch::setupintintstuff ss_dst and cs_dst complete" << endl; + + /* + for(int i=0;inext; + ts=ts->next; + } + } + exit(0); + */ +} +void NullShellPatch::checkPatch() +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << " belong to NullShell Patchs " << endl; + MyList *Pp = PatL; + while (Pp) + { + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << Pp->data->shape[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << Pp->data->bbox[i] << ":" << Pp->data->bbox[dim + i]; + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + Pp = Pp->next; + } + } +} +void NullShellPatch::checkBlock(int sst) +{ + if (myrank == 0) + { + cout << "checking shell patch sst = " << sst << endl; + MyList *Pp = PatL; + while (Pp) + { + if (Pp->data->sst == sst) + { + MyList *BP = Pp->data->blb; + while (BP) + { + BP->data->checkBlock(); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + } + Pp = Pp->next; + } + } +} +double NullShellPatch::getdX(int dir) +{ + if (dir < 0 || dir >= dim) + { + cout << "NullShellPatch::getdX: error input dir = " << dir << ", this Patch has direction (0," << dim - 1 << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double h; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (shape[dir] == 1) + { + cout << "NullShellPatch::getdX: for direction " << dir << ", this Patch has only one point. Can not determine dX for vertex center grid." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (dir < 2) + h = PI / 2 / (shape[dir] - 1); + else + h = (xmax - xmin) / (shape[dir] - 1); +#else +#ifdef Cell + if (dir < 2) + h = PI / 2 / shape[dir]; + else + h = (xmax - xmin) / shape[dir]; +#else +#error Not define Vertex nor Cell +#endif +#endif + return h; +} +void NullShellPatch::shellname(char *sn, int i) +{ + switch (i) + { + case 0: + sprintf(sn, "zp"); + return; + case 1: + sprintf(sn, "zm"); + return; + case 2: + sprintf(sn, "xp"); + return; + case 3: + sprintf(sn, "xm"); + return; + case 4: + sprintf(sn, "yp"); + return; + case 5: + sprintf(sn, "ym"); + return; + } +} +// Now we dump the data including overlap points +void NullShellPatch::Dump_xyz(char *tag, double time, double dT) +{ + MyList *DumpListi = 0; + DumpListi = new MyList(gx); + DumpListi->insert(gy); + DumpListi->insert(gz); + Dump_Data(DumpListi, tag, time, dT); + DumpListi->clearList(); +} +void NullShellPatch::Dump_Data(MyList *DumpListi, char *tag, double time, double dT) +{ + MyList *PP = PatL; + while (PP) + { + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->data->shape[0] * PP->data->shape[1] * PP->data->shape[2]); + if (!databuffer) + { + cout << "NullShellPatch::Dump_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *DumpList = DumpListi; + while (DumpList) + { + var *VP = DumpList->data; + + MyList *Bp = PP->data->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->data->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + char filename[100]; + char sn[3]; + shellname(sn, PP->data->sst); + if (tag) + sprintf(filename, "%s_LevSH-%s_%s_%05d.bin", tag, sn, VP->name, ncount); + else + sprintf(filename, "LevSH-%s_%s_%05d.bin", sn, VP->name, ncount); + + Parallel::writefile(time, PP->data->shape[0], PP->data->shape[1], PP->data->shape[2], + PP->data->bbox[0], PP->data->bbox[3], PP->data->bbox[1], PP->data->bbox[4], + PP->data->bbox[2], PP->data->bbox[5], filename, databuffer); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + free(databuffer); + + PP = PP->next; + } +} +void NullShellPatch::intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry, int *Varwt) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(rec_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt); + } + } + else + { + // send from this cpu to cpu#node + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(send_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = interdata_packer(0, src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry, Varwt)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + interdata_packer(rec_data[node], src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry, Varwt); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +// PACK: prepare target data in 'data' +// UNPACK: copy target data from 'data' to corresponding numerical grids +int NullShellPatch::interdata_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, int *Varwt) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + int ordn = 2 * ghost_width; + + if (dir != PACK && dir != UNPACK) + { + cout << "error dir " << dir << " for data_packer " << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (src && dst) + { + if ((dir == PACK && dst->data->Bg->rank == rank_in && src->data->Bg->rank == myrank) || + (dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + int vind = 0; + bool flag = true; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + { + /* + f_global_interp(src->data->Bg->shape,src->data->Bg->X[0],src->data->Bg->X[1],src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn],data[size_out], + src->data->lpox[0],src->data->lpox[1],src->data->lpox[2],ordn,varls->data->SoA,Symmetry); + */ + int DIMh = (src->data->dumyd == -1) ? dim : 1; + if (src->data->coef == 0) + { + src->data->coef = new double[ordn * DIMh]; + src->data->sind = new int[dim]; + if (DIMh == 3) + { + for (int i = 0; i < DIMh; i++) + { + double dd = src->data->Bg->getdX(i); + // 0.001 instead of 0.4 makes the point locate more center + src->data->sind[i] = int((src->data->lpox[i] - src->data->Bg->X[i][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[i][0] + (src->data->sind[i] + j) * dd; + src->data->coef[i * ordn + j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + } + } + } + else + { + int actd = 1 - src->data->dumyd; + double dd = src->data->Bg->getdX(actd); + src->data->sind[0] = int((src->data->lpox[actd] - src->data->Bg->X[actd][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[actd][0] + (src->data->sind[0] + j) * dd; + src->data->coef[j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + } + src->data->sind[2] = int((src->data->lpox[2] - src->data->Bg->X[2][0]) / src->data->Bg->getdX(2) + 0.001); + if (!feq(src->data->Bg->X[2][src->data->sind[2]], src->data->lpox[2], src->data->Bg->getdX(2) / 2000)) + cout << "error in NullShellPatch::interdata_packer point = " << src->data->lpox[2] << " != grid " << src->data->Bg->X[2][src->data->sind[2]] << endl; + src->data->sind[1] = int((src->data->lpox[src->data->dumyd] - src->data->Bg->X[src->data->dumyd][0]) / + src->data->Bg->getdX(src->data->dumyd) + + 0.001); + if (!feq(src->data->Bg->X[src->data->dumyd][src->data->sind[1]], src->data->lpox[src->data->dumyd], src->data->Bg->getdX(src->data->dumyd) / 2000)) + cout << "error in NullShellPatch::interdata_packer for dumy dimension point = " + << src->data->lpox[src->data->dumyd] << " != grid " << src->data->Bg->X[src->data->dumyd][src->data->sind[1]] << endl; + } + } + // interpolate + switch (DIMh) + { + case 3: + f_global_interpind(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 2: + f_global_interpind2d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 1: + f_global_interpind1d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst, src->data->dumyd); + break; + default: + cout << "NullShellPatch::interdata_packer: not recognized DIM = " << DIMh << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + if (dir == UNPACK) // from target data to corresponding grid + { + if (Varwt[vind / 2] != 0) // we always assume 2 time number relation + { + if (flag) + { + complex rtp = complex(data[size_out], data[size_out + 1]); + rtp = rtp * pow(dst->data->swtf, Varwt[vind / 2]); // note we only stored the factor in dst + data[size_out] = rtp.real(); + data[size_out + 1] = rtp.imag(); + } + flag = !flag; // on-off method + } + // if(dst->data->tsst==2 && fabs(dst->data->lpox[0]+0.02617993878)<0.00001 && fabs(dst->data->lpox[2]-0.510417)<0.00001)cout<data->name<data->Bg->bbox, dst->data->Bg->bbox + dim, dst->data->Bg->shape, dst->data->Bg->fgfs[varld->data->sgfn], + dst->data->lpox[0], dst->data->lpox[1], dst->data->lpox[2], data[size_out]); + } + } + size_out += 1; + vind += 1; + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +void NullShellPatch::Synch(MyList *VarList, int Symmetry, int *Varwt) +{ + MyList *Pp = PatL; + while (Pp) + { + Pp->data->Sync(VarList, Symmetry); + Pp = Pp->next; + } + // we need this before interpolation + if (Symmetry > 0) + fill_symmetric_boundarybuffer(VarList, Varwt); + + intertransfer(ss_src, ss_dst, VarList, VarList, Symmetry, Varwt); + + // we need this here to correct conners + if (Symmetry > 0) + fill_symmetric_boundarybuffer(VarList, Varwt); +} +void NullShellPatch::check_pointstrul(MyList *pp, bool first_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (!pp) + cout << "ShellPatch::check_pointstrul meets empty pointstru" << endl; + else + cout << "checking check_pointstrul..." << endl; + while (pp) + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + if (first_only) + return; + pp = pp->next; + } + } +} +void NullShellPatch::check_pointstrul2(MyList *pp, int first_last_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (!pp) + cout << "ShellPatch::check_pointstrul meets empty pointstru" << endl; + else + cout << "checking check_pointstrul..." << endl; + while (pp) + { + if (first_last_only == 2) + { + if (pp->next == 0) + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + } + } + else + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + if (first_last_only == 1) + return; + } + pp = pp->next; + } + } +} +void NullShellPatch::matchcheck(MyList *CPatL) +{ + double cbd = CPatL->data->bbox[dim]; + for (int i = 1; i < dim; i++) + cbd = Mymin(cbd, CPatL->data->bbox[dim + i]); + cbd = cbd - xmin * Rmin / (1 - xmin); + double dr, dc; + dc = CPatL->data->getdX(0); + dr = getdX(2); + for (int i = 1; i < dim; i++) + { + dc = Mymax(dc, CPatL->data->getdX(i)); + // dr = Mymax(dr,getdX(i)); + } + + int ir, ic; + ir = int(cbd / dr); + ic = int(cbd / dc); + if (Mymin(ir, ic) < 3 * ghost_width) + { + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << "NullShell Patches insert too shallow:" << endl; + cout << "distantance between these two boundaries is " << cbd << ", spatial step is " << Mymax(dc, dr) << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +} +void NullShellPatch::Interp_Points(MyList *VarList, + int NN, double **XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + int sst; + getlocalpox(XX[0][j], XX[1][j], XX[2][j], sst, pox[0], pox[1], pox[2]); // pox[2] is x indeed + + MyList *sPp = PatL; + while (sPp->data->sst != sst) + sPp = sPp->next; + + if (myrank == 0 && ((!sPp) || pox[2] < xmin - 0.0001 * DH[2] || pox[2] > xmax + 0.0001 * DH[2])) + { + cout << "NullShellPatch::Interp_Points: point gc = ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + } + if (sPp) + { + cout << ") sst = " << sst << " lc = ("; + for (int k = 0; k < dim; k++) + { + cout << pox[k]; + if (k < dim - 1) + cout << ","; + } + } + cout << ") is out of the NullShellPatch." << endl; + cout << "xmin = " << xmin << ", xmax = " << xmax << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (!sPp) + return; + + MyList *Bp = sPp->data->blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +// +// because of getlocalpox, pox will not goes into overghost region of ss_patch +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (pox[i] - llb[i] < -DH[i] / 2 || pox[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + f_global_interp_ss(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry, sst); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: NullShellPatch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: NullShellPatch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j][i]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on NullShellPatch (" << xmin << ":" << xmax << ")" << endl; + + cout << "splited domains:" << endl; + MyList *sPp = PatL; + while (sPp) + { + char sn[3]; + shellname(sn, sPp->data->sst); + cout << "ss_patch " << sn << ":" << endl; + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} +void NullShellPatch::Interp_Points_2D(MyList *VarList, + int NN, double **XX, /*input fake global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + int sst; + getlocalpox_fake(XX[0][j], XX[1][j], XX[2][j], sst, pox[0], pox[1], pox[2]); // pox[2] is x indeed + + int indZ = int((pox[2] - xmin) / DH[2]); + MyList *sPp = PatL; + while (sPp->data->sst != sst) + sPp = sPp->next; + + if (myrank == 0 && ((!sPp) || pox[2] < xmin - 0.0001 * DH[2] || pox[2] > xmax + 0.0001 * DH[2])) + { + cout << "NullShellPatch::Interp_Points: point gc = ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + } + if (sPp) + { + cout << ") sst = " << sst << " lc = ("; + for (int k = 0; k < dim; k++) + { + cout << pox[k]; + if (k < dim - 1) + cout << ","; + } + } + cout << ") is out of the NullShellPatch." << endl; + cout << "xmin = " << xmin << ", xmax = " << xmax << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (!sPp) + return; + + MyList *Bp = sPp->data->blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +// +// because of getlocalpox, pox will not goes into overghost region of ss_patch +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (pox[i] - llb[i] < -DH[i] / 2 || pox[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + f_global_interp_ss_2d(BP->shape, BP->X[0], BP->X[1], indZ, BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], ordn, varl->data->SoA, Symmetry, sst); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: NullShellPatch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: NullShellPatch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j][i]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on NullShellPatch (" << xmin << ":" << xmax << ")" << endl; + + cout << "splited domains:" << endl; + MyList *sPp = PatL; + while (sPp) + { + char sn[3]; + shellname(sn, sPp->data->sst); + cout << "ss_patch " << sn << ":" << endl; + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} +void NullShellPatch::Step(double dT, double PhysTime, monitor *ErrorMonitor) +{ + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + double TT = PhysTime; + double neps = 0.05; + MyList *sPp; + + // Predictor + HyperSlice(dT, TT, ErrorMonitor, iter_count); + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + // cg->swapList(TheList,JrhsList,myrank); + if (myrank == cg->rank) + { + // rhs calculation + f_array_copy(cg->shape, cg->fgfs[RJ_rhs->sgfn], cg->fgfs[RTheta->sgfn]); + f_array_copy(cg->shape, cg->fgfs[IJ_rhs->sgfn], cg->fgfs[ITheta->sgfn]); + f_kodis_shor(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[RJ0->sgfn], cg->fgfs[RJ_rhs->sgfn], + RJ0->SoA, Symmetry, neps, sPp->data->sst); + f_kodis_shor(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[IJ0->sgfn], cg->fgfs[IJ_rhs->sgfn], + RJ0->SoA, Symmetry, neps, sPp->data->sst); + f_omega_rhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], cg->fgfs[omega_rhs->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[RJ0->sgfn], cg->fgfs[RJ->sgfn], cg->fgfs[RJ_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[IJ0->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[IJ_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[omega0->sgfn], cg->fgfs[omega->sgfn], cg->fgfs[omega_rhs->sgfn], + iter_count); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + /* + { + char str[50]; + sprintf(str,"rk%d",iter_count); + Dump_Data(SynchList_pre,str,PhysTime,dT); + Dump_Data(RHSList,str,PhysTime,dT); + } + */ + // no nedd to synchronize J, because Theta has already been synchnized previously + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(omega); + DG_List->insert(FXZEO); + Varwt[0] = 0; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + + Compute_News(PhysTime, dT, false); // put here because after step J and omega are at t+dt, while other variables at t + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TT += dT / 2; + HyperSlice(dT, TT, ErrorMonitor, iter_count); + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + // cg->swapList(TheList,J1List,myrank); + if (myrank == cg->rank) + { + // rhs calculation + f_array_copy(cg->shape, cg->fgfs[RJ1->sgfn], cg->fgfs[RTheta->sgfn]); + f_array_copy(cg->shape, cg->fgfs[IJ1->sgfn], cg->fgfs[ITheta->sgfn]); + f_kodis_shor(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[RJ0->sgfn], cg->fgfs[RJ1->sgfn], + RJ0->SoA, Symmetry, neps, sPp->data->sst); + f_kodis_shor(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[IJ0->sgfn], cg->fgfs[IJ1->sgfn], + RJ0->SoA, Symmetry, neps, sPp->data->sst); + f_omega_rhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], cg->fgfs[omega1->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[RJ0->sgfn], cg->fgfs[RJ1->sgfn], cg->fgfs[RJ_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[IJ0->sgfn], cg->fgfs[IJ1->sgfn], cg->fgfs[IJ_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[omega0->sgfn], cg->fgfs[omega1->sgfn], cg->fgfs[omega_rhs->sgfn], + iter_count); + } + if (iter_count < 3) + cg->swapList(SynchList_cor, SynchList_pre, myrank); + else + { + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(omega0); + DG_List->insert(FXZEO); + Varwt[0] = 0; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + + /* + { + char str[50]; + sprintf(str,"rk%d",iter_count); + Dump_Data(SynchList_cor,str,PhysTime,dT); + } + */ + } +} +void NullShellPatch::Null_Boundary(double PhysTime) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + int Varwt[3]; + MyList *DG_List; + DG_List = new MyList(RU); + DG_List->insert(IU); + Varwt[0] = 1; + DG_List->insert(RQ); + DG_List->insert(IQ); + Varwt[1] = 1; + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Varwt[2] = 2; + + Synch(DG_List, Symmetry, Varwt); + // Dump_Data(DG_List,0,0,1); + DG_List->clearList(); +} +#if 1 +// real evolve +void NullShellPatch::HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count) +{ + int ERROR = 0; + Null_Boundary(PhysTime); + + int spin, e; + + MyList *sPp; + + // evolve beta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + if (f_NullEvol_beta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + if (f_NullEvol_beta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(betaList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(betaList, Symmetry, betawt); + // get nu, k and B + spin = 2; + e = -1; + if (RK_count == 0) + eth_derivs(RJ0, IJ0, Rnu, Inu, spin, e); + else + eth_derivs(RJ, IJ, Rnu, Inu, spin, e); + spin = 0; + e = 1; + eth_derivs(KK, FXZEO, Rk, Ik, spin, e); + eth_derivs(beta, FXZEO, RB, IB, spin, e); + + // evolve Q and U + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_Q(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of Q, we can deal with U together here + // at this stage Q has been updated already + f_NullEvol_U(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], + cg->fgfs[beta->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], Rmin)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_Q(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of Q, we can deal with U together here + // at this stage Q has been updated already + f_NullEvol_U(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], + cg->fgfs[beta->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], Rmin)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(QUList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in Q and/or U on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in Q and/or U on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(QUList, Symmetry, QUwt); + + // evolve W and Theta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); +} +#else +#if 0 +//For check, give all surface varialbes +//check J evolve only +void NullShellPatch::HyperSlice(double dT,double PhysTime,monitor *ErrorMonitor,int RK_count) +{ + int ERROR=0; + + int spin,e; + + MyList *sPp; + + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { +/* + f_get_exact_null_theta(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[RTheta->sgfn],cg->fgfs[ITheta->sgfn],sPp->data->sst,Rmin,PhysTime, + cg->fgfs[quR1->sgfn],cg->fgfs[quR2->sgfn],cg->fgfs[quI1->sgfn],cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn],cg->fgfs[qlR2->sgfn],cg->fgfs[qlI1->sgfn],cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn],cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn],cg->fgfs[dquR2->sgfn],cg->fgfs[dquI1->sgfn],cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn],cg->fgfs[bdquR2->sgfn],cg->fgfs[bdquI1->sgfn],cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn],cg->fgfs[dgI->sgfn],cg->fgfs[bdgR->sgfn],cg->fgfs[bdgI->sgfn]); +*/ + f_get_null_boundary_c(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[beta->sgfn],cg->fgfs[RQ->sgfn],cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn],cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn],cg->fgfs[RTheta->sgfn],cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn],cg->fgfs[quR2->sgfn],cg->fgfs[quI1->sgfn],cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn],cg->fgfs[qlR2->sgfn],cg->fgfs[qlI1->sgfn],cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn],cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn],cg->fgfs[dquR2->sgfn],cg->fgfs[dquI1->sgfn],cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn],cg->fgfs[bdquR2->sgfn],cg->fgfs[bdquI1->sgfn],cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn],cg->fgfs[dgI->sgfn],cg->fgfs[bdgR->sgfn],cg->fgfs[bdgI->sgfn], + PhysTime,Rmin,sPp->data->sst); + + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } +} +#elif 0 +// For check Theta calculation with given Theta_x +void NullShellPatch::HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count) +{ + int ERROR = 0; + + int spin, e; + + MyList *sPp; + + // calculate K + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + if (RK_count == 0) + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + else + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + if (0) + { + int Varwt[3]; + MyList *DG_List; + DG_List = new MyList(RU); + DG_List->insert(IU); + Varwt[0] = 1; + DG_List->insert(RQ); + DG_List->insert(IQ); + Varwt[1] = 1; + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Varwt[2] = 2; + + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + // get nu, k and B + spin = 2; + e = -1; + if (RK_count == 0) + eth_derivs(RJ0, IJ0, Rnu, Inu, spin, e); + else + eth_derivs(RJ, IJ, Rnu, Inu, spin, e); + spin = 0; + e = 1; + eth_derivs(KK, FXZEO, Rk, Ik, spin, e); + eth_derivs(beta, FXZEO, RB, IB, spin, e); + + // evolve Theta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_Theta_givenx(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, sPp->data->sst)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_Theta_givenx(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, sPp->data->sst)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); +} +#elif 0 +// For check Theta calculation +void NullShellPatch::HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count) +{ + int ERROR = 0; + + int spin, e; + + MyList *sPp; + + // calculate K + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + if (RK_count == 0) + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + else + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + if (0) + { + int Varwt[3]; + MyList *DG_List; + DG_List = new MyList(RU); + DG_List->insert(IU); + Varwt[0] = 1; + DG_List->insert(RQ); + DG_List->insert(IQ); + Varwt[1] = 1; + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Varwt[2] = 2; + + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + // get nu, k and B + spin = 2; + e = -1; + if (RK_count == 0) + eth_derivs(RJ0, IJ0, Rnu, Inu, spin, e); + else + eth_derivs(RJ, IJ, Rnu, Inu, spin, e); + spin = 0; + e = 1; + eth_derivs(KK, FXZEO, Rk, Ik, spin, e); + eth_derivs(beta, FXZEO, RB, IB, spin, e); + + // evolve Theta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); +} +#elif 0 +// For check W and Theta calculation +void NullShellPatch::HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count) +{ + int ERROR = 0; + + int spin, e; + + MyList *sPp; + + // calculate K + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + if (RK_count == 0) + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + else + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[3]; + MyList *DG_List; + DG_List = new MyList(RU); + DG_List->insert(IU); + Varwt[0] = 1; + DG_List->insert(RQ); + DG_List->insert(IQ); + Varwt[1] = 1; + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Varwt[2] = 2; + + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + // get nu, k and B + spin = 2; + e = -1; + if (RK_count == 0) + eth_derivs(RJ0, IJ0, Rnu, Inu, spin, e); + else + eth_derivs(RJ, IJ, Rnu, Inu, spin, e); + spin = 0; + e = 1; + eth_derivs(KK, FXZEO, Rk, Ik, spin, e); + eth_derivs(beta, FXZEO, RB, IB, spin, e); + + // evolve W and Theta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); +} +#elif 1 +// For check Q, U, W and Theta calculation +void NullShellPatch::HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count) +{ + int ERROR = 0; + + int spin, e; + + MyList *sPp; + + // calculate K + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + if (RK_count == 0) + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + else + { + f_calculate_K(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn]); + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[3]; + MyList *DG_List; + DG_List = new MyList(RU); + DG_List->insert(IU); + Varwt[0] = 1; + DG_List->insert(RQ); + DG_List->insert(IQ); + Varwt[1] = 1; + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Varwt[2] = 2; + + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + // get nu, k and B + spin = 2; + e = -1; + if (RK_count == 0) + eth_derivs(RJ0, IJ0, Rnu, Inu, spin, e); + else + eth_derivs(RJ, IJ, Rnu, Inu, spin, e); + spin = 0; + e = 1; + eth_derivs(KK, FXZEO, Rk, Ik, spin, e); + eth_derivs(beta, FXZEO, RB, IB, spin, e); + + // evolve Q and U + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_Q(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of Q, we can deal with U together here + // at this stage Q has been updated already + f_NullEvol_U(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], + cg->fgfs[beta->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], Rmin)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_Q(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of Q, we can deal with U together here + // at this stage Q has been updated already + f_NullEvol_U(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], + cg->fgfs[beta->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], Rmin)) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(QUList, 0, PhysTime, dT); + Dump_Data(SynchList_pre, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in Q and/or U on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in Q and/or U on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(QUList, Symmetry, QUwt); + + // evolve W and Theta + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_W(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[beta->sgfn], cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]) || + // since we do not need derivetive of W, we can deal with Theta together here + // at this stage W has been updated already + f_NullEvol_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ->sgfn], cg->fgfs[IJ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + cg->fgfs[KK->sgfn], cg->fgfs[HKK->sgfn], cg->fgfs[KKx->sgfn], cg->fgfs[HKKx->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + Dump_Data(QUList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); +} +#endif +#endif +#if 1 +// need evolve step +// 0: real L2 norm; 1: root mean squar +#define L2m 0 +double NullShellPatch::Error_Check(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ1->sgfn], cg->fgfs[IJ1->sgfn], sPp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + if (0) + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RJ1); + DG_List->insert(IJ1); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + + if (dp) + { + DG_List->insert(RJ0); + DG_List->insert(IJ0); + Dump_Data(DG_List, 0, PhysTime, dT); + } + DG_List->clearList(); + } + + double tvf, dtvf = 0; + int tN, dtN = 0; + int BDW = ghost_width, OBDW = overghost; + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_array_subtract(cg->shape, cg->fgfs[RJ1->sgfn], cg->fgfs[RJ0->sgfn]); +#if (L2m == 0) + f_l2normhelper_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[RJ1->sgfn], tvf, BDW, OBDW, Symmetry); +#elif (L2m == 1) + f_l2normhelper_sh_rms(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[RJ1->sgfn], tvf, BDW, OBDW, Symmetry, dtN); + dtN += dtN; +#endif + + dtvf += tvf; + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); +#if (L2m == 0) + tvf = sqrt(tvf); +#elif (L2m == 1) + MPI_Allreduce(&dtN, &tN, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + tvf = sqrt(tvf / tN); +#endif +#if 0 + { + MyList * DG_List; + DG_List=new MyList(RJ1); DG_List->insert(IJ1); + + Dump_Data(DG_List,0,0,1); + DG_List->clearList(); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } +#endif + + return tvf; +} +#else +// only check Theta calculation, do not need Evolve step +double NullShellPatch::Error_Check(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], sPp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RJ0); + DG_List->insert(IJ0); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + HyperSlice(dT, PhysTime, 0, 0); + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RJ1->sgfn], cg->fgfs[IJ1->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RJ1); + DG_List->insert(IJ1); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + + if (dp) + { + DG_List->insert(RTheta); + DG_List->insert(ITheta); + Dump_Data(DG_List, 0, PhysTime, dT); + } + DG_List->clearList(); + } + + double tvf, dtvf = 0; + int BDW = ghost_width, OBDW = overghost; + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_array_subtract(cg->shape, cg->fgfs[RJ1->sgfn], cg->fgfs[RTheta->sgfn]); + + f_l2normhelper_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[RJ1->sgfn], tvf, BDW, OBDW, Symmetry); + dtvf += tvf; + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + tvf = sqrt(tvf); + + return tvf; +} +#endif +double NullShellPatch::EqTheta_Check(double PhysTime, double dT, bool dp) +{ + int ERROR = 0; + + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], sPp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RJ0); + DG_List->insert(IJ0); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + + HyperSlice(dT, PhysTime, 0, 0); + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RTheta); + DG_List->insert(ITheta); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + + DG_List->clearList(); + } + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_Eq_Theta(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn], cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn], cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn], cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn])) + /* if(f_Eq_Theta_2(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[RJ0->sgfn],cg->fgfs[IJ0->sgfn], + cg->fgfs[RU->sgfn],cg->fgfs[IU->sgfn], + cg->fgfs[beta->sgfn], + cg->fgfs[RB->sgfn],cg->fgfs[IB->sgfn], + cg->fgfs[Rnu->sgfn],cg->fgfs[Inu->sgfn], + cg->fgfs[Rk->sgfn],cg->fgfs[Ik->sgfn], + cg->fgfs[RTheta->sgfn],cg->fgfs[ITheta->sgfn], + cg->fgfs[W->sgfn], + Rmin, + cg->fgfs[qlR1->sgfn],cg->fgfs[qlR2->sgfn],cg->fgfs[qlI1->sgfn],cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn],cg->fgfs[quR2->sgfn],cg->fgfs[quI1->sgfn],cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn],cg->fgfs[gI->sgfn],PhysTime,sPp->data->sst)) */ + { + cout << "find NaN in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(WTheList, 0, PhysTime, dT); + if (myrank == 0) + { + cout << "find NaN in W and/or Theta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Synch(WTheList, Symmetry, WThewt); + + if (dp) + { + MyList *DG_List; + DG_List = new MyList(RTheta); + DG_List->insert(ITheta); + Dump_Data(DG_List, 0, PhysTime, dT); + DG_List->clearList(); + } + + double tvf, dtvf = 0; + int BDW = ghost_width, OBDW = overghost; + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_l2normhelper_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[RTheta->sgfn], tvf, BDW, OBDW, Symmetry); + dtvf += tvf; + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + tvf = sqrt(tvf); + + return tvf; +} +void NullShellPatch::Compute_News(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +// for check +#if 0 + f_get_exact_omega(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[omega0->sgfn],sPp->data->sst,Rmin,PhysTime); +#endif +#if 1 + f_drive_null_news(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[omega0->sgfn], cg->fgfs[beta->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + cg->fgfs[RNews->sgfn], cg->fgfs[INews->sgfn], Rmin, sPp->data->sst); +#else + f_drive_null_news_diff(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[omega0->sgfn], cg->fgfs[beta->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + cg->fgfs[RNews->sgfn], cg->fgfs[INews->sgfn], Rmin, sPp->data->sst, PhysTime); +#endif + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RNews); + DG_List->insert(INews); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } +} +#if 1 +// evolve omega +void NullShellPatch::Check_News(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], sPp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + + f_drive_null_news(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[omega0->sgfn], cg->fgfs[beta->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + cg->fgfs[RNews->sgfn], cg->fgfs[INews->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RNews); + DG_List->insert(INews); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } + // evolve omega + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + double TT = PhysTime; + + // Predictor + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(TheList, JrhsList, myrank); + if (myrank == cg->rank) + { +#if 1 + f_get_exact_omegau(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega_rhs->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); +#if 0 + f_euler_rout(cg->shape, dT,cg->fgfs[omega0->sgfn],cg->fgfs[omega_rhs->sgfn]); + PhysTime += dT; + f_get_exact_omega(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[omega->sgfn],sPp->data->sst,Rmin,PhysTime); + PhysTime -= dT; + if(sPp->data->sst==0 && cg->X[0][0] < -PI/4 && cg->X[1][0] < -PI/4) + { + int hi=cg->shape[0]/2-1,hj=cg->shape[1]/2-1,hk=cg->shape[2]-1; + int hg=hi+hj*cg->shape[0]+hk*cg->shape[0]*cg->shape[1]; + cout<fgfs[omega->sgfn][hg]-1<<","<fgfs[omega0->sgfn][hg]-1<shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], cg->fgfs[omega_rhs->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]); +#endif + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[omega0->sgfn], cg->fgfs[omega->sgfn], cg->fgfs[omega_rhs->sgfn], + iter_count); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TT += dT / 2; + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(TheList, J1List, myrank); + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], sPp->data->sst, Rmin, TT, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + TT, Rmin, sPp->data->sst); +#if 1 + f_get_exact_omegau(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega1->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); +#else + f_omega_rhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], cg->fgfs[omega1->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn]); +#endif + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[omega0->sgfn], cg->fgfs[omega1->sgfn], cg->fgfs[omega_rhs->sgfn], + iter_count); + } + if (iter_count < 3) + cg->swapList(SynchList_cor, SynchList_pre, myrank); + else + { + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(omega0); + DG_List->insert(FXZEO); + Varwt[0] = 0; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } +#if 0 + { + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + while(BP) + { + Block *cg=BP->data; + cg->swapList(TheList,J1List,myrank); + if(myrank == cg->rank) + { + PhysTime += dT; + f_get_exact_omega(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[omega->sgfn],sPp->data->sst,Rmin,PhysTime); + PhysTime -= dT; + if(sPp->data->sst==0 && cg->X[0][0] < -PI/4 && cg->X[1][0] < -PI/4) + { + int hi=cg->shape[0]/2-1,hj=cg->shape[1]/2-1,hk=cg->shape[2]-1; + int hg=hi+hj*cg->shape[0]+hk*cg->shape[0]*cg->shape[1]; + cout<fgfs[omega->sgfn][hg]-1<<","<fgfs[omega0->sgfn][hg]-1<data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + } +#endif + +#if 0 +// dump omega for check +{ + MyList * DG_List; + DG_List=new MyList(omega0); + Dump_Data(DG_List,"evo",PhysTime,dT); + + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_exact_omega(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[omega0->sgfn],sPp->data->sst,Rmin,TT); + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + + Dump_Data(DG_List,"exa",PhysTime,dT); + DG_List->clearList(); + + if(TT>0.5 && myrank==0) MPI_Abort(MPI_COMM_WORLD,1); +} +#endif +} +#else +// given omega +void NullShellPatch::Check_News(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_exact_null(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], sPp->data->sst, Rmin, PhysTime, + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn]); + + f_get_null_boundary_c(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[beta->sgfn], cg->fgfs[RQ->sgfn], cg->fgfs[IQ->sgfn], + cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[W->sgfn], cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + PhysTime, Rmin, sPp->data->sst); + + f_get_exact_omega(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega0->sgfn], sPp->data->sst, Rmin, PhysTime); + + f_drive_null_news(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[RJ0->sgfn], cg->fgfs[IJ0->sgfn], cg->fgfs[RU->sgfn], cg->fgfs[IU->sgfn], + cg->fgfs[RTheta->sgfn], cg->fgfs[ITheta->sgfn], + cg->fgfs[omega0->sgfn], cg->fgfs[beta->sgfn], + cg->fgfs[qlR1->sgfn], cg->fgfs[qlR2->sgfn], cg->fgfs[qlI1->sgfn], cg->fgfs[qlI2->sgfn], + cg->fgfs[quR1->sgfn], cg->fgfs[quR2->sgfn], cg->fgfs[quI1->sgfn], cg->fgfs[quI2->sgfn], + cg->fgfs[gR->sgfn], cg->fgfs[gI->sgfn], + cg->fgfs[dquR1->sgfn], cg->fgfs[dquR2->sgfn], cg->fgfs[dquI1->sgfn], cg->fgfs[dquI2->sgfn], + cg->fgfs[bdquR1->sgfn], cg->fgfs[bdquR2->sgfn], cg->fgfs[bdquI1->sgfn], cg->fgfs[bdquI2->sgfn], + cg->fgfs[dgR->sgfn], cg->fgfs[dgI->sgfn], cg->fgfs[bdgR->sgfn], cg->fgfs[bdgI->sgfn], + cg->fgfs[RNews->sgfn], cg->fgfs[INews->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + { + int Varwt[1]; + MyList *DG_List; + DG_List = new MyList(RNews); + DG_List->insert(INews); + Varwt[0] = 2; + Synch(DG_List, Symmetry, Varwt); + DG_List->clearList(); + } +} +#endif +double NullShellPatch::News_Error_Check(double PhysTime, double dT, bool dp) +{ + MyList *sPp; + + double tvf, dtvf = 0; + int BDW = ghost_width, OBDW = overghost; + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_l2normhelper_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[RNews->sgfn], tvf, BDW, OBDW, Symmetry); + dtvf += tvf; + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + tvf = sqrt(tvf); + + return tvf; +} diff --git a/AMSS_NCKU_source/NullShellPatch.h b/AMSS_NCKU_source/NullShellPatch.h new file mode 100644 index 0000000..26ff030 --- /dev/null +++ b/AMSS_NCKU_source/NullShellPatch.h @@ -0,0 +1,189 @@ + +#ifndef NULLSHELLPATCH_H +#define NULLSHELLPATCH_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include +#include "MyList.h" +#include "Block.h" +#include "Parallel.h" +#include "ShellPatch.h" +#include "var.h" +#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width + +#if (dim != 3) +#error NullShellPatch only supports 3 dimensional stuff yet +#endif + +class xp_npatch : public ss_patch +{ +public: + xp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; }; +}; + +class xm_npatch : public ss_patch +{ +public: + xm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; }; +}; +class yp_npatch : public ss_patch +{ +public: + yp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; }; +}; + +class ym_npatch : public ss_patch +{ +public: + ym_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; }; +}; +class zp_npatch : public ss_patch +{ +public: + zp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; }; +}; + +class zm_npatch : public ss_patch +{ +public: + zm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; }; +}; + +class NullShellPatch +{ + +public: + struct pointstru + { + double gpox[dim]; // global cordinate + double lpox[dim]; // local cordinate + Block *Bg; + int ssst; //-1: cardisian, others as sst of ss_patch source sst + int tsst; //-1: cardisian, others as sst of ss_patch target sst + double *coef; + int *sind; + int dumyd; // the dimension which has common lines, only useful in interdata_packer + complex swtf; // exp(i gamma) of Eq.(26) of CQG 24 S327 + }; + + var *FXZEO; + var *gx, *gy, *gz; + // we always assume the number of VarList = 2* the number of Varwt + // so VarList must apear with pairs, either components of complex number or a fake pair + var *beta, *W; + var *Rnu, *Inu, *Rk, *Ik, *RB, *IB; + var *RQ, *IQ, *RU, *IU, *RTheta, *ITheta; + var *KK, *HKK, *KKx, *HKKx; + var *RJo, *IJo, *omegao; + var *RJ0, *IJ0, *omega0; + var *RJ, *IJ, *omega; + var *RJ1, *IJ1, *omega1; + var *RJ_rhs, *IJ_rhs, *omega_rhs; + + var *quR1, *quR2, *quI1, *quI2; + var *qlR1, *qlR2, *qlI1, *qlI2; + var *gR, *gI; + var *dquR1, *dquR2, *dquI1, *dquI2; + var *bdquR1, *bdquR2, *bdquI1, *bdquI2; + var *dgR, *dgI; + var *bdgR, *bdgI; + + var *RNews, *INews; + + MyList *StateList, *SynchList_pre, *SynchList_cor, *RHSList; + MyList *OldStateList, *DumpList, *CheckList; + + MyList *betaList, *QUList, *WTheList, *TheList, *JrhsList, *J1List; + int betawt[1], QUwt[2], WThewt[2]; + + int myrank; + int shape[dim]; // for (rho, sigma, X), for rho and sigma means number of points for every pi/2 + double Rmin, xmin, xmax; + int Symmetry; + int ingfs, fngfs; + + MyList *PatL; + + MyList **ss_src, **ss_dst; + MyList **cs_src, **cs_dst; + +public: + NullShellPatch(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetry, int myranki); + + ~NullShellPatch(); + + void destroypsuList(MyList *ct); + void fill_symmetric_boundarybuffer(MyList *VarList, int *Varwt); + MyList *compose_sh(int cpusize); + int getdumydimension(int acsst, int posst); + void Setup_dyad(); + void Setup_Initial_Data(bool checkrun, double PhysTime); + void eth_derivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e); + void eth_dderivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e1, int e2); + void getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz); + void getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz); + void getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz); + void getlocalpoxsst_ss(int isst, double ix, double iy, double iz, int lsst, double &lx, double &ly, double &lz); + void getlocalpoxsst(double x, double y, double z, int sst, double &lx, double &ly, double &lz); + void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz); + complex get_swtf(double *pox, int tsst, int ssst); + void prolongpointstru(MyList *&psul, MyList *sPpi, double DH[dim], + MyList *Ppi, double CDH[dim], MyList *pss); + bool prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in); + bool prolongpointstru_ss(MyList *&psul, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in); + void setupintintstuff(int cpusize, MyList *CPatL, int Symmetry); + void checkPatch(); + void checkBlock(int sst); + double getdX(int dir); + void shellname(char *sn, int i); + void Dump_xyz(char *tag, double time, double dT); + void Dump_Data(MyList *DumpListi, char *tag, double time, double dT); + void intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry, int *Varwt); + int interdata_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, int *Varwt); + void Synch(MyList *VarList, int Symmetry, int *Varwt); + void CS_Inter(MyList *VarList, int Symmetry, int *Varwt); + void check_pointstrul(MyList *pp, bool first_only); + void check_pointstrul2(MyList *pp, int first_last_only); + void matchcheck(MyList *CPatL); + void Interp_Points(MyList *VarList, + int NN, double **XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry); + void Interp_Points_2D(MyList *VarList, + int NN, double **XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry); + void Step(double dT, double PhysTime, monitor *ErrorMonitor); + void Null_Boundary(double PhysTime); + void HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count); + double News_Error_Check(double PhysTime, double dT, bool dp); + double Error_Check(double PhysTime, double dT, bool dp); + double EqTheta_Check(double PhysTime, double dT, bool dp); + void Compute_News(double PhysTime, double dT, bool dp); + void Check_News(double PhysTime, double dT, bool dp); +}; + +#endif /* NULLSHELLPATCH_H */ diff --git a/AMSS_NCKU_source/NullShellPatch2.C b/AMSS_NCKU_source/NullShellPatch2.C new file mode 100644 index 0000000..e946bd0 --- /dev/null +++ b/AMSS_NCKU_source/NullShellPatch2.C @@ -0,0 +1,2684 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "NullShellPatch2.h" +#include "Parallel.h" +#include "fmisc.h" +#include "misc.h" +#include "shellfunctions.h" +#include "NullEvol.h" +#include "NullNews.h" +#include "initial_null2.h" +#include "rungekutta4_rout.h" +#include "kodiss.h" + +#define PI M_PI + +NullShellPatch2::NullShellPatch2(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetryi, int myranki) : myrank(myranki), Rmin(Rmini), xmin(xmini), xmax(xmaxi), PatL(0), Symmetry(Symmetryi) +{ + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; +// we always assume the input parameter is in cell center style +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape[i] = shape[i] + 1; +#endif + } + + if (myrank == 0) + { + cout << "null shell's range: r = [" << xmin * Rmin / (1 - xmin) << ":"; + if (xmax == 1) + cout << "+Infty]" << endl; + else + cout << xmax * Rmin / (1 - xmax) << "]" << endl; + cout << " x = [" << xmin << ":" << xmax << "]" << endl + << "shape: " << shape[2] << endl + << "resolution: [" << getdX(0) << "," << getdX(1) << "," << getdX(2) << "]" << endl; + } +// in order to touch infinity, we always use vertex center in r direction +// for Cell center it is some fake as following +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + { + double ht = (xmax - xmin) / shape[2]; + xmax = xmax + ht / 2; + xmin = xmin - ht / 2; + shape[2] = shape[2] + 1; + } +#endif + + double bbox[2 * dim]; + int shape_here[dim]; + bbox[2] = xmin; + bbox[5] = xmax; + shape_here[2] = shape[2]; + + switch (Symmetry) + { + case 0: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 1: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + shape_here[0] = shape[0] + 2 * overghost; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape_here[1] = (shape[1] + 1) / 2 + overghost; +#else +#ifdef Cell + shape_here[1] = shape[1] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + bbox[0] = -PI / 4 - overghost * getdX(0); + shape_here[1] += ghost_width; + bbox[1] = -ghost_width * getdX(1); // buffer points method to deal with boundary + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL->insert(new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = ghost_width * getdX(1); // buffer points method to deal with boundary + PatL->insert(new xm_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 2: +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int i = 0; i < 2; i++) + shape_here[i] = (shape[i] + 1) / 2 + overghost; +#else +#ifdef Cell + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + shape_here[0] += ghost_width; + shape_here[1] += ghost_width; + bbox[0] = -ghost_width * getdX(0); // buffer points method to deal with boundary + bbox[1] = -ghost_width * getdX(1); // buffer points method to deal with boundary + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_npatch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_npatch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + default: + cout << "not recognized Symmetry type" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int ngfs = 0; + gx = new var("gx", ngfs++, 1, 1, 1); + gy = new var("gy", ngfs++, 1, 1, 1); + gz = new var("gz", ngfs++, 1, 1, 1); + + g00 = new var("g00", ngfs++, 1, 1, 1); + g01 = new var("g01", ngfs++, -1, 1, 1); + p02 = new var("p02", ngfs++, 1, -1, 1); + p03 = new var("p03", ngfs++, 1, 1, -1); + g02 = new var("g02", ngfs++, 1, -1, 1); + g03 = new var("g03", ngfs++, 1, 1, -1); + Theta22 = new var("Theta22", ngfs++, 1, 1, 1); + Theta23 = new var("Theta23", ngfs++, 1, -1, -1); + Theta33 = new var("Theta33", ngfs++, 1, 1, 1); + + g22o = new var("g22o", ngfs++, 1, 1, 1); + g23o = new var("g23o", ngfs++, 1, -1, -1); + g33o = new var("g33o", ngfs++, 1, 1, 1); + g220 = new var("g220", ngfs++, 1, 1, 1); + g230 = new var("g230", ngfs++, 1, -1, -1); + g330 = new var("g330", ngfs++, 1, 1, 1); + g22 = new var("g22", ngfs++, 1, 1, 1); + g23 = new var("g23", ngfs++, 1, -1, -1); + g33 = new var("g33", ngfs++, 1, 1, 1); + g221 = new var("g221", ngfs++, 1, 1, 1); + g231 = new var("g231", ngfs++, 1, -1, -1); + g331 = new var("g331", ngfs++, 1, 1, 1); + g22_rhs = new var("g22_rhs", ngfs++, 1, 1, 1); + g23_rhs = new var("g23_rhs", ngfs++, 1, -1, -1); + g33_rhs = new var("g33_rhs", ngfs++, 1, 1, 1); + + RNews = new var("RNews", ngfs++, 1, 1, 1); + INews = new var("INews", ngfs++, 1, 1, 1); + omega = new var("omega", ngfs++, 1, 1, 1); + dtomega = new var("dtomega", ngfs++, 1, 1, 1); + + DumpList = new MyList(g220); + DumpList->insert(g230); + DumpList->insert(g330); + + OldStateList = new MyList(g22o); + OldStateList->insert(g23o); + OldStateList->insert(g33o); + StateList = new MyList(g220); + StateList->insert(g230); + StateList->insert(g330); + SynchList_pre = new MyList(g22); + SynchList_pre->insert(g23); + SynchList_pre->insert(g33); + RHSList = new MyList(g22_rhs); + RHSList->insert(g23_rhs); + RHSList->insert(g33_rhs); + SynchList_cor = new MyList(g221); + SynchList_cor->insert(g231); + SynchList_cor->insert(g331); + + NewsList = new MyList(RNews); + NewsList->insert(INews); + + g01List = new MyList(g01); + g01wt = new double *[1]; + for (int ii = 0; ii < 1; ii++) + { + g01wt[ii] = new double[3]; + g01wt[ii][0] = g01wt[ii][1] = g01wt[ii][2] = 1; + } + + pg0AList = new MyList(p02); + pg0AList->insert(p03); + pg0AList->insert(g02); + pg0AList->insert(g03); + pg0Awt = new double *[4]; + for (int ii = 0; ii < 4; ii++) + { + pg0Awt[ii] = new double[3]; + pg0Awt[ii][0] = pg0Awt[ii][1] = pg0Awt[ii][2] = 1; + } + pg0Awt[0][0] = pg0Awt[1][1] = pg0Awt[2][0] = pg0Awt[3][1] = -1; + + g00List = new MyList(g00); + g00wt = new double *[1]; + for (int ii = 0; ii < 1; ii++) + { + g00wt[ii] = new double[3]; + g00wt[ii][0] = g00wt[ii][1] = g00wt[ii][2] = 1; + } + + ThetaList = new MyList(Theta22); + ThetaList->insert(Theta23); + ThetaList->insert(Theta33); + Thetawt = new double *[3]; + for (int ii = 0; ii < 3; ii++) + { + Thetawt[ii] = new double[3]; + Thetawt[ii][0] = Thetawt[ii][1] = Thetawt[ii][2] = 1; + } + Thetawt[1][0] = Thetawt[1][1] = -1; + + ingfs = 0; + fngfs = ngfs; +} +NullShellPatch2::~NullShellPatch2() +{ + int nprocs = 1; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + for (int node = 0; node < nprocs; node++) + { + if (ss_src[node]) + destroypsuList(ss_src[node]); + if (ss_dst[node]) + destroypsuList(ss_dst[node]); + if (cs_src) + { + if (cs_src[node]) + destroypsuList(cs_src[node]); + if (cs_dst[node]) + destroypsuList(cs_dst[node]); + } + } + + delete[] ss_src; + delete[] ss_dst; + if (cs_src) + { + delete[] cs_src; + delete[] cs_dst; + } + + while (PatL) + { + ss_patch *sPp = PatL->data; + MyList *bg; + while (sPp->blb) + { + if (sPp->blb == sPp->ble) + break; + bg = (sPp->blb->next) ? sPp->blb->next : 0; + delete sPp->blb->data; + delete sPp->blb; + sPp->blb = bg; + } + if (sPp->ble) + { + delete sPp->ble->data; + delete sPp->ble; + } + sPp->blb = sPp->ble = 0; + PatL = PatL->next; + } + PatL->destroyList(); + + StateList->clearList(); + SynchList_pre->clearList(); + SynchList_cor->clearList(); + RHSList->clearList(); + OldStateList->clearList(); + DumpList->clearList(); + CheckList->clearList(); + + NewsList->clearList(); + + g01List->clearList(); + g00List->clearList(); + pg0AList->clearList(); + ThetaList->clearList(); + + delete gx; + delete gy; + delete gz; + + delete g00; + delete g01; + delete p02; + delete p03; + delete g02; + delete g03; + delete Theta22; + delete Theta23; + delete Theta33; + + delete g22o; + delete g23o; + delete g33o; + delete g220; + delete g230; + delete g330; + delete g22; + delete g23; + delete g33; + delete g221; + delete g231; + delete g331; + delete g22_rhs; + delete g23_rhs; + delete g33_rhs; + + delete RNews; + delete INews; + delete omega; + delete dtomega; + + for (int ii = 0; ii < 1; ii++) + delete[] g01wt[ii]; + delete[] g01wt; + for (int ii = 0; ii < 4; ii++) + delete[] pg0Awt[ii]; + delete[] pg0Awt; + for (int ii = 0; ii < 1; ii++) + delete[] g00wt[ii]; + delete[] g00wt; + for (int ii = 0; ii < 3; ii++) + delete[] Thetawt[ii]; + delete[] Thetawt; +} +double NullShellPatch2::getdX(int dir) +{ + if (dir < 0 || dir >= dim) + { + cout << "NullShellPatch::getdX: error input dir = " << dir << ", this Patch has direction (0," << dim - 1 << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double h; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (shape[dir] == 1) + { + cout << "NullShellPatch::getdX: for direction " << dir << ", this Patch has only one point. Can not determine dX for vertex center grid." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (dir < 2) + h = PI / 2 / (shape[dir] - 1); + else + h = (xmax - xmin) / (shape[dir] - 1); +#else +#ifdef Cell + if (dir < 2) + h = PI / 2 / shape[dir]; + else + h = (xmax - xmin) / shape[dir]; +#else +#error Not define Vertex nor Cell +#endif +#endif + return h; +} +void NullShellPatch2::destroypsuList(MyList *ct) +{ + MyList *n; + while (ct) + { + n = ct->next; + if (ct->data->coef) + { + delete[] ct->data->coef; + delete[] ct->data->sind; + } + delete ct->data; + delete ct; + ct = n; + } +} +void NullShellPatch2::shellname(char *sn, int i) +{ + switch (i) + { + case 0: + sprintf(sn, "zp"); + return; + case 1: + sprintf(sn, "zm"); + return; + case 2: + sprintf(sn, "xp"); + return; + case 3: + sprintf(sn, "xm"); + return; + case 4: + sprintf(sn, "yp"); + return; + case 5: + sprintf(sn, "ym"); + return; + } +} +MyList *NullShellPatch2::compose_sh(int cpusize) +{ + if (dim != 3) + { + cout << "distrivute: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + // checkPatch(); + + MyList *BlL = 0; + + int split_size, min_size, block_size = 0; + + int min_width = 2 * Mymax(ghost_width, buffer_width); + int nxy[2], mmin_width[2], min_shape[2]; + + MyList *PLi = PatL; + for (int i = 0; i < 2; i++) + min_shape[i] = PLi->data->shape[i]; + PLi = PLi->next; + while (PLi) + { + ss_patch *PP = PLi->data; + for (int i = 0; i < 2; i++) + min_shape[i] = Mymin(min_shape[i], PP->shape[i]); + PLi = PLi->next; + } + + for (int i = 0; i < 2; i++) + mmin_width[i] = Mymin(min_width, min_shape[i]); + + min_size = mmin_width[0]; + for (int i = 1; i < 2; i++) + min_size = min_size * mmin_width[i]; + + PLi = PatL; + while (PLi) + { + ss_patch *PP = PLi->data; + // PP->checkPatch(true); + int bs = PP->shape[0]; + for (int i = 1; i < 2; i++) + bs = bs * PP->shape[i]; + block_size = block_size + bs; + PLi = PLi->next; + } + split_size = Mymax(min_size, block_size / cpusize); + split_size = Mymax(1, split_size); + + int n_rank = 0; + PLi = PatL; + int reacpu = 0; + while (PLi) + { + ss_patch *PP = PLi->data; + + reacpu += Parallel::partition2(nxy, split_size, mmin_width, cpusize, PP->shape); // r direction can not be splitted!! It's ode! + + Block *ng; + int shape_here[3], ibbox_here[2 * 2]; + double bbox_here[2 * 3], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxy[0]; i++) + for (int j = 0; j < nxy[1]; j++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxy[0]; + ibbox_here[2] = (PP->shape[0] * (i + 1)) / nxy[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxy[1]; + ibbox_here[3] = (PP->shape[1] * (j + 1)) / nxy[1] - 1; + + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[2] = Mymin(PP->shape[0] - 1, ibbox_here[2] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[1] - 1, ibbox_here[3] + ghost_width); + + shape_here[0] = ibbox_here[2] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[3] - ibbox_here[1] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[2] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[3] * dd; +#else +#ifdef Cell + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[2] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[3] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + shape_here[2] = PP->shape[2]; + bbox_here[2] = PP->bbox[2]; + bbox_here[5] = PP->bbox[5]; + ng = new Block(dim, shape_here, bbox_here, n_rank++, ingfs, fngfs, 0); // delete through KillBlocks + // ng->checkBlock(); + if (n_rank == cpusize) + n_rank = 0; + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + // set PP->blb + if (i == 0 && j == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < cpusize * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch::distribute CAUSTION: uses essencially " << reacpu << " processors vs " << cpusize << " cpus run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +void NullShellPatch2::Dump_Data(MyList *DumpListi, char *tag, double time, double dT) +{ + MyList *PP = PatL; + while (PP) + { + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->data->shape[0] * PP->data->shape[1] * PP->data->shape[2]); + if (!databuffer) + { + cout << "NullShellPatch::Dump_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *DumpList = DumpListi; + while (DumpList) + { + var *VP = DumpList->data; + + MyList *Bp = PP->data->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->data->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + char filename[100]; + char sn[3]; + shellname(sn, PP->data->sst); + if (tag) + sprintf(filename, "%s_LevSH-%s_%s_%05d.bin", tag, sn, VP->name, ncount); + else + sprintf(filename, "LevSH-%s_%s_%05d.bin", sn, VP->name, ncount); + + Parallel::writefile(time, PP->data->shape[0], PP->data->shape[1], PP->data->shape[2], + PP->data->bbox[0], PP->data->bbox[3], PP->data->bbox[1], PP->data->bbox[4], + PP->data->bbox[2], PP->data->bbox[5], filename, databuffer); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + free(databuffer); + + PP = PP->next; + } +} +// Now we dump the data including overlap points +void NullShellPatch2::Dump_xyz(char *tag, double time, double dT) +{ + MyList *DumpListi = 0; + DumpListi = new MyList(gx); + DumpListi->insert(gy); + DumpListi->insert(gz); + Dump_Data(DumpListi, tag, time, dT); + DumpListi->clearList(); +} +// setup interpatch interpolation stuffs +void NullShellPatch2::setupintintstuff(int cpusize, MyList *CPatL, int Symmetry) +{ + const int hCS_width = 0; // do not input data from null shell to box + const int hSC_width = 1; // do input data from box to null shell + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch2::setupintintstuff begines..." << endl; + + ss_src = new MyList *[cpusize]; + ss_dst = new MyList *[cpusize]; + + if (!CPatL) // if characteristic evolve alone + { + cs_src = 0; + cs_dst = 0; + } + else + { + cs_src = new MyList *[cpusize]; + cs_dst = new MyList *[cpusize]; + } + + MyList *ps, *ts; + MyList *sPp; + MyList *Bgl; + MyList *Pp; + Block *Bg; + double CDH[dim], DH[dim], llb[dim], uub[dim]; + double x, y, z; + + for (int i = 0; i < dim; i++) + { + if (CPatL) + CDH[i] = CPatL->data->getdX(i); + DH[i] = getdX(i); + } + + for (int i = 0; i < cpusize; i++) + { + ss_src[i] = 0; + ss_dst[i] = 0; + if (CPatL) + { + cs_src[i] = 0; + cs_dst[i] = 0; + } + } + + sPp = PatL; + while (sPp) + { + for (int iz = 0; iz < sPp->data->shape[2]; iz++) + for (int is = 0; is < sPp->data->shape[1]; is++) + for (int ir = 0; ir < sPp->data->shape[0]; ir++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = sPp->data->bbox[0] + ir * DH[0]; + y = sPp->data->bbox[1] + is * DH[1]; + z = sPp->data->bbox[2] + iz * DH[2]; +#else +#ifdef Cell + x = sPp->data->bbox[0] + (ir + 0.5) * DH[0]; + y = sPp->data->bbox[1] + (is + 0.5) * DH[1]; + z = sPp->data->bbox[2] + (iz + 0.5) * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (CPatL && z < sPp->data->bbox[2] + (hSC_width + 0.0001) * DH[2]) + { + double gx, gy, gz; + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = false; + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(cs_src[i], false, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i, iz); + if (flag) + break; + } + if (!flag) + { + CPatL->data->checkBlock(); + if (myrank == 0) + { + cout << "ShellPatch2::prolongpointstru fail to find cardisian source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + cout << "x,y,z = " << gx << "," << gy << "," << gz << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + if (x < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[0] || x > PI / 4 + (overghost - ghost_width - 0.0001) * DH[0] || + y < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[1] || y > PI / 4 + (overghost - ghost_width - 0.0001) * DH[1]) + { + double gx, gy, gz; + if (z < 1 - 0.0001 * DH[2]) + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = true; + if (flag) + { + flag = false; + for (int i = 0; i < cpusize; i++) + { + if (z < 1 - 0.0001 * DH[2]) + flag = prolongpointstru(ss_src[i], true, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i, iz); + else + flag = prolongpointstru_ss(ss_src[i], sPp->data->sst, PatL, DH, CPatL, CDH, x, y, z, Symmetry, i, iz); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + // if you used Vertex grid please note x=1, try 0.999999 instead + cout << "NullShellPatch2::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + } + sPp = sPp->next; + } + if (myrank == 0) + cout << "NullShellPatch2::setupintintstuff ss_src completes" << endl; + + Pp = CPatL; + while (Pp) + { + double llb[dim], uub[dim]; + if (Symmetry > 0) + llb[2] = Pp->data->bbox[2] - 0.0001 * CDH[2]; + else + llb[2] = Pp->data->bbox[2] + (hCS_width + 0.0001) * CDH[2]; + uub[2] = Pp->data->bbox[dim + 2] - (hCS_width + 0.0001) * CDH[2]; + for (int j = 0; j < 2; j++) + { + if (Symmetry > 1) + llb[j] = Pp->data->bbox[j] - 0.0001 * CDH[j]; + else + llb[j] = Pp->data->bbox[j] + (hCS_width + 0.0001) * CDH[j]; + uub[j] = Pp->data->bbox[dim + j] - (hCS_width + 0.0001) * CDH[j]; + } + for (int iz = 0; iz < Pp->data->shape[2]; iz++) + for (int iy = 0; iy < Pp->data->shape[1]; iy++) + for (int ix = 0; ix < Pp->data->shape[0]; ix++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = Pp->data->bbox[0] + ix * CDH[0]; + y = Pp->data->bbox[1] + iy * CDH[1]; + z = Pp->data->bbox[2] + iz * CDH[2]; +#else +#ifdef Cell + x = Pp->data->bbox[0] + (ix + 0.5) * CDH[0]; + y = Pp->data->bbox[1] + (iy + 0.5) * CDH[1]; + z = Pp->data->bbox[2] + (iz + 0.5) * CDH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (x < llb[0] || x > uub[0] || + y < llb[1] || y > uub[1] || + z < llb[2] || z > uub[2]) + { + int sst; + double lx, ly, lz; + bool flag = false; + getlocalpox(x, y, z, sst, lx, ly, lz); + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(cs_src[i], true, -1, PatL, DH, CPatL, CDH, x, y, z, Symmetry, i, -1); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + cout << "ShellPatch2::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = -1, x,y,z = " << x << "," << y << "," << z << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + Pp = Pp->next; + } + if (myrank == 0) + if (CPatL) + cout << "NullShellPatch2::setupintintstuff cs_src completes" << endl; + else + cout << "NullShellPatch2::no cs_src exists" << endl; + + for (int i = 0; i < cpusize; i++) + { + ps = ss_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(ss_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + + if (CPatL) + { + ps = cs_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(cs_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + } + } + if (myrank == 0) + cout << "NullShellPatch2::setupintintstuff ss_dst and cs_dst complete" << endl; + + /* + for(int i=0;inext; + ts=ts->next; + } + } + exit(0); + */ +} +// lz is x instead of r +void NullShellPatch2::getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = r / (r + Rmin); + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch2::getlocalpox should not come here, something wrong" << endl; + } +} +// lz is x instead of r +// using fake global coordinates to get local coordinate +void NullShellPatch2::getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = r; + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch2::getlocalpox should not come here, something wrong" << endl; + } +} +// lz is x instead of r +// specially for usage from shell to shell +void NullShellPatch2::getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz) +{ + // fake global coordinate + double r = 1, x, y, z; + switch (isst) + { + case 0: + x = tan(ix); + y = tan(iy); + z = r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 1: + x = tan(ix); + y = tan(iy); + z = -r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 2: + y = tan(ix); + z = tan(iy); + x = r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 3: + y = tan(ix); + z = tan(iy); + x = -r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 4: + x = tan(ix); + z = tan(iy); + y = r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + case 5: + x = tan(ix); + z = tan(iy); + y = -r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + } + + // map with fake global coordinate + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "NullShellPatch2::getlocalpox should not come here, something wrong" << endl; + } + + lz = iz; + + // if(lx != lx) cout<data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + if (first_only) + return; + pp = pp->next; + } + } +} +// for check +// used by _dst construction, so these x,y,z must coinside with grid point +// we have considered ghost points now +void NullShellPatch2::prolongpointstru(MyList *&psul, MyList *sPpi, double DH[dim], + MyList *Ppi, double CDH[dim], MyList *pss) +{ + int n_dst = 0; + MyList *sPp = sPpi; + MyList *Pp = Ppi; + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz, lsst; + + if (pss->data->tsst >= 0) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + if (lx != lx) + getlocalpoxsst_ss(pss->data->ssst, pss->data->lpox[0], pss->data->lpox[1], pss->data->lpox[2], + pss->data->tsst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == pss->data->tsst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * DH[0] && lx < uub[0] + 0.1 * DH[0] && + ly > llb[1] - 0.1 * DH[1] && ly < uub[1] + 0.1 * DH[1] && + lz > llb[2] - 0.1 * DH[2] && lz < uub[2] + 0.1 * DH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = sPp->data->sst; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = pss->data->indz; + get_Jacob(ps->data->lpox, ps->data->tsst, ps->data->ssst, ps->data->Jacob); + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + if (pss->data->tsst != -1) + cout << "somthing is wrong in NullShellPatch2::prolongpointstru" << endl; + lx = pss->data->gpox[0]; + ly = pss->data->gpox[1]; + lz = pss->data->gpox[2]; + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * CDH[0] && lx < uub[0] + 0.1 * CDH[0] && + ly > llb[1] - 0.1 * CDH[1] && ly < uub[1] + 0.1 * CDH[1] && + lz > llb[2] - 0.1 * CDH[2] && lz < uub[2] + 0.1 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = -1; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = pss->data->indz; + for (int i = 0; i < 2; i++) + for (int j = 0; j < 2; j++) + ps->data->Jacob[i][j] = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + // if n_dst > 0, that's because of ghost_points then prolong source list + if (n_dst == 0) + { + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "NullShellPatch2::prolongpointstru fail to find target Block for pointstru:" << endl; + check_pointstrul(pss, true); + if (Pp == Ppi) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + if (myrank == 0) + cout << "sst = " << pss->data->tsst << ", lx,ly,lz = " << lx << "," << ly << "," << lz << endl; + checkBlock(pss->data->tsst); + } + else + { + Pp = Ppi; + while (Pp) + { + Pp->data->checkBlock(); + Pp = Pp->next; + } + } + if (myrank == 0) + MPI_Abort(MPI_COMM_WORLD, 1); + } + else + { + MyList *ts = 0; + for (int i = 1; i < n_dst; i++) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = (i == n_dst - 1) ? pss->next : 0; + for (int i = 0; i < dim; i++) + { + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[i] = pss->data->lpox[i]; + } + ps->data->ssst = pss->data->ssst; + ps->data->tsst = pss->data->tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->Bg = pss->data->Bg; + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = pss->data->indz; + for (int i = 0; i < 2; i++) + for (int j = 0; j < 2; j++) + ps->data->Jacob[i][j] = pss->data->Jacob[i][j]; + if (ts) + ts->catList(ps); + else + ts = ps; + } + if (ts) + pss->next = ts; + } +} +// used by _src construction, so these x,y,z do not coinside with grid point +bool NullShellPatch2::prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, + const int iz) +{ + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + if (ssyn) + { + int sst; + getlocalpox(x, y, z, sst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == sst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < 2; j++) + { + if (feq(Bg->bbox[j], -PI / 4 - overghost * DH[j], DH[j] / 2)) + llb[j] = -PI / 4; + else if (feq(Bg->bbox[j], sPp->data->bbox[j], DH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * DH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * DH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], PI / 4 + overghost * DH[j], DH[j] / 2)) + uub[j] = PI / 4; + else if (feq(Bg->bbox[dim + j], sPp->data->bbox[dim + j], DH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * DH[j]; + } + if (feq(Bg->bbox[2], sPp->data->bbox[2], DH[2] / 2)) + llb[2] = Bg->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[2] = Bg->bbox[2] + (ghost_width - 1) * DH[2]; +#else +#ifdef Cell + else + llb[2] = Bg->bbox[2] + ghost_width * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + 2], sPp->data->bbox[dim + 2], DH[2] / 2)) + uub[2] = Bg->bbox[dim + 2]; + else + uub[2] = Bg->bbox[dim + 2] - ghost_width * DH[2]; + if (lx > llb[0] - 0.0001 * DH[0] && lx < uub[0] + 0.0001 * DH[0] && + ly > llb[1] - 0.0001 * DH[1] && ly < uub[1] + 0.0001 * DH[1] && + lz > llb[2] - 0.0001 * DH[2] && lz < uub[2] + 0.0001 * DH[2]) // even ghost_width-1 the region is like |----|----| + // ^ + // so for ^ point may miss for vertext center, so we use 0.0001 + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = sPp->data->sst; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = iz; + for (int i = 0; i < 2; i++) + for (int j = 0; j < 2; j++) + ps->data->Jacob[i][j] = 0; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < dim; j++) + { + if (feq(Bg->bbox[j], Pp->data->bbox[j], CDH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * CDH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * CDH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], Pp->data->bbox[dim + j], CDH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * CDH[j]; + } + if (x > llb[0] - 0.0001 * CDH[0] && x < uub[0] + 0.0001 * CDH[0] && + y > llb[1] - 0.0001 * CDH[1] && y < uub[1] + 0.0001 * CDH[1] && + z > llb[2] - 0.0001 * CDH[2] && z < uub[2] + 0.0001 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = x; + ps->data->lpox[1] = y; + ps->data->lpox[2] = z; + ps->data->ssst = -1; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = -1; + for (int i = 0; i < 2; i++) + for (int j = 0; j < 2; j++) + ps->data->Jacob[i][j] = 0; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + + return false; +} +// used by _src construction, so these x,y,z do not coinside with grid point +// specially used from shell to shell +bool NullShellPatch2::prolongpointstru_ss(MyList *&psul, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz) +{ + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + int sst; + getlocalpox_ss(tsst, x, y, z, sst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == sst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < 2; j++) + { + if (feq(Bg->bbox[j], -PI / 4 - overghost * DH[j], DH[j] / 2)) + llb[j] = -PI / 4; + else if (feq(Bg->bbox[j], sPp->data->bbox[j], DH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * DH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * DH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], PI / 4 + overghost * DH[j], DH[j] / 2)) + uub[j] = PI / 4; + else if (feq(Bg->bbox[dim + j], sPp->data->bbox[dim + j], DH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * DH[j]; + } + if (feq(Bg->bbox[2], sPp->data->bbox[2], DH[2] / 2)) + llb[2] = Bg->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[2] = Bg->bbox[2] + (ghost_width - 1) * DH[2]; +#else +#ifdef Cell + else + llb[2] = Bg->bbox[2] + ghost_width * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + 2], sPp->data->bbox[dim + 2], DH[2] / 2)) + uub[2] = Bg->bbox[dim + 2]; + else + uub[2] = Bg->bbox[dim + 2] - ghost_width * DH[2]; + if (lx > llb[0] - 0.0001 * DH[0] && lx < uub[0] + 0.0001 * DH[0] && + ly > llb[1] - 0.0001 * DH[1] && ly < uub[1] + 0.0001 * DH[1] && + lz > llb[2] - 0.0001 * DH[2] && lz < uub[2] + 0.0001 * DH[2]) // even ghost_width-1 the region is like |----|----| + // ^ + // so for ^ point may miss for vertext center, so we use 0.0001 + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = 0; // global coordinate is not valid for r=infinity + ps->data->gpox[1] = 0; + ps->data->gpox[2] = 0; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = sPp->data->sst; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->data->indz = iz; + for (int i = 0; i < 2; i++) + for (int j = 0; j < 2; j++) + ps->data->Jacob[i][j] = 0; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + + return false; +} +// J[new][old] = d x_new/d x_old +void NullShellPatch2::get_Jacob(double *pox, int tsst, int ssst, double J[2][2]) +{ + double rn = pox[0], sn = pox[1], ro, so; + + double cosro, sinro, cosso, sinso; + if (tsst == 0 || tsst == 1) // z + { + if (ssst == 2 || ssst == 3) // x + { + ro = atan(tan(sn) / tan(rn)); + so = atan(1 / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = 0; + J[0][1] = -1; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = -cosro * sinro / J[1][0]; + J[1][0] = cosso * sinso / J[1][0]; + } + else if (ssst == 4 || ssst == 5) // y + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = -cosro * sinro / J[0][0]; + J[0][0] = cosso * sinso / J[0][0]; + J[1][0] = 0; + J[1][1] = -1; + } + else + cout << "Error in NullShellPatch2::get_Jacob 1" << endl; + } + else if (tsst == 2 || tsst == 3) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(1 / tan(sn)); + so = atan(tan(rn) / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = cosro * sinro / J[0][0]; + J[0][0] = -cosso * sinso / J[0][0]; + J[1][0] = -1; + J[1][1] = 0; + } + else if (ssst == 4 || ssst == 5) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = -1; + J[0][1] = 0; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = cosro * sinro / J[1][0]; + J[1][0] = -cosso * sinso / J[1][0]; + } + else + cout << "Error in NullShellPatch2::get_Jacob 2" << endl; + } + else if (tsst == 4 || tsst == 5) + { + if (ssst == 0 || ssst == 1) + { + ro = atan(tan(rn) / tan(sn)); + so = atan(1 / tan(sn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[0][1] = -cosro * sinro / J[0][0]; + J[0][0] = cosso * sinso / J[0][0]; + J[1][0] = 0; + J[1][1] = -1; + } + else if (ssst == 2 || ssst == 3) + { + ro = atan(1 / tan(rn)); + so = atan(tan(sn) / tan(rn)); + cosro = cos(ro); + sinro = sin(ro); + cosso = cos(so); + sinso = sin(so); + J[0][0] = -1; + J[0][1] = 0; + J[1][0] = cosso * cosso * sinro * sinro + cosro * cosro * sinso * sinso; + J[1][1] = cosro * sinro / J[1][0]; + J[1][0] = -cosso * sinso / J[1][0]; + } + else + cout << "Error in NullShellPatch2::get_Jacob 3" << endl; + } +} +int NullShellPatch2::getdumydimension(int acsst, int posst) // -1 means no dumy dimension +{ + int dms; + if (acsst == -1 || posst == -1) + return -1; + switch (acsst) + { + case 0: + case 1: + switch (posst) + { + case 0: + case 1: + cout << "error in NullShellPatch2::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 2: + case 3: + return 0; + case 4: + case 5: + return 1; + default: + cout << "error in NullShellPatch2::getdumydimension: posst = " << posst << endl; + return -1; + } + case 2: + case 3: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + cout << "error in NullShellPatch2::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 4: + case 5: + return 0; + default: + cout << "error in NullShellPatch2::getdumydimension: posst = " << posst << endl; + return -1; + } + case 4: + case 5: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + return 0; + case 4: + case 5: + cout << "error in NullShellPatch2::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + default: + cout << "error in NullShellPatch2::getdumydimension: posst = " << posst << endl; + return -1; + } + default: + cout << "error in NullShellPatch2::getdumydimension: acsst = " << acsst << endl; + return -1; + } +} +void NullShellPatch2::Synch(MyList *VarList, int Symmetry, double **Varwt, const short int svt) +{ + MyList *Pp = PatL; + while (Pp) + { + Pp->data->Sync(VarList, Symmetry); + Pp = Pp->next; + } + + // we need this before interpolation + if (Symmetry > 0) + fill_symmetric_boundarybuffer(VarList, Varwt); + + intertransfer(ss_src, ss_dst, VarList, VarList, Symmetry, Varwt, svt); + + // we need this here to correct conners + if (Symmetry > 0) + fill_symmetric_boundarybuffer(VarList, Varwt); +} +// Varwt: AoS of rho, sigma, x +void NullShellPatch2::fill_symmetric_boundarybuffer(MyList *VarList, double **Varwt) +{ + MyList *varl; + int ind; + double drho = getdX(0), dsigma = getdX(1); + + if (Symmetry == 0) + return; + else + { + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + varl = VarList; + ind = 0; + while (varl) + { + f_fill_symmetric_boundarybuffer2(cg->shape, cg->X[0], cg->X[1], cg->X[2], drho, dsigma, + cg->fgfs[varl->data->sgfn], + Symmetry, Pp->data->sst, Varwt[ind]); // defined in NullEvol2.f90 + varl = varl->next; + ind++; + } + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +} +void NullShellPatch2::intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry, double **Varwt, const short int svt) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt, svt)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(rec_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt, svt); + } + } + else + { + // send from this cpu to cpu#node + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt, svt)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(send_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry, Varwt, svt); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = interdata_packer(0, src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry, Varwt, svt)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + interdata_packer(rec_data[node], src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry, Varwt, svt); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +// PACK: prepare target data in 'data' +// UNPACK: copy target data from 'data' to corresponding numerical grids +int NullShellPatch2::interdata_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt) +{ + int rev; + rev = interdata_packer_pre(data, src, dst, rank_in, dir, VarLists, VarListd, Symmetry, Varwt, svt); + if (dir == PACK) + return rev; + rev = interdata_packer_pot(data, src, dst, rank_in, dir, VarLists, VarListd, Symmetry, Varwt, svt); + return rev; +} +int NullShellPatch2::interdata_packer_pre(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + int ordn = 2 * ghost_width; + + if (dir != PACK && dir != UNPACK) + { + cout << "error dir " << dir << " for data_packer " << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (src && dst) + { + if ((dir == PACK && dst->data->Bg->rank == rank_in && src->data->Bg->rank == myrank) || + (dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + int vind = 1; + bool flag = true; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + { + int DIMh = (src->data->dumyd == -1) ? dim : 1; + if (src->data->coef == 0) + { + src->data->coef = new double[ordn * DIMh]; + src->data->sind = new int[dim]; + if (DIMh == 3) + { + for (int i = 0; i < DIMh; i++) + { + double dd = src->data->Bg->getdX(i); + // 0.001 instead of 0.4 makes the point locate more center + src->data->sind[i] = int((src->data->lpox[i] - src->data->Bg->X[i][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[i][0] + (src->data->sind[i] + j) * dd; + src->data->coef[i * ordn + j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + } + } + } + else + { + int actd = 1 - src->data->dumyd; + double dd = src->data->Bg->getdX(actd); + src->data->sind[0] = int((src->data->lpox[actd] - src->data->Bg->X[actd][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[actd][0] + (src->data->sind[0] + j) * dd; + src->data->coef[j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + } + src->data->sind[2] = int((src->data->lpox[2] - src->data->Bg->X[2][0]) / src->data->Bg->getdX(2) + 0.001); + if (!feq(src->data->Bg->X[2][src->data->sind[2]], src->data->lpox[2], src->data->Bg->getdX(2) / 2000)) + cout << "error in NullShellPatch::interdata_packer point = " << src->data->lpox[2] << " != grid " << src->data->Bg->X[2][src->data->sind[2]] << endl; + src->data->sind[1] = int((src->data->lpox[src->data->dumyd] - src->data->Bg->X[src->data->dumyd][0]) / + src->data->Bg->getdX(src->data->dumyd) + + 0.001); + if (!feq(src->data->Bg->X[src->data->dumyd][src->data->sind[1]], src->data->lpox[src->data->dumyd], src->data->Bg->getdX(src->data->dumyd) / 2000)) + cout << "error in NullShellPatch::interdata_packer for dumy dimension point = " + << src->data->lpox[src->data->dumyd] << " != grid " << src->data->Bg->X[src->data->dumyd][src->data->sind[1]] << endl; + } + } + // interpolate + switch (DIMh) + { + case 3: + f_global_interpind(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 2: + f_global_interpind2d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 1: + f_global_interpind1d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst, src->data->dumyd); + break; + default: + cout << "NullShellPatch2::interdata_packer: not recognized DIM = " << DIMh << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + if (dir == UNPACK) // from target data to corresponding grid + { + switch (svt) + { + case 1: // type(0,0) + vind = 0; + break; + case 2: // type(0,1) + { + if (vind / 2 * 2 == vind) + { + double tmp[2]; + double Jon[2][2]; + Jon[0][0] = dst->data->Jacob[0][0]; + Jon[0][1] = dst->data->Jacob[0][1]; + Jon[1][0] = dst->data->Jacob[1][0]; + Jon[1][1] = dst->data->Jacob[1][1]; + + tmp[0] = Jon[0][0] * Jon[1][1] - Jon[0][1] * Jon[1][0]; + tmp[1] = Jon[1][1] / tmp[0]; + Jon[0][1] = -Jon[0][1] / tmp[0]; + Jon[1][0] = -Jon[1][0] / tmp[0]; + Jon[1][1] = Jon[0][0] / tmp[0]; + Jon[0][0] = tmp[1]; + + tmp[0] = data[size_out - 1]; + tmp[1] = data[size_out]; + data[size_out - 1] = Jon[0][0] * tmp[0] + Jon[1][0] * tmp[1]; + data[size_out] = Jon[0][1] * tmp[0] + Jon[1][1] * tmp[1]; + + vind = 0; + } + break; + } + case 3: // symmetric type(0,2) + { + if (vind / 3 * 3 == vind) + { + double tmp[3]; + double Jon[2][2]; + Jon[0][0] = dst->data->Jacob[0][0]; + Jon[0][1] = dst->data->Jacob[0][1]; + Jon[1][0] = dst->data->Jacob[1][0]; + Jon[1][1] = dst->data->Jacob[1][1]; + tmp[0] = Jon[0][0] * Jon[1][1] - Jon[0][1] * Jon[1][0]; + tmp[1] = Jon[1][1] / tmp[0]; + Jon[0][1] = -Jon[0][1] / tmp[0]; + Jon[1][0] = -Jon[1][0] / tmp[0]; + Jon[1][1] = Jon[0][0] / tmp[0]; + Jon[0][0] = tmp[1]; + + tmp[0] = data[size_out - 2]; + tmp[1] = data[size_out - 1]; + tmp[2] = data[size_out]; + data[size_out - 2] = Jon[0][0] * Jon[0][0] * tmp[0] + 2 * Jon[1][0] * Jon[0][0] * tmp[1] + Jon[1][0] * Jon[1][0] * tmp[2]; + data[size_out - 1] = Jon[0][0] * Jon[0][1] * tmp[0] + (Jon[1][0] * Jon[0][1] + Jon[0][0] * Jon[1][1]) * tmp[1] + Jon[1][0] * Jon[1][1] * tmp[2]; + data[size_out] = Jon[0][1] * Jon[0][1] * tmp[0] + 2 * Jon[1][1] * Jon[0][1] * tmp[1] + Jon[1][1] * Jon[1][1] * tmp[2]; + + vind = 0; + } + break; + } + default: + { + cout << "NullShellPatch2::interdata_packer: not recognized svt = " << svt << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + size_out += 1; + vind += 1; + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +int NullShellPatch2::interdata_packer_pot(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt) +{ + if (dir != UNPACK) + return 0; + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + int ordn = 2 * ghost_width; + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (src && dst) + { + if ((dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + if (data) + { + if (dir == UNPACK) // from target data to corresponding grid + { + f_pointcopy(DIM, dst->data->Bg->bbox, dst->data->Bg->bbox + dim, dst->data->Bg->shape, dst->data->Bg->fgfs[varld->data->sgfn], + dst->data->lpox[0], dst->data->lpox[1], dst->data->lpox[2], data[size_out]); + } + } + size_out += 1; + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +void NullShellPatch2::Interp_Points_2D(MyList *VarList, + int NN, double **XX, /*input fake global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + int sst; + getlocalpox_fake(XX[0][j], XX[1][j], XX[2][j], sst, pox[0], pox[1], pox[2]); // pox[2] is x indeed + + // int indZ=int((pox[2]-xmin)/DH[2]); + int indZ = shape[2]; // note we use index for Fortran + MyList *sPp = PatL; + while (sPp->data->sst != sst) + sPp = sPp->next; + + if (myrank == 0 && ((!sPp) || pox[2] < xmin - 0.0001 * DH[2] || pox[2] > xmax + 0.0001 * DH[2])) + { + cout << "NullShellPatch::Interp_Points: point gc = ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + } + if (sPp) + { + cout << ") sst = " << sst << " lc = ("; + for (int k = 0; k < dim; k++) + { + cout << pox[k]; + if (k < dim - 1) + cout << ","; + } + } + cout << ") is out of the NullShellPatch." << endl; + cout << "xmin = " << xmin << ", xmax = " << xmax << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (!sPp) + return; + + MyList *Bp = sPp->data->blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +// +// because of getlocalpox, pox will not goes into overghost region of ss_patch +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (pox[i] - llb[i] < -DH[i] / 2 || pox[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + f_global_interp_ss_2d(BP->shape, BP->X[0], BP->X[1], indZ, BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], ordn, varl->data->SoA, Symmetry, sst); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: NullShellPatch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: NullShellPatch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j][i]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on NullShellPatch (" << xmin << ":" << xmax << ")" << endl; + + cout << "splited domains:" << endl; + MyList *sPp = PatL; + while (sPp) + { + char sn[3]; + shellname(sn, sPp->data->sst); + cout << "ss_patch " << sn << ":" << endl; + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} diff --git a/AMSS_NCKU_source/NullShellPatch2.h b/AMSS_NCKU_source/NullShellPatch2.h new file mode 100644 index 0000000..df132ff --- /dev/null +++ b/AMSS_NCKU_source/NullShellPatch2.h @@ -0,0 +1,183 @@ + +#ifndef NULLSHELLPATCH2_H +#define NULLSHELLPATCH2_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include +#include "MyList.h" +#include "Block.h" +#include "Parallel.h" +#include "ShellPatch.h" +#include "var.h" +#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width + +#if (dim != 3) +#error NullShellPatch2 only supports 3 dimensional stuff yet +#endif + +// x x x x x o * +// * o x x x x x +// each side contribute an overlap points +// so we need half of that +#define overghost ((ghost_width + 1) / 2 + ghost_width) + +class NullShellPatch2 +{ + + class xp_npatch : public ss_patch + { + public: + xp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; }; + }; + + class xm_npatch : public ss_patch + { + public: + xm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; }; + }; + class yp_npatch : public ss_patch + { + public: + yp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; }; + }; + + class ym_npatch : public ss_patch + { + public: + ym_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; }; + }; + class zp_npatch : public ss_patch + { + public: + zp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; }; + }; + + class zm_npatch : public ss_patch + { + public: + zm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; }; + }; + +public: + struct pointstru + { + double gpox[dim]; // global cordinate + double lpox[dim]; // local cordinate + Block *Bg; + int ssst; //-1: cardisian, others as sst of ss_patch source sst + int tsst; //-1: cardisian, others as sst of ss_patch target sst + double *coef; + int *sind; // index position, considered dummy dimension already + int dumyd; // the dimension which has common lines, only useful in interdata_packer + double Jacob[2][2]; + int indz; // index position of r direction + }; + + var *gx, *gy, *gz; + // surface variable + var *g00, *g01, *p02, *p03, *g02, *g03; + var *Theta22, *Theta23, *Theta33; + + // evolution variables + var *g22o, *g23o, *g33o; + var *g220, *g230, *g330; + var *g22, *g23, *g33; + var *g221, *g231, *g331; + var *g22_rhs, *g23_rhs, *g33_rhs; + + var *RNews, *INews; + var *omega, *dtomega; + + MyList *StateList, *SynchList_pre, *SynchList_cor, *RHSList; + MyList *OldStateList, *DumpList, *CheckList; + MyList *NewsList; + + MyList *g01List, *pg0AList, *g00List, *ThetaList; + + double **g01wt, **pg0Awt, **g00wt, **Thetawt; + + int myrank; + int shape[dim]; // for (rho, sigma, X), for rho and sigma means number of points for every pi/2 + double Rmin, xmin, xmax; + int Symmetry; + int ingfs, fngfs; + + MyList *PatL; + + MyList **ss_src, **ss_dst; + MyList **cs_src, **cs_dst; + +public: + NullShellPatch2(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetry, int myranki); + + ~NullShellPatch2(); + + double getdX(int dir); + void shellname(char *sn, int i); + void destroypsuList(MyList *ct); + MyList *compose_sh(int cpusize); + void Dump_xyz(char *tag, double time, double dT); + void Dump_Data(MyList *DumpListi, char *tag, double time, double dT); + void setupintintstuff(int cpusize, MyList *CPatL, int Symmetry); + void getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz); + void getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz); + void getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz); + void getlocalpoxsst_ss(int isst, double ix, double iy, double iz, int lsst, double &lx, double &ly, double &lz); + void getlocalpoxsst(double x, double y, double z, int sst, double &lx, double &ly, double &lz); + void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz); + int getdumydimension(int acsst, int posst); + void get_Jacob(double *pox, int tsst, int ssst, double J[2][2]); + void prolongpointstru(MyList *&psul, MyList *sPpi, double DH[dim], + MyList *Ppi, double CDH[dim], MyList *pss); + bool prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz); + bool prolongpointstru_ss(MyList *&psul, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz); + void Setup_Initial_Data(bool checkrun, double PhysTime); + void Step(double dT, double PhysTime, monitor *ErrorMonitor); + void HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count); + void Synch(MyList *VarList, int Symmetry, double **Varwt, const short int svt); + void fill_symmetric_boundarybuffer(MyList *VarList, double **Varwt); + void intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry, double **Varwt, const short int svt); + int interdata_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt); + int interdata_packer_pre(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt); + int interdata_packer_pot(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry, double **Varwt, + const short int svt); + void check_pointstrul(MyList *pp, bool first_only); + void checkBlock(int sst); + void Null_Boundary(double PhysTime); + void Compute_News(double PhysTime); + void Interp_Points_2D(MyList *VarList, + int NN, double **XX, /*input fake global Cartesian coordinate*/ + double *Shellf, int Symmetry); + double Error_Check(double PhysTime); +}; + +#endif /* NULLSHELLPATCH2_H */ diff --git a/AMSS_NCKU_source/NullShellPatch2_Evo.C b/AMSS_NCKU_source/NullShellPatch2_Evo.C new file mode 100644 index 0000000..adf7818 --- /dev/null +++ b/AMSS_NCKU_source/NullShellPatch2_Evo.C @@ -0,0 +1,1036 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "NullShellPatch2.h" +#include "Parallel.h" +#include "fmisc.h" +#include "misc.h" +#include "shellfunctions.h" +#include "NullEvol.h" +#include "NullNews.h" +#include "initial_null2.h" +#include "rungekutta4_rout.h" +#include "kodiss.h" + +#define PI M_PI + +#if 0 +// for RT +void NullShellPatch2::Setup_Initial_Data(bool checkrun,double PhysTime) +{ + if(checkrun) + { + } + else + { + MyList *Pp=PatL; + while(Pp) + { + MyList *BL=Pp->data->blb; + while(BL) + { + Block *cg=BL->data; + if(myrank == cg->rank) + { + f_get_initial_null2(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + Pp->data->sst,Rmin); +// for Theta_AB + f_get_gauge_g00_K(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn], + cg->fgfs[g00->sgfn],Rmin); + } + if(BL == Pp->data->ble) break; + BL=BL->next; + } + Pp=Pp->next; + } +//Synchronize K + Synch(g00List,Symmetry,g00wt,1); + Pp=PatL; + int IONE=1; + while(Pp) + { + MyList *BP=Pp->data->blb; + int fngfs = Pp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_gauge_g00(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn], + cg->fgfs[g00->sgfn],Rmin,IONE); + } + if(BP==Pp->data->ble) break; + BP=BP->next; + } + Pp=Pp->next; + } + Synch(ThetaList,Symmetry,Thetawt,3); + } +} +#else +void NullShellPatch2::Setup_Initial_Data(bool checkrun, double PhysTime) +{ + if (checkrun) + { + } + else + { + MyList *Pp = PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_null3(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g220->sgfn], cg->fgfs[g230->sgfn], cg->fgfs[g330->sgfn], + Pp->data->sst, Rmin); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +} +#endif +void NullShellPatch2::Step(double dT, double PhysTime, monitor *ErrorMonitor) +{ + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + double TT = PhysTime; + double neps = -0.05; + MyList *sPp; + + // Predictor + HyperSlice(dT, TT, ErrorMonitor, iter_count); + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + // rhs calculation + f_array_copy(cg->shape, cg->fgfs[g22_rhs->sgfn], cg->fgfs[Theta22->sgfn]); + f_array_copy(cg->shape, cg->fgfs[g23_rhs->sgfn], cg->fgfs[Theta23->sgfn]); + f_array_copy(cg->shape, cg->fgfs[g33_rhs->sgfn], cg->fgfs[Theta33->sgfn]); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g220->sgfn], cg->fgfs[g22_rhs->sgfn], + Thetawt[0], Symmetry, neps, sPp->data->sst); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g230->sgfn], cg->fgfs[g23_rhs->sgfn], + Thetawt[1], Symmetry, neps, sPp->data->sst); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g330->sgfn], cg->fgfs[g33_rhs->sgfn], + Thetawt[2], Symmetry, neps, sPp->data->sst); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g220->sgfn], cg->fgfs[g22->sgfn], cg->fgfs[g22_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g230->sgfn], cg->fgfs[g23->sgfn], cg->fgfs[g23_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g330->sgfn], cg->fgfs[g33->sgfn], cg->fgfs[g33_rhs->sgfn], + iter_count); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + Synch(SynchList_pre, Symmetry, Thetawt, 3); + // Synch(SynchList_pre,Symmetry,g00wt,1); + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TT += dT / 2; + HyperSlice(dT, TT, ErrorMonitor, iter_count); + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + // rhs calculation + f_array_copy(cg->shape, cg->fgfs[g221->sgfn], cg->fgfs[Theta22->sgfn]); + f_array_copy(cg->shape, cg->fgfs[g231->sgfn], cg->fgfs[Theta23->sgfn]); + f_array_copy(cg->shape, cg->fgfs[g331->sgfn], cg->fgfs[Theta33->sgfn]); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g22->sgfn], cg->fgfs[g221->sgfn], + Thetawt[0], Symmetry, neps, sPp->data->sst); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g23->sgfn], cg->fgfs[g231->sgfn], + Thetawt[1], Symmetry, neps, sPp->data->sst); + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[g33->sgfn], cg->fgfs[g331->sgfn], + Thetawt[2], Symmetry, neps, sPp->data->sst); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g220->sgfn], cg->fgfs[g221->sgfn], cg->fgfs[g22_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g230->sgfn], cg->fgfs[g231->sgfn], cg->fgfs[g23_rhs->sgfn], + iter_count); + f_rungekutta4_rout(cg->shape, dT, cg->fgfs[g330->sgfn], cg->fgfs[g331->sgfn], cg->fgfs[g33_rhs->sgfn], + iter_count); + } + if (iter_count < 3) + cg->swapList(SynchList_cor, SynchList_pre, myrank); + else + { + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + if (iter_count < 3) + Synch(SynchList_pre, Symmetry, Thetawt, 3); + else + Synch(StateList, Symmetry, Thetawt, 3); + // if( iter_count < 3 ) Synch(SynchList_pre,Symmetry,g00wt,1); + // else Synch(StateList,Symmetry,g00wt,1); + } +} +// really ODEs, so we do not need Synch in this routine at all +#if 0 +void NullShellPatch2::HyperSlice(double dT,double PhysTime,monitor *ErrorMonitor,int RK_count) +{ + int ERROR=0; + Null_Boundary(PhysTime); +#if 1 + MyList *sPp; + +// evolve g01 + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + if(RK_count==0) + { + if(f_NullEvol_g01(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[g01->sgfn],Rmin)) + { + cout<<"find NaN of g01 in NullShell domain: sst = "<data->sst<<", ("<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g22->sgfn],cg->fgfs[g23->sgfn],cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn],Rmin)) + { + cout<<"find NaN of g01 in NullShell domain: sst = "<data->sst<<", ("<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + Synch(g01List,Symmetry,g01wt,1); + if(RK_count==3) Dump_Data(g01List,0,PhysTime,dT); +//check error information + {int erh=ERROR;MPI_Allreduce(&erh,&ERROR,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD); } + if(ERROR) + { + if(RK_count==0) Dump_Data(StateList,0,PhysTime,dT); + else Dump_Data(SynchList_pre,0,PhysTime,dT); + if(myrank == 0) + { + if(ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile<<"find NaN in beta on NullShell Patches at t = "<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g22->sgfn],cg->fgfs[g23->sgfn],cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn],cg->fgfs[p03->sgfn], + cg->fgfs[g02->sgfn],cg->fgfs[g03->sgfn],Rmin)) + { + cout<<"find NaN of pg0A in NullShell domain: sst = "<data->sst<<", ("<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + Synch(pg0AList,Symmetry,pg0Awt,2); + if(RK_count==3) Dump_Data(pg0AList,0,PhysTime,dT); +//check error information + {int erh=ERROR;MPI_Allreduce(&erh,&ERROR,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD); } + if(ERROR) + { + Dump_Data(g01List,0,PhysTime,dT); + if(myrank == 0) + { + if(ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile<<"find NaN in beta on NullShell Patches at t = "<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g22->sgfn],cg->fgfs[g23->sgfn],cg->fgfs[g33->sgfn], + cg->fgfs[g00->sgfn],cg->fgfs[g01->sgfn], + cg->fgfs[g02->sgfn],cg->fgfs[g03->sgfn], + cg->fgfs[p02->sgfn],cg->fgfs[p03->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn],Rmin)) + { + cout<<"find NaN of ThetaAB in NullShell domain: sst = "<data->sst<<", ("<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + Synch(ThetaList,Symmetry,Thetawt,3); + if(RK_count==3) Dump_Data(ThetaList,0,PhysTime,dT); +//check error information + {int erh=ERROR;MPI_Allreduce(&erh,&ERROR,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD); } + if(ERROR) + { + Dump_Data(pg0AList,0,PhysTime,dT); + if(myrank == 0) + { + if(ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile<<"find NaN in beta on NullShell Patches at t = "<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g22->sgfn],cg->fgfs[g23->sgfn],cg->fgfs[g33->sgfn], + cg->fgfs[g00->sgfn],cg->fgfs[g01->sgfn], + cg->fgfs[g02->sgfn],cg->fgfs[g03->sgfn], + cg->fgfs[p02->sgfn],cg->fgfs[p03->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn],Rmin)) + { + cout<<"find NaN of ThetaAB in NullShell domain: sst = "<data->sst<<", ("<bbox[0]<<":"<bbox[3]<<"," + <bbox[1]<<":"<bbox[4]<<","<bbox[2]<<":"<bbox[5]<<")"<data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + Synch(ThetaList,Symmetry,Thetawt,3); + if(RK_count==3) Dump_Data(ThetaList,0,PhysTime,dT); + Synch(g00List,Symmetry,g00wt,1); + if(RK_count==3) Dump_Data(g00List,0,PhysTime,dT); +//check error information + {int erh=ERROR;MPI_Allreduce(&erh,&ERROR,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD); } + if(ERROR) + { + Dump_Data(pg0AList,0,PhysTime,dT); + if(myrank == 0) + { + if(ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile<<"find NaN in beta on NullShell Patches at t = "<bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_g01(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g22->sgfn], cg->fgfs[g23->sgfn], cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn], Rmin)) + { + cout << "find NaN of g01 in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + Synch(g01List, Symmetry, g01wt, 1); + // if(RK_count==3) Dump_Data(g01List,0,PhysTime,dT); + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + if (RK_count == 0) + Dump_Data(StateList, 0, PhysTime, dT); + else + Dump_Data(SynchList_pre, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // evolve p02, p03, g02 and g03 + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_pg0A(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g220->sgfn], cg->fgfs[g230->sgfn], cg->fgfs[g330->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], Rmin)) + { + cout << "find NaN of pg0A in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_pg0A(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g22->sgfn], cg->fgfs[g23->sgfn], cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], Rmin)) + { + cout << "find NaN of pg0A in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + Synch(pg0AList, Symmetry, pg0Awt, 2); + // if(RK_count==3) Dump_Data(pg0AList,0,PhysTime,dT); + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(g01List, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + // for gauge variable g00 + { + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_g00_with_t(PhysTime, cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g00->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // if(RK_count==3) Dump_Data(g00List,0,PhysTime,dT); + } + // evolve ThetaAB + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (RK_count == 0) + { + if (f_NullEvol_Theta2(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g220->sgfn], cg->fgfs[g230->sgfn], cg->fgfs[g330->sgfn], + cg->fgfs[g00->sgfn], cg->fgfs[g01->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[Theta22->sgfn], cg->fgfs[Theta23->sgfn], cg->fgfs[Theta33->sgfn], Rmin)) + { + cout << "find NaN of ThetaAB in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + else + { + if (f_NullEvol_Theta2(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g22->sgfn], cg->fgfs[g23->sgfn], cg->fgfs[g33->sgfn], + cg->fgfs[g00->sgfn], cg->fgfs[g01->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[Theta22->sgfn], cg->fgfs[Theta23->sgfn], cg->fgfs[Theta33->sgfn], Rmin)) + { + cout << "find NaN of ThetaAB in NullShell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + Synch(ThetaList, Symmetry, Thetawt, 3); + // if(RK_count==3) Dump_Data(ThetaList,0,PhysTime,dT); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Dump_Data(pg0AList, 0, PhysTime, dT); + if (myrank == 0) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + else + cout << "find NaN in beta on NullShell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +} +#endif +#if 0 +void NullShellPatch2::Null_Boundary(double PhysTime) +{ + MyList *sPp; + + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_null_boundary2(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g22->sgfn],cg->fgfs[g23->sgfn],cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn],cg->fgfs[p03->sgfn], + cg->fgfs[g02->sgfn],cg->fgfs[g03->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn],Rmin); +// for Theta_AB + f_get_gauge_g00_K(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn], + cg->fgfs[g00->sgfn],Rmin); + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } +// boundary for Theta_AB +//Synchronize K + Synch(g00List,Symmetry,g00wt,1); + sPp=PatL; + int IZEO=1; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_gauge_g00(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[Theta22->sgfn],cg->fgfs[Theta23->sgfn],cg->fgfs[Theta33->sgfn], + cg->fgfs[g00->sgfn],Rmin,IZEO); + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } + Synch(ThetaList,Symmetry,Thetawt,3); + //Synch(ThetaList,Symmetry,g00wt,1); +// boundary condition is independent of angular direction, do not need synch +// Synch(pg0AList,Symmetry,pg0Awt,2,-1); +// Synch(g00List,Symmetry,g00wt,1,-1); +// Synch(ThetaList,Symmetry,Thetawt,3,-1); +} +#else +void NullShellPatch2::Null_Boundary(double PhysTime) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary3(PhysTime, cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g22->sgfn], cg->fgfs[g23->sgfn], cg->fgfs[g33->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], + cg->fgfs[Theta22->sgfn], cg->fgfs[Theta23->sgfn], cg->fgfs[Theta33->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + /* + // check Synch + Synch(g01List,Symmetry,g01wt,1); + Dump_Data(g01List,0,PhysTime,1); + Synch(pg0AList,Symmetry,pg0Awt,2); + Dump_Data(pg0AList,0,PhysTime,1); + Synch(StateList,Symmetry,Thetawt,3); + Dump_Data(StateList,0,PhysTime,1); + Synch(ThetaList,Symmetry,Thetawt,3); + Dump_Data(ThetaList,0,PhysTime,1); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + */ +} +// 0: real L2 norm; 1: root mean squar +#define L2m 0 +double NullShellPatch2::Error_Check(double PhysTime) +{ + MyList *sPp; + + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_boundary3(PhysTime, cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[g221->sgfn], cg->fgfs[g231->sgfn], cg->fgfs[g331->sgfn], + cg->fgfs[g01->sgfn], + cg->fgfs[p02->sgfn], cg->fgfs[p03->sgfn], + cg->fgfs[g22_rhs->sgfn], cg->fgfs[g03->sgfn], + cg->fgfs[Theta22->sgfn], cg->fgfs[Theta23->sgfn], cg->fgfs[Theta33->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + double tvf, dtvf = 0; + int tN, dtN = 0; + int BDW = ghost_width, OBDW = overghost; + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_array_subtract(cg->shape, cg->fgfs[g22_rhs->sgfn], cg->fgfs[g02->sgfn]); +#if (L2m == 0) + f_l2normhelper_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[g22_rhs->sgfn], tvf, BDW, OBDW, Symmetry); +#elif (L2m == 1) + f_l2normhelper_sh_rms(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[g22_rhs->sgfn], tvf, BDW, OBDW, Symmetry, dtN); + dtN += dtN; +#endif + + dtvf += tvf; + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + // Dump_Data(RHSList,0,PhysTime,1); + // Dump_Data(ThetaList,0,PhysTime,1); + // if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); +#if (L2m == 0) + tvf = sqrt(tvf); +#elif (L2m == 1) + MPI_Allreduce(&dtN, &tN, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + tvf = sqrt(tvf / tN); +#endif + + return tvf; +} +#undef L2m +#endif + +void NullShellPatch2::Compute_News(double PhysTime) +{ + MyList *sPp; + +// get omega and dtomega +// for RT +#if 0 + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_omega_and_dtomega_pre(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[omega->sgfn],cg->fgfs[dtomega->sgfn],Rmin); + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } +// Synch + { + MyList * DG_List; + DG_List=new MyList(omega); + Synch(DG_List,Symmetry,g00wt,1); + DG_List->clearList(); + DG_List=new MyList(dtomega); + Synch(DG_List,Symmetry,g00wt,1); + DG_List->clearList(); + } +// get dtomega + sPp=PatL; + while(sPp) + { + MyList *BP=sPp->data->blb; + int fngfs = sPp->data->fngfs; + while(BP) + { + Block *cg=BP->data; + if(myrank == cg->rank) + { + f_get_dtomega(cg->shape,cg->X[0],cg->X[1],cg->X[2], + cg->fgfs[g220->sgfn],cg->fgfs[g230->sgfn],cg->fgfs[g330->sgfn], + cg->fgfs[omega->sgfn],cg->fgfs[dtomega->sgfn],Rmin); + } + if(BP==sPp->data->ble) break; + BP=BP->next; + } + sPp=sPp->next; + } +// Synch + { + MyList * DG_List; + DG_List=new MyList(dtomega); + Synch(DG_List,Symmetry,g00wt,1); + DG_List->clearList(); + } +#else + // for linear wave + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_omega_and_dtomega_LN(PhysTime, cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega->sgfn], cg->fgfs[dtomega->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + // Synch + { + MyList *DG_List; + DG_List = new MyList(omega); + Synch(DG_List, Symmetry, g00wt, 1); + DG_List->clearList(); + DG_List = new MyList(dtomega); + Synch(DG_List, Symmetry, g00wt, 1); + DG_List->clearList(); + } +#endif + // calculate News + sPp = PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_get_null_news2(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[omega->sgfn], cg->fgfs[dtomega->sgfn], + cg->fgfs[g00->sgfn], cg->fgfs[g01->sgfn], + cg->fgfs[g02->sgfn], cg->fgfs[g03->sgfn], + cg->fgfs[g220->sgfn], cg->fgfs[g230->sgfn], cg->fgfs[g330->sgfn], + cg->fgfs[Theta22->sgfn], cg->fgfs[Theta23->sgfn], cg->fgfs[Theta33->sgfn], + cg->fgfs[RNews->sgfn], cg->fgfs[INews->sgfn], Rmin, sPp->data->sst); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +} diff --git a/AMSS_NCKU_source/Parallel.C b/AMSS_NCKU_source/Parallel.C new file mode 100644 index 0000000..713a6a7 --- /dev/null +++ b/AMSS_NCKU_source/Parallel.C @@ -0,0 +1,5791 @@ + +#include "Parallel.h" +#include "fmisc.h" +#include "prolongrestrict.h" +#include "misc.h" +#include "parameters.h" + +int Parallel::partition1(int &nx, int split_size, int min_width, int cpusize, int shape) // special for 1 diemnsion +{ + nx = Mymax(1, shape / min_width); + nx = Mymin(cpusize, nx); + + return nx; +} +int Parallel::partition2(int *nxy, int split_size, int *min_width, int cpusize, int *shape) // special for 2 diemnsions +{ +#define SEARCH_SIZE 5 + int i, j, nx, ny; + int maxnx, maxny; + int mnx, mny; + int dn, hmin_width, cmin_width; + int cnx, cny; + double fx, fy; + int block_size; + int n; + + block_size = shape[0] * shape[1]; + n = Mymax(1, (block_size + split_size / 2) / split_size); + + maxnx = Mymax(1, shape[0] / min_width[0]); + maxnx = Mymin(cpusize, maxnx); + maxny = Mymax(1, shape[1] / min_width[1]); + maxny = Mymin(cpusize, maxny); + fx = (double)shape[0] / (shape[0] + shape[1]); + fy = (double)shape[1] / (shape[0] + shape[1]); + nx = mnx = Mymax(1, Mymin(maxnx, (int)(sqrt(double(n)) * fx / fy))); + ny = mny = Mymax(1, Mymin(maxny, (int)(sqrt(double(n)) * fy / fx))); + dn = abs(n - nx * ny); + hmin_width = Mymin(shape[0] / nx, shape[1] / ny); + for (cny = Mymax(1, mny - SEARCH_SIZE); cny <= (Mymin(mny + SEARCH_SIZE, maxny)); cny++) + for (cnx = Mymax(1, mnx - SEARCH_SIZE); cnx <= (Mymin(mnx + SEARCH_SIZE, maxnx)); cnx++) + { + cmin_width = Mymin(shape[0] / cnx, shape[1] / cny); + if (dn > abs(n - cnx * cny) || (dn == abs(n - cnx * cny) && cmin_width > hmin_width)) + { + dn = abs(n - cnx * cny); + nx = cnx; + ny = cny; + hmin_width = cmin_width; + } + } + + nxy[0] = nx; + nxy[1] = ny; + + return nx * ny; +#undef SEARCH_SIZE +} +int Parallel::partition3(int *nxyz, int split_size, int *min_width, int cpusize, int *shape) // special for 3 diemnsions +#if 1 // algrithsm from Pretorius +{ +// cout< abs(n - cnx * cny * cnz) || (dn == abs(n - cnx * cny * cnz) && cmin_width > hmin_width)) + { + dn = abs(n - cnx * cny * cnz); + nx = cnx; + ny = cny; + nz = cnz; + hmin_width = cmin_width; + } + } + + nxyz[0] = nx; + nxyz[1] = ny; + nxyz[2] = nz; + + return nx * ny * nz; +#undef SEARCH_SIZE +} +#elif 1 // Zhihui's idea one on 2013-09-25 +{ + int nx, ny, nz; + int hmin_width; + hmin_width = Mymin(min_width[0], min_width[1]); + hmin_width = Mymin(hmin_width, min_width[2]); + nx = shape[0] / hmin_width; + if (nx * hmin_width < shape[0]) + nx++; + ny = shape[1] / hmin_width; + if (ny * hmin_width < shape[1]) + ny++; + nz = shape[2] / hmin_width; + if (nz * hmin_width < shape[2]) + nz++; + while (nx * ny * nz > cpusize) + { + hmin_width++; + nx = shape[0] / hmin_width; + if (nx * hmin_width < shape[0]) + nx++; + ny = shape[1] / hmin_width; + if (ny * hmin_width < shape[1]) + ny++; + nz = shape[2] / hmin_width; + if (nz * hmin_width < shape[2]) + nz++; + } + + nxyz[0] = nx; + nxyz[1] = ny; + nxyz[2] = nz; + + return nx * ny * nz; +} +#elif 1 // Zhihui's idea two on 2013-09-25 +{ + int nx, ny, nz; + const int hmin_width = 8; // for example we use 8 + nx = shape[0] / hmin_width; + if (nx * hmin_width < shape[0]) + nx++; + ny = shape[1] / hmin_width; + if (ny * hmin_width < shape[1]) + ny++; + nz = shape[2] / hmin_width; + if (nz * hmin_width < shape[2]) + nz++; + + nxyz[0] = nx; + nxyz[1] = ny; + nxyz[2] = nz; + + return nx * ny * nz; +} +#endif +// distribute the data to cprocessors +#if (PSTR == 0) +MyList *Parallel::distribute(MyList *PatchLIST, int cpusize, int ingfsi, int fngfsi, + bool periodic, int nodes) +{ +#ifdef USE_GPU_DIVIDE + double cpu_part, gpu_part; + map::iterator iter; + iter = parameters::dou_par.find("cpu part"); + if (iter != parameters::dou_par.end()) + { + cpu_part = iter->second; + } + else + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "cpu part") + cpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("cpu part", cpu_part)); + } + iter = parameters::dou_par.find("gpu part"); + if (iter != parameters::dou_par.end()) + { + gpu_part = iter->second; + } + else + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "gpu part") + gpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("gpu part", gpu_part)); + } + + if (nodes == 0) + nodes = cpusize / 2; +#else + if (nodes == 0) + nodes = cpusize; +#endif + + if (dim != 3) + { + cout << "distrivute: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + MyList *BlL = 0; + + int split_size, min_size, block_size = 0; + + int min_width = 2 * Mymax(ghost_width, buffer_width); + int nxyz[dim], mmin_width[dim], min_shape[dim]; + + MyList *PLi = PatchLIST; + for (int i = 0; i < dim; i++) + min_shape[i] = PLi->data->shape[i]; + int lev = PLi->data->lev; + PLi = PLi->next; + while (PLi) + { + Patch *PP = PLi->data; + for (int i = 0; i < dim; i++) + min_shape[i] = Mymin(min_shape[i], PP->shape[i]); + if (lev != PLi->data->lev) + cout << "Parallel::distribute CAUSTION: meet Patches for different level: " << lev << " and " << PLi->data->lev << endl; + PLi = PLi->next; + } + + for (int i = 0; i < dim; i++) + mmin_width[i] = Mymin(min_width, min_shape[i]); + + min_size = mmin_width[0]; + for (int i = 1; i < dim; i++) + min_size = min_size * mmin_width[i]; + + PLi = PatchLIST; + while (PLi) + { + Patch *PP = PLi->data; + // PP->checkPatch(true); + int bs = PP->shape[0]; + for (int i = 1; i < dim; i++) + bs = bs * PP->shape[i]; + block_size = block_size + bs; + PLi = PLi->next; + } + split_size = Mymax(min_size, block_size / nodes); + split_size = Mymax(1, split_size); + + int n_rank = 0; + PLi = PatchLIST; + int reacpu = 0; + while (PLi) + { + Patch *PP = PLi->data; + + reacpu += partition3(nxyz, split_size, mmin_width, nodes, PP->shape); + + Block *ng0, *ng; + int shape_here[dim], ibbox_here[2 * dim]; + double bbox_here[2 * dim], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxyz[0]; i++) + for (int j = 0; j < nxyz[1]; j++) + for (int k = 0; k < nxyz[2]; k++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxyz[0]; + ibbox_here[3] = (PP->shape[0] * (i + 1)) / nxyz[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxyz[1]; + ibbox_here[4] = (PP->shape[1] * (j + 1)) / nxyz[1] - 1; + ibbox_here[2] = (PP->shape[2] * k) / nxyz[2]; + ibbox_here[5] = (PP->shape[2] * (k + 1)) / nxyz[2] - 1; + + if (periodic) + { + ibbox_here[0] = ibbox_here[0] - ghost_width; + ibbox_here[3] = ibbox_here[3] + ghost_width; + ibbox_here[1] = ibbox_here[1] - ghost_width; + ibbox_here[4] = ibbox_here[4] + ghost_width; + ibbox_here[2] = ibbox_here[2] - ghost_width; + ibbox_here[5] = ibbox_here[5] + ghost_width; + } + else + { + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[0] - 1, ibbox_here[3] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[4] = Mymin(PP->shape[1] - 1, ibbox_here[4] + ghost_width); + ibbox_here[2] = Mymax(0, ibbox_here[2] - ghost_width); + ibbox_here[5] = Mymin(PP->shape[2] - 1, ibbox_here[5] + ghost_width); + } + + shape_here[0] = ibbox_here[3] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[4] - ibbox_here[1] + 1; + shape_here[2] = ibbox_here[5] - ibbox_here[2] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // 0--4, 5--10 + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[3] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[4] * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / (PP->shape[2] - 1); + bbox_here[2] = PP->bbox[2] + ibbox_here[2] * dd; + bbox_here[5] = PP->bbox[2] + ibbox_here[5] * dd; +#else +#ifdef Cell + // 0--5, 5--10 + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[3] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[4] + 1) * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / PP->shape[2]; + bbox_here[2] = PP->bbox[2] + (ibbox_here[2]) * dd; + bbox_here[5] = PP->bbox[2] + (ibbox_here[5] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + +#ifdef USE_GPU_DIVIDE + { + const int pices = 2; + double picef[pices]; + picef[0] = cpu_part; + picef[1] = gpu_part; + int shape_res[dim * pices]; + double bbox_res[2 * dim * pices]; + misc::dividBlock(dim, shape_here, bbox_here, pices, picef, shape_res, bbox_res, min_width); + ng = ng0 = new Block(dim, shape_res, bbox_res, n_rank++, ingfsi, fngfsi, PP->lev, 0); // delete through KillBlocks + + // if(n_rank==cpusize) {n_rank=0; cerr<<"place one!!"<checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + for (int i = 1; i < pices; i++) + { + ng = new Block(dim, shape_res + i * dim, bbox_res + i * 2 * dim, n_rank++, ingfsi, fngfsi, PP->lev, i); // delete through KillBlocks + // if(n_rank==cpusize) {n_rank=0; cerr<<"place two!! "<checkBlock(); + BlL->insert(ng); + } + } +#else + ng = ng0 = new Block(dim, shape_here, bbox_here, n_rank++, ingfsi, fngfsi, PP->lev); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks +#endif + if (n_rank == cpusize) + n_rank = 0; + + // set PP->blb + if (i == 0 && j == 0 && k == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng0) + Bp = Bp->next; // ng0 is the first of the pices list + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; // ng is the last of the pices list + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < nodes * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "Parallel::distribute CAUSTION: level#" << lev << " uses essencially " << reacpu << " processors vs " << nodes << " nodes run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) +MyList *Parallel::distribute(MyList *PatchLIST, int cpusize, int ingfsi, int fngfsi, + bool periodic, int start_rank, int end_rank, int nodes) +{ +#ifdef USE_GPU_DIVIDE + double cpu_part, gpu_part; + map::iterator iter; + iter = parameters::dou_par.find("cpu part"); + if (iter != parameters::dou_par.end()) + { + cpu_part = iter->second; + } + else + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "cpu part") + cpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("cpu part", cpu_part)); + } + iter = parameters::dou_par.find("gpu part"); + if (iter != parameters::dou_par.end()) + { + gpu_part = iter->second; + } + else + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "gpu part") + gpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("gpu part", gpu_part)); + } + + if (nodes == 0) + nodes = cpusize / 2; +#else + if (nodes == 0) + nodes = cpusize; +#endif + + if (dim != 3) + { + cout << "distrivute: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + MyList *BlL = 0; + + int split_size, min_size, block_size = 0; + + int min_width = 2 * Mymax(ghost_width, buffer_width); + int nxyz[dim], mmin_width[dim], min_shape[dim]; + + MyList *PLi = PatchLIST; + for (int i = 0; i < dim; i++) + min_shape[i] = PLi->data->shape[i]; + int lev = PLi->data->lev; + PLi = PLi->next; + while (PLi) + { + Patch *PP = PLi->data; + for (int i = 0; i < dim; i++) + min_shape[i] = Mymin(min_shape[i], PP->shape[i]); + if (lev != PLi->data->lev) + cout << "Parallel::distribute CAUSTION: meet Patches for different level: " << lev << " and " << PLi->data->lev << endl; + PLi = PLi->next; + } + + for (int i = 0; i < dim; i++) + mmin_width[i] = Mymin(min_width, min_shape[i]); + + min_size = mmin_width[0]; + for (int i = 1; i < dim; i++) + min_size = min_size * mmin_width[i]; + + PLi = PatchLIST; + while (PLi) + { + Patch *PP = PLi->data; + // PP->checkPatch(true); + int bs = PP->shape[0]; + for (int i = 1; i < dim; i++) + bs = bs * PP->shape[i]; + block_size = block_size + bs; + PLi = PLi->next; + } + split_size = Mymax(min_size, block_size / cpusize); + split_size = Mymax(1, split_size); + + int n_rank = start_rank; + PLi = PatchLIST; + int reacpu = 0; + while (PLi) + { + Patch *PP = PLi->data; + + reacpu += partition3(nxyz, split_size, mmin_width, cpusize, PP->shape); + + Block *ng, *ng0; + int shape_here[dim], ibbox_here[2 * dim]; + double bbox_here[2 * dim], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxyz[0]; i++) + for (int j = 0; j < nxyz[1]; j++) + for (int k = 0; k < nxyz[2]; k++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxyz[0]; + ibbox_here[3] = (PP->shape[0] * (i + 1)) / nxyz[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxyz[1]; + ibbox_here[4] = (PP->shape[1] * (j + 1)) / nxyz[1] - 1; + ibbox_here[2] = (PP->shape[2] * k) / nxyz[2]; + ibbox_here[5] = (PP->shape[2] * (k + 1)) / nxyz[2] - 1; + + if (periodic) + { + ibbox_here[0] = ibbox_here[0] - ghost_width; + ibbox_here[3] = ibbox_here[3] + ghost_width; + ibbox_here[1] = ibbox_here[1] - ghost_width; + ibbox_here[4] = ibbox_here[4] + ghost_width; + ibbox_here[2] = ibbox_here[2] - ghost_width; + ibbox_here[5] = ibbox_here[5] + ghost_width; + } + else + { + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[0] - 1, ibbox_here[3] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[4] = Mymin(PP->shape[1] - 1, ibbox_here[4] + ghost_width); + ibbox_here[2] = Mymax(0, ibbox_here[2] - ghost_width); + ibbox_here[5] = Mymin(PP->shape[2] - 1, ibbox_here[5] + ghost_width); + } + + shape_here[0] = ibbox_here[3] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[4] - ibbox_here[1] + 1; + shape_here[2] = ibbox_here[5] - ibbox_here[2] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // 0--4, 5--10 + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[3] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[4] * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / (PP->shape[2] - 1); + bbox_here[2] = PP->bbox[2] + ibbox_here[2] * dd; + bbox_here[5] = PP->bbox[2] + ibbox_here[5] * dd; +#else +#ifdef Cell + // 0--5, 5--10 + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[3] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[4] + 1) * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / PP->shape[2]; + bbox_here[2] = PP->bbox[2] + (ibbox_here[2]) * dd; + bbox_here[5] = PP->bbox[2] + (ibbox_here[5] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + +#ifdef USE_GPU_DIVIDE + { + const int pices = 2; + double picef[pices]; + picef[0] = cpu_part; + picef[1] = gpu_part; + int shape_res[dim * pices]; + double bbox_res[2 * dim * pices]; + misc::dividBlock(dim, shape_here, bbox_here, pices, picef, shape_res, bbox_res, min_width); + ng = ng0 = new Block(dim, shape_res, bbox_res, n_rank++, ingfsi, fngfsi, PP->lev, 0); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + for (int i = 1; i < pices; i++) + { + ng = new Block(dim, shape_res + i * dim, bbox_res + i * 2 * dim, n_rank++, ingfsi, fngfsi, PP->lev, i); // delete through KillBlocks + // ng->checkBlock(); + BlL->insert(ng); + } + } +#else + ng = ng0 = new Block(dim, shape_here, bbox_here, n_rank++, ingfsi, fngfsi, PP->lev); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks +#endif + + if (n_rank == end_rank + 1) + n_rank = start_rank; + + // set PP->blb + if (i == 0 && j == 0 && k == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng0) + Bp = Bp->next; // ng0 is the first of the pices list + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; // ng is the last of the pices list + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < nodes * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == start_rank) + cout << "Parallel::distribute CAUSTION: level#" << lev << " uses essencially " << reacpu << " processors vs " << nodes << " nodes run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +#endif +void Parallel::setfunction(MyList *BlL, var *vn, double func(double x, double y, double z)) +{ + while (BlL) + { + if (BlL->data->X[0]) + { + int nn = BlL->data->shape[0] * BlL->data->shape[1] * BlL->data->shape[2]; + double *p = BlL->data->fgfs[vn->sgfn]; + for (int i = 0; i < nn; i++) + { + int ind[3]; + getarrayindex(3, BlL->data->shape, ind, i); + p[i] = func(BlL->data->X[0][ind[0]], BlL->data->X[1][ind[1]], BlL->data->X[2][ind[2]]); + } + } + BlL = BlL->next; + } +} +// set function only for cpu rank +void Parallel::setfunction(int rank, MyList *BlL, var *vn, double func(double x, double y, double z)) +{ + while (BlL) + { + if (BlL->data->X[0] && BlL->data->rank == rank) + { + int nn = BlL->data->shape[0] * BlL->data->shape[1] * BlL->data->shape[2]; + double *p = BlL->data->fgfs[vn->sgfn]; + for (int i = 0; i < nn; i++) + { + int ind[3]; + getarrayindex(3, BlL->data->shape, ind, i); + p[i] = func(BlL->data->X[0][ind[0]], BlL->data->X[1][ind[1]], BlL->data->X[2][ind[2]]); + } + } + BlL = BlL->next; + } +} +void Parallel::getarrayindex(int DIM, int *shape, int *index, int n) +{ + // we assume index has already memory space + int *mu; + mu = new int[DIM]; + mu[0] = 1; + for (int i = 1; i < DIM; i++) + mu[i] = mu[i - 1] * shape[i - 1]; + for (int i = DIM - 1; i >= 0; i--) + { + index[i] = n / mu[i]; + n = n - index[i] * mu[i]; + } + + delete[] mu; +} +int Parallel::getarraylocation(int DIM, int *shape, int *index) +{ + int n, mu; + mu = shape[0]; + n = index[0]; + for (int i = 1; i < DIM; i++) + { + n = n + index[i] * mu; + mu = mu * shape[i]; + } + + return n; +} +void Parallel::copy(int DIM, double *llbout, double *uubout, int *Dshape, double *DD, double *llbin, double *uubin, + int *shape, double *datain, double *llb, double *uub) +{ + // for 3 dimensional case, based on simple test, I found this is half slower than f90 code + int *illi, *iuui; + int *illo, *iuuo; + int *indi, *indo; + illi = new int[DIM]; + iuui = new int[DIM]; + illo = new int[DIM]; + iuuo = new int[DIM]; + indi = new int[DIM]; + indo = new int[DIM]; + + int ial = 1; + for (int i = 0; i < DIM; i++) + { + double ho, hi; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + ho = (uubout[i] - llbout[i]) / (Dshape[i] - 1); + hi = (uubin[i] - llbin[i]) / (shape[i] - 1); +#else +#ifdef Cell + ho = (uubout[i] - llbout[i]) / Dshape[i]; + hi = (uubin[i] - llbin[i]) / shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + illo[i] = int((llb[i] - llbout[i]) / ho); + iuuo[i] = Dshape[i] - 1 - int((uubout[i] - uub[i]) / ho); + illi[i] = int((llb[i] - llbin[i]) / hi); + iuui[i] = shape[i] - 1 - int((uubin[i] - uub[i]) / hi); + + if (illo[i] > iuuo[i] || illi[i] > iuui[i] || illo[i] < 0 || illi[i] < 0 || + iuui[i] >= shape[i] || iuuo[i] >= Dshape[i]) + { + cout << "Parallel copy: in direction " << i << ":" << endl; + cout << "llb = " << llb[i] << ", uub = " << uub[i] << endl; + cout << " in data : il = " << illi[i] << ", iu = " << iuui[i] << endl; + cout << "bbox = (" << llbin[i] << "," << uubin[i] << ")" << endl; + cout << "shape = " << shape[i] << endl; + cout << "out data : il = " << illo[i] << ", iu = " << iuuo[i] << endl; + cout << "bbox = (" << llbout[i] << "," << uubout[i] << ")" << endl; + cout << "shape = " << Dshape[i] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int ihi = iuui[i] - illi[i] + 1, iho = iuuo[i] - illo[i] + 1; + if (!(feq(ho, hi, ho / 2)) || ihi != iho) + { + cout << "Parallel copy: in direction " << i << ":" << endl; + cout << "Parallel copy: not the same grid structure." << endl; + cout << "hi = " << hi << ", bbox = (" << llbin[i] << "," << uubin[i] << "), shape = " << shape[i] << endl; + cout << "ho = " << ho << ", bbox = (" << llbout[i] << "," << uubout[i] << "), shape = " << Dshape[i] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + ial = ial * ihi; + } + + for (int i = 0; i < DIM; i++) + { + indi[i] = illi[i]; + indo[i] = illo[i]; + } + /* + //check start index + for(int i=0;i NNi) + { + cout << "Parallel copy: ni = " << ni << " is out of array range (0," << NNi << ")." << endl; + cout << "shape = ("; + for (int j = 0; j < DIM; j++) + { + cout << shape[j]; + if (j < DIM - 1) + cout << ","; + else + cout << ")" << endl; + } + cout << "ind = ("; + for (int j = 0; j < DIM; j++) + { + cout << indi[j]; + if (j < DIM - 1) + cout << ","; + else + cout << ")" << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + DD[no] = datain[ni]; + + indi[0]++; + for (int j = 1; j < DIM; j++) + { + if (indi[j - 1] == iuui[j - 1] + 1) + { + indi[j - 1] = illi[j - 1]; + indi[j]++; + } // carry 1 to next digital + else + break; + } + indo[0]++; + for (int j = 1; j < DIM; j++) + { + if (indo[j - 1] == iuuo[j - 1] + 1) + { + indo[j - 1] = illo[j - 1]; + indo[j]++; + } + else + break; + } + } + /* + //check final index + for(int i=0;i *BlL, MyList *DumpList, char *tag, double time, double dT) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MyList *Bp; + while (DumpList) + { + Bp = BlL; + int Bi = 0; + while (Bp) + { + Block *BP = Bp->data; + var *VP = DumpList->data; + if (BP->rank == myrank) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + if (tag) + sprintf(filename, "%s/%s_Lev%02d-%02d_%02d_%s_%05d.bin", out_dir.c_str(), tag, BP->lev, Bi, myrank, VP->name, ncount); + else + sprintf(filename, "%s/Lev%02d-%02d_%02d_%s_%05d.bin", out_dir.c_str(), BP->lev, Bi, myrank, VP->name, ncount); + writefile(time, BP->shape[0], BP->shape[1], BP->shape[2], BP->bbox[0], BP->bbox[3], BP->bbox[1], BP->bbox[4], + BP->bbox[2], BP->bbox[5], filename, BP->fgfs[VP->sgfn]); + cout << "end of dump " << VP->name << " at time " << time << ", on node " << myrank << endl; + } + Bp = Bp->next; + Bi++; + } + DumpList = DumpList->next; + } +} +// Now we dump the data including buffer points +void Parallel::Dump_Data(Patch *PP, MyList *DumpList, char *tag, double time, double dT, int grd) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->shape[0] * PP->shape[1] * PP->shape[2]); + if (!databuffer) + { + cout << "Parallel::Dump_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + while (DumpList) + { + var *VP = DumpList->data; + + MyList *Bp = PP->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + if (tag) + sprintf(filename, "%s/%s_Lev%02d-%02d_%s_%05d.bin", out_dir.c_str(), tag, PP->lev, grd, VP->name, ncount); + else + sprintf(filename, "%s/Lev%02d-%02d_%s_%05d.bin", out_dir.c_str(), PP->lev, grd, VP->name, ncount); + + writefile(time, PP->shape[0], PP->shape[1], PP->shape[2], PP->bbox[0], PP->bbox[3], PP->bbox[1], PP->bbox[4], + PP->bbox[2], PP->bbox[5], filename, databuffer); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + free(databuffer); +} +void Parallel::Dump_Data(MyList *PL, MyList *DumpList, char *tag, double time, double dT) +{ + MyList *Pp; + Pp = PL; + int grd = 0; + while (Pp) + { + Patch *PP = Pp->data; + Dump_Data(PP, DumpList, tag, time, dT, grd); + grd++; + Pp = Pp->next; + } +} +// collect the data including buffer points +double *Parallel::Collect_Data(Patch *PP, var *VP) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->shape[0] * PP->shape[1] * PP->shape[2]); + if (!databuffer) + { + cout << "Parallel::Collect_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *Bp = PP->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->ble) + break; + Bp = Bp->next; + } + + return databuffer; +} +// Now we dump the data including buffer points +// dump z = 0 plane +void Parallel::d2Dump_Data(Patch *PP, MyList *DumpList, char *tag, double time, double dT, int grd) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0, *databuffer2 = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->shape[0] * PP->shape[1] * PP->shape[2]); + databuffer2 = (double *)malloc(sizeof(double) * PP->shape[0] * PP->shape[1]); + if (!databuffer || !databuffer2) + { + cout << "Parallel::d2Dump_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + while (DumpList) + { + var *VP = DumpList->data; + + MyList *Bp = PP->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + if (tag) + sprintf(filename, "%s/%s_2d_Lev%02d-%02d_%s_%05d.dat", out_dir.c_str(), tag, PP->lev, grd, VP->name, ncount); + else + sprintf(filename, "%s/2d_Lev%02d-%02d_%s_%05d.dat", out_dir.c_str(), PP->lev, grd, VP->name, ncount); + + int gord = ghost_width; + f_d2dump(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, databuffer2, gord, VP->SoA); + writefile(time, PP->shape[0], PP->shape[1], PP->bbox[0], PP->bbox[3], PP->bbox[1], PP->bbox[4], + filename, databuffer2); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + { + free(databuffer); + free(databuffer2); + } +} +void Parallel::d2Dump_Data(MyList *PL, MyList *DumpList, char *tag, double time, double dT) +{ + MyList *Pp; + Pp = PL; + int grd = 0; + while (Pp) + { + Patch *PP = Pp->data; + d2Dump_Data(PP, DumpList, tag, time, dT, grd); + grd++; + Pp = Pp->next; + } +} +// Now we dump the data including buffer points and ghost points of the given patch +void Parallel::Dump_Data0(Patch *PP, MyList *DumpList, char *tag, double time, double dT) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3], tllb[3], tuub[3]; + int tshape[3]; + double DX, DY, DZ; + + for (int i = 0; i < 3; i++) + { + double DX = PP->blb->data->getdX(i); + tshape[i] = PP->shape[i] + 2 * ghost_width; + tllb[i] = PP->bbox[i] - ghost_width * DX; + tuub[i] = PP->bbox[i + dim] + ghost_width * DX; + } + + int NN = tshape[0] * tshape[1] * tshape[2]; + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * NN); + if (!databuffer) + { + cout << "on node# " << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + while (DumpList) + { + var *VP = DumpList->data; + MyList *Bp = PP->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], tllb[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], tllb[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], tllb[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], tuub[0], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], tuub[1], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], tuub[2], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, tllb, tuub, tshape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + if (myrank == 0) + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], tllb[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], tllb[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], tllb[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], tuub[0], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], tuub[1], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], tuub[2], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, tllb, tuub, tshape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + if (tag) + sprintf(filename, "%s/%s_Lev%02d_%s_%05d.bin", out_dir.c_str(), tag, PP->lev, VP->name, ncount); + else + sprintf(filename, "%s/Lev%02d_%s_%05d.bin", out_dir.c_str(), PP->lev, VP->name, ncount); + + writefile(time, tshape[0], tshape[1], tshape[2], tllb[0], tuub[0], tllb[1], tuub[2], + tllb[2], tuub[2], filename, databuffer); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + free(databuffer); +} +// Map point is much easier than maping data itself +// But the main problem is about the points near the boundary +// worst case is -ghost -ghost+1 .... 0 * ...... +double Parallel::global_interp(int DIM, int *ext, double **CoX, double *datain, + double *poXb, int ordn, double *SoA, int Symmetry) +{ + if (DIM != 3) + { + cout << "Parallel::global_interp does not suport DIM = " << DIM << " for Symmetry." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double resu; + double poX[3]; + double asgn = 1; + + for (int i = 0; i < 3; i++) + poX[i] = poXb[i]; + + switch (Symmetry) + { + case 2: + for (int i = 0; i < 3; i++) + if (poX[i] < 0) + { + poX[i] = -poX[i]; + asgn = asgn * SoA[i]; + } + break; + case 1: + if (poX[2] < 0) + { + poX[2] = -poX[2]; + asgn = asgn * SoA[2]; + } + } + + int extb[3]; + + for (int i = 0; i < 3; i++) + extb[i] = ext[i]; + + switch (Symmetry) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + case 2: + if (poX[0] < (ghost_width - 1) * (CoX[0][1] - CoX[0][0])) + extb[0] = extb[0] + ghost_width - 1; + if (poX[1] < (ghost_width - 1) * (CoX[1][1] - CoX[1][0])) + extb[1] = extb[1] + ghost_width - 1; + case 1: + if (poX[2] < (ghost_width - 1) * (CoX[2][1] - CoX[2][0])) + extb[2] = extb[2] + ghost_width - 1; +#else +#ifdef Cell + case 2: + if (poX[0] < (ghost_width - 0.5) * (CoX[0][1] - CoX[0][0])) + extb[0] = extb[0] + ghost_width; + if (poX[1] < (ghost_width - 0.5) * (CoX[1][1] - CoX[1][0])) + extb[1] = extb[1] + ghost_width; + case 1: + if (poX[2] < (ghost_width - 0.5) * (CoX[2][1] - CoX[2][0])) + extb[2] = extb[2] + ghost_width; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + if (extb[0] > ext[0] || extb[1] > ext[1] || extb[2] > ext[2]) + { + double *CoXb[3]; + int Nb = extb[0] * extb[1] * extb[2]; + double *datab; + datab = new double[Nb]; + for (int i = 0; i < 3; i++) + { + CoXb[i] = new double[extb[i]]; + double DH = CoX[i][1] - CoX[i][0]; + if (extb[i] > ext[i]) + { + if (CoX[i][0] > DH) + { + cout << "lower boundary[" << i << "] = " << CoX[i][0] << ", but SYmmetry = " << Symmetry << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int j = 0; j < ghost_width - 1; j++) + CoXb[i][j] = -CoX[i][ghost_width - 1 - j]; + for (int j = ghost_width - 1; j < extb[i]; j++) + CoXb[i][j] = CoX[i][j - ghost_width + 1]; +#else +#ifdef Cell + for (int j = 0; j < ghost_width; j++) + CoXb[i][j] = -CoX[i][ghost_width - 1 - j]; + for (int j = ghost_width; j < extb[i]; j++) + CoXb[i][j] = CoX[i][j - ghost_width]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + { + for (int j = 0; j < extb[i]; j++) + CoXb[i][j] = CoX[i][j]; + } + } + + for (int i = 0; i < Nb; i++) + { + int ind[3], indb[3]; + getarrayindex(3, extb, indb, i); + double sgn = 1; + for (int j = 0; j < 3; j++) + { + if (extb[j] > ext[j]) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (indb[j] < ghost_width - 1) + { + ind[j] = ghost_width - 1 - indb[j]; + sgn = sgn * SoA[j]; + } + else + { + ind[j] = 1 + indb[j] - ghost_width; + } +#else +#ifdef Cell + if (indb[j] < ghost_width) + { + ind[j] = ghost_width - 1 - indb[j]; + sgn = sgn * SoA[j]; + } + else + { + ind[j] = indb[j] - ghost_width; + } +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + ind[j] = indb[j]; + } + int lon = getarraylocation(3, ext, ind); + datab[i] = datain[lon] * sgn; + } + + resu = global_interp(DIM, extb, CoXb, datab, poX, ordn); + + for (int i = 0; i < 3; i++) + delete[] CoXb[i]; + delete[] datab; + } + else + { + resu = global_interp(DIM, ext, CoX, datain, poX, ordn); + } + + return resu * asgn; +} +double Parallel::global_interp(int DIM, int *ext, double **CoX, double *datain, + double *poX, int ordn) +{ + if (ordn > 2 * ghost_width) + { + cout << "Parallel::global_interp can not handle ordn = " << ordn << " > 2*ghost_width = " << 2 * ghost_width << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + double *bbox, *datainbbox; + bbox = new double[2 * DIM]; + datainbbox = new double[2 * DIM]; + + int *NN, *ind, *shape; + NN = new int[DIM]; + ind = new int[DIM]; + shape = new int[DIM]; + + for (int i = 0; i < DIM; i++) + { + ind[i] = int((poX[i] - CoX[i][0]) / (CoX[i][1] - CoX[i][0])) - ordn / 2 + 1; + // poX may exactly locate on the boundary (exclude ghost) + if (ind[i] == -1 && feq(poX[i], CoX[i][0], (CoX[i][1] - CoX[i][0]) / 2)) + ind[i] = 0; + /* + if(ind[i] < 0) + { + cout<<"Parallel::global_interp error ind["< ext = "<= 0; i--) + NN[i] = NN[i + 1] * ordn; + + double *xpts, *funcvals; + xpts = new double[ordn]; + funcvals = new double[ordn]; + double *DDd, *DDd1, rr; + + DDd = new double[NN[0]]; + + copy(DIM, bbox, bbox + DIM, shape, DDd, datainbbox, datainbbox + DIM, ext, datain, bbox, bbox + DIM); + + for (int i = 0; i < DIM; i++) + { + for (int j = ind[i]; j < ind[i] + ordn; j++) + { + xpts[j - ind[i]] = CoX[i][j]; + } + + if (i < DIM - 1) + { + DDd1 = new double[NN[i + 1]]; + for (int j = 0; j < NN[i + 1]; j++) + { + for (int k = 0; k < ordn; k++) + funcvals[k] = DDd[k + j * ordn]; + DDd1[j] = Lagrangian_Int(poX[i], ordn, xpts, funcvals); + } + delete[] DDd; + DDd = DDd1; + } + else + { + for (int j = 0; j < ordn; j++) + funcvals[j] = DDd[j]; + rr = Lagrangian_Int(poX[i], ordn, xpts, funcvals); + delete[] DDd1; // since DDd and DDd1 now point to the same stuff, we need delete after above int + } + } + + delete[] NN; + delete[] ind; + delete[] xpts; + delete[] funcvals; + delete[] bbox; + delete[] datainbbox; + delete[] shape; + + return rr; +} +double Parallel::Lagrangian_Int(double x, int npts, double *xpts, double *funcvals) +{ + double sum = 0; + for (int i = 0; i < npts; i++) + { + sum = sum + funcvals[i] * LagrangePoly(x, i, npts, xpts); + } + return sum; +} +double Parallel::LagrangePoly(double x, int pt, int npts, double *xpts) +{ + double h = 1; + int i; + + for (i = 0; i < pt; i++) + h = h * (x - xpts[i]) / (xpts[pt] - xpts[i]); + + for (i = pt + 1; i < npts; i++) + h = h * (x - xpts[i]) / (xpts[pt] - xpts[i]); + + return h; +} +// collect all grid segments or blocks including ghost and buffer for given patch +MyList *Parallel::build_complete_gsl(Patch *Pat) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + if (!cgsl) + { + cgsl = gs = new MyList; // delete through destroyList(); + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + gs->data->llb[i] = BP->data->bbox[i]; + gs->data->uub[i] = BP->data->bbox[dim + i]; + gs->data->shape[i] = BP->data->shape[i]; + } + gs->data->Bg = BP->data; + gs->next = 0; + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks including ghost and buffer for given patch list +MyList *Parallel::build_complete_gsl(MyList *PatL) +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + if (!cgsl) + { + cgsl = build_complete_gsl(PatL->data); + gs = cgsl; + while (gs->next) + gs = gs->next; + } + else + { + gs->next = build_complete_gsl(PatL->data); + gs = gs->next; + while (gs->next) + gs = gs->next; + } + PatL = PatL->next; + } + + return cgsl; +} +// cellect the information of Patch list +MyList *Parallel::build_complete_gsl_virtual(MyList *PatL) +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + if (cgsl) + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + else + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + gs->data->llb[i] = PatL->data->bbox[i]; + gs->data->uub[i] = PatL->data->bbox[dim + i]; + gs->data->shape[i] = PatL->data->shape[i]; + } + gs->data->Bg = 0; + gs->next = 0; + + PatL = PatL->next; + } + + return cgsl; +} +// cellect the information of Patch list without buffer points +MyList *Parallel::build_complete_gsl_virtual2(MyList *PatL) // - buffer +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + if (cgsl) + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + else + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = PatL->data->getdX(i); + gs->data->llb[i] = PatL->data->bbox[i] + PatL->data->lli[i] * DH; + gs->data->uub[i] = PatL->data->bbox[dim + i] - PatL->data->uui[i] * DH; + gs->data->shape[i] = PatL->data->shape[i] - PatL->data->lli[i] - PatL->data->uui[i]; + } + gs->data->Bg = 0; + gs->next = 0; + + PatL = PatL->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch, without extension +MyList *Parallel::build_bulk_gsl(Patch *Pat) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// bulk part for given Block within given patch, without extension +MyList *Parallel::build_bulk_gsl(Block *bp, Patch *Pat) +{ + MyList *gs = 0; + + gs = new MyList; + gs->data = new Parallel::gridseg; + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = bp; + gs->next = 0; + + return gs; +} +MyList *Parallel::clone_gsl(MyList *p, bool first_only) +{ + MyList *np = 0, *q = 0, *pq = 0; + + while (p) + { + q = new MyList; + q->data = new Parallel::gridseg; + q->data->Bg = p->data->Bg; + for (int i = 0; i < dim; i++) + { + q->data->llb[i] = p->data->llb[i]; + q->data->uub[i] = p->data->uub[i]; + q->data->shape[i] = p->data->shape[i]; + } + if (pq) + pq->next = q; + else + np = q; + if (first_only) + { + np->next = 0; + return np; + } + pq = q; + p = p->next; + } + return np; +} +MyList *Parallel::gs_subtract(MyList *A, MyList *B) +{ + if (!A) + return 0; + if (!B) + return clone_gsl(A, true); + + double cut_plane[2 * dim], DH[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = A->data->Bg->getdX(i); + if (B->data->Bg && !feq(DH[i], B->data->Bg->getdX(i), DH[i] / 2)) + { + cout << "Parallel::gs_subtract meets different grid segment " << DH[i] << " vs " << B->data->Bg->getdX(i) << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *C = 0, *q; + for (int i = 0; i < dim; i++) + { + if (B->data->llb[i] > A->data->uub[i] || B->data->uub[i] < A->data->llb[i]) + return clone_gsl(A, true); + cut_plane[i] = A->data->llb[i]; + cut_plane[i + dim] = A->data->uub[i]; + } + + for (int i = 0; i < dim; i++) + { + cut_plane[i] = Mymax(A->data->llb[i], B->data->llb[i]); + if (cut_plane[i] - A->data->llb[i] > DH[i] / 2) + { + q = clone_gsl(A, true); + // prolong the list from head + if (C) + q->next = C; + C = q; + for (int j = 0; j < dim; j++) + { + if (i == j) + { + C->data->llb[i] = A->data->llb[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->uub[i] = Mymax(C->data->llb[i], cut_plane[i] - DH[i]); +#else +#ifdef Cell + C->data->uub[i] = Mymax(C->data->llb[i], cut_plane[i]); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + { + C->data->llb[j] = cut_plane[j]; + C->data->uub[j] = cut_plane[j + dim]; + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + + cut_plane[i + dim] = Mymin(A->data->uub[i], B->data->uub[i]); + if (A->data->uub[i] - cut_plane[i + dim] > DH[i] / 2) + { + q = clone_gsl(A, true); + if (C) + q->next = C; + C = q; + for (int j = 0; j < dim; j++) + { + if (i == j) + { + C->data->uub[i] = A->data->uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->llb[i] = Mymin(C->data->uub[i], cut_plane[i + dim] + DH[i]); +#else +#ifdef Cell + C->data->llb[i] = Mymin(C->data->uub[i], cut_plane[i + dim]); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + { + C->data->llb[j] = cut_plane[j]; + C->data->uub[j] = cut_plane[j + dim]; + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + } + return C; +} +// stupid method +/* +MyList *Parallel::gsl_subtract(MyList *A,MyList *B) //A subtract B but with A's information +{ +// always make return and A, B distinct + if(!A) return 0; + + if(!B) return clone_gsl(A,0); + + MyList *C=0,*C0,*C1,*Cc,*CC0,*gs; + + while(A) + { + C0=gs_subtract(A,B); // note C0 becomes a list after subtraction + C1=B->next; + while(C1) + { + CC0=C0; + Cc=0; + while(CC0) + { + gs=gs_subtract(CC0,C1); + if(Cc) Cc->catList(gs); + else Cc=gs; + CC0=CC0->next; + } + if(C0) C0->destroyList(); + C0=Cc; + C1=C1->next; + } + if(C) C->catList(C0); + else C=C0; + A=A->next; + } + + return C; +} +*/ +// more clever method +MyList *Parallel::gsl_subtract(MyList *A, MyList *B) // A subtract B but with A's information +{ + // always make return and A, B distinct + if (!A) + return 0; + + MyList *C = 0, *C0, *C1; + + C = clone_gsl(A, 0); + + while (B) + { + C0 = 0; + C1 = C; + while (C1) + { + if (C0) + C0->catList(gs_subtract(C1, B)); + else + C0 = gs_subtract(C1, B); + C1 = C1->next; + } + if (C) + C->destroyList(); + else + { + if (C0) + C0->destroyList(); + return 0; + } + + C = C0; + B = B->next; + } + + return C; +} +MyList *Parallel::gs_and(MyList *A, MyList *B) +{ + if (!A || !B) + return 0; + + double llb[dim], uub[dim]; + bool flag = false; + for (int i = 0; i < dim; i++) + { + llb[i] = Mymax(A->data->llb[i], B->data->llb[i]); + uub[i] = Mymin(A->data->uub[i], B->data->uub[i]); + if (llb[i] > uub[i]) + { + flag = true; + break; + } + } + if (flag) + return 0; + + MyList *C; + C = clone_gsl(A, true); + for (int i = 0; i < dim; i++) + { + C->data->llb[i] = llb[i]; + C->data->uub[i] = uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / C->data->Bg->getdX(i) + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / C->data->Bg->getdX(i) + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + return C; +} +// overlap of A_i and (union of all j of B_j) +MyList *Parallel::gsl_and(MyList *A, MyList *B) // A and B but with A's information +{ + MyList *C = 0, *C1; + + while (A) + { + C1 = B; + while (C1) + { + if (C) + C->catList(gs_and(A, C1)); + else + C = gs_and(A, C1); + C1 = C1->next; + } + A = A->next; + } + return C; +} +// collect all ghost grid segments or blocks for given patch +MyList *Parallel::build_ghost_gsl(Patch *Pat) +{ + MyList *cgsl = 0, *gs, *gsb; + MyList *BP = Pat->blb; + while (BP) + { + gs = new MyList; + gs->data = new Parallel::gridseg; + + for (int i = 0; i < dim; i++) + { + gs->data->llb[i] = BP->data->bbox[i]; + gs->data->uub[i] = BP->data->bbox[dim + i]; + gs->data->shape[i] = BP->data->shape[i]; + } + gs->data->Bg = BP->data; + gs->next = 0; + + gsb = build_bulk_gsl(BP->data, Pat); + + if (!cgsl) + cgsl = gs_subtract(gs, gsb); + else + cgsl->catList(gs_subtract(gs, gsb)); + + gsb->destroyList(); + gs->destroyList(); + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all ghost grid segments or blocks for given patch list +MyList *Parallel::build_ghost_gsl(MyList *PatL) +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + if (!cgsl) + { + cgsl = build_ghost_gsl(PatL->data); + gs = cgsl; + while (gs->next) + gs = gs->next; + } + else + { + gs->next = build_ghost_gsl(PatL->data); + gs = gs->next; + while (gs->next) + gs = gs->next; + } + PatL = PatL->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch +// special for Sync usage, so we do not need consider missing points +MyList *Parallel::build_owned_gsl0(Patch *Pat, int rank_in) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch +MyList *Parallel::build_owned_gsl1(Patch *Pat, int rank_in) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // NOTE: our dividing structure is (exclude ghost) + // -1 0 + // 1 2 + // so (0,1) does not belong to any part for vertex structure, we always put it to right part, this is consistent to + // the fortran routine where we always take floor to get index + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + (ghost_width - 1) * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost nor buffer for given patch +MyList *Parallel::build_owned_gsl2(Patch *Pat, int rank_in) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] - Pat->uui[i] * DH : bp->bbox[dim + i] - ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // NOTE: our dividing structure is (exclude ghost) + // -1 0 + // 1 2 + // so (0,1) does not belong to any part for vertex structure, we always put it to right part, this is consistent to + // the fortran routine where we always take floor to get index + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] + Pat->lli[i] * DH : bp->bbox[i] + (ghost_width - 1) * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] + Pat->lli[i] * DH : bp->bbox[i] + ghost_width * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch, and delete the ghost_width for interpolation consideration on the patch boundary +MyList *Parallel::build_owned_gsl3(Patch *Pat, int rank_in, int Symmetry) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = bp->bbox[dim + i] - ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // NOTE: our dividing structure is (exclude ghost) + // -1 0 + // 1 2 + // so (0,1) does not belong to any part for vertex structure, we always put it to right part, this is consistent to + // the fortran routine where we always take floor to get index + gs->data->llb[i] = bp->bbox[i] + (ghost_width - 1) * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->llb[i] = bp->bbox[i] + ghost_width * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + // Symmetry consideration + if (Symmetry > 0) + { + double DH = bp->getdX(2); + if (feq(bp->bbox[2], 0, DH / 2)) + { + gs->data->llb[2] = bp->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[2] = int((gs->data->uub[2] - gs->data->llb[2]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[2] = int((gs->data->uub[2] - gs->data->llb[2]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + if (Symmetry > 1) + { + for (int i = 0; i < 2; i++) + { + DH = bp->getdX(i); + if (feq(bp->bbox[i], 0, DH / 2)) + { + gs->data->llb[i] = bp->bbox[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + } + } + + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost nor buffer for given patch, +// and delete the ghost_width for interpolation consideration on the patch boundary +MyList *Parallel::build_owned_gsl4(Patch *Pat, int rank_in, int Symmetry) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] - Pat->uui[i] * DH : bp->bbox[dim + i]; + gs->data->uub[i] -= ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // NOTE: our dividing structure is (exclude ghost) + // -1 0 + // 1 2 + // so (0,1) does not belong to any part for vertex structure, we always put it to right part, this is consistent to + // the fortran routine where we always take floor to get index + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] + Pat->lli[i] * DH : bp->bbox[i]; + gs->data->llb[i] += (ghost_width - 1) * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] + Pat->lli[i] * DH : bp->bbox[i]; + gs->data->llb[i] += ghost_width * DH; + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + // Symmetry consideration + if (Symmetry > 0) + { + double DH = bp->getdX(2); + if (feq(bp->bbox[2], 0, DH / 2)) + { + gs->data->llb[2] = bp->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[2] = int((gs->data->uub[2] - gs->data->llb[2]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[2] = int((gs->data->uub[2] - gs->data->llb[2]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + if (Symmetry > 1) + { + for (int i = 0; i < 2; i++) + { + DH = bp->getdX(i); + if (feq(bp->bbox[i], 0, DH / 2)) + { + gs->data->llb[i] = bp->bbox[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + } + } + + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost nor buffer for given patch, no extention +MyList *Parallel::build_owned_gsl5(Patch *Pat, int rank_in) +{ + MyList *cgsl = 0, *gs; + MyList *BP = Pat->blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], Pat->bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] - Pat->uui[i] * DH : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], Pat->bbox[i], DH / 2)) ? bp->bbox[i] + Pat->lli[i] * DH : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == Pat->ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch list +// stupid method +/* +MyList *Parallel::build_owned_gsl(MyList *PatL,int rank_in,int type,int Symmetry) +{ + MyList *cgsl=0,*gs; + while(PatL) + { + if(!cgsl) + { + switch(type) + { + case 0: + cgsl = build_owned_gsl0(PatL->data,rank_in); + break; + case 1: + cgsl = build_owned_gsl1(PatL->data,rank_in); + break; + case 2: + cgsl = build_owned_gsl2(PatL->data,rank_in); + break; + case 3: + cgsl = build_owned_gsl3(PatL->data,rank_in,Symmetry); + break; + case 4: + cgsl = build_owned_gsl4(PatL->data,rank_in,Symmetry); + break; + case 5: + cgsl = build_owned_gsl5(PatL->data,rank_in); + break; + default: + cout<<"Parallel::build_owned_gsl : unknown type = "<next) gs = gs->next; + } + else + { + switch(type) + { + case 0: + gs->next = build_owned_gsl0(PatL->data,rank_in); + break; + case 1: + gs->next = build_owned_gsl1(PatL->data,rank_in); + break; + case 2: + gs->next = build_owned_gsl2(PatL->data,rank_in); + break; + case 3: + gs->next = build_owned_gsl3(PatL->data,rank_in,Symmetry); + break; + case 4: + gs->next = build_owned_gsl4(PatL->data,rank_in,Symmetry); + break; + case 5: + gs->next = build_owned_gsl5(PatL->data,rank_in); + break; + default: + cout<<"Parallel::build_owned_gsl : unknown type = "<next) gs = gs->next; + } + PatL = PatL->next; + } + + return cgsl; +} +*/ +// more clever method +MyList *Parallel::build_owned_gsl(MyList *PatL, int rank_in, int type, int Symmetry) +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + switch (type) + { + case 0: + gs = build_owned_gsl0(PatL->data, rank_in); + break; + case 1: + gs = build_owned_gsl1(PatL->data, rank_in); + break; + case 2: + gs = build_owned_gsl2(PatL->data, rank_in); + break; + case 3: + gs = build_owned_gsl3(PatL->data, rank_in, Symmetry); + break; + case 4: + gs = build_owned_gsl4(PatL->data, rank_in, Symmetry); + break; + case 5: + gs = build_owned_gsl5(PatL->data, rank_in); + break; + default: + cout << "Parallel::build_owned_gsl : unknown type = " << type << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (cgsl) + cgsl->catList(gs); + else + cgsl = gs; + PatL = PatL->next; + } + + return cgsl; +} +// according to overlape to determine real grid segments +void Parallel::build_gstl(MyList *srci, MyList *dsti, + MyList **out_src, MyList **out_dst) +{ + *out_src = *out_dst = 0; + + if (!srci || !dsti) + return; + + MyList *s, *d; + MyList *s2, *d2; + + double llb[dim], uub[dim]; + + s = srci; + while (s) + { + Parallel::gridseg *sd = s->data; + d = dsti; + while (d) + { + Parallel::gridseg *dd = d->data; + bool flag = true; + for (int i = 0; i < dim; i++) + { + double SH = sd->Bg->getdX(i), DH = dd->Bg->getdX(i); + llb[i] = Mymax(sd->llb[i], dd->llb[i]); + uub[i] = Mymin(sd->uub[i], dd->uub[i]); + // make sure the region boundary is consistent to the grids + // here we only judge if the domain is empty, so do not need to adjust the align + double lb = llb[i], ub = uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // ---*--- + // x-------x + // if (int(2*(sd->uub[i]-uub[i])/SH+0.4)%2 == 1) ub = uub[i]-SH/2; + // else if(int(2*(dd->uub[i]-uub[i])/DH+0.4)%2 == 1) ub = uub[i]-DH/2; + // if (int(2*(llb[i]-sd->llb[i])/SH+0.4)%2 == 1) lb = llb[i]+SH/2; + // else if(int(2*(llb[i]-dd->llb[i])/DH+0.4)%2 == 1) lb = llb[i]+DH/2; + if (lb > ub + Mymin(SH, DH) / 2) + { + flag = false; + break; + } // special for isolated point +#else +#ifdef Cell + // |------| + // |-------------| + // if (int(2*(sd->uub[i]-uub[i])/SH+0.4)%2 == 1) ub = uub[i]+SH/2; + // else if(int(2*(dd->uub[i]-uub[i])/DH+0.4)%2 == 1) ub = uub[i]+DH/2; + // |------| + // |-------------| + // if (int(2*(llb[i]-sd->llb[i])/SH+0.4)%2 == 1) lb = llb[i]-SH/2; + // else if(int(2*(llb[i]-dd->llb[i])/DH+0.4)%2 == 1) lb = llb[i]-DH/2; + if (ub - lb < Mymin(SH, DH) / 2) + { + flag = false; + break; + } // even for isolated point, it has a cell belong to it +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + if (flag) + { + if (!(*out_src)) + { + *out_src = s2 = new MyList; + *out_dst = d2 = new MyList; + s2->data = new Parallel::gridseg; + d2->data = new Parallel::gridseg; + } + else + { + s2->next = new MyList; + s2 = s2->next; + d2->next = new MyList; + d2 = d2->next; + s2->data = new Parallel::gridseg; + d2->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double SH = sd->Bg->getdX(i), DH = dd->Bg->getdX(i); + s2->data->llb[i] = d2->data->llb[i] = llb[i]; + s2->data->uub[i] = d2->data->uub[i] = uub[i]; +// using float method to count point, we do not need following consideration (2012 nov 17) +#if 1 + +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + // old code distuinguish vertex and cell + // if (int(2*(sd->uub[i]-uub[i])/SH+0.4)%2 == 1) s2->data->uub[i] = uub[i]-SH/2; + // else if(int(2*(dd->uub[i]-uub[i])/DH+0.4)%2 == 1) d2->data->uub[i] = uub[i]-DH/2; + // if (int(2*(llb[i]-sd->llb[i])/SH+0.4)%2 == 1) s2->data->llb[i] = llb[i]+SH/2; + // else if(int(2*(llb[i]-dd->llb[i])/DH+0.4)%2 == 1) d2->data->llb[i] = llb[i]+DH/2; + // new code: here we concern much more about missing point, because overlaping domain has been gaureented above + if (int(2 * (sd->uub[i] - uub[i]) / SH + 0.4) % 2 == 1) + s2->data->uub[i] = uub[i] + SH / 2; + else if (int(2 * (dd->uub[i] - uub[i]) / DH + 0.4) % 2 == 1) + d2->data->uub[i] = uub[i] + DH / 2; + if (int(2 * (llb[i] - sd->llb[i]) / SH + 0.4) % 2 == 1) + s2->data->llb[i] = llb[i] - SH / 2; + else if (int(2 * (llb[i] - dd->llb[i]) / DH + 0.4) % 2 == 1) + d2->data->llb[i] = llb[i] - DH / 2; + s2->data->shape[i] = int((s2->data->uub[i] - s2->data->llb[i]) / SH + 0.4) + 1; + d2->data->shape[i] = int((d2->data->uub[i] - d2->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + if (int(2 * (sd->uub[i] - uub[i]) / SH + 0.4) % 2 == 1) + s2->data->uub[i] = uub[i] + SH / 2; + else if (int(2 * (dd->uub[i] - uub[i]) / DH + 0.4) % 2 == 1) + d2->data->uub[i] = uub[i] + DH / 2; + if (int(2 * (llb[i] - sd->llb[i]) / SH + 0.4) % 2 == 1) + s2->data->llb[i] = llb[i] - SH / 2; + else if (int(2 * (llb[i] - dd->llb[i]) / DH + 0.4) % 2 == 1) + d2->data->llb[i] = llb[i] - DH / 2; + s2->data->shape[i] = int((s2->data->uub[i] - s2->data->llb[i]) / SH + 0.4); + d2->data->shape[i] = int((d2->data->uub[i] - d2->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + +#endif + s2->data->illb[i] = sd->illb[i]; + d2->data->illb[i] = dd->illb[i]; + s2->data->iuub[i] = sd->iuub[i]; + d2->data->iuub[i] = dd->iuub[i]; + } + s2->data->Bg = sd->Bg; + s2->next = 0; + d2->data->Bg = dd->Bg; + d2->next = 0; + } + d = d->next; + } + s = s->next; + } +} +// PACK: prepare target data in 'data' +// UNPACK: copy target data from 'data' to corresponding numerical grids +int Parallel::data_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + + if (dir != PACK && dir != UNPACK) + { + cout << "error dir " << dir << " for data_packer " << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int type; /* 1 copy, 2 restrict, 3 prolong */ + if (src->data->Bg->lev == dst->data->Bg->lev) + type = 1; + else if (src->data->Bg->lev > dst->data->Bg->lev) + type = 2; + else + type = 3; + + while (src && dst) + { + if ((dir == PACK && dst->data->Bg->rank == rank_in && src->data->Bg->rank == myrank) || + (dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + switch (type) + { + // attention must be paied to the difference between src's llb,uub and dst's llb,uub + case 1: + f_copy(DIM, dst->data->llb, dst->data->uub, dst->data->shape, data + size_out, + src->data->Bg->bbox, src->data->Bg->bbox + dim, src->data->Bg->shape, src->data->Bg->fgfs[varls->data->sgfn], + dst->data->llb, dst->data->uub); + break; + case 2: + f_restrict3(DIM, dst->data->llb, dst->data->uub, dst->data->shape, data + size_out, + src->data->Bg->bbox, src->data->Bg->bbox + dim, src->data->Bg->shape, src->data->Bg->fgfs[varls->data->sgfn], + dst->data->llb, dst->data->uub, varls->data->SoA, Symmetry); + break; + case 3: + f_prolong3(DIM, src->data->Bg->bbox, src->data->Bg->bbox + dim, src->data->Bg->shape, src->data->Bg->fgfs[varls->data->sgfn], + dst->data->llb, dst->data->uub, dst->data->shape, data + size_out, + dst->data->llb, dst->data->uub, varls->data->SoA, Symmetry); + } + if (dir == UNPACK) // from target data to corresponding grid + f_copy(DIM, dst->data->Bg->bbox, dst->data->Bg->bbox + dim, dst->data->Bg->shape, dst->data->Bg->fgfs[varld->data->sgfn], + dst->data->llb, dst->data->uub, dst->data->shape, data + size_out, + dst->data->llb, dst->data->uub); + } + size_out += dst->data->shape[0] * dst->data->shape[1] * dst->data->shape[2]; + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +int Parallel::data_packermix(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + + if (dir != PACK && dir != UNPACK) + { + cout << "Parallel::data_packermix: error dir " << dir << " for data_packermix." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int type; /* 1 copy, 2 restrict, 3 prolong */ + if (src->data->Bg->lev == dst->data->Bg->lev) + type = 1; + else if (src->data->Bg->lev > dst->data->Bg->lev) + type = 2; + else + type = 3; + + if (type != 3) + { + cout << "Parallel::data_packermix: error type " << type << " for data_packermix." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (src && dst) + { + if ((dir == PACK && dst->data->Bg->rank == rank_in && src->data->Bg->rank == myrank) || + (dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + f_prolongcopy3(DIM, src->data->Bg->bbox, src->data->Bg->bbox + dim, src->data->Bg->shape, src->data->Bg->fgfs[varls->data->sgfn], + dst->data->llb, dst->data->uub, src->data->shape, data + size_out, + src->data->llb, src->data->uub, varls->data->SoA, Symmetry); + if (dir == UNPACK) // from target data to corresponding grid + f_prolongmix3(DIM, dst->data->Bg->bbox, dst->data->Bg->bbox + dim, dst->data->Bg->shape, dst->data->Bg->fgfs[varld->data->sgfn], + src->data->llb, src->data->uub, src->data->shape, data + size_out, + dst->data->llb, dst->data->uub, varls->data->SoA, Symmetry, dst->data->illb, dst->data->iuub); + } + // the symmetry problem should be dealt in prolongcopy3, + // so we always have ghost_width for both sides + size_out += (src->data->shape[0] + 2 * ghost_width) * (src->data->shape[1] + 2 * ghost_width) * (src->data->shape[2] + 2 * ghost_width); + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +// +void Parallel::transfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + if (length = data_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + data_packer(rec_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + } + } + else + { + // send from this cpu to cpu#node + if (length = data_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + data_packer(send_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = data_packer(0, src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + data_packer(rec_data[node], src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +// +void Parallel::transfermix(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + if (length = data_packermix(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + data_packermix(rec_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + } + } + else + { + // send from this cpu to cpu#node + if (length = data_packermix(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + data_packermix(send_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = data_packermix(0, src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + data_packermix(rec_data[node], src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +void Parallel::Sync(Patch *Pat, MyList *VarList, int Symmetry) +{ + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_ghost_gsl(Pat); // ghost region only + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl0(Pat, node); // for the part without ghost points and do not extend + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer_src[node], data locate on cpu#node; + // but for transfer_dst[node] the data may locate on any node + } + + transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +void Parallel::Sync(MyList *PatL, MyList *VarList, int Symmetry) +{ + // Patch inner Synch + MyList *Pp = PatL; + while (Pp) + { + Sync(Pp->data, VarList, Symmetry); + Pp = Pp->next; + } + + // Patch inter Synch + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_buffer_gsl(PatL); // buffer region only + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatL, node, 5, Symmetry); // for the part without ghost nor buffer points and do not extend + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +// collect buffer grid segments or blocks for the periodic boundary condition of given patch +// --------------------------------------------------- +// |con | |con | +// |ner | PhysBD |ner | +// |-------------------------------------------------| +// | | | | +// |Phy | |Phy | +// |sBD | |BD | +// | | | | +// | | | | +// | | | | +// |-------------------------------------------------| +// |con | PhysBD |con | +// |ner | |ner | +// --------------------------------------------------- +// first order derivetive does not need conner information, +// but second order derivative needs! +/* the following code does not include conner part +MyList *Parallel::build_PhysBD_gsl(Patch *Pat) +{ + MyList *cgsl,*gsc,*gsb=0,*p; + gsc = build_ghost_gsl(Pat); + for(int i=0;idata->Bg->getdX(i); +// lower boundary + if(gsb) + { + p = new MyList; + p->data = new Parallel::gridseg; + p->next=gsb; + gsb=p; + } + else + { + gsb = new MyList; + gsb->data = new Parallel::gridseg; + gsb->next=0; + } + for(int j=0;jdata->llb[i] = Pat->bbox[i]-ghost_width*DH; + gsb->data->uub[i] = Pat->bbox[i]-DH; +#else +#ifdef Cell + gsb->data->llb[i] = Pat->bbox[i]-ghost_width*DH; + gsb->data->uub[i] = Pat->bbox[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + gsb->data->shape[i] = ghost_width; + } + else + { + gsb->data->llb[j] = Pat->bbox[j]; + gsb->data->uub[j] = Pat->bbox[j+dim]; + gsb->data->shape[j] = Pat->shape[j]; + } + } + gsb->data->Bg = 0; //vertual grid segment +// upper boundary + p = new MyList; + p->data = new Parallel::gridseg; + p->next=gsb; + gsb=p; + for(int j=0;jdata->llb[i] = Pat->bbox[i+dim]+DH; + gsb->data->uub[i] = Pat->bbox[i+dim]+ghost_width*DH; +#else +#ifdef Cell + gsb->data->llb[i] = Pat->bbox[i+dim]; + gsb->data->uub[i] = Pat->bbox[i+dim]+ghost_width*DH; +#else +#error Not define Vertex nor Cell +#endif +#endif + gsb->data->shape[i] = ghost_width; + } + else + { + gsb->data->llb[j] = Pat->bbox[j]; + gsb->data->uub[j] = Pat->bbox[j+dim]; + gsb->data->shape[j] = Pat->shape[j]; + } + } + gsb->data->Bg = 0; //vertual grid segment + } + + cgsl = gsl_and(gsc,gsb); + + gsc->destroyList(); + gsb->destroyList(); + + return cgsl; +} +*/ +// the following code includes conner part +MyList *Parallel::build_PhysBD_gsl(Patch *Pat) +{ + MyList *cgsl, *gsc, *gsb = 0, *p; + + gsc = build_complete_gsl(Pat); + + gsb = new MyList; + gsb->data = new Parallel::gridseg; + gsb->next = 0; + gsb->data->Bg = 0; + + for (int j = 0; j < dim; j++) + { + gsb->data->llb[j] = Pat->bbox[j]; + gsb->data->uub[j] = Pat->bbox[j + dim]; + gsb->data->shape[j] = Pat->shape[j]; + } + + p = gsl_subtract(gsc, gsb); + + gsc->destroyList(); + gsb->destroyList(); + + cgsl = divide_gsl(p, Pat); + + p->destroyList(); + + return cgsl; +} +MyList *Parallel::divide_gsl(MyList *p, Patch *Pat) +{ + MyList *cgsl = 0; + while (p) + { + if (cgsl) + cgsl->catList(divide_gs(p, Pat)); + else + cgsl = divide_gs(p, Pat); + p = p->next; + } + + return cgsl; +} +// divide the gs into pices which locate either totally outside of the given Patch coordinate range +// or totally inside it. It's usefull for periodic boundary condition +MyList *Parallel::divide_gs(MyList *p, Patch *Pat) +{ + double DH[dim]; + for (int i = 0; i < dim; i++) + { + DH[i] = p->data->Bg->getdX(i); + } + + int num[dim]; + double llb[3][dim], uub[3][dim]; + for (int i = 0; i < dim; i++) + { + if (p->data->llb[i] < Pat->bbox[i] - DH[i] / 2) + { + if (p->data->uub[i] > Pat->bbox[i + dim] + DH[i] / 2) + { + num[i] = 3; + llb[0][i] = p->data->llb[i]; + llb[1][i] = Pat->bbox[i]; + uub[1][i] = Pat->bbox[i + dim]; + uub[2][i] = p->data->uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + uub[0][i] = Pat->bbox[i] - DH[i]; + llb[2][i] = Pat->bbox[i + dim] + DH[i]; +#else +#ifdef Cell + uub[0][i] = Pat->bbox[i]; + llb[2][i] = Pat->bbox[i + dim]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else if (p->data->uub[i] > Pat->bbox[i] + DH[i] / 2) + { + num[i] = 2; + llb[0][i] = p->data->llb[i]; + llb[1][i] = Pat->bbox[i]; + uub[1][i] = p->data->uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + uub[0][i] = Pat->bbox[i] - DH[i]; +#else +#ifdef Cell + uub[0][i] = Pat->bbox[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + { + num[i] = 1; + llb[0][i] = p->data->llb[i]; + uub[0][i] = p->data->uub[i]; + } + } + else if (p->data->llb[i] < Pat->bbox[i + dim] - DH[i] / 2) + { + if (p->data->uub[i] > Pat->bbox[i + dim] + DH[i] / 2) + { + num[i] = 2; + llb[0][i] = p->data->llb[i]; + uub[0][i] = Pat->bbox[i + dim]; + uub[1][i] = p->data->uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[1][i] = Pat->bbox[i + dim] + DH[i]; +#else +#ifdef Cell + llb[1][i] = Pat->bbox[i + dim]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + else + { + num[i] = 1; + llb[0][i] = p->data->llb[i]; + uub[0][i] = p->data->uub[i]; + } + } + else + { + num[i] = 1; + llb[0][i] = p->data->llb[i]; + uub[0][i] = p->data->uub[i]; + } + } + MyList *cgsl = 0, *gg; + int NN = 1; + for (int i = 0; i < dim; i++) + NN = NN * num[i]; + + for (int i = 0; i < NN; i++) + { + int ind[dim]; + getarrayindex(dim, num, ind, i); + gg = clone_gsl(p, true); + for (int k = 0; k < dim; k++) + { + gg->data->llb[k] = llb[ind[k]][k]; + gg->data->uub[k] = uub[ind[k]][k]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gg->data->shape[k] = int((uub[ind[k]][k] - llb[ind[k]][k]) / DH[k] + 0.4) + 1; +#else +#ifdef Cell + gg->data->shape[k] = int((uub[ind[k]][k] - llb[ind[k]][k]) / DH[k] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + if (cgsl) + cgsl->catList(gg); + else + cgsl = gg; + } + + return cgsl; +} +// after mod operation, according to overlape to determine real grid segments +void Parallel::build_PhysBD_gstl(Patch *Pat, MyList *srci, MyList *dsti, + MyList **out_src, MyList **out_dst) +{ + *out_src = *out_dst = 0; + + if (!srci || !dsti) + return; + + MyList *s, *d; + MyList *s2, *d2; + + double llb[dim], uub[dim]; + + s = srci; + while (s) + { + Parallel::gridseg *sd = s->data; + d = dsti; + while (d) + { + Parallel::gridseg *dd = d->data; + bool flag = true; + for (int i = 0; i < dim; i++) + { + double SH = sd->Bg->getdX(i), DH = dd->Bg->getdX(i); + if (!feq(SH, DH, SH / 2)) + { + cout << "Parallel::build_PhysBD_gstl meets different grid space SH = " << SH << ", DH = " << DH << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + // we assume dst and src locate on the same Patch + if (dd->llb[i] < Pat->bbox[i]) + llb[i] = Mymax(sd->llb[i], dd->llb[i] + Pat->bbox[dim + i] - Pat->bbox[i]); + else if (dd->llb[i] > Pat->bbox[i + dim]) + llb[i] = Mymax(sd->llb[i], dd->llb[i] - Pat->bbox[dim + i] + Pat->bbox[i]); + else + llb[i] = Mymax(sd->llb[i], dd->llb[i]); + + if (dd->uub[i] < Pat->bbox[i]) + uub[i] = Mymin(sd->uub[i], dd->uub[i] + Pat->bbox[dim + i] - Pat->bbox[i]); + else if (dd->uub[i] > Pat->bbox[dim + i]) + uub[i] = Mymin(sd->uub[i], dd->uub[i] - Pat->bbox[dim + i] + Pat->bbox[i]); + else + uub[i] = Mymin(sd->uub[i], dd->uub[i]); +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (llb[i] > uub[i] + SH / 2) + { + flag = false; + break; + } // special for isolated point +#else +#ifdef Cell + if (llb[i] > uub[i]) + { + flag = false; + break; + } +#else +#error Not define Vertex nor Cell +#endif +#endif + } + + if (flag) + { + if (!(*out_src)) + { + *out_src = s2 = new MyList; + *out_dst = d2 = new MyList; + s2->data = new Parallel::gridseg; + d2->data = new Parallel::gridseg; + } + else + { + s2->next = new MyList; + s2 = s2->next; + d2->next = new MyList; + d2 = d2->next; + s2->data = new Parallel::gridseg; + d2->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double SH = sd->Bg->getdX(i), DH = dd->Bg->getdX(i); + s2->data->llb[i] = llb[i]; + s2->data->uub[i] = uub[i]; + + if (dd->llb[i] < Pat->bbox[i]) + d2->data->llb[i] = llb[i] - Pat->bbox[dim + i] + Pat->bbox[i]; + else if (dd->llb[i] > Pat->bbox[i + dim]) + d2->data->llb[i] = llb[i] + Pat->bbox[dim + i] - Pat->bbox[i]; + else + d2->data->llb[i] = llb[i]; + + if (dd->uub[i] < Pat->bbox[i]) + d2->data->uub[i] = uub[i] - Pat->bbox[dim + i] + Pat->bbox[i]; + else if (dd->uub[i] > Pat->bbox[dim + i]) + d2->data->uub[i] = uub[i] + Pat->bbox[dim + i] - Pat->bbox[i]; + else + d2->data->uub[i] = uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + s2->data->shape[i] = int((s2->data->uub[i] - s2->data->llb[i]) / SH + 0.4) + 1; + d2->data->shape[i] = int((d2->data->uub[i] - d2->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + s2->data->shape[i] = int((s2->data->uub[i] - s2->data->llb[i]) / SH + 0.4); + d2->data->shape[i] = int((d2->data->uub[i] - d2->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + s2->data->Bg = sd->Bg; + s2->next = 0; + d2->data->Bg = dd->Bg; + d2->next = 0; + } + d = d->next; + } + s = s->next; + } +} +void Parallel::PeriodicBD(Patch *Pat, MyList *VarList, int Symmetry) +{ + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_PhysBD_gsl(Pat); + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl0(Pat, node); // for the part without ghost points and do not extend + build_PhysBD_gstl(Pat, src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +double Parallel::L2Norm(Patch *Pat, var *vf) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + double tvf, dtvf = 0; + int BDW = ghost_width; + + MyList *BP = Pat->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_l2normhelper(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pat->bbox[0], Pat->bbox[1], Pat->bbox[2], + Pat->bbox[3], Pat->bbox[4], Pat->bbox[5], + cg->fgfs[vf->sgfn], tvf, BDW); + dtvf += tvf; + } + if (BP == Pat->ble) + break; + BP = BP->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + tvf = sqrt(tvf); + + return tvf; +} +double Parallel::L2Norm(Patch *Pat, var *vf, MPI_Comm Comm_here) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + double tvf, dtvf = 0; + int BDW = ghost_width; + + MyList *BP = Pat->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_l2normhelper(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pat->bbox[0], Pat->bbox[1], Pat->bbox[2], + Pat->bbox[3], Pat->bbox[4], Pat->bbox[5], + cg->fgfs[vf->sgfn], tvf, BDW); + dtvf += tvf; + } + if (BP == Pat->ble) + break; + BP = BP->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + + tvf = sqrt(tvf); + + return tvf; +} +void Parallel::checkgsl(MyList *pp, bool first_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (!pp) + cout << " Parallel::checkgsl meets empty gsl" << endl; + while (pp) + { + if (pp->data->Bg) + cout << " on node#" << pp->data->Bg->rank << endl; + else + cout << " virtual grid segment" << endl; + cout << " shape: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->shape[i] << ","; + else + cout << pp->data->shape[i] << ")" << endl; + } + cout << " range: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->llb[i] << ":" << pp->data->uub[i] << ","; + else + cout << pp->data->llb[i] << ":" << pp->data->uub[i] << ")" << endl; + } + if (first_only) + return; + pp = pp->next; + } + } +} +void Parallel::checkvarl(MyList *pp, bool first_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + while (pp) + { + cout << "name: " << pp->data->name << endl; + cout << "SoA = (" << pp->data->SoA[0] << "," << pp->data->SoA[1] << "," << pp->data->SoA[2] << ")" << endl; + cout << "sgfn = " << pp->data->sgfn << endl; + if (first_only) + return; + pp = pp->next; + } + } +} +void Parallel::prepare_inter_time_level(MyList *PatL, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* target (t+a*dt) */, int tindex) +{ + while (PatL) + { + prepare_inter_time_level(PatL->data, VarList1, VarList2, VarList3, tindex); + PatL = PatL->next; + } +} +void Parallel::prepare_inter_time_level(Patch *Pat, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* target (t+a*dt) */, int tindex) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + MyList *varl1; + MyList *varl2; + MyList *varl3; + + MyList *BP = Pat->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + varl1 = VarList1; + varl2 = VarList2; + varl3 = VarList3; + while (varl1) + { + if (tindex == 0) + f_average(cg->shape, cg->fgfs[varl1->data->sgfn], cg->fgfs[varl2->data->sgfn], cg->fgfs[varl3->data->sgfn]); + else if (tindex == 1) + f_average3(cg->shape, cg->fgfs[varl1->data->sgfn], cg->fgfs[varl2->data->sgfn], cg->fgfs[varl3->data->sgfn]); + else if (tindex == -1) + // just change data order to use average3 + f_average3(cg->shape, cg->fgfs[varl2->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varl3->data->sgfn]); + else + { + cout << "error tindex in Parallel::prepare_inter_time_level" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + varl1 = varl1->next; + varl2 = varl2->next; + varl3 = varl3->next; + } + } + if (BP == Pat->ble) + break; + BP = BP->next; + } +} +void Parallel::prepare_inter_time_level(MyList *PatL, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* source (t-dt) */, MyList *VarList4 /* target (t+a*dt) */, int tindex) +{ + while (PatL) + { + prepare_inter_time_level(PatL->data, VarList1, VarList2, VarList3, VarList4, tindex); + PatL = PatL->next; + } +} +void Parallel::prepare_inter_time_level(Patch *Pat, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* source (t-dt) */, MyList *VarList4 /* target (t+a*dt) */, int tindex) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + MyList *varl1; + MyList *varl2; + MyList *varl3; + MyList *varl4; + + MyList *BP = Pat->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + varl1 = VarList1; + varl2 = VarList2; + varl3 = VarList3; + varl4 = VarList4; + while (varl1) + { + if (tindex == 0) + f_average2(cg->shape, cg->fgfs[varl1->data->sgfn], cg->fgfs[varl2->data->sgfn], + cg->fgfs[varl3->data->sgfn], cg->fgfs[varl4->data->sgfn]); + else if (tindex == 1) + f_average2p(cg->shape, cg->fgfs[varl1->data->sgfn], cg->fgfs[varl2->data->sgfn], + cg->fgfs[varl3->data->sgfn], cg->fgfs[varl4->data->sgfn]); + else if (tindex == -1) + f_average2m(cg->shape, cg->fgfs[varl1->data->sgfn], cg->fgfs[varl2->data->sgfn], + cg->fgfs[varl3->data->sgfn], cg->fgfs[varl4->data->sgfn]); + else + { + cout << "error tindex in long cgh::prepare_inter_time_level" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + varl1 = varl1->next; + varl2 = varl2->next; + varl3 = varl3->next; + varl4 = varl4->next; + } + } + if (BP == Pat->ble) + break; + BP = BP->next; + } +} +void Parallel::Prolong(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (Patc->lev >= Patf->lev) + { + cout << "Parallel::Prolong: meet requst of Prolong from lev#" << Patc->lev << " to lev#" << Patf->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_complete_gsl(Patf); // including ghost + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl4(Patc, node, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +void Parallel::Restrict(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (PatcL->data->lev >= PatfL->data->lev) + { + cout << "Parallel::Restrict: meet requst of Restrict from lev#" << PatfL->data->lev << " to lev#" << PatcL->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_complete_gsl(PatcL); // including ghost + for (int node = 0; node < cpusize; node++) + { +#if 0 +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + src[node]=build_owned_gsl(PatfL,node,2,Symmetry); // - buffer - ghost +#else +#ifdef Cell + src[node]=build_owned_gsl(PatfL,node,4,Symmetry); // - buffer - ghost - BD ghost +#else +#error Not define Vertex nor Cell +#endif +#endif +#else + // it seems bam always use this + src[node] = build_owned_gsl(PatfL, node, 2, Symmetry); // - buffer - ghost +#endif + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +void Parallel::Restrict_after(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (PatcL->data->lev >= PatfL->data->lev) + { + cout << "Parallel::Restrict: meet requst of Restrict from lev#" << PatfL->data->lev << " to lev#" << PatcL->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_complete_gsl(PatcL); // including ghost + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatfL, node, 3, Symmetry); // - ghost - BD ghost + + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +// for the same time level +void Parallel::OutBdLow2Hi(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (Patc->lev >= Patf->lev) + { + cout << "Parallel::OutBdLow2Hi: meet requst of Prolong from lev#" << Patc->lev << " to lev#" << Patf->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_buffer_gsl(Patf); // buffer region only + + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl4(Patc, node, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +void Parallel::OutBdLow2Hi(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + MyList *Pp, *Ppc; + Ppc = PatcL; + while (Ppc) + { + Pp = PatfL; + while (Pp) + { + if (Ppc->data->lev >= Pp->data->lev) + { + cout << "Parallel::OutBdLow2Hi(list): meet requst of Prolong from lev#" << Ppc->data->lev << " to lev#" << Pp->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + Pp = Pp->next; + } + Ppc = Ppc->next; + } + + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_buffer_gsl(PatfL); // buffer region only + + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatcL, node, 4, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +// for the same time level +void Parallel::OutBdLow2Himix(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (Patc->lev >= Patf->lev) + { + cout << "Parallel::OutBdLow2Himix: meet requst of Prolong from lev#" << Patc->lev << " to lev#" << Patf->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_buffer_gsl(Patf); // buffer region only + + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl4(Patc, node, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfermix(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; + + // do not need this, we have done after calling of this routine in ProlongRestrict or RestrictProlong + // Sync(Patf,VarList2,Symmetry); // fine level points may be not enough for interpolation +} +void Parallel::OutBdLow2Himix(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + MyList *Pp, *Ppc; + Ppc = PatcL; + while (Ppc) + { + Pp = PatfL; + while (Pp) + { + if (Ppc->data->lev >= Pp->data->lev) + { + cout << "Parallel::OutBdLow2Himix(list): meet requst of Prolong from lev#" << Ppc->data->lev << " to lev#" << Pp->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + Pp = Pp->next; + } + Ppc = Ppc->next; + } + + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_buffer_gsl(PatfL); // buffer region only + + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatcL, node, 4, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfermix(transfer_src, transfer_dst, VarList1, VarList2, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +// collect all buffer grid segments or blocks for given patch +MyList *Parallel::build_buffer_gsl(Patch *Pat) +{ + MyList *cgsl, *gsc, *gsb; + + gsc = build_complete_gsl(Pat); // including ghost + + gsb = new MyList; + gsb->data = new Parallel::gridseg; + + for (int i = 0; i < dim; i++) + { + double DH = Pat->blb->data->getdX(i); + gsb->data->uub[i] = Pat->bbox[dim + i] - Pat->uui[i] * DH; + gsb->data->llb[i] = Pat->bbox[i] + Pat->lli[i] * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gsb->data->shape[i] = int((gsb->data->uub[i] - gsb->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gsb->data->shape[i] = int((gsb->data->uub[i] - gsb->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gsb->data->Bg = 0; + gsb->next = 0; + + cgsl = gsl_subtract(gsc, gsb); + + gsc->destroyList(); + gsb->destroyList(); + + // set illb and iuub + gsb = cgsl; + while (gsb) + { + for (int i = 0; i < dim; i++) + { + double DH = Pat->blb->data->getdX(i); + gsb->data->iuub[i] = Pat->bbox[dim + i] - Pat->uui[i] * DH; + gsb->data->illb[i] = Pat->bbox[i] + Pat->lli[i] * DH; + } + gsb = gsb->next; + } + + return cgsl; +} +MyList *Parallel::build_buffer_gsl(MyList *PatL) +{ + MyList *cgsl = 0, *gs; + while (PatL) + { + if (cgsl) + { + gs->next = build_buffer_gsl(PatL->data); + gs = gs->next; + if (gs) + while (gs->next) + gs = gs->next; + } + else + { + cgsl = build_buffer_gsl(PatL->data); + gs = cgsl; + if (gs) + while (gs->next) + gs = gs->next; + } + PatL = PatL->next; + } + + return cgsl; +} +void Parallel::Prolongint(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + if (Patc->lev >= Patf->lev) + { + cout << "Parallel::Prolong: meet requst of Prolong from lev#" << Patc->lev << " to lev#" << Patf->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int num_var = 0; + MyList *varl; + varl = VarList1; + while (varl) + { + num_var++; + varl = varl->next; + } + + MyList *BP = Patf->blb; + while (BP) + { + int Npts; + if (myrank == BP->data->rank) + Npts = BP->data->shape[0] * BP->data->shape[1] * BP->data->shape[2]; + MPI_Bcast(&Npts, 1, MPI_INT, BP->data->rank, MPI_COMM_WORLD); + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[Npts]; + if (myrank == BP->data->rank) + { + for (int i = 0; i < Npts; i++) + { + int ind[3]; + Parallel::getarrayindex(3, BP->data->shape, ind, i); + pox[0][i] = BP->data->X[0][ind[0]]; + pox[1][i] = BP->data->X[1][ind[1]]; + pox[2][i] = BP->data->X[2][ind[2]]; + } + } + for (int i = 0; i < 3; i++) + MPI_Bcast(pox[i], Npts, MPI_DOUBLE, BP->data->rank, MPI_COMM_WORLD); + double *res; + res = new double[num_var * Npts]; + Patc->Interp_Points(VarList1, Npts, pox, res, Symmetry); // because this operation is a global operation (for all processors) + // we have to isolate it out of myrank==BP->data->rank + if (myrank == BP->data->rank) + { + for (int i = 0; i < Npts; i++) + { + varl = VarList2; + int j = 0; + while (varl) + { + (BP->data->fgfs[varl->data->sgfn])[i] = res[j + i * num_var]; + j++; + varl = varl->next; + } + } + } + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] res; + BP = BP->next; + } +} +// +void Parallel::merge_gsl(MyList *&A, const double ratio) +{ + if (!A) + return; + + MyList *B, *C, *D = A; + bool flag = false; + while (D->next) + { + B = D->next; + while (B) + { + flag = merge_gs(D, B, C, ratio); + if (flag) + break; + B = B->next; + } + if (flag) + break; + D = D->next; + } + + if (flag) + { + // delete D and B from A + MyList *E = A; + while (E->next) + { + MyList *tp = E->next; + if (D == tp || B == tp) + { + E->next = (tp->next) ? tp->next : 0; + delete tp->data; + delete tp; + } + if (E->next) + E = E->next; + } + + if (D == A) + { + MyList *tp = A; + A = (A->next) ? A->next : 0; + delete tp->data; + delete tp; + } + // cat C to A + if (A) + A->catList(C); + else + A = C; + + merge_gsl(A, ratio); + } +} +// +bool Parallel::merge_gs(MyList *D, MyList *B, MyList *&C, const double ratio) +{ + if (!B || !D) + return false; + + C = 0; + double llb[dim], uub[dim], DH[dim]; + for (int i = 0; i < dim; i++) + { + double tdh; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH[i] = (D->data->uub[i] - D->data->llb[i]) / (D->data->shape[i] - 1); + tdh = (B->data->uub[i] - B->data->llb[i]) / (B->data->shape[i] - 1); +#else +#ifdef Cell + DH[i] = (D->data->uub[i] - D->data->llb[i]) / D->data->shape[i]; + tdh = (B->data->uub[i] - B->data->llb[i]) / B->data->shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (!feq(DH[i], tdh, DH[i] / 2)) + { + cout << "Parallel::merge_gs meets different grid segment " << DH[i] << " vs " << tdh << endl; + checkgsl(B, true); + checkgsl(D, true); + MPI_Abort(MPI_COMM_WORLD, 1); + } + llb[i] = Mymax(D->data->llb[i], B->data->llb[i]); + uub[i] = Mymin(D->data->uub[i], B->data->uub[i]); + // if(uub[i]-llb[i] < DH[i]/2) return false; //here this is valid for both vertex and cell + + // use 0 instead of DH[i]/2, we consider contact case, 2012 Aug 8 + if (uub[i] - llb[i] < 0) + return false; // here this is valid for both vertex and cell + } + + // vb: volume of B + // vd: volume of D + // vo: volume of overlap + // vt: volume of smallest common box (virtual merged box) + double vd = 1, vb = 1, vt = 1, vo = 1; + for (int i = 0; i < dim; i++) + { + vt = vt * (Mymax(D->data->uub[i], B->data->uub[i]) - Mymin(D->data->llb[i], B->data->llb[i])); + vo = vo * (uub[i] - llb[i]); + vd = vd * (D->data->uub[i] - D->data->llb[i]); + vb = vb * (B->data->uub[i] - B->data->llb[i]); + } + + // smller ratio, more possible to merge + if ((vd + vb - vo) / vt > ratio) + { + C = new MyList; + C->data = new gridseg; + for (int i = 0; i < dim; i++) + { + C->data->uub[i] = Mymax(D->data->uub[i], B->data->uub[i]); + C->data->llb[i] = Mymin(D->data->llb[i], B->data->llb[i]); +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / DH[i] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / DH[i] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + if (D->data->Bg == B->data->Bg) + C->data->Bg = D->data->Bg; + else + C->data->Bg = 0; + + C->next = 0; + + return true; + } + else + { + return false; + } +} +// Add ghost region to tangent plane +// we assume the grids have the same resolution +void Parallel::add_ghost_touch(MyList *&A) +{ + if (!A || !(A->next)) + return; + + double DH[dim]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int i = 0; i < dim; i++) + DH[i] = (A->data->uub[i] - A->data->llb[i]) / (A->data->shape[i] - 1) / 2; +#else +#ifdef Cell + for (int i = 0; i < dim; i++) + DH[i] = (A->data->uub[i] - A->data->llb[i]) / A->data->shape[i] / 2; +#else +#error Not define Vertex nor Cell +#endif +#endif + + MyList *C1, *C2, *A1 = A, *A2, *dc; + dc = C1 = clone_gsl(A, false); + while (C1) + { + C2 = C1->next; + A2 = A1->next; + while (C2) + { + for (int i = 0; i < dim; i++) + { + if (feq(C1->data->llb[i], C2->data->uub[i], DH[i])) + { + // direction i touch, other directions overlap + bool flag = true; + for (int j = 0; j < i; j++) + if ((C1->data->llb[j] - C2->data->llb[j]) * (C1->data->uub[j] - C2->data->llb[j]) > 0 && + (C2->data->llb[j] - C1->data->llb[j]) * (C2->data->uub[j] - C1->data->llb[j]) > 0) + flag = false; + for (int j = i + 1; j < dim; j++) + if ((C1->data->llb[j] - C2->data->llb[j]) * (C1->data->uub[j] - C2->data->llb[j]) > 0 && + (C2->data->llb[j] - C1->data->llb[j]) * (C2->data->uub[j] - C1->data->llb[j]) > 0) + flag = false; + + if (flag) + { + // only add one ghost region + if (feq(A1->data->llb[i], C1->data->llb[i], DH[i])) + { + A1->data->llb[i] -= ghost_width * 2 * DH[i]; + A1->data->shape[i] += ghost_width; + } + if (feq(A2->data->uub[i], C2->data->uub[i], DH[i])) + { + A2->data->uub[i] += ghost_width * 2 * DH[i]; + A2->data->shape[i] += ghost_width; + } + } + } + if (feq(C1->data->uub[i], C2->data->llb[i], DH[i])) + { + // direction i touch, other directions overlap + bool flag = true; + for (int j = 0; j < i; j++) + if ((C1->data->llb[j] - C2->data->llb[j]) * (C1->data->uub[j] - C2->data->llb[j]) > 0 && + (C2->data->llb[j] - C1->data->llb[j]) * (C2->data->uub[j] - C1->data->llb[j]) > 0) + flag = false; + for (int j = i + 1; j < dim; j++) + if ((C1->data->llb[j] - C2->data->llb[j]) * (C1->data->uub[j] - C2->data->llb[j]) > 0 && + (C2->data->llb[j] - C1->data->llb[j]) * (C2->data->uub[j] - C1->data->llb[j]) > 0) + flag = false; + + if (flag) + { + // only add one ghost region + if (feq(A1->data->uub[i], C1->data->uub[i], DH[i])) + { + A1->data->uub[i] += ghost_width * 2 * DH[i]; + A1->data->shape[i] += ghost_width; + } + if (feq(A2->data->llb[i], C2->data->llb[i], DH[i])) + { + A2->data->llb[i] -= ghost_width * 2 * DH[i]; + A2->data->shape[i] += ghost_width; + } + } + } + } + C2 = C2->next; + A2 = A2->next; + } + C1 = C1->next; + A1 = A1->next; + } + + if (dc) + dc->destroyList(); +} +// According to overlap to cut the gsl into recular pices +void Parallel::cut_gsl(MyList *&A) +{ + if (!A) + return; + + MyList *B, *C, *D = A; + bool flag = false; + while (D->next) + { + B = D->next; + while (B) + { + flag = cut_gs(D, B, C); + if (flag) + break; + B = B->next; + } + if (flag) + break; + D = D->next; + } + + if (flag) + { + // delete D and B from A + MyList *E = A; + while (E->next) + { + MyList *tp = E->next; + if (D == tp || B == tp) + { + E->next = (tp->next) ? tp->next : 0; + delete tp->data; + delete tp; + } + if (E->next) + E = E->next; + } + + if (D == A) + { + MyList *tp = A; + A = (A->next) ? A->next : 0; + delete tp->data; + delete tp; + } + // cat C to A + if (A) + A->catList(C); + else + A = C; + + cut_gsl(A); + } +} +// when D and B have overlap, cut them into C and return true +// otherwise return false and C=0 +bool Parallel::cut_gs(MyList *D, MyList *B, MyList *&C) +{ + C = 0; + double llb[dim], uub[dim], DH[dim]; + for (int i = 0; i < dim; i++) + { + double tdh; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH[i] = (D->data->uub[i] - D->data->llb[i]) / (D->data->shape[i] - 1); + tdh = (B->data->uub[i] - B->data->llb[i]) / (B->data->shape[i] - 1); +#else +#ifdef Cell + DH[i] = (D->data->uub[i] - D->data->llb[i]) / D->data->shape[i]; + tdh = (B->data->uub[i] - B->data->llb[i]) / B->data->shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (!feq(DH[i], tdh, DH[i] / 2)) + { + cout << "Parallel::cut_gs meets different grid segment " << DH[i] << " vs " << tdh << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + llb[i] = Mymax(D->data->llb[i], B->data->llb[i]); + uub[i] = Mymin(D->data->uub[i], B->data->uub[i]); + // for efficiency we ask the width of the patch at least 2(buffer+ghost+BD ghost) + if (uub[i] - llb[i] < DH[i] * 2 * (buffer_width + 2 * ghost_width)) + return false; // here this is valid for both vertex and cell + } + + // this part code results in 5 patches generally + + C = new MyList; + C->data = new gridseg; + for (int i = 0; i < dim; i++) + { + C->data->llb[i] = llb[i]; + C->data->uub[i] = uub[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / DH[i] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[i] = int((C->data->uub[i] - C->data->llb[i]) / DH[i] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + if (D->data->Bg == B->data->Bg) + C->data->Bg = D->data->Bg; + else + C->data->Bg = 0; + + C->next = gs_subtract_virtual(D, C); + + MyList *E = C; + + while (E->next) + E = E->next; + + E->next = gs_subtract_virtual(B, C); + + // this part code results in 3 patches generally + /* + C = clone_gsl(D,true); + C->next = gs_subtract_virtual(B,C); + */ + + return true; +} +// note here it is different to real cut, we need leave the cutting edge for both vertex center and cell center +MyList *Parallel::gs_subtract_virtual(MyList *A, MyList *B) +{ + if (!A) + return 0; + if (!B) + return clone_gsl(A, true); + + double cut_plane[2 * dim], DH[dim]; + + for (int i = 0; i < dim; i++) + { + double tdh; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH[i] = (A->data->uub[i] - A->data->llb[i]) / (A->data->shape[i] - 1); + tdh = (B->data->uub[i] - B->data->llb[i]) / (B->data->shape[i] - 1); +#else +#ifdef Cell + DH[i] = (A->data->uub[i] - A->data->llb[i]) / A->data->shape[i]; + tdh = (B->data->uub[i] - B->data->llb[i]) / B->data->shape[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (!feq(DH[i], tdh, DH[i] / 2)) + { + cout << "Parallel::gs_subtract_virtual meets different grid segment " << DH[i] << " vs " << tdh << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *C = 0, *q; + for (int i = 0; i < dim; i++) + { + if (B->data->llb[i] > A->data->uub[i] || B->data->uub[i] < A->data->llb[i]) + return clone_gsl(A, true); + cut_plane[i] = A->data->llb[i]; + cut_plane[i + dim] = A->data->uub[i]; + } + + for (int i = 0; i < dim; i++) + { + cut_plane[i] = Mymax(A->data->llb[i], B->data->llb[i]); + if (cut_plane[i] > A->data->llb[i]) + { + q = clone_gsl(A, true); + // prolong the list from head + if (C) + q->next = C; + C = q; + for (int j = 0; j < dim; j++) + { + if (i == j) + { + C->data->llb[i] = A->data->llb[i]; + // **note here it is different to real cut, we need leave the cutting edge for both vertex center and cell center** + C->data->uub[i] = Mymax(C->data->llb[i], cut_plane[i]); + } + else + { + C->data->llb[j] = cut_plane[j]; + C->data->uub[j] = cut_plane[j + dim]; + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + + cut_plane[i + dim] = Mymin(A->data->uub[i], B->data->uub[i]); + if (cut_plane[i + dim] < A->data->uub[i]) + { + q = clone_gsl(A, true); + if (C) + q->next = C; + C = q; + for (int j = 0; j < dim; j++) + { + if (i == j) + { + C->data->uub[i] = A->data->uub[i]; + // note here it is different to real cut, we need leave the cutting edge for both vertex center and cell center + C->data->llb[i] = Mymin(C->data->uub[i], cut_plane[i + dim]); + } + else + { + C->data->llb[j] = cut_plane[j]; + C->data->uub[j] = cut_plane[j + dim]; + } +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4) + 1; +#else +#ifdef Cell + C->data->shape[j] = int((C->data->uub[j] - C->data->llb[j]) / DH[j] + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + } + } + return C; +} +// note the data structure +// if CC is true +// 1 ----------- 1 ------ ^ +// 0 ------ | t +// 0 ----------- old ------ | +// +// old ----------- +// if CC is false +// 1 ----------- 1 ------ ^ +// 0 ----------- 0 ------ | t +// old ----------- old ------ | +void Parallel::fill_level_data(MyList *PatLd, MyList *PatLs, MyList *PatcL, + MyList *OldList, MyList *StateList, MyList *FutureList, + MyList *tmList, int Symmetry, bool BB, bool CC) +{ + if (PatLd->data->lev != PatLs->data->lev) + { + cout << "Parallel::fill_level_data: meet requst from lev#" << PatLs->data->lev << " to lev#" << PatLd->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (PatLd->data->lev <= PatcL->data->lev) + { + cout << "Parallel::fill_level_data: meet prolong requst from lev#" << PatcL->data->lev << " to lev#" << PatLd->data->lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *VarList = 0; + MyList *p; + p = StateList; + while (p) + { + if (VarList) + VarList->insert(p->data); + else + VarList = new MyList(p->data); + p = p->next; + } + p = FutureList; + while (p) + { + if (VarList) + VarList->insert(p->data); + else + VarList = new MyList(p->data); + p = p->next; + } + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_complete_gsl(PatLd); // including ghost + // copy part + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatLs, node, 0, Symmetry); // similar to Sync + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + MyList *dsts, *dstd; + dsts = build_complete_gsl_virtual(PatLs); + dstd = dst; + dst = gsl_subtract(dstd, dsts); + if (dstd) + dstd->destroyList(); + if (dsts) + dsts->destroyList(); + + if (dst) + { + // prolongation part + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl(PatcL, node, 4, Symmetry); // - buffer - ghost - BD ghost + build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + if (CC) + { + // for FutureList + // restrict first~~~> + { + Restrict(PatcL, PatLs, FutureList, FutureList, Symmetry); + Sync(PatcL, FutureList, Symmetry); + } + //<~~~prolong then + transfer(transfer_src, transfer_dst, FutureList, FutureList, Symmetry); + + // for StateList + // time interpolation part + if (BB) + prepare_inter_time_level(PatcL, FutureList, StateList, OldList, + tmList, 0); // use SynchList_pre as temporal storage space + else + prepare_inter_time_level(PatcL, FutureList, StateList, + tmList, 0); // use SynchList_pre as temporal storage space + // restrict first~~~> + { + Restrict(PatcL, PatLs, StateList, tmList, Symmetry); + Sync(PatcL, tmList, Symmetry); + } + //<~~~prolong then + transfer(transfer_src, transfer_dst, tmList, StateList, Symmetry); + } + else + { + // for both FutureList and StateList + // restrict first~~~> + { + Restrict(PatcL, PatLs, VarList, VarList, Symmetry); + Sync(PatcL, VarList, Symmetry); + } + //<~~~prolong then + transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + } + + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + dst->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; + + VarList->clearList(); +} +void Parallel::KillBlocks(MyList *PatchLIST) +{ + while (PatchLIST) + { + Patch *Pp = PatchLIST->data; + MyList *bg; + while (Pp->blb) + { + if (Pp->blb == Pp->ble) + break; + bg = (Pp->blb->next) ? Pp->blb->next : 0; + delete Pp->blb->data; + delete Pp->blb; + Pp->blb = bg; + } + if (Pp->ble) + { + delete Pp->ble->data; + delete Pp->ble; + } + Pp->blb = Pp->ble = 0; + PatchLIST = PatchLIST->next; + } +} +bool Parallel::PatList_Interp_Points(MyList *PatL, MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double lld[dim], uud[dim]; + double **pox; + pox = new double *[dim]; + for (int j = 0; j < dim; j++) + pox[j] = new double[1]; + for (int i = 0; i < NN; i++) + { + MyList *PL = PatL; + while (PL) + { + bool flag = true; + for (int j = 0; j < dim; j++) + { + double h = PL->data->getdX(j); + lld[j] = PL->data->lli[j] * h; + uud[j] = PL->data->uui[j] * h; + if (XX[j][i] < PL->data->bbox[j] + lld[j] || XX[j][i] > PL->data->bbox[j + dim] - uud[j]) + { + flag = false; + break; + } + pox[j][0] = XX[j][i]; + } + if (flag) + { + PL->data->Interp_Points(VarList, 1, pox, Shellf + i * num_var, Symmetry); + break; + } + PL = PL->next; + } + if (!PL) + { + checkpatchlist(PatL, false); + return false; + } + } + for (int j = 0; j < dim; j++) + delete[] pox[j]; + delete[] pox; + + return true; +} +bool Parallel::PatList_Interp_Points(MyList *PatL, MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double lld[dim], uud[dim]; + double **pox; + pox = new double *[dim]; + for (int j = 0; j < dim; j++) + pox[j] = new double[1]; + for (int i = 0; i < NN; i++) + { + MyList *PL = PatL; + while (PL) + { + bool flag = true; + for (int j = 0; j < dim; j++) + { + double h = PL->data->getdX(j); + lld[j] = PL->data->lli[j] * h; + uud[j] = PL->data->uui[j] * h; + if (XX[j][i] < PL->data->bbox[j] + lld[j] || XX[j][i] > PL->data->bbox[j + dim] - uud[j]) + { + flag = false; + break; + } + pox[j][0] = XX[j][i]; + } + if (flag) + { + PL->data->Interp_Points(VarList, 1, pox, Shellf + i * num_var, Symmetry, Comm_here); + break; + } + PL = PL->next; + } + if (!PL) + { + checkpatchlist(PatL, false); + return false; + } + } + for (int j = 0; j < dim; j++) + delete[] pox[j]; + delete[] pox; + + return true; +} +void Parallel::aligncheck(double *bbox0, double *bboxl, int lev, double *DH0, int *shape) +{ + const double aligntiny = 0.1; + double DHl, rr; + int NN; + for (int i = 0; i < dim; i++) + { + DHl = DH0[i] * pow(0.5, lev); + rr = bboxl[i] - bbox0[i]; + bboxl[i] = bbox0[i] + int(rr / DHl + 0.4) * DHl; + rr = bbox0[i + dim] - bboxl[i + dim]; + bboxl[i + dim] = bbox0[i + dim] - int(rr / DHl + 0.4) * DHl; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + NN = int((bboxl[i + dim] - bboxl[i]) / DHl + 0.4) + 1; +#else +#ifdef Cell + NN = int((bboxl[i + dim] - bboxl[i]) / DHl + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + if (NN != shape[i]) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << "Parallel::aligncheck want shape " << NN << " for lev#" << lev << ", but " << shape[i] << endl; + cout << "i = " << i << ", low = " << bboxl[i] << ", up = " << bboxl[i + dim] << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } +} +bool Parallel::point_locat_gsl(double *pox, MyList *gsl) +{ + bool flag = false; + while (gsl) + { + for (int i = 0; i < dim; i++) + { + if (pox[i] > gsl->data->llb[i] && pox[i] < gsl->data->uub[i]) + flag = true; + else + { + flag = false; + break; + } + } + if (flag) + break; + gsl = gsl->next; + } + + return flag; +} +void Parallel::checkpatchlist(MyList *PatL, bool buflog) +{ + MyList *PL = PatL; + while (PL) + { + PL->data->checkPatch(buflog); + PL = PL->next; + } +} diff --git a/AMSS_NCKU_source/Parallel.h b/AMSS_NCKU_source/Parallel.h new file mode 100644 index 0000000..12fc356 --- /dev/null +++ b/AMSS_NCKU_source/Parallel.h @@ -0,0 +1,167 @@ + +#ifndef PARALLEL_H +#define PARALLEL_H + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "Parallel_bam.h" +#include "var.h" +#include "MPatch.h" +#include "Block.h" +#include "MyList.h" +#include "macrodef.h" //need dim; ghost_width; CONTRACT +namespace Parallel +{ + struct gridseg + { + double llb[dim]; + double uub[dim]; + int shape[dim]; + double illb[dim], iuub[dim]; // only use for OutBdLow2Hi + Block *Bg; + }; + int partition1(int &nx, int split_size, int min_width, int cpusize, int shape); // special for 1 diemnsion + int partition2(int *nxy, int split_size, int *min_width, int cpusize, int *shape); // special for 2 diemnsions + int partition3(int *nxyz, int split_size, int *min_width, int cpusize, int *shape); + MyList *distribute(MyList *PatchLIST, int cpusize, int ingfsi, int fngfs, bool periodic, int nodes = 0); // produce corresponding Blocks + void KillBlocks(MyList *PatchLIST); + + void setfunction(MyList *BlL, var *vn, double func(double x, double y, double z)); + void setfunction(int rank, MyList *BlL, var *vn, double func(double x, double y, double z)); + void writefile(double time, int nx, int ny, int nz, double xmin, double xmax, double ymin, double ymax, + double zmin, double zmax, char *filename, double *data_out); + void writefile(double time, int nx, int ny, double xmin, double xmax, double ymin, double ymax, + char *filename, double *datain); + void getarrayindex(int DIM, int *shape, int *index, int n); + int getarraylocation(int DIM, int *shape, int *index); + void copy(int DIM, double *llbout, double *uubout, int *Dshape, double *DD, double *llbin, double *uubin, + int *shape, double *datain, double *llb, double *uub); + void Dump_CPU_Data(MyList *BlL, MyList *DumpList, char *tag, double time, double dT); + void Dump_Data(MyList *PL, MyList *DumpList, char *tag, double time, double dT); + void Dump_Data(Patch *PP, MyList *DumpList, char *tag, double time, double dT, int grd); + double *Collect_Data(Patch *PP, var *VP); + void d2Dump_Data(MyList *PL, MyList *DumpList, char *tag, double time, double dT); + void d2Dump_Data(Patch *PP, MyList *DumpList, char *tag, double time, double dT, int grd); + void Dump_Data0(Patch *PP, MyList *DumpList, char *tag, double time, double dT); + double global_interp(int DIM, int *ext, double **CoX, double *datain, + double *poX, int ordn, double *SoA, int Symmetry); + double global_interp(int DIM, int *ext, double **CoX, double *datain, + double *poX, int ordn); + double Lagrangian_Int(double x, int npts, double *xpts, double *funcvals); + double LagrangePoly(double x, int pt, int npts, double *xpts); + MyList *build_complete_gsl(Patch *Pat); + MyList *build_complete_gsl(MyList *PatL); + MyList *build_complete_gsl_virtual(MyList *PatL); + MyList *build_complete_gsl_virtual2(MyList *PatL); // - buffer + MyList *build_owned_gsl0(Patch *Pat, int rank_in); // - ghost without extension, special for Sync usage + MyList *build_owned_gsl1(Patch *Pat, int rank_in); // - ghost, similar to build_owned_gsl0 but extend one point on left side for vertex grid + MyList *build_owned_gsl2(Patch *Pat, int rank_in); // - buffer - ghost + MyList *build_owned_gsl3(Patch *Pat, int rank_in, int Symmetry); // - ghost - BD ghost + MyList *build_owned_gsl4(Patch *Pat, int rank_in, int Symmetry); // - buffer - ghost - BD ghost + MyList *build_owned_gsl5(Patch *Pat, int rank_in); // similar to build_owned_gsl2 but no extension + MyList *build_owned_gsl(MyList *PatL, int rank_in, int type, int Symmetry); + void build_gstl(MyList *srci, MyList *dsti, MyList **out_src, MyList **out_dst); + int data_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists, MyList *VarListd, int Symmetry); + void transfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry); + int data_packermix(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists, MyList *VarListd, int Symmetry); + void transfermix(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry); + void Sync(Patch *Pat, MyList *VarList, int Symmetry); + void Sync(MyList *PatL, MyList *VarList, int Symmetry); + void OutBdLow2Hi(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void OutBdLow2Hi(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void OutBdLow2Himix(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void OutBdLow2Himix(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void Prolong(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void Prolongint(Patch *Patc, Patch *Patf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void Restrict(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void Restrict_after(MyList *PatcL, MyList *PatfL, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); // for -ghost - BDghost + MyList *build_PhysBD_gsl(Patch *Pat); + MyList *build_ghost_gsl(MyList *PatL); + MyList *build_ghost_gsl(Patch *Pat); + MyList *build_buffer_gsl(Patch *Pat); + MyList *build_buffer_gsl(MyList *PatL); + MyList *gsl_subtract(MyList *A, MyList *B); + MyList *gs_subtract(MyList *A, MyList *B); + MyList *gsl_and(MyList *A, MyList *B); + MyList *gs_and(MyList *A, MyList *B); + MyList *clone_gsl(MyList *p, bool first_only); + MyList *build_bulk_gsl(Patch *Pat); // similar to build_owned_gsl0 but does not care rank issue + MyList *build_bulk_gsl(Block *bp, Patch *Pat); + void build_PhysBD_gstl(Patch *Pat, MyList *srci, MyList *dsti, + MyList **out_src, MyList **out_dst); + void PeriodicBD(Patch *Pat, MyList *VarList, int Symmetry); + double L2Norm(Patch *Pat, var *vf); + void checkgsl(MyList *pp, bool first_only); + void checkvarl(MyList *pp, bool first_only); + MyList *divide_gsl(MyList *p, Patch *Pat); + MyList *divide_gs(MyList *p, Patch *Pat); + void prepare_inter_time_level(Patch *Pat, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* target (t+a*dt) */, int tindex); + void prepare_inter_time_level(Patch *Pat, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* source (t-dt) */, MyList *VarList4 /* target (t+a*dt) */, int tindex); + void prepare_inter_time_level(MyList *PatL, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* target (t+a*dt) */, int tindex); + void prepare_inter_time_level(MyList *Pat, + MyList *VarList1 /* source (t+dt) */, MyList *VarList2 /* source (t) */, + MyList *VarList3 /* source (t-dt) */, MyList *VarList4 /* target (t+a*dt) */, int tindex); + void merge_gsl(MyList *&A, const double ratio); + bool merge_gs(MyList *D, MyList *B, MyList *&C, const double ratio); + // Add ghost region to tangent plane + // we assume the grids have the same resolution + void add_ghost_touch(MyList *&A); + void cut_gsl(MyList *&A); + bool cut_gs(MyList *D, MyList *B, MyList *&C); + MyList *gs_subtract_virtual(MyList *A, MyList *B); + void fill_level_data(MyList *PatLd, MyList *PatLs, MyList *PatcL, + MyList *OldList, MyList *StateList, MyList *FutureList, + MyList *tmList, int Symmetry, bool BB, bool CC); + bool PatList_Interp_Points(MyList *PatL, MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry); + void aligncheck(double *bbox0, double *bboxl, int lev, double *DH0, int *shape); + bool point_locat_gsl(double *pox, MyList *gsl); + void checkpatchlist(MyList *PatL, bool buflog); + + double L2Norm(Patch *Pat, var *vf, MPI_Comm Comm_here); + bool PatList_Interp_Points(MyList *PatL, MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetry, MPI_Comm Comm_here); +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + MyList *distribute(MyList *PatchLIST, int cpusize, int ingfsi, int fngfsi, + bool periodic, int start_rank, int end_rank, int nodes = 0); +#endif +} +#endif /*PARALLEL_H */ diff --git a/AMSS_NCKU_source/Parallel_bam.C b/AMSS_NCKU_source/Parallel_bam.C new file mode 100644 index 0000000..d0afa9a --- /dev/null +++ b/AMSS_NCKU_source/Parallel_bam.C @@ -0,0 +1,662 @@ + +#include "Parallel.h" +#include "fmisc.h" +#include "prolongrestrict.h" +#include "misc.h" + +void Parallel::OutBdLow2Hi_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + MyList *bdsul; + Constr_pointstr_OutBdLow2Hi(PLf, PLc, bdsul); + + intertransfer(bdsul, VarList1, VarList2, Symmetry); + + destroypsuList_bam(bdsul); +} +void Parallel::Restrict_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry) +{ + MyList *rsul; + Constr_pointstr_Restrict(PLf, PLc, rsul); + + intertransfer(rsul, VarList1, VarList2, Symmetry); + + destroypsuList_bam(rsul); +} +void Parallel::OutBdLow2Hi_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + MyList *bdsul, int Symmetry) +{ + intertransfer(bdsul, VarList1, VarList2, Symmetry); +} +void Parallel::Restrict_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + MyList *rsul, int Symmetry) +{ + intertransfer(rsul, VarList1, VarList2, Symmetry); +} +void Parallel::Constr_pointstr_OutBdLow2Hi(MyList *PLf, MyList *PLc, + MyList *&bdsul) +{ + MyList *PL; + + MyList *ps; + bdsul = 0; + + // find out points + PL = PLf; + while (PL) + { + double dx, dy, dz; + + dx = PL->data->blb->data->getdX(0); + dy = PL->data->blb->data->getdX(1); + dz = PL->data->blb->data->getdX(2); + + double uub[3], llb[3]; + + llb[0] = PL->data->bbox[0] + PL->data->lli[0] * dx; + llb[1] = PL->data->bbox[1] + PL->data->lli[1] * dy; + llb[2] = PL->data->bbox[2] + PL->data->lli[2] * dz; + uub[0] = PL->data->bbox[3] - PL->data->uui[0] * dx; + uub[1] = PL->data->bbox[4] - PL->data->uui[1] * dy; + uub[2] = PL->data->bbox[5] - PL->data->uui[2] * dz; + + double x, y, z; + + for (int i = 0; i < PL->data->shape[0]; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = PL->data->bbox[0] + i * dx; +#else +#ifdef Cell + x = PL->data->bbox[0] + (0.5 + i) * dx; +#else +#error Not define Vertex nor Cell +#endif +#endif + for (int j = 0; j < PL->data->shape[1]; j++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y = PL->data->bbox[1] + j * dy; +#else +#ifdef Cell + y = PL->data->bbox[1] + (0.5 + j) * dy; +#else +#error Not define Vertex nor Cell +#endif +#endif + for (int k = 0; k < PL->data->shape[2]; k++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + z = PL->data->bbox[2] + k * dz; +#else +#ifdef Cell + z = PL->data->bbox[2] + (0.5 + k) * dz; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (!(llb[0] - TINY < x && uub[0] + TINY > x && + llb[1] - TINY < y && uub[1] + TINY > y && + llb[2] - TINY < z && uub[2] + TINY > z)) // not in the inner part + { + if (bdsul) + { + ps->next = new MyList; + ps = ps->next; + ps->data = new Parallel::pointstru_bam; + } + else + { + bdsul = ps = new MyList; + ps->data = new Parallel::pointstru_bam; + } + + ps->data->pox[0] = x; + ps->data->pox[1] = y; + ps->data->pox[2] = z; + ps->data->Bgs = 0; + ps->data->Bgd = 0; + ps->data->coef = 0; + + ps->next = 0; + } + } + } + } + + PL = PL->next; + } + + // find out blocks + ps = bdsul; + while (ps) + { + double x, y, z; + x = ps->data->pox[0]; + y = ps->data->pox[1]; + z = ps->data->pox[2]; + bool flag; + // find target block + flag = true; + PL = PLf; + while (flag && PL) + { + MyList *BP = PL->data->blb; + while (flag && BP) + { + double llb[3], uub[3]; + + for (int i = 0; i < dim; i++) + { + double DH = BP->data->getdX(i); + uub[i] = (feq(BP->data->bbox[dim + i], PL->data->bbox[dim + i], DH / 2)) ? BP->data->bbox[dim + i] : BP->data->bbox[dim + i] - ghost_width * DH; + llb[i] = (feq(BP->data->bbox[i], PL->data->bbox[i], DH / 2)) ? BP->data->bbox[i] : BP->data->bbox[i] + ghost_width * DH; + } + + if (llb[0] - TINY < x && uub[0] + TINY > x && + llb[1] - TINY < y && uub[1] + TINY > y && + llb[2] - TINY < z && uub[2] + TINY > z) + { + ps->data->Bgd = BP->data; + flag = false; + } + + if (BP == PL->data->ble) + break; + BP = BP->next; + } + PL = PL->next; + } + if (flag) + { + cout << "error in Parallel::Constr_pointstr_OutBdLow2Hi 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + // find source block + flag = true; + PL = PLc; + while (flag && PL) + { + MyList *BP = PL->data->blb; + while (flag && BP) + { + double llb[3], uub[3]; + + for (int i = 0; i < dim; i++) + { + double DH = BP->data->getdX(i); + uub[i] = (feq(BP->data->bbox[dim + i], PL->data->bbox[dim + i], DH / 2)) ? BP->data->bbox[dim + i] : BP->data->bbox[dim + i] - ghost_width * DH; + llb[i] = (feq(BP->data->bbox[i], PL->data->bbox[i], DH / 2)) ? BP->data->bbox[i] : BP->data->bbox[i] + ghost_width * DH; + } + + if (llb[0] - TINY < x && uub[0] + TINY > x && + llb[1] - TINY < y && uub[1] + TINY > y && + llb[2] - TINY < z && uub[2] + TINY > z) + { + ps->data->Bgs = BP->data; + flag = false; + } + + if (BP == PL->data->ble) + break; + BP = BP->next; + } + PL = PL->next; + } + if (flag) + { + cout << "error in Parallel::Constr_pointstr_OutBdLow2Hi 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + ps = ps->next; + } +} +void Parallel::Constr_pointstr_Restrict(MyList *PLf, MyList *PLc, + MyList *&rsul) +{ + MyList *gdlf = 0, *gs; + MyList *PL = PLf; + while (PL) + { + if (gdlf) + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + else + { + gdlf = gs = new MyList; + gs->data = new Parallel::gridseg; + } + + gs->next = 0; + + for (int i = 0; i < dim; i++) + { + double DH = PL->data->blb->data->getdX(i); + + gs->data->llb[i] = PL->data->bbox[i] + PL->data->lli[i] * DH; + gs->data->uub[i] = PL->data->bbox[dim + i] - PL->data->uui[i] * DH; + } + + PL = PL->next; + } + + MyList *ps; + rsul = 0; + + // find out points + gs = gdlf; + while (gs) + { + PL = PLc; + bool flag = true; + while (flag) + { + if (!PL) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << "error in Parallel::Constr_pointstr_Restrict: fail to find grid segment [" << gs->data->llb[0] << ":" << gs->data->uub[0] << "," + << gs->data->llb[1] << ":" << gs->data->uub[1] << "," + << gs->data->llb[2] << ":" << gs->data->uub[2] << "]" + << endl; + PL = PLc; + while (PL) + { + PL->data->checkPatch(0); + PL = PL->next; + } + } + + misc::tillherecheck("for wait."); + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (gs->data->llb[0] > PL->data->bbox[0] - TINY && gs->data->uub[0] < PL->data->bbox[3] + TINY && + gs->data->llb[1] > PL->data->bbox[1] - TINY && gs->data->uub[1] < PL->data->bbox[4] + TINY && + gs->data->llb[2] > PL->data->bbox[2] - TINY && gs->data->uub[2] < PL->data->bbox[5] + TINY) + flag = false; + + if (flag) + PL = PL->next; + } + + double dx, dy, dz; + + dx = PL->data->blb->data->getdX(0); + dy = PL->data->blb->data->getdX(1); + dz = PL->data->blb->data->getdX(2); + + double x, y, z; + + for (int i = 0; i < PL->data->shape[0]; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = PL->data->bbox[0] + i * dx; +#else +#ifdef Cell + x = PL->data->bbox[0] + (0.5 + i) * dx; +#else +#error Not define Vertex nor Cell +#endif +#endif + for (int j = 0; j < PL->data->shape[1]; j++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y = PL->data->bbox[1] + j * dy; +#else +#ifdef Cell + y = PL->data->bbox[1] + (0.5 + j) * dy; +#else +#error Not define Vertex nor Cell +#endif +#endif + for (int k = 0; k < PL->data->shape[2]; k++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + z = PL->data->bbox[2] + k * dz; +#else +#ifdef Cell + z = PL->data->bbox[2] + (0.5 + k) * dz; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (gs->data->llb[0] - TINY < x && gs->data->uub[0] + TINY > x && + gs->data->llb[1] - TINY < y && gs->data->uub[1] + TINY > y && + gs->data->llb[2] - TINY < z && gs->data->uub[2] + TINY > z) // in the inner part + { + if (rsul) + { + ps->next = new MyList; + ps = ps->next; + ps->data = new Parallel::pointstru_bam; + } + else + { + rsul = ps = new MyList; + ps->data = new Parallel::pointstru_bam; + } + + ps->data->pox[0] = x; + ps->data->pox[1] = y; + ps->data->pox[2] = z; + ps->data->Bgs = 0; + ps->data->Bgd = 0; + ps->data->coef = 0; + + ps->next = 0; + } + } + } + } + + gs = gs->next; + } + + gdlf->destroyList(); + + // find out blocks + ps = rsul; + while (ps) + { + double x, y, z; + x = ps->data->pox[0]; + y = ps->data->pox[1]; + z = ps->data->pox[2]; + bool flag; + // find source block + flag = true; + PL = PLf; + while (flag && PL) + { + MyList *BP = PL->data->blb; + while (flag && BP) + { + double llb[3], uub[3]; + + for (int i = 0; i < dim; i++) + { + double DH = BP->data->getdX(i); + uub[i] = (feq(BP->data->bbox[dim + i], PL->data->bbox[dim + i], DH / 2)) ? BP->data->bbox[dim + i] : BP->data->bbox[dim + i] - ghost_width * DH; + llb[i] = (feq(BP->data->bbox[i], PL->data->bbox[i], DH / 2)) ? BP->data->bbox[i] : BP->data->bbox[i] + ghost_width * DH; + } + + if (llb[0] - TINY < x && uub[0] + TINY > x && + llb[1] - TINY < y && uub[1] + TINY > y && + llb[2] - TINY < z && uub[2] + TINY > z) + { + ps->data->Bgs = BP->data; + flag = false; + } + + if (BP == PL->data->ble) + break; + BP = BP->next; + } + PL = PL->next; + } + if (flag) + { + cout << "error in Parallel::Constr_pointstr_Restrict 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + // find target block + flag = true; + PL = PLc; + while (flag && PL) + { + MyList *BP = PL->data->blb; + while (flag && BP) + { + double llb[3], uub[3]; + + for (int i = 0; i < dim; i++) + { + double DH = BP->data->getdX(i); + uub[i] = (feq(BP->data->bbox[dim + i], PL->data->bbox[dim + i], DH / 2)) ? BP->data->bbox[dim + i] : BP->data->bbox[dim + i] - ghost_width * DH; + llb[i] = (feq(BP->data->bbox[i], PL->data->bbox[i], DH / 2)) ? BP->data->bbox[i] : BP->data->bbox[i] + ghost_width * DH; + } + + if (llb[0] - TINY < x && uub[0] + TINY > x && + llb[1] - TINY < y && uub[1] + TINY > y && + llb[2] - TINY < z && uub[2] + TINY > z) + { + ps->data->Bgd = BP->data; + flag = false; + } + + if (BP == PL->data->ble) + break; + BP = BP->next; + } + PL = PL->next; + } + if (flag) + { + cout << "error in Parallel::Constr_pointstr_Restrict 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + ps = ps->next; + } +} + +void Parallel::intertransfer(MyList *&sul, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + // myrank: local; node : remote + if (length = interdata_packer(0, sul, myrank, node, PACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "Parallel::intertransfer: out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(rec_data[node], sul, myrank, node, PACK, VarList1, VarList2, Symmetry); + } + } + else + { + // send from this cpu to cpu#node + if (length = interdata_packer(0, sul, myrank, node, PACK, VarList1, VarList2, Symmetry)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "Parallel::intertransfer: out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(send_data[node], sul, myrank, node, PACK, VarList1, VarList2, Symmetry); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = interdata_packer(0, sul, myrank, node, UNPACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "Parallel::intertransfer: out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + interdata_packer(rec_data[node], sul, myrank, node, UNPACK, VarList1, VarList2, Symmetry); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +// PACK: prepare target data in 'data' +// UNPACK: copy target data from 'data' to corresponding numerical grids +int Parallel::interdata_packer(double *data, MyList *sul, int myrank, int node, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry) +{ + int DIM = dim; + int ordn = 2 * ghost_width; + + if (dir != PACK && dir != UNPACK) + { + cout << "Parallel::interdata_packer: error dir " << dir << " for data_packer " << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (sul) + { + if ((dir == PACK && sul->data->Bgs->rank == myrank && sul->data->Bgd->rank == node) || + (dir == UNPACK && sul->data->Bgd->rank == myrank && sul->data->Bgs->rank == node)) + { + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + { + // f_global_interp(sul->data->Bgs->shape,sul->data->Bgs->X[0],sul->data->Bgs->X[1],sul->data->Bgs->X[2], + // sul->data->Bgs->fgfs[varls->data->sgfn],data[size_out], + // sul->data->pox[0],sul->data->pox[1],sul->data->pox[2],ordn,varls->data->SoA,Symmetry); + if (sul->data->coef == 0) + { + sul->data->coef = new double[ordn * dim]; + for (int i = 0; i < dim; i++) + { + double dd = sul->data->Bgs->getdX(i); + sul->data->sind[i] = int((sul->data->pox[i] - sul->data->Bgs->X[i][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = sul->data->Bgs->X[i][0] + (sul->data->sind[i] + j) * dd; + sul->data->coef[i * ordn + j] = 1; + for (int k = 0; k < j; k++) + { + h2 = sul->data->Bgs->X[i][0] + (sul->data->sind[i] + k) * dd; + sul->data->coef[i * ordn + j] *= (sul->data->pox[i] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = sul->data->Bgs->X[i][0] + (sul->data->sind[i] + k) * dd; + sul->data->coef[i * ordn + j] *= (sul->data->pox[i] - h2) / (h1 - h2); + } + } + } + } + int sst = -1; + f_global_interpind(sul->data->Bgs->shape, sul->data->Bgs->X[0], sul->data->Bgs->X[1], sul->data->Bgs->X[2], + sul->data->Bgs->fgfs[varls->data->sgfn], data[size_out], + sul->data->pox[0], sul->data->pox[1], sul->data->pox[2], ordn, varls->data->SoA, Symmetry, + sul->data->sind, sul->data->coef, sst); + } + if (dir == UNPACK) // from target data to corresponding grid + f_pointcopy(DIM, sul->data->Bgd->bbox, sul->data->Bgd->bbox + dim, sul->data->Bgd->shape, sul->data->Bgd->fgfs[varld->data->sgfn], + sul->data->pox[0], sul->data->pox[1], sul->data->pox[2], data[size_out]); + } + size_out += 1; + varls = varls->next; + varld = varld->next; + } + } + sul = sul->next; + } + + return size_out; +} +void Parallel::destroypsuList_bam(MyList *ct) +{ + MyList *n; + while (ct) + { + n = ct->next; + if (ct->data->coef) + delete[] ct->data->coef; + delete ct->data; + delete ct; + ct = n; + } +} diff --git a/AMSS_NCKU_source/Parallel_bam.h b/AMSS_NCKU_source/Parallel_bam.h new file mode 100644 index 0000000..0916b16 --- /dev/null +++ b/AMSS_NCKU_source/Parallel_bam.h @@ -0,0 +1,53 @@ + +#ifndef PARALLEL_BAM_H +#define PARALLEL_BAM_H + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "var.h" +#include "MPatch.h" +#include "Block.h" +#include "MyList.h" +#include "macrodef.h" +namespace Parallel +{ + struct pointstru_bam + { + double pox[dim]; // cordinate + Block *Bgs; // interplate from + Block *Bgd; // interplate for + double *coef; // interpolation coefficients + int sind[dim]; // interpolation starting array index + }; + void destroypsuList_bam(MyList *ct); + void OutBdLow2Hi_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void OutBdLow2Hi_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + MyList *bdsul, int Symmetry); + void Constr_pointstr_OutBdLow2Hi(MyList *PLf, MyList *PLc, + MyList *&bdsul); + void Restrict_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + int Symmetry); + void Restrict_bam(MyList *PLc, MyList *PLf, + MyList *VarList1 /* source */, MyList *VarList2 /* target */, + MyList *rsul, int Symmetry); + void Constr_pointstr_Restrict(MyList *PLf, MyList *PLc, + MyList *&rsul); + void intertransfer(MyList *&sul, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry); + int interdata_packer(double *data, MyList *sul, int myrank, int node, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry); +} +#endif /*PARALLEL_BAM_H */ diff --git a/AMSS_NCKU_source/Set_Rho_ADM.f90 b/AMSS_NCKU_source/Set_Rho_ADM.f90 new file mode 100644 index 0000000..4e486bf --- /dev/null +++ b/AMSS_NCKU_source/Set_Rho_ADM.f90 @@ -0,0 +1,271 @@ + +! define scalar field distribution and potential in F(R) scalar-tensor theory +! 1: Case C of 1112.3928, V=0 +! 2: shell with a2^2*phi0/(1+a2^2), f(R) = R+a2*R^2 induced V +! 3: ground state of Schrodinger-Newton system, f(R) = R+a2*R^2 induced V +! 4: a2 = oo and \phi = \phi_0*0.5*(tanh((r+r_0)/\sigma)-tanh((r-r_0)/\sigma)) +! 5: shell with phi0*dexp(-(r-r0)**2/sigma), V = 0 + +! original way, manually define the preprocessor macro +! #define CC 2 +! the new way, define according to the preprocessor macro in "macrodef.fh" +#include "macrodef.fh" +#define CC EScalar_CC + +subroutine setparameters(a2,r0,phi0,sigma,l2) +implicit none +real*8,intent(out) :: a2,r0,phi0,sigma,l2 + +! original way: read in parameters one by one +! call seta2(a2) +! call setphi0(phi0) + +! new way: read in all parameters at once +call set_escalar_parameter(a2, phi0, r0, sigma, l2) + +! r0=120.d0 +! sigma=8.d0 +! l2=1.d4 + +! write(*,*) +! write(*,*) " Set_Rho_ADM.f90 a2 = ", a2 +! write(*,*) " Set_Rho_ADM.f90 phi0 = ", phi0 +! write(*,*) " Set_Rho_ADM.f90 r0 = ", r0 +! write(*,*) " Set_Rho_ADM.f90 sigma0 = ", sigma +! write(*,*) " Set_Rho_ADM.f90 l2 = ", l2 +! write(*,*) + +return + +end subroutine setparameters +!=================================================================== +function phi(X,Y,Z) result(gont) +implicit none + +double precision,intent(in)::X +double precision,intent(in)::Y +double precision,intent(in)::Z +real*8 :: gont + +real*8 ::r +real*8 :: a2,r0,phi0,sigma,l2 + + call setparameters(a2,r0,phi0,sigma,l2) + r=dsqrt(X*X+Y*Y+Z*Z) +#if ( CC == 1) +! configuration 1 + gont = phi0*dtanh((r-r0)/sigma) +#elif ( CC == 2) +! configuration 2 + phi0 = a2**2*phi0/(1+a2**2) + gont = phi0*dexp(-(r-r0)**2/sigma) +#elif ( CC == 3) + gont = (0.0481646d0*dexp(-0.0581545d0*(r-1.8039d-8)*(r-1.8039d-8)/l2) & + +0.298408d0*dexp(-0.111412d0*(r+9.6741d-9)*(r+9.6741d-9)/l2)+ & + 0.42755d0*dexp(-0.207156d0*(r-1.09822d-8)*(r-1.09822d-8)/l2)+ & + 0.204229d0*dexp(-0.37742d0*(r+2.13778d-8)*(r+2.13778d-8)/l2)+ & + 0.021649d0*dexp(-0.68406d0*(r-8.78608d-8)*(r-8.78608d-8)/l2))/l2 +#elif ( CC == 4) +! configuration 4, a2 = oo + phi0 = 0.5d0*phi0 + gont = phi0*(dtanh((r+r0)/sigma)-dtanh((r-r0)/sigma)) +#elif ( CC == 5) +! configuration 5 + gont = phi0*dexp(-(r-r0)**2/sigma) +#endif + +return + +end function phi + +! d phi/dr +function dphi(X,Y,Z) result(gont) +implicit none + +double precision,intent(in)::X +double precision,intent(in)::Y +double precision,intent(in)::Z +real*8 :: gont + +real*8 ::r +real*8 :: a2,r0,phi0,sigma,l2 + + call setparameters(a2,r0,phi0,sigma,l2) + r=dsqrt(X*X+Y*Y+Z*Z) +#if ( CC == 1) +! configuration 1 + gont = phi0/sigma*(1-(dtanh((r-r0)/sigma))**2) +#elif ( CC == 2) +! configuration 2 + phi0 = a2**2*phi0/(1+a2**2) + gont = -2.d0*phi0*(r-r0)/sigma*exp(-(r-r0)**2/sigma) +#elif ( CC == 3) + gont = (-0.5601976461d-2*(r-0.18039d-7)/l2*dexp(-0.581545d-1*(r-0.18039d-7)**2/l2) & + -0.6649246419d-1*(r+0.96741d-8)/l2*dexp(-0.111412d0*(r+.96741e-8)**2/l2) & + -0.1771390956d0*(r-0.109822d-7)/l2*dexp(-0.207156d0*(r-0.109822d-7)**2/l2) & + -0.1541602184d0*(r+0.213778d-7)/l2*dexp(-0.37742d0*(r+0.213778d-7)**2/l2) & + -0.2961842988d-1*(r-0.878608d-7)/l2*dexp(-0.68406*(r-0.878608d-7)**2/l2))/l2 +#elif ( CC == 4) +! configuration 4, a2 = oo + phi0 = 0.5d0*phi0 + gont = phi0*((1-dtanh((r+r0)/sigma)**2)/sigma- & + (1-dtanh((r-r0)/sigma)**2)/sigma) +#elif ( CC == 5) +! configuration 5 + gont = -2.d0*phi0*(r-r0)/sigma*exp(-(r-r0)**2/sigma) +#endif + +return + +end function dphi +!================================================================== +function potential(X,Y,Z) result(gont) +implicit none + +double precision,intent(in)::X +double precision,intent(in)::Y +double precision,intent(in)::Z +real*8 :: gont + +real*8 :: phi +real*8 :: PI,v + +real*8 :: a2,r0,phi0,sigma,l2 + +#if ( CC == 1 || CC == 4 || CC == 5) + gont = 0.d0 + +#elif ( CC == 2 || CC == 3) + call setparameters(a2,r0,phi0,sigma,l2) + PI = dacos(-1.d0) + + v = phi(X,Y,Z) + + gont = dexp(-8.d0*dsqrt(PI/3)*v)*(1-dexp(4*dsqrt(PI/3)*v))**2/32/PI/a2 +#endif + +return + +end function potential +!================================================================== +!Note this part is for evolution +!not just for initial configuration + +!f(R) potential F=R+a_2R^2 +subroutine frpotential(ex,Sphi,V,dVdSphi) + +implicit none + +integer,intent(in ):: ex(1:3) +real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi +real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: V,dVdSphi + +real*8 :: a2,r0,phi0,sigma,l2 +real*8, parameter :: Four = 4.d0, TWO = 2.d0,ONE = 1.d0,ZEO=0.d0 +real*8 :: PI + + PI = dacos(-ONE) + +#if ( CC == 1 || CC == 4 || CC == 5) + V = ZEO + dVdSphi = ZEO +#elif ( CC == 2 || CC == 3) + call setparameters(a2,r0,phi0,sigma,l2) + V = dexp(-8.d0*dsqrt(PI/3)*Sphi)*(1-dexp(4*dsqrt(PI/3)*Sphi))**2/32/PI/a2 + dVdSphi = 1.d0/a2/1.2d1*dsqrt(3.d0/PI)*dexp(-8.d0*dsqrt(PI/3.d0)*Sphi)*(-1+dexp(4*dsqrt(Pi/3)*Sphi)) +#endif + +return + +end subroutine frpotential +!================================================================== +!f(R) potential F=R+a_2R^2 +!fprim(R) = 1+2*a_2*R +subroutine frfprim(ex,RR,fprim) + +implicit none + +integer,intent(in ):: ex(1:3) +real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: RR +real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: fprim + +real*8 :: a2,r0,phi0,sigma,l2 +real*8, parameter :: ONE=1.d0, TWO = 2.d0 + +#if ( CC == 1 || CC == 4 || CC == 5) + fprim = ONE +#elif ( CC == 2 || CC == 3) + call setparameters(a2,r0,phi0,sigma,l2) + fprim = ONE+TWO*a2*RR +#endif + +return + +end subroutine frfprim +!================================================================== +subroutine set_rho_adm2(ex,rho,X,Y,Z) + +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::X +double precision,intent(in),dimension(ex)::Y +double precision,intent(in),dimension(ex)::Z +double precision,intent(out),dimension(ex)::rho + +integer :: i +real*8 :: dphi + + do i=1,ex + ! rho(i) = dphi(X,Y,Z) + rho(i) = dphi(X(i),Y(i),Z(i)) + rho(i) = rho(i)*rho(i) + enddo + + return + +end subroutine set_rho_adm2 + +subroutine set_rho_adm1(ex,rho,X,Y,Z) + +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::X +double precision,intent(in),dimension(ex)::Y +double precision,intent(in),dimension(ex)::Z +double precision,intent(out),dimension(ex)::rho + +real*8 :: potential +integer :: i + + do i=1,ex + rho(i) = potential(X(i),Y(i),Z(i)) + enddo + + return + +end subroutine set_rho_adm1 + +subroutine set_rho_adm(ex,rho,X,Y,Z) + +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::X +double precision,intent(in),dimension(ex)::Y +double precision,intent(in),dimension(ex)::Z +! in psivac, out rho_adm +double precision,intent(inout),dimension(ex)::rho + +double precision,dimension(ex)::rho1,rho2 + + call set_rho_adm1(ex,rho1,X,Y,Z) + call set_rho_adm2(ex,rho2,X,Y,Z) + + rho = rho**4 + rho = rho**2*rho1+rho*rho2 + + return + +end subroutine set_rho_adm diff --git a/AMSS_NCKU_source/ShellPatch.C b/AMSS_NCKU_source/ShellPatch.C new file mode 100644 index 0000000..50ad334 --- /dev/null +++ b/AMSS_NCKU_source/ShellPatch.C @@ -0,0 +1,3585 @@ + +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include "ShellPatch.h" +#include "Parallel.h" +#include "fmisc.h" +#include "misc.h" +#include "shellfunctions.h" +#include "parameters.h" + +#define PI M_PI + +// x x x x x o * +// * o x x x x x +// each side contribute an overlap points +// so we need half of that +#define overghost ((ghost_width + 1) / 2 + ghost_width) + +ss_patch::ss_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ingfs(ingfsi), fngfs(fngfsi), myrank(myranki), blb(0), ble(0) +{ + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; + bbox[i] = bboxi[i]; + bbox[i + dim] = bboxi[i + dim]; + } +} +ss_patch::~ss_patch() +{ + MyList *bg; + while (blb) + { + if (blb == ble) + break; + bg = (blb->next) ? blb->next : 0; + delete blb->data; + delete blb; + blb = bg; + } + if (ble) + { + delete ble->data; + delete ble; + } + blb = ble = 0; +} +// bulk part for given Block within given patch, without extension +MyList *ss_patch::build_bulk_gsl(Block *bp) +{ + MyList *gs = 0; + + gs = new MyList; + gs->data = new Parallel::gridseg; + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = bp; + gs->next = 0; + + return gs; +} +// collect all ghost grid segments or blocks for given patch +MyList *ss_patch::build_ghost_gsl() +{ + MyList *cgsl = 0, *gs, *gsb; + MyList *BP = blb; + while (BP) + { + gs = new MyList; + gs->data = new Parallel::gridseg; + + for (int i = 0; i < dim; i++) + { + gs->data->llb[i] = BP->data->bbox[i]; + gs->data->uub[i] = BP->data->bbox[dim + i]; + gs->data->shape[i] = BP->data->shape[i]; + } + gs->data->Bg = BP->data; + gs->next = 0; + + gsb = build_bulk_gsl(BP->data); + + if (!cgsl) + cgsl = Parallel::gs_subtract(gs, gsb); + else + cgsl->catList(Parallel::gs_subtract(gs, gsb)); + + gsb->destroyList(); + gs->destroyList(); + + if (BP == ble) + break; + BP = BP->next; + } + + return cgsl; +} +// collect all grid segments or blocks without ghost for given patch +// special for Sync usage, so we do not need consider missing points +MyList *ss_patch::build_owned_gsl0(int rank_in) +{ + MyList *cgsl = 0, *gs; + MyList *BP = blb; + while (BP) + { + Block *bp = BP->data; + if (bp->rank == rank_in) + { + if (!cgsl) + { + cgsl = gs = new MyList; + gs->data = new Parallel::gridseg; + } + else + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + + for (int i = 0; i < dim; i++) + { + double DH = bp->getdX(i); + gs->data->uub[i] = (feq(bp->bbox[dim + i], bbox[dim + i], DH / 2)) ? bp->bbox[dim + i] : bp->bbox[dim + i] - ghost_width * DH; + gs->data->llb[i] = (feq(bp->bbox[i], bbox[i], DH / 2)) ? bp->bbox[i] : bp->bbox[i] + ghost_width * DH; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4) + 1; +#else +#ifdef Cell + gs->data->shape[i] = int((gs->data->uub[i] - gs->data->llb[i]) / DH + 0.4); +#else +#error Not define Vertex nor Cell +#endif +#endif + } + gs->data->Bg = BP->data; + gs->next = 0; + } + + if (BP == ble) + break; + BP = BP->next; + } + + return cgsl; +} +void ss_patch::Sync(MyList *VarList, int Symmetry) +{ + int cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + + MyList *dst; + MyList **src, **transfer_src, **transfer_dst; + src = new MyList *[cpusize]; + transfer_src = new MyList *[cpusize]; + transfer_dst = new MyList *[cpusize]; + + dst = build_ghost_gsl(); // ghost region only + for (int node = 0; node < cpusize; node++) + { + src[node] = build_owned_gsl0(node); // for the part without ghost points and do not extend + Parallel::build_gstl(src[node], dst, &transfer_src[node], &transfer_dst[node]); // for transfer[node], data locate on cpu#node + } + + Parallel::transfer(transfer_src, transfer_dst, VarList, VarList, Symmetry); + + if (dst) + dst->destroyList(); + for (int node = 0; node < cpusize; node++) + { + if (src[node]) + src[node]->destroyList(); + if (transfer_src[node]) + transfer_src[node]->destroyList(); + if (transfer_dst[node]) + transfer_dst[node]->destroyList(); + } + + delete[] src; + delete[] transfer_src; + delete[] transfer_dst; +} +//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +void xp_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_xp_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_xpm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +void xm_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_xm_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_xpm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +void yp_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_yp_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_ypm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +void ym_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_ym_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_ypm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +void zp_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_zp_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_zpm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +void zm_patch::setupcordtrans() +{ + MyList *BP = blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_zm_getxyz(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz]); + f_zpm_getjacobian(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz]); + } + if (BP == ble) + break; + BP = BP->next; + } +} +ShellPatch::ShellPatch(int ingfsi, int fngfsi, char *filename, int Symmetry, int myranki, monitor *ErrorMonitor) : ingfs(ingfsi), fngfs(fngfsi), myrank(myranki), PatL(0) +{ + int shapei[dim]; + double Rrangei[2]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of Shell patches" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN") + { + if (skey == "Shell shape") + shapei[sind] = atof(sval.c_str()); + else if (skey == "Shell R range") + Rrangei[sind] = atof(sval.c_str()); + } + } + inf.close(); + } + + for (int i = 0; i < dim; i++) + { + shape[i] = shapei[i]; +// we always assume the input parameter is in cell center style +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape[i] = shape[i] + 1; +#endif + } + // change from cardisian r to local corrdinate r + Rrange[0] = getR(Rrangei[0]); + Rrange[1] = getR(Rrangei[1]); + + if (myrank == 0) + { + cout << endl; + cout << " shell's range: [" << Rrange[0] << ":" << Rrange[1] << "]" << endl + << " shape: " << shape[2] << endl + << " resolution: [" << getdX(0) << "," << getdX(1) << "," << getdX(2) << "]" << endl; + } + // extend buffer points for lower boundary + Rrange[0] -= buffer_width * getdX(2); + shape[2] += buffer_width; + + // extend ghost_width points at lower boundary for double cover region + // in input.par we do not ask shell and box have over lap + Rrange[0] -= ghost_width * getdX(2); + shape[2] += ghost_width; + +// extend buffer points for upper boundary if CPBC is used +#ifdef CPBC + + Rrange[1] += CPBC_ghost_width * getdX(2); + shape[2] += CPBC_ghost_width; + +#endif + + double bbox[2 * dim]; + int shape_here[dim]; + bbox[2] = Rrange[0]; + bbox[5] = Rrange[1]; + shape_here[2] = shape[2]; + + switch (Symmetry) + { + case 0: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new xp_patch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xm_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new zm_patch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 1: + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] + 2 * overghost; + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_patch(ingfs, fngfs, shape_here, bbox, myrank); + shape_here[0] = shape[0] + 2 * overghost; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + shape_here[1] = (shape[1] + 1) / 2 + overghost; +#else +#ifdef Cell + shape_here[1] = shape[1] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = 0; + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL->insert(new xp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + bbox[0] = -PI / 4 - overghost * getdX(0); + bbox[1] = -PI / 4 - overghost * getdX(1); + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = 0; + PatL->insert(new xm_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new ym_patch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + case 2: +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int i = 0; i < 2; i++) + shape_here[i] = (shape[i] + 1) / 2 + overghost; +#else +#ifdef Cell + for (int i = 0; i < 2; i++) + shape_here[i] = shape[i] / 2 + overghost; +#else +#error Not define Vertex nor Cell +#endif +#endif + bbox[0] = 0; + bbox[1] = 0; + bbox[3] = PI / 4 + overghost * getdX(0); + bbox[4] = PI / 4 + overghost * getdX(1); + PatL = new MyList; + PatL->data = new zp_patch(ingfs, fngfs, shape_here, bbox, myrank); + PatL->insert(new xp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + PatL->insert(new yp_patch(ingfs, fngfs, shape_here, bbox, myrank)); + break; + default: + cout << "not recognized Symmetry type" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } +} +ShellPatch::~ShellPatch() +{ + int nprocs = 1; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + for (int node = 0; node < nprocs; node++) + { + if (ss_src[node]) + destroypsuList(ss_src[node]); + if (ss_dst[node]) + destroypsuList(ss_dst[node]); + if (csatc_src[node]) + destroypsuList(csatc_src[node]); + if (csatc_dst[node]) + destroypsuList(csatc_dst[node]); + if (csats_src[node]) + destroypsuList(csats_src[node]); + if (csats_dst[node]) + destroypsuList(csats_dst[node]); + } + + delete[] ss_src; + delete[] ss_dst; + delete[] csatc_src; + delete[] csatc_dst; + delete[] csats_src; + delete[] csats_dst; + + while (PatL) + { + ss_patch *sPp = PatL->data; + MyList *bg; + while (sPp->blb) + { + if (sPp->blb == sPp->ble) + break; + bg = (sPp->blb->next) ? sPp->blb->next : 0; + delete sPp->blb->data; + delete sPp->blb; + sPp->blb = bg; + } + if (sPp->ble) + { + delete sPp->ble->data; + delete sPp->ble; + } + sPp->blb = sPp->ble = 0; + PatL = PatL->next; + } + PatL->destroyList(); +} +void ShellPatch::destroypsuList(MyList *ct) +{ + MyList *n; + while (ct) + { + n = ct->next; + if (ct->data->coef) + { + delete[] ct->data->coef; + delete[] ct->data->sind; + } + delete ct->data; + delete ct; + ct = n; + } +} +double ShellPatch::getR(double r) +{ + double A = 1, B = 0, r0 = 0, eps = 1; + f_shellcordpar(A, B, r0, eps); + double f = A * (r - r0) + B * sqrt(1 + (r - r0) * (r - r0) / eps); + return f + A * r0 - B * sqrt(1 + r0 * r0 / eps); +} +double ShellPatch::getsr(double R) +{ + double A = 1, B = 0, r0 = 0, eps = 1; + f_shellcordpar(A, B, r0, eps); + double f = R + B; + return r0 + (A * f - B * sqrt(A * A + (f * f - B * B) / eps)) / (A * A - B * B / eps); +} +MyList *ShellPatch::compose_sh(int cpusize, int nodes) +{ +#ifdef USE_GPU_DIVIDE + double cpu_part, gpu_part; + map::iterator iter; + iter = parameters::dou_par.find("cpu part"); + if (iter != parameters::dou_par.end()) + { + cpu_part = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "cpu part") + cpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("cpu part", cpu_part)); + } + iter = parameters::dou_par.find("gpu part"); + if (iter != parameters::dou_par.end()) + { + gpu_part = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "gpu part") + gpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("gpu part", gpu_part)); + } + + if (nodes == 0) + nodes = cpusize / 2; +#else + if (nodes == 0) + nodes = cpusize; +#endif + + if (dim != 3) + { + cout << "distrivute: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + // checkPatch(); + + bool periodic = false; + MyList *BlL = 0; + + int split_size, min_size, block_size = 0; + + int min_width = 2 * Mymax(ghost_width, buffer_width); + int nxyz[dim], mmin_width[dim], min_shape[dim]; + + MyList *PLi = PatL; + for (int i = 0; i < dim; i++) + min_shape[i] = PLi->data->shape[i]; + PLi = PLi->next; + while (PLi) + { + ss_patch *PP = PLi->data; + for (int i = 0; i < dim; i++) + min_shape[i] = Mymin(min_shape[i], PP->shape[i]); + PLi = PLi->next; + } + + for (int i = 0; i < dim; i++) + mmin_width[i] = Mymin(min_width, min_shape[i]); + + min_size = mmin_width[0]; + for (int i = 1; i < dim; i++) + min_size = min_size * mmin_width[i]; + + PLi = PatL; + while (PLi) + { + ss_patch *PP = PLi->data; + // PP->checkPatch(true); + int bs = PP->shape[0]; + for (int i = 1; i < dim; i++) + bs = bs * PP->shape[i]; + block_size = block_size + bs; + PLi = PLi->next; + } + split_size = Mymax(min_size, block_size / nodes); + split_size = Mymax(1, split_size); + + int n_rank = 0; + PLi = PatL; + int reacpu = 0; + while (PLi) + { + ss_patch *PP = PLi->data; + + reacpu += Parallel::partition3(nxyz, split_size, mmin_width, nodes, PP->shape); + + Block *ng, *ng0; + int shape_here[dim], ibbox_here[2 * dim]; + double bbox_here[2 * dim], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxyz[0]; i++) + for (int j = 0; j < nxyz[1]; j++) + for (int k = 0; k < nxyz[2]; k++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxyz[0]; + ibbox_here[3] = (PP->shape[0] * (i + 1)) / nxyz[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxyz[1]; + ibbox_here[4] = (PP->shape[1] * (j + 1)) / nxyz[1] - 1; + ibbox_here[2] = (PP->shape[2] * k) / nxyz[2]; + ibbox_here[5] = (PP->shape[2] * (k + 1)) / nxyz[2] - 1; + + if (periodic) + { + ibbox_here[0] = ibbox_here[0] - ghost_width; + ibbox_here[3] = ibbox_here[3] + ghost_width; + ibbox_here[1] = ibbox_here[1] - ghost_width; + ibbox_here[4] = ibbox_here[4] + ghost_width; + ibbox_here[2] = ibbox_here[2] - ghost_width; + ibbox_here[5] = ibbox_here[5] + ghost_width; + } + else + { + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[0] - 1, ibbox_here[3] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[4] = Mymin(PP->shape[1] - 1, ibbox_here[4] + ghost_width); + ibbox_here[2] = Mymax(0, ibbox_here[2] - ghost_width); + ibbox_here[5] = Mymin(PP->shape[2] - 1, ibbox_here[5] + ghost_width); + } + + shape_here[0] = ibbox_here[3] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[4] - ibbox_here[1] + 1; + shape_here[2] = ibbox_here[5] - ibbox_here[2] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[3] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[4] * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / (PP->shape[2] - 1); + bbox_here[2] = PP->bbox[2] + ibbox_here[2] * dd; + bbox_here[5] = PP->bbox[2] + ibbox_here[5] * dd; +#else +#ifdef Cell + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[3] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[4] + 1) * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / PP->shape[2]; + bbox_here[2] = PP->bbox[2] + (ibbox_here[2]) * dd; + bbox_here[5] = PP->bbox[2] + (ibbox_here[5] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + +#ifdef USE_GPU_DIVIDE + { + const int pices = 2; + double picef[pices]; + picef[0] = cpu_part; + picef[1] = gpu_part; + int shape_res[dim * pices]; + double bbox_res[2 * dim * pices]; + misc::dividBlock(dim, shape_here, bbox_here, pices, picef, shape_res, bbox_res, min_width); + ng = ng0 = new Block(dim, shape_res, bbox_res, n_rank++, ingfs, fngfs + dRdzz + 1, 0, 0); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + for (int i = 1; i < pices; i++) + { + ng = new Block(dim, shape_res + i * dim, bbox_res + i * 2 * dim, n_rank++, ingfs, fngfs + dRdzz + 1, 0, i); // delete through KillBlocks + // ng->checkBlock(); + BlL->insert(ng); + } + } +#else + ng = ng0 = new Block(dim, shape_here, bbox_here, n_rank++, ingfs, fngfs + dRdzz + 1, 0); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks +#endif + if (n_rank == cpusize) + n_rank = 0; + + // set PP->blb + if (i == 0 && j == 0 && k == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng0) + Bp = Bp->next; // ng0 is the first of the pices list + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; // ng is the last of the pices list + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < nodes * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "ShellPatch::distribute CAUSTION: uses essencially " << reacpu << " processors vs " << nodes << " nodes run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +// distribute data only along r direction +MyList *ShellPatch::compose_shr(int cpusize, int nodes) +{ +#ifdef USE_GPU_DIVIDE + double cpu_part, gpu_part; + map::iterator iter; + iter = parameters::dou_par.find("cpu part"); + if (iter != parameters::dou_par.end()) + { + cpu_part = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "cpu part") + cpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("cpu part", cpu_part)); + } + iter = parameters::dou_par.find("gpu part"); + if (iter != parameters::dou_par.end()) + { + gpu_part = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "gpu part") + gpu_part = atof(sval.c_str()); + } + } + inf.close(); + + parameters::dou_par.insert(map::value_type("gpu part", gpu_part)); + } + + if (nodes == 0) + nodes = cpusize / 2; +#else + if (nodes == 0) + nodes = cpusize; +#endif + + if (dim != 3) + { + cout << "ShellPatch::compose_shr: now we only support 3-dimension" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + // checkPatch(); + + bool periodic = false; + MyList *BlL = 0; + + int min_size = 2 * Mymax(ghost_width, buffer_width); + int nxyz[dim]; + + MyList *PLi; + + PLi = PatL; + int reacpu = 0; + while (PLi) + { + // make sure the block with the same r range locate at the same cpu + int n_rank = 0; + ss_patch *PP = PLi->data; + + reacpu += Parallel::partition1(nxyz[2], min_size, min_size, nodes, PP->shape[2]); + nxyz[0] = nxyz[1] = 1; + + Block *ng, *ng0; + int shape_here[dim], ibbox_here[2 * dim]; + double bbox_here[2 * dim], dd; + + // ibbox : 0,...N-1 + for (int i = 0; i < nxyz[0]; i++) + for (int j = 0; j < nxyz[1]; j++) + for (int k = 0; k < nxyz[2]; k++) + { + ibbox_here[0] = (PP->shape[0] * i) / nxyz[0]; + ibbox_here[3] = (PP->shape[0] * (i + 1)) / nxyz[0] - 1; + ibbox_here[1] = (PP->shape[1] * j) / nxyz[1]; + ibbox_here[4] = (PP->shape[1] * (j + 1)) / nxyz[1] - 1; + ibbox_here[2] = (PP->shape[2] * k) / nxyz[2]; + ibbox_here[5] = (PP->shape[2] * (k + 1)) / nxyz[2] - 1; + + if (periodic) + { + ibbox_here[0] = ibbox_here[0] - ghost_width; + ibbox_here[3] = ibbox_here[3] + ghost_width; + ibbox_here[1] = ibbox_here[1] - ghost_width; + ibbox_here[4] = ibbox_here[4] + ghost_width; + ibbox_here[2] = ibbox_here[2] - ghost_width; + ibbox_here[5] = ibbox_here[5] + ghost_width; + } + else + { + ibbox_here[0] = Mymax(0, ibbox_here[0] - ghost_width); + ibbox_here[3] = Mymin(PP->shape[0] - 1, ibbox_here[3] + ghost_width); + ibbox_here[1] = Mymax(0, ibbox_here[1] - ghost_width); + ibbox_here[4] = Mymin(PP->shape[1] - 1, ibbox_here[4] + ghost_width); + ibbox_here[2] = Mymax(0, ibbox_here[2] - ghost_width); + ibbox_here[5] = Mymin(PP->shape[2] - 1, ibbox_here[5] + ghost_width); + } + + shape_here[0] = ibbox_here[3] - ibbox_here[0] + 1; + shape_here[1] = ibbox_here[4] - ibbox_here[1] + 1; + shape_here[2] = ibbox_here[5] - ibbox_here[2] + 1; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (PP->bbox[3] - PP->bbox[0]) / (PP->shape[0] - 1); + bbox_here[0] = PP->bbox[0] + ibbox_here[0] * dd; + bbox_here[3] = PP->bbox[0] + ibbox_here[3] * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / (PP->shape[1] - 1); + bbox_here[1] = PP->bbox[1] + ibbox_here[1] * dd; + bbox_here[4] = PP->bbox[1] + ibbox_here[4] * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / (PP->shape[2] - 1); + bbox_here[2] = PP->bbox[2] + ibbox_here[2] * dd; + bbox_here[5] = PP->bbox[2] + ibbox_here[5] * dd; +#else +#ifdef Cell + dd = (PP->bbox[3] - PP->bbox[0]) / PP->shape[0]; + bbox_here[0] = PP->bbox[0] + (ibbox_here[0]) * dd; + bbox_here[3] = PP->bbox[0] + (ibbox_here[3] + 1) * dd; + + dd = (PP->bbox[4] - PP->bbox[1]) / PP->shape[1]; + bbox_here[1] = PP->bbox[1] + (ibbox_here[1]) * dd; + bbox_here[4] = PP->bbox[1] + (ibbox_here[4] + 1) * dd; + + dd = (PP->bbox[5] - PP->bbox[2]) / PP->shape[2]; + bbox_here[2] = PP->bbox[2] + (ibbox_here[2]) * dd; + bbox_here[5] = PP->bbox[2] + (ibbox_here[5] + 1) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + +#ifdef USE_GPU_DIVIDE + { + const int pices = 2; + double picef[pices]; + picef[0] = cpu_part; + picef[1] = gpu_part; + int shape_res[dim * pices]; + double bbox_res[2 * dim * pices]; + misc::dividBlock(dim, shape_here, bbox_here, pices, picef, shape_res, bbox_res, min_size); + ng = ng0 = new Block(dim, shape_res, bbox_res, n_rank++, ingfs, fngfs + dRdzz + 1, 0, 0); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks + + for (int i = 1; i < pices; i++) + { + ng = new Block(dim, shape_res + i * dim, bbox_res + i * 2 * dim, n_rank++, ingfs, fngfs + dRdzz + 1, 0, i); // delete through KillBlocks + // ng->checkBlock(); + BlL->insert(ng); + } + } +#else + ng = ng0 = new Block(dim, shape_here, bbox_here, n_rank++, ingfs, fngfs + dRdzz + 1, 0); // delete through KillBlocks + // ng->checkBlock(); + if (BlL) + BlL->insert(ng); + else + BlL = new MyList(ng); // delete through KillBlocks +#endif + if (n_rank == cpusize) + n_rank = 0; + + // set PP->blb + if (i == 0 && j == 0 && k == 0) + { + MyList *Bp = BlL; + while (Bp->data != ng0) + Bp = Bp->next; // ng0 is the first of the pices list + PP->blb = Bp; + } + } + // set PP->ble + { + MyList *Bp = BlL; + while (Bp->data != ng) + Bp = Bp->next; // ng is the last of the pices list + PP->ble = Bp; + } + PLi = PLi->next; + } + if (reacpu < nodes * 2 / 3) + { + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "ShellPatch::distribute CAUSTION: uses essencially " << reacpu << " processors vs " << nodes << " nodes run, your scientific computation scale is not as large as you estimate." << endl; + } + + return BlL; +} +void ShellPatch::getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = getR(r); + if (fabs(x) <= z && fabs(y) <= z) + { + sst = 0; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(x) <= -z && fabs(y) <= -z) + { + sst = 1; + lx = atan(x / z); + ly = atan(y / z); + } + else if (fabs(y) <= x && fabs(z) <= x) + { + sst = 2; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(y) <= -x && fabs(z) <= -x) + { + sst = 3; + lx = atan(y / x); + ly = atan(z / x); + } + else if (fabs(x) <= y && fabs(z) <= y) + { + sst = 4; + lx = atan(x / y); + ly = atan(z / y); + } + else if (fabs(x) <= -y && fabs(z) <= -y) + { + sst = 5; + lx = atan(x / y); + ly = atan(z / y); + } + else + { + cout << "ShellPatch::getlocalpox should not come here, something wrong" << endl; + } +} +void ShellPatch::getlocalpoxsst(double x, double y, double z, int sst, double &lx, double &ly, double &lz) +{ + double r; + r = sqrt(x * x + y * y + z * z); + lz = getR(r); + switch (sst) + { + case -1: + lx = x; + ly = y; + lz = z; + break; + case 0: + lx = atan(x / z); + ly = atan(y / z); + break; + case 1: + lx = atan(x / z); + ly = atan(y / z); + break; + case 2: + lx = atan(y / x); + ly = atan(z / x); + break; + case 3: + lx = atan(y / x); + ly = atan(z / x); + break; + case 4: + lx = atan(x / y); + ly = atan(z / y); + break; + case 5: + lx = atan(x / y); + ly = atan(z / y); + break; + default: + cout << "ShellPatch::getlocalpoxsst should not come here, something wrong" << endl; + } +} +void ShellPatch::getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz) +{ + double r = getsr(lz); + switch (sst) + { + case 0: + x = tan(lx); + y = tan(ly); + z = r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 1: + x = tan(lx); + y = tan(ly); + z = -r / sqrt(1 + x * x + y * y); + x = z * x; + y = z * y; + break; + case 2: + y = tan(lx); + z = tan(ly); + x = r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 3: + y = tan(lx); + z = tan(ly); + x = -r / sqrt(1 + z * z + y * y); + y = x * y; + z = x * z; + break; + case 4: + x = tan(lx); + z = tan(ly); + y = r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + case 5: + x = tan(lx); + z = tan(ly); + y = -r / sqrt(1 + x * x + z * z); + x = y * x; + z = y * z; + break; + } +} +// from to +// dumyd refer to 'from' +int ShellPatch::getdumydimension(int acsst, int posst) // -1 means no dumy dimension +{ + int dms; + if (acsst == -1 || posst == -1) + return -1; + switch (acsst) + { + case 0: + case 1: + switch (posst) + { + case 0: + case 1: + cout << "error in ShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 2: + case 3: + return 0; + case 4: + case 5: + return 1; + default: + cout << "error in ShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + case 2: + case 3: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + cout << "error in ShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + case 4: + case 5: + return 0; + default: + cout << "error in ShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + case 4: + case 5: + switch (posst) + { + case 0: + case 1: + return 1; + case 2: + case 3: + return 0; + case 4: + case 5: + cout << "error in ShellPatch::getdumydimension: acsst = " << acsst << ", posst = " << posst << endl; + return -1; + default: + cout << "error in ShellPatch::getdumydimension: posst = " << posst << endl; + return -1; + } + default: + cout << "error in ShellPatch::getdumydimension: acsst = " << acsst << endl; + return -1; + } +} +// used by _dst construction, so these x,y,z must coinside with grid point +// we have considered ghost points now +void ShellPatch::prolongpointstru(MyList *&psul, MyList *sPpi, double DH[dim], + MyList *Ppi, double CDH[dim], MyList *pss) +{ + int n_dst = 0; + MyList *sPp = sPpi; + MyList *Pp = Ppi; + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + if (pss->data->tsst >= 0) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == pss->data->tsst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * DH[0] && lx < uub[0] + 0.1 * DH[0] && + ly > llb[1] - 0.1 * DH[1] && ly < uub[1] + 0.1 * DH[1] && + lz > llb[2] - 0.1 * DH[2] && lz < uub[2] + 0.1 * DH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = sPp->data->sst; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + if (pss->data->tsst != -1) + cout << "somthing is wrong in ShellPatch::prolongpointstru" << endl; + lx = pss->data->gpox[0]; + ly = pss->data->gpox[1]; + lz = pss->data->gpox[2]; + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + { + for (int j = 0; j < dim; j++) + { + llb[j] = Bg->bbox[j]; + uub[j] = Bg->bbox[j + dim]; + } + + if (lx > llb[0] - 0.1 * CDH[0] && lx < uub[0] + 0.1 * CDH[0] && + ly > llb[1] - 0.1 * CDH[1] && ly < uub[1] + 0.1 * CDH[1] && + lz > llb[2] - 0.1 * CDH[2] && lz < uub[2] + 0.1 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = 0; + for (int i = 0; i < dim; i++) + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = pss->data->ssst; + ps->data->tsst = -1; + ps->data->dumyd = getdumydimension(ps->data->tsst, ps->data->ssst); + ps->data->Bg = Bg; + ps->data->coef = 0; + ps->data->sind = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + n_dst++; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + // if n_dst > 0, that's because of ghost_points + if (n_dst == 0) + { + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + cout << "ShellPatch::prolongpointstru fail to find target Block for pointstru:" << endl; + check_pointstrul(pss, true); + if (Pp == Ppi) + { + getlocalpoxsst(pss->data->gpox[0], pss->data->gpox[1], pss->data->gpox[2], pss->data->tsst, + lx, ly, lz); + if (myrank == 0) + cout << "sst = " << pss->data->tsst << ", lx,ly,lz = " << lx << "," << ly << "," << lz << endl; + checkBlock(pss->data->tsst); + } + else + { + Pp = Ppi; + while (Pp) + { + Pp->data->checkBlock(); + Pp = Pp->next; + } + } + if (myrank == 0) + MPI_Abort(MPI_COMM_WORLD, 1); + } + else + { + MyList *ts = 0; + for (int i = 1; i < n_dst; i++) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->next = (i == n_dst - 1) ? pss->next : 0; + for (int i = 0; i < dim; i++) + { + ps->data->gpox[i] = pss->data->gpox[i]; + ps->data->lpox[i] = pss->data->lpox[i]; + } + ps->data->ssst = pss->data->ssst; + ps->data->tsst = pss->data->tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->Bg = pss->data->Bg; + ps->data->coef = 0; + ps->data->sind = 0; + if (ts) + ts->catList(ps); + else + ts = ps; + } + if (ts) + pss->next = ts; + } +} +// used by _src construction, so these x,y,z do not coinside with grid point +bool ShellPatch::prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in) +{ + MyList *Bgl; + Block *Bg; + double llb[dim], uub[dim]; + double lx, ly, lz; + + if (ssyn) + { + int sst; + getlocalpox(x, y, z, sst, lx, ly, lz); + while (sPp) + { + if (sPp->data->sst == sst) + { + Bgl = sPp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < 2; j++) + { + if (feq(Bg->bbox[j], -PI / 4 - overghost * DH[j], DH[j] / 2)) + llb[j] = -PI / 4; + else if (feq(Bg->bbox[j], sPp->data->bbox[j], DH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * DH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * DH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], PI / 4 + overghost * DH[j], DH[j] / 2)) + uub[j] = PI / 4; + else if (feq(Bg->bbox[dim + j], sPp->data->bbox[dim + j], DH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * DH[j]; + } + if (feq(Bg->bbox[2], sPp->data->bbox[2], DH[2] / 2)) + llb[2] = Bg->bbox[2]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[2] = Bg->bbox[2] + (ghost_width - 1) * DH[2]; +#else +#ifdef Cell + else + llb[2] = Bg->bbox[2] + ghost_width * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + 2], sPp->data->bbox[dim + 2], DH[2] / 2)) + uub[2] = Bg->bbox[dim + 2]; + else + uub[2] = Bg->bbox[dim + 2] - ghost_width * DH[2]; + if (lx > llb[0] - 0.0001 * DH[0] && lx < uub[0] + 0.0001 * DH[0] && + ly > llb[1] - 0.0001 * DH[1] && ly < uub[1] + 0.0001 * DH[1] && + lz > llb[2] - 0.0001 * DH[2] && lz < uub[2] + 0.0001 * DH[2]) // even ghost_width-1 the region is like |----|----| + // ^ + // so for ^ point may miss for vertext center, so we use 0.0001 + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = lx; + ps->data->lpox[1] = ly; + ps->data->lpox[2] = lz; + ps->data->ssst = sPp->data->sst; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == sPp->data->ble) + break; + Bgl = Bgl->next; + } + } + sPp = sPp->next; + } + } + else + { + while (Pp) + { + Bgl = Pp->data->blb; + while (Bgl) + { + Bg = Bgl->data; + if (Bg->rank == rank_in) + { + for (int j = 0; j < dim; j++) + { + if (feq(Bg->bbox[j], Pp->data->bbox[j], CDH[j] / 2)) + llb[j] = Bg->bbox[j]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + llb[j] = Bg->bbox[j] + (ghost_width - 1) * CDH[j]; +#else +#ifdef Cell + else + llb[j] = Bg->bbox[j] + ghost_width * CDH[j]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (feq(Bg->bbox[dim + j], Pp->data->bbox[dim + j], CDH[j] / 2)) + uub[j] = Bg->bbox[dim + j]; + else + uub[j] = Bg->bbox[dim + j] - ghost_width * CDH[j]; + } + if (x > llb[0] - 0.0001 * CDH[0] && x < uub[0] + 0.0001 * CDH[0] && + y > llb[1] - 0.0001 * CDH[1] && y < uub[1] + 0.0001 * CDH[1] && + z > llb[2] - 0.0001 * CDH[2] && z < uub[2] + 0.0001 * CDH[2]) + { + MyList *ps = new MyList; + ps->data = new pointstru; + ps->data->Bg = Bg; + ps->data->gpox[0] = x; + ps->data->gpox[1] = y; + ps->data->gpox[2] = z; + ps->data->lpox[0] = x; + ps->data->lpox[1] = y; + ps->data->lpox[2] = z; + ps->data->ssst = -1; + ps->data->tsst = tsst; + ps->data->dumyd = getdumydimension(ps->data->ssst, ps->data->tsst); + ps->data->coef = 0; + ps->data->sind = 0; + ps->next = 0; + if (psul) + psul->catList(ps); + else + psul = ps; + return true; + } + } + if (Bgl == Pp->data->ble) + break; + Bgl = Bgl->next; + } + Pp = Pp->next; + } + } + + return false; +} + +// setup interpatch interpolation stuffs +void ShellPatch::setupintintstuff(int cpusize, MyList *CPatL, int Symmetry) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) { + cout << endl; + cout << " ShellPatch::setup interpatch interpolation stuffs begines..." << endl; + } + + ss_src = new MyList *[cpusize]; + ss_dst = new MyList *[cpusize]; + csatc_src = new MyList *[cpusize]; + csatc_dst = new MyList *[cpusize]; + csats_src = new MyList *[cpusize]; + csats_dst = new MyList *[cpusize]; + + MyList *ps, *ts; + MyList *sPp; + MyList *Bgl; + MyList *Pp; + Block *Bg; + double CDH[dim], DH[dim], llb[dim], uub[dim]; + double x, y, z; + + for (int i = 0; i < dim; i++) + { + CDH[i] = CPatL->data->getdX(i); + DH[i] = getdX(i); + } + + for (int i = 0; i < cpusize; i++) + { + ss_src[i] = 0; + csatc_src[i] = 0; + csats_src[i] = 0; + ss_dst[i] = 0; + csatc_dst[i] = 0; + csats_dst[i] = 0; + } + + sPp = PatL; + while (sPp) + { + for (int iz = 0; iz < sPp->data->shape[2]; iz++) + for (int is = 0; is < sPp->data->shape[1]; is++) + for (int ir = 0; ir < sPp->data->shape[0]; ir++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = sPp->data->bbox[0] + ir * DH[0]; + y = sPp->data->bbox[1] + is * DH[1]; + z = sPp->data->bbox[2] + iz * DH[2]; +#else +#ifdef Cell + x = sPp->data->bbox[0] + (ir + 0.5) * DH[0]; + y = sPp->data->bbox[1] + (is + 0.5) * DH[1]; + z = sPp->data->bbox[2] + (iz + 0.5) * DH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (z < sPp->data->bbox[2] + (SC_width + 0.0001) * DH[2]) + { + double gx, gy, gz; + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = false; + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(csats_src[i], false, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + CPatL->data->checkBlock(); + if (myrank == 0) + { + cout << "ShellPatch::prolongpointstru fail to find cardisian source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + cout << "x,y,z = " << gx << "," << gy << "," << gz << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + // else if(x<-PI/4-(overghost-ghost_width-0.0001)*DH[0] || x>PI/4+(overghost-ghost_width-0.0001)*DH[0] || + // y<-PI/4-(overghost-ghost_width-0.0001)*DH[1] || y>PI/4+(overghost-ghost_width-0.0001)*DH[1] ) //0.0001 is for vertex center + if (x < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[0] || x > PI / 4 + (overghost - ghost_width - 0.0001) * DH[0] || + y < -PI / 4 - (overghost - ghost_width - 0.0001) * DH[1] || y > PI / 4 + (overghost - ghost_width - 0.0001) * DH[1]) + { + double gx, gy, gz; + getglobalpox(gx, gy, gz, sPp->data->sst, x, y, z); + bool flag = false; + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(ss_src[i], true, sPp->data->sst, PatL, DH, CPatL, CDH, gx, gy, gz, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + cout << "ShellPatch::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = " << sPp->data->sst << " lx,ly,lz = " << x << "," << y << "," << z << endl; + if (sPp->data->sst == -1) + cout << "your angular resolution for shell is too coarse?" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + sPp = sPp->next; + } + if (myrank == 0) + cout << " ShellPatch::setup interpatch interpolation stuffs ss_src completes" << endl; + + Pp = CPatL; + while (Pp) + { + double llb[dim], uub[dim]; + if (Symmetry > 0) + llb[2] = Pp->data->bbox[2] - 0.0001 * CDH[2]; + else + llb[2] = Pp->data->bbox[2] + (CS_width + 0.0001) * CDH[2]; + uub[2] = Pp->data->bbox[dim + 2] - (CS_width + 0.0001) * CDH[2]; + for (int j = 0; j < 2; j++) + { + if (Symmetry > 1) + llb[j] = Pp->data->bbox[j] - 0.0001 * CDH[j]; + else + llb[j] = Pp->data->bbox[j] + (CS_width + 0.0001) * CDH[j]; + uub[j] = Pp->data->bbox[dim + j] - (CS_width + 0.0001) * CDH[j]; + } + for (int iz = 0; iz < Pp->data->shape[2]; iz++) + for (int iy = 0; iy < Pp->data->shape[1]; iy++) + for (int ix = 0; ix < Pp->data->shape[0]; ix++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + x = Pp->data->bbox[0] + ix * CDH[0]; + y = Pp->data->bbox[1] + iy * CDH[1]; + z = Pp->data->bbox[2] + iz * CDH[2]; +#else +#ifdef Cell + x = Pp->data->bbox[0] + (ix + 0.5) * CDH[0]; + y = Pp->data->bbox[1] + (iy + 0.5) * CDH[1]; + z = Pp->data->bbox[2] + (iz + 0.5) * CDH[2]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (x < llb[0] || x > uub[0] || + y < llb[1] || y > uub[1] || + z < llb[2] || z > uub[2]) + { + int sst; + double lx, ly, lz; + bool flag = false; + getlocalpox(x, y, z, sst, lx, ly, lz); + for (int i = 0; i < cpusize; i++) + { + flag = prolongpointstru(csatc_src[i], true, -1, PatL, DH, CPatL, CDH, x, y, z, Symmetry, i); + if (flag) + break; + } + if (!flag) + { + if (myrank == 0) + { + cout << "ShellPatch::prolongpointstru fail to find shell source point for" << endl; + cout << "sst = -1, x,y,z = " << x << "," << y << "," << z << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + } + } + Pp = Pp->next; + } + if (myrank == 0) + cout << " ShellPatch::setup interpatch interpolation stuffs csatc_src and csats_src completes" << endl; + + for (int i = 0; i < cpusize; i++) + { + ps = ss_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(ss_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + + ps = csatc_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(csatc_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + ps = csats_src[i]; + while (ps) + { + ts = ps->next; + prolongpointstru(csats_dst[i], PatL, DH, CPatL, CDH, ps); // ps may be insterted more here + ps = ts; + } + } + if (myrank == 0) + cout << " ShellPatch::ssetup interpatch interpolation stuffs ss_dst and csatc_dst, csats_dst complete" << endl; + + /* + for(int i=0;inext; + ts=ts->next; + } + } + exit(0); + */ +} + +void ShellPatch::setupcordtrans() +{ + MyList *PP = PatL; + while (PP) + { + PP->data->setupcordtrans(); + PP = PP->next; + } +} + +void ShellPatch::checkPatch() +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << " belong to Shell Patchs " << endl; + MyList *Pp = PatL; + while (Pp) + { + cout << " shape: ["; + for (int i = 0; i < dim; i++) + { + cout << Pp->data->shape[i]; + if (i < dim - 1) + cout << ","; + else + cout << "]" << endl; + } + cout << " range:" << "("; + for (int i = 0; i < dim; i++) + { + cout << Pp->data->bbox[i] << ":" << Pp->data->bbox[dim + i]; + if (i < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + Pp = Pp->next; + } + } +} + +void ShellPatch::checkBlock(int sst) +{ + if (myrank == 0) + { + cout << "checking shell patch sst = " << sst << endl; + MyList *Pp = PatL; + while (Pp) + { + if (Pp->data->sst == sst) + { + MyList *BP = Pp->data->blb; + while (BP) + { + BP->data->checkBlock(); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + } + Pp = Pp->next; + } + } +} + +double ShellPatch::getdX(int dir) +{ + if (dir < 0 || dir >= dim) + { + cout << "ShellPatch::getdX: error input dir = " << dir << ", this Patch has direction (0," << dim - 1 << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double h; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + if (shape[dir] == 1) + { + cout << "ShellPatch::getdX: for direction " << dir << ", this Patch has only one point. Can not determine dX for vertex center grid." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + if (dir < 2) + h = PI / 2 / (shape[dir] - 1); + else + h = (Rrange[1] - Rrange[0]) / (shape[dir] - 1); +#else +#ifdef Cell + if (dir < 2) + h = PI / 2 / shape[dir]; + else + h = (Rrange[1] - Rrange[0]) / shape[dir]; +#else +#error Not define Vertex nor Cell +#endif +#endif + return h; +} + +void ShellPatch::shellname(char *sn, int i) +{ + switch (i) + { + case 0: + sprintf(sn, "zp"); + return; + case 1: + sprintf(sn, "zm"); + return; + case 2: + sprintf(sn, "xp"); + return; + case 3: + sprintf(sn, "xm"); + return; + case 4: + sprintf(sn, "yp"); + return; + case 5: + sprintf(sn, "ym"); + return; + } +} +// Now we dump the data including overlap points +void ShellPatch::Dump_xyz(char *tag, double time, double dT) +{ + MyList *PP = PatL; + while (PP) + { + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->data->shape[0] * PP->data->shape[1] * PP->data->shape[2]); + if (!databuffer) + { + cout << "ShellPatch::Dump_xyz: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + for (int DumpList = fngfs + gx; DumpList <= fngfs + gz; DumpList++) + { + MyList *Bp = PP->data->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[DumpList], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[DumpList], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->data->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + char sn[3]; + shellname(sn, PP->data->sst); + switch (DumpList - fngfs) + { + case gx: + if (tag) + sprintf(filename, "%s/%s_LevSH-%s_x_%05d.bin", out_dir.c_str(), tag, sn, ncount); + else + sprintf(filename, "%s/LevSH-%s_x_%05d.bin", out_dir.c_str(), sn, ncount); + break; + case gy: + if (tag) + sprintf(filename, "%s/%s_LevSH-%s_y_%05d.bin", out_dir.c_str(), tag, sn, ncount); + else + sprintf(filename, "%s/LevSH-%s_y_%05d.bin", out_dir.c_str(), sn, ncount); + break; + case gz: + if (tag) + sprintf(filename, "%s/%s_LevSH-%s_z_%05d.bin", out_dir.c_str(), tag, sn, ncount); + else + sprintf(filename, "%s/LevSH-%s_z_%05d.bin", out_dir.c_str(), sn, ncount); + break; + } + + Parallel::writefile(time, PP->data->shape[0], PP->data->shape[1], PP->data->shape[2], + PP->data->bbox[0], PP->data->bbox[3], PP->data->bbox[1], PP->data->bbox[4], + PP->data->bbox[2], PP->data->bbox[5], filename, databuffer); + } + } + + if (myrank == 0) + free(databuffer); + + PP = PP->next; + } +} + +void ShellPatch::Dump_Data(MyList *DumpListi, char *tag, double time, double dT) +{ + MyList *PP = PatL; + while (PP) + { + // round at 4 and 5 + int ncount = int(time / dT + 0.5); + + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->data->shape[0] * PP->data->shape[1] * PP->data->shape[2]); + if (!databuffer) + { + cout << "ShellPatch::Dump_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *DumpList = DumpListi; + while (DumpList) + { + var *VP = DumpList->data; + + MyList *Bp = PP->data->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->data->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->data->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->data->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->data->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->data->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->data->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->data->bbox, PP->data->bbox + DIM, PP->data->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->data->ble) + break; + Bp = Bp->next; + } + if (myrank == 0) + { + + string out_dir; + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + char filename[100]; + char sn[3]; + shellname(sn, PP->data->sst); + if (tag) + sprintf(filename, "%s/%s_LevSH-%s_%s_%05d.bin", out_dir.c_str(), tag, sn, VP->name, ncount); + else + sprintf(filename, "%s/LevSH-%s_%s_%05d.bin", out_dir.c_str(), sn, VP->name, ncount); + + Parallel::writefile(time, PP->data->shape[0], PP->data->shape[1], PP->data->shape[2], + PP->data->bbox[0], PP->data->bbox[3], PP->data->bbox[1], PP->data->bbox[4], + PP->data->bbox[2], PP->data->bbox[5], filename, databuffer); + } + DumpList = DumpList->next; + } + + if (myrank == 0) + free(databuffer); + + PP = PP->next; + } +} + +double *ShellPatch::Collect_Data(ss_patch *PP, var *VP) +{ + MPI_Status sta; + int DIM = 3; + double llb[3], uub[3]; + double DX, DY, DZ; + + double *databuffer = 0; + if (myrank == 0) + { + databuffer = (double *)malloc(sizeof(double) * PP->shape[0] * PP->shape[1] * PP->shape[2]); + if (!databuffer) + { + cout << "ShellPatch::Collect_Data: out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + MyList *Bp = PP->blb; + while (Bp) + { + Block *BP = Bp->data; + if (BP->rank == 0 && myrank == 0) + { + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, BP->fgfs[VP->sgfn], llb, uub); + } + else + { + int nnn = (BP->shape[0]) * (BP->shape[1]) * (BP->shape[2]); + if (myrank == 0) + { + double *bufferhere = (double *)malloc(sizeof(double) * nnn); + if (!bufferhere) + { + cout << "on node#" << myrank << ", out of memory when dumping data." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Recv(bufferhere, nnn, MPI_DOUBLE, BP->rank, 0, MPI_COMM_WORLD, &sta); + DX = BP->getdX(0); + DY = BP->getdX(1); + DZ = BP->getdX(2); + llb[0] = (feq(BP->bbox[0], PP->bbox[0], DX / 2)) ? BP->bbox[0] : BP->bbox[0] + ghost_width * DX; + llb[1] = (feq(BP->bbox[1], PP->bbox[1], DY / 2)) ? BP->bbox[1] : BP->bbox[1] + ghost_width * DY; + llb[2] = (feq(BP->bbox[2], PP->bbox[2], DZ / 2)) ? BP->bbox[2] : BP->bbox[2] + ghost_width * DZ; + uub[0] = (feq(BP->bbox[3], PP->bbox[3], DX / 2)) ? BP->bbox[3] : BP->bbox[3] - ghost_width * DX; + uub[1] = (feq(BP->bbox[4], PP->bbox[4], DY / 2)) ? BP->bbox[4] : BP->bbox[4] - ghost_width * DY; + uub[2] = (feq(BP->bbox[5], PP->bbox[5], DZ / 2)) ? BP->bbox[5] : BP->bbox[5] - ghost_width * DZ; + f_copy(DIM, PP->bbox, PP->bbox + DIM, PP->shape, databuffer, BP->bbox, BP->bbox + DIM, BP->shape, bufferhere, llb, uub); + free(bufferhere); + } + else if (myrank == BP->rank) + { + MPI_Send(BP->fgfs[VP->sgfn], nnn, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD); + } + } + if (Bp == PP->ble) + break; + Bp = Bp->next; + } + + return databuffer; +} + +void ShellPatch::intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry) +{ + int myrank, cpusize; + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int node; + + MPI_Request *reqs; + MPI_Status *stats; + reqs = new MPI_Request[2 * cpusize]; + stats = new MPI_Status[2 * cpusize]; + int req_no = 0; + + double **send_data, **rec_data; + send_data = new double *[cpusize]; + rec_data = new double *[cpusize]; + int length; + + for (node = 0; node < cpusize; node++) + { + send_data[node] = rec_data[node] = 0; + if (node == myrank) + { + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 1" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(rec_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + } + } + else + { + // send from this cpu to cpu#node + if (length = interdata_packer(0, src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry)) + { + send_data[node] = new double[length]; + if (!send_data[node]) + { + cout << "out of memory when new in short transfer, place 2" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + interdata_packer(send_data[node], src[myrank], dst[myrank], node, PACK, VarList1, VarList2, Symmetry); + MPI_Isend((void *)send_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + // receive from cpu#node to this cpu + if (length = interdata_packer(0, src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry)) + { + rec_data[node] = new double[length]; + if (!rec_data[node]) + { + cout << "out of memory when new in short transfer, place 3" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + MPI_Irecv((void *)rec_data[node], length, MPI_DOUBLE, node, 1, MPI_COMM_WORLD, reqs + req_no++); + } + } + } + // wait for all requests to complete + MPI_Waitall(req_no, reqs, stats); + + for (node = 0; node < cpusize; node++) + if (rec_data[node]) + interdata_packer(rec_data[node], src[node], dst[node], node, UNPACK, VarList1, VarList2, Symmetry); + + for (node = 0; node < cpusize; node++) + { + if (send_data[node]) + delete[] send_data[node]; + if (rec_data[node]) + delete[] rec_data[node]; + } + + delete[] reqs; + delete[] stats; + delete[] send_data; + delete[] rec_data; +} +// PACK: prepare target data in 'data' +// UNPACK: copy target data from 'data' to corresponding numerical grids +int ShellPatch::interdata_packer(double *data, MyList *src, MyList *dst, int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, int Symmetry) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int DIM = dim; + int ordn = 2 * ghost_width; + + if (dir != PACK && dir != UNPACK) + { + cout << "error dir " << dir << " for data_packer " << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + int size_out = 0; + + if (!src || !dst) + return size_out; + + MyList *varls, *varld; + + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + varls = varls->next; + varld = varld->next; + } + + if (varls || varld) + { + cout << "error in short data packer, var lists does not match." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + while (src && dst) + { + if ((dir == PACK && dst->data->Bg->rank == rank_in && src->data->Bg->rank == myrank) || + (dir == UNPACK && src->data->Bg->rank == rank_in && dst->data->Bg->rank == myrank)) + { + varls = VarLists; + varld = VarListd; + while (varls && varld) + { + if (data) + { + if (dir == PACK) + { + /* + f_global_interp(src->data->Bg->shape,src->data->Bg->X[0],src->data->Bg->X[1],src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn],data[size_out], + src->data->lpox[0],src->data->lpox[1],src->data->lpox[2],ordn,varls->data->SoA,Symmetry); + */ + int DIMh = (src->data->dumyd == -1) ? dim : 1; + if (src->data->coef == 0) + { + src->data->coef = new double[ordn * DIMh]; + src->data->sind = new int[dim]; + if (DIMh == 3) + { + for (int i = 0; i < DIMh; i++) + { + double dd = src->data->Bg->getdX(i); + // 0.001 instead of 0.4 makes the point locate more center + src->data->sind[i] = int((src->data->lpox[i] - src->data->Bg->X[i][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[i][0] + (src->data->sind[i] + j) * dd; + src->data->coef[i * ordn + j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[i][0] + (src->data->sind[i] + k) * dd; + src->data->coef[i * ordn + j] *= (src->data->lpox[i] - h2) / (h1 - h2); + } + } + } + } + else + { + int actd = 1 - src->data->dumyd; + double dd = src->data->Bg->getdX(actd); + src->data->sind[0] = int((src->data->lpox[actd] - src->data->Bg->X[actd][0]) / dd) - ordn / 2 + 1; + double h1, h2; + for (int j = 0; j < ordn; j++) + { + h1 = src->data->Bg->X[actd][0] + (src->data->sind[0] + j) * dd; + src->data->coef[j] = 1; + for (int k = 0; k < j; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + for (int k = j + 1; k < ordn; k++) + { + h2 = src->data->Bg->X[actd][0] + (src->data->sind[0] + k) * dd; + src->data->coef[j] *= (src->data->lpox[actd] - h2) / (h1 - h2); + } + } + src->data->sind[2] = int((src->data->lpox[2] - src->data->Bg->X[2][0]) / src->data->Bg->getdX(2) + 0.001); + if (!feq(src->data->Bg->X[2][src->data->sind[2]], src->data->lpox[2], src->data->Bg->getdX(2) / 2000)) + cout << "error in ShellPatch::interdata_packer point = " << src->data->lpox[2] << " != grid " << src->data->Bg->X[2][src->data->sind[2]] << endl; + src->data->sind[1] = int((src->data->lpox[src->data->dumyd] - src->data->Bg->X[src->data->dumyd][0]) / + src->data->Bg->getdX(src->data->dumyd) + + 0.001); + if (!feq(src->data->Bg->X[src->data->dumyd][src->data->sind[1]], src->data->lpox[src->data->dumyd], src->data->Bg->getdX(src->data->dumyd) / 2000)) + cout << "error in ShellPatch::interdata_packer for dumy dimension point = " + << src->data->lpox[src->data->dumyd] << " != grid " << src->data->Bg->X[src->data->dumyd][src->data->sind[1]] << endl; + } + } + // interpolate + switch (DIMh) + { + case 3: + f_global_interpind(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 2: + f_global_interpind2d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst); + break; + case 1: + f_global_interpind1d(src->data->Bg->shape, src->data->Bg->X[0], src->data->Bg->X[1], src->data->Bg->X[2], + src->data->Bg->fgfs[varls->data->sgfn], data[size_out], + src->data->lpox[0], src->data->lpox[1], src->data->lpox[2], ordn, varls->data->SoA, Symmetry, + src->data->sind, src->data->coef, src->data->ssst, src->data->dumyd); + break; + default: + cout << "ShellPatch::interdata_packer: not recognized DIM = " << DIMh << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + if (dir == UNPACK) // from target data to corresponding grid + f_pointcopy(DIM, dst->data->Bg->bbox, dst->data->Bg->bbox + dim, dst->data->Bg->shape, dst->data->Bg->fgfs[varld->data->sgfn], + dst->data->lpox[0], dst->data->lpox[1], dst->data->lpox[2], data[size_out]); + } + size_out += 1; + varls = varls->next; + varld = varld->next; + } + } + dst = dst->next; + src = src->next; + } + + return size_out; +} +void ShellPatch::Synch(MyList *VarList, int Symmetry) +{ + MyList *Pp = PatL; + while (Pp) + { + Pp->data->Sync(VarList, Symmetry); + Pp = Pp->next; + } + + intertransfer(ss_src, ss_dst, VarList, VarList, Symmetry); +} + +void ShellPatch::CS_Inter(MyList *VarList, int Symmetry) +{ + // fill shell first + intertransfer(csats_src, csats_dst, VarList, VarList, Symmetry); + // fill box then + intertransfer(csatc_src, csatc_dst, VarList, VarList, Symmetry); +} + +void ShellPatch::check_pointstrul(MyList *pp, bool first_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (!pp) + cout << "ShellPatch::check_pointstrul meets empty pointstru" << endl; + else + cout << "checking check_pointstrul..." << endl; + while (pp) + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + if (first_only) + return; + pp = pp->next; + } + } +} + +void ShellPatch::check_pointstrul2(MyList *pp, int first_last_only) +{ + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + if (!pp) + cout << "ShellPatch::check_pointstrul meets empty pointstru" << endl; + else + cout << "checking check_pointstrul..." << endl; + while (pp) + { + if (first_last_only == 2) + { + if (pp->next == 0) + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + } + } + else + { + if (pp->data->Bg) + cout << "on node#" << pp->data->Bg->rank << endl; + else + cout << "virtual pointstru" << endl; + cout << "source sst = " << pp->data->ssst << endl; + cout << "target sst = " << pp->data->tsst << endl; + cout << "dumy dimension = " << pp->data->dumyd << endl; + cout << "global coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->gpox[i] << ","; + else + cout << pp->data->gpox[i] << ")" << endl; + } + cout << "local coordinates: ("; + for (int i = 0; i < dim; i++) + { + if (i < dim - 1) + cout << pp->data->lpox[i] << ","; + else + cout << pp->data->lpox[i] << ")" << endl; + } + if (first_last_only == 1) + return; + } + pp = pp->next; + } + } +} + +void ShellPatch::matchcheck(MyList *CPatL) +{ + double cbd = CPatL->data->bbox[dim]; + for (int i = 1; i < dim; i++) + cbd = Mymin(cbd, CPatL->data->bbox[dim + i]); + cbd = cbd - getsr(Rrange[0]); + double dr, dc; + dc = CPatL->data->getdX(0); + dr = getdX(2); + for (int i = 1; i < dim; i++) + { + dc = Mymax(dc, CPatL->data->getdX(i)); + // dr = Mymax(dr,getdX(i)); + } + + int ir, ic; + ir = int(cbd / dr); + ic = int(cbd / dc); + if (Mymin(ir, ic) < 3 * ghost_width) // 3 because we need 1 for double cover region + { + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << "Shell Patches insert too shallow:" << endl; + cout << "distantance between these two boundaries is " << cbd << ", spatial step is " << Mymax(dc, dr) << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +} + +void ShellPatch::Interp_Points(MyList *VarList, + int NN, double **XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + int sst; + getlocalpox(XX[0][j], XX[1][j], XX[2][j], sst, pox[0], pox[1], pox[2]); + + MyList *sPp = PatL; + while (sPp->data->sst != sst) + sPp = sPp->next; + + if (myrank == 0 && ((!sPp) || pox[2] < Rrange[0] || pox[2] > Rrange[1])) + { + cout << "ShellPatch::Interp_Points: point ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k][j]; + if (k < dim - 1) + cout << ","; + else + cout << ") is out of the ShellPatch." << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (!sPp) + return; + + MyList *Bp = sPp->data->blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +// +// because of getlocalpox, pox will not goes into overghost region of ss_patch +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (pox[i] - llb[i] < -DH[i] / 2 || pox[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + f_global_interp_ss(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry, sst); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: ShellPatch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: ShellPatch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j][i]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on ShellPatch (" << Rrange[0] << "," << Rrange[1] << endl; + + cout << "splited domains:" << endl; + MyList *sPp = PatL; + while (sPp) + { + char sn[3]; + shellname(sn, sPp->data->sst); + cout << "ss_patch " << sn << ":" << endl; + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; +} + +bool ShellPatch::Interp_One_Point(MyList *VarList, + double *XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + const int NN = 1; + // NOTE: we do not Synchnize variables here, make sure of that before calling this routine + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int ordn = 2 * ghost_width; + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf; + shellf = new double[NN * num_var]; + memset(shellf, 0, sizeof(double) * NN * num_var); + + // we use weight to monitor code, later some day we can move it for optimization + int *weight; + weight = new int[NN]; + memset(weight, 0, sizeof(int) * NN); + + double *DH, *llb, *uub; + DH = new double[dim]; + + for (int i = 0; i < dim; i++) + { + DH[i] = getdX(i); + } + llb = new double[dim]; + uub = new double[dim]; + + for (int j = 0; j < NN; j++) // run along points + { + double pox[dim]; + int sst; + getlocalpox(XX[0], XX[1], XX[2], sst, pox[0], pox[1], pox[2]); + + MyList *sPp = PatL; + while (sPp->data->sst != sst) + sPp = sPp->next; + + if ((!sPp) || pox[2] < Rrange[0] || pox[2] > Rrange[1]) + { + if (myrank == 0) + { + cout << "ShellPatch::Interp_One_Point: point ("; + for (int k = 0; k < dim; k++) + { + cout << XX[k]; + if (k < dim - 1) + cout << ","; + else + cout << ") is out of the ShellPatch." << endl; + } + } + return false; + } + + MyList *Bp = sPp->data->blb; + bool notfind = true; + while (notfind && Bp) // run along Blocks + { + Block *BP = Bp->data; + + bool flag = true; + for (int i = 0; i < dim; i++) + { +// NOTE: our dividing structure is (exclude ghost) +// -1 0 +// 1 2 +// so (0,1) does not belong to any part for vertex structure +// here we put (0,0.5) to left part and (0.5,1) to right part +// BUT for cell structure the bbox is (-1.5,0.5) and (0.5,2.5), there is no missing region at all +// +// because of getlocalpox, pox will not goes into overghost region of ss_patch +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + if (pox[i] - llb[i] < -DH[i] / 2 || pox[i] - uub[i] > DH[i] / 2) + { + flag = false; + break; + } + } + + if (flag) + { + notfind = false; + if (myrank == BP->rank) + { + //---> interpolation + varl = VarList; + int k = 0; + while (varl) // run along variables + { + f_global_interp_ss(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], shellf[j * num_var + k], + pox[0], pox[1], pox[2], ordn, varl->data->SoA, Symmetry, sst); + varl = varl->next; + k++; + } + weight[j] = 1; + } + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + } + + MPI_Allreduce(shellf, Shellf, NN * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + int *Weight; + Weight = new int[NN]; + MPI_Allreduce(weight, Weight, NN, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + + for (int i = 0; i < NN; i++) + { + if (Weight[i] > 1) + { + if (myrank == 0) + cout << "WARNING: ShellPatch::Interp_Points meets multiple weight" << endl; + for (int j = 0; j < num_var; j++) + Shellf[j + i * num_var] = Shellf[j + i * num_var] / Weight[i]; + } + else if (Weight[i] == 0 && myrank == 0) + { + cout << "ERROR: ShellPatch::Interp_Points fails to find point ("; + for (int j = 0; j < dim; j++) + { + cout << XX[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")"; + } + cout << " on ShellPatch (" << Rrange[0] << "," << Rrange[1] << endl; + + cout << "splited domains:" << endl; + MyList *sPp = PatL; + while (sPp) + { + char sn[3]; + shellname(sn, sPp->data->sst); + cout << "ss_patch " << sn << ":" << endl; + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + for (int i = 0; i < dim; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + (ghost_width - 0.5) * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - (ghost_width - 0.5) * DH[i]; +#else +#ifdef Cell + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? BP->bbox[i] : BP->bbox[i] + ghost_width * DH[i]; + uub[i] = (feq(BP->bbox[dim + i], sPp->data->bbox[dim + i], DH[i] / 2)) ? BP->bbox[dim + i] : BP->bbox[dim + i] - ghost_width * DH[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + } + cout << "("; + for (int j = 0; j < dim; j++) + { + cout << llb[j] << ":" << uub[j]; + if (j < dim - 1) + cout << ","; + else + cout << ")" << endl; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + delete[] shellf; + delete[] weight; + delete[] Weight; + delete[] DH; + delete[] llb; + delete[] uub; + + return true; +} + +void ShellPatch::write_Pablo_file_ss(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename, int sst) +{ + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + double *X, *Y, *Z; + X = new double[nx]; + Y = new double[ny]; + Z = new double[nz]; + double dX, dY, dZ; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dX = (xmax - xmin) / (nx - 1); + for (i = 0; i < nx; i++) + X[i] = xmin + i * dX; + dY = (ymax - ymin) / (ny - 1); + for (j = 0; j < ny; j++) + Y[j] = ymin + j * dY; + dZ = (zmax - zmin) / (nz - 1); + for (k = 0; k < nz; k++) + Z[k] = zmin + k * dZ; +#else +#ifdef Cell + dX = (xmax - xmin) / nx; + for (i = 0; i < nx; i++) + X[i] = xmin + (i + 0.5) * dX; + dY = (ymax - ymin) / ny; + for (j = 0; j < ny; j++) + Y[j] = ymin + (j + 0.5) * dY; + dZ = (zmax - zmin) / nz; + for (k = 0; k < nz; k++) + Z[k] = zmin + (k + 0.5) * dZ; +#else +#error Not define Vertex nor Cell +#endif +#endif + //|--->open out put file + ofstream outfile; + outfile.open(filename); + if (!outfile) + { + cout << "bssn_class: write_Pablo_file can't open " << filename << " for output." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + double gx, gy, gz; + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + for (k = 0; k < nz; k++) + for (j = 0; j < ny; j++) + for (i = 0; i < nx; i++) + { + getglobalpox(gx, gy, gz, sst, X[i], Y[j], Z[k]); + outfile << gx << " " << gy << " " << gz << " " + << 0 << endl; + } + outfile.close(); + + delete[] X; + delete[] Y; + delete[] Z; +} + +double ShellPatch::L2Norm(var *vf) +{ + double tvf, dtvf = 0; + int BDW = overghost; + + MyList *sPp = PatL; + while (sPp) + { + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *cg = Bp->data; + if (myrank == cg->rank) + { + f_l2normhelper(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[vf->sgfn], tvf, BDW); + dtvf += tvf; + } + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + + MPI_Allreduce(&dtvf, &tvf, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + tvf = sqrt(tvf); + + return tvf; +} + +// find maximum of abstract value, XX store position for maximum, Shellf store maximum themselvs +void ShellPatch::Find_Maximum(MyList *VarList, double *XX, + double *Shellf) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double *shellf, *xx; + shellf = new double[num_var]; + xx = new double[3 * num_var]; + for (int i = 0; i < num_var; i++) + shellf[i] = -1; // make sure be rewriten + memset(xx, 0, sizeof(double) * 3 * num_var); + + double *DH; + int *llb, *uub; + DH = new double[3]; + + for (int i = 0; i < 3; i++) + { + DH[i] = getdX(i); + } + + llb = new int[3]; + uub = new int[3]; + + MyList *sPp = PatL; + while (sPp) + { + MyList *Bp = sPp->data->blb; + while (Bp) + { + Block *BP = Bp->data; + + if (myrank == BP->rank) + { + + for (int i = 0; i < 2; i++) + { + llb[i] = (feq(BP->bbox[i], sPp->data->bbox[i], DH[i] / 2)) ? 0 : ghost_width; + uub[i] = (feq(BP->bbox[3 + i], sPp->data->bbox[3 + i], DH[i] / 2)) ? 0 : ghost_width; + } + llb[2] = (feq(BP->bbox[2], sPp->data->bbox[2], DH[2] / 2)) ? buffer_width : ghost_width; + uub[2] = (feq(BP->bbox[5], sPp->data->bbox[5], DH[2] / 2)) ? 0 : ghost_width; + + varl = VarList; + int k = 0; + double tmp, tmpx[3]; + while (varl) // run along variables + { + f_find_maximum(BP->shape, BP->X[0], BP->X[1], BP->X[2], BP->fgfs[varl->data->sgfn], tmp, tmpx, llb, uub); + if (tmp > shellf[k]) + { + shellf[k] = tmp; + getglobalpox(xx[3 * k], xx[3 * k + 1], xx[3 * k + 2], sPp->data->sst, tmpx[0], tmpx[1], tmpx[2]); + } + varl = varl->next; + k++; + } + } + + if (Bp == sPp->data->ble) + break; + Bp = Bp->next; + } + sPp = sPp->next; + } + + struct mloc + { + double val; + int rank; + }; + + mloc *IN, *OUT; + IN = new mloc[num_var]; + OUT = new mloc[num_var]; + for (int i = 0; i < num_var; i++) + { + IN[i].val = shellf[i]; + IN[i].rank = myrank; + } + + MPI_Allreduce(IN, OUT, num_var, MPI_DOUBLE_INT, MPI_MAXLOC, MPI_COMM_WORLD); + + for (int i = 0; i < num_var; i++) + { + Shellf[i] = OUT[i].val; + if (myrank != OUT[i].rank) + for (int k = 0; k < 3; k++) + xx[3 * i + k] = 0; + } + + MPI_Allreduce(xx, XX, 3 * num_var, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + delete[] IN; + delete[] OUT; + delete[] shellf; + delete[] xx; + delete[] DH; + delete[] llb; + delete[] uub; +} + diff --git a/AMSS_NCKU_source/ShellPatch.h b/AMSS_NCKU_source/ShellPatch.h new file mode 100644 index 0000000..b64c79d --- /dev/null +++ b/AMSS_NCKU_source/ShellPatch.h @@ -0,0 +1,204 @@ + +#ifndef SHELLPATCH_H +#define SHELLPATCH_H + +#include +#include "MyList.h" +#include "Block.h" +#include "Parallel.h" +#include "var.h" +#include "monitor.h" +#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width + +#if (dim != 3) +#error shellpatch only supports 3 dimensional stuff yet +#endif + +class ss_patch +{ + +public: + int sst; // ss_patch type: 0:zp, 1:zm, 2:xp, 3:xm, 4:yp, 5:ym + int myrank; + int shape[dim]; + double bbox[2 * dim]; // this bbox includes nominal points and overlap points + MyList *blb, *ble; + int ingfs, fngfs; + + ss_patch() {}; + ss_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki); + + ~ss_patch(); + + virtual void setupcordtrans() {}; + void Sync(MyList *VarList, int Symmetry); + MyList *build_bulk_gsl(Block *bp); + MyList *build_ghost_gsl(); + MyList *build_owned_gsl0(int rank_in); +}; + +class xp_patch : public ss_patch +{ +public: + xp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; }; + void setupcordtrans(); +}; + +class xm_patch : public ss_patch +{ +public: + xm_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; }; + void setupcordtrans(); +}; +class yp_patch : public ss_patch +{ +public: + yp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; }; + void setupcordtrans(); +}; + +class ym_patch : public ss_patch +{ +public: + ym_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; }; + void setupcordtrans(); +}; +class zp_patch : public ss_patch +{ +public: + zp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; }; + void setupcordtrans(); +}; + +class zm_patch : public ss_patch +{ +public: + zm_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; }; + void setupcordtrans(); +}; +// Shell Patch system +// for derivatives usage we ask 27 more double type grid functions +// here we use **sngfs corresponding to fngfs to store them: +// drho/dx, drho/dy, drho/dz +// dsigma/dx, dsigma/dy, dsigma/dz +// dR/dx, dR/dy, dR/dz +// drho/dxdx, drho/dxdy, drho/dxdz, drho/dydy, drho/dydz, drho/dzdz +// dsigma/dxdx, dsigma/dxdy, dsigma/dxdz, dsigma/dydy, dsigma/dydz, dsigma/dzdz +// dR/dxdx, dR/dxdy, dR/dxdz, dR/dydy, dR/dydz, dR/dzdz +class ShellPatch +{ + +public: + struct pointstru + { + double gpox[dim]; // global cordinate + double lpox[dim]; // local cordinate + Block *Bg; + int ssst; //-1: cardisian, others as sst of ss_patch source sst + int tsst; //-1: cardisian, others as sst of ss_patch target sst + double *coef; + int *sind; + int dumyd; // the dimension which has common lines, only useful in interdata_packer + //-1: means no dumy dimension at all; 0: means rho; 1: means sigma + }; + + int myrank; + int shape[dim]; // for (rho, sigma, R), for rho and sigma means number of points for every pi/2 + double Rrange[2]; // for Rmin and Rmax + int Symmetry; + int ingfs, fngfs; + + MyList *PatL; + + // we use fngfs+v to reference the variable + enum + { + gx = 0, + gy, + gz, + drhodx, + drhody, + drhodz, + dsigmadx, + dsigmady, + dsigmadz, + dRdx, + dRdy, + dRdz, + drhodxx, + drhodxy, + drhodxz, + drhodyy, + drhodyz, + drhodzz, + dsigmadxx, + dsigmadxy, + dsigmadxz, + dsigmadyy, + dsigmadyz, + dsigmadzz, + dRdxx, + dRdxy, + dRdxz, + dRdyy, + dRdyz, + dRdzz + }; + + MyList **ss_src, **ss_dst; + // at means target + MyList **csatc_src, **csatc_dst; + MyList **csats_src, **csats_dst; + +public: + ShellPatch(int ingfsi, int fngfsi, char *filename, int Symmetry, int myranki, monitor *ErrorMonitor); + + ~ShellPatch(); + + MyList *compose_sh(int cpusize, int nodes = 0); + MyList *compose_shr(int cpusize, int nodes = 0); + void setupcordtrans(); + double getR(double r); + double getsr(double R); + void checkPatch(); + void checkBlock(int sst); + void check_pointstrul(MyList *pp, bool first_only); + void check_pointstrul2(MyList *pp, int first_last_only); + double getdX(int dir); //(rho, sigma, R) + void Dump_xyz(char *tag, double time, double dT); + void Dump_Data(MyList *DumpList, char *tag, double time, double dT); + double *Collect_Data(ss_patch *PP, var *VP); + void getlocalpoxsst(double gx, double gy, double gz, int sst, double &lx, double &ly, double &lz); + void getlocalpox(double gx, double gy, double gz, int &sst, double &lx, double &ly, double &lz); + void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz); + void prolongpointstru(MyList *&psul, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], MyList *pss); + bool prolongpointstru(MyList *&psul, bool ssyn, int tsst, MyList *sPp, double DH[dim], + MyList *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in); + void setupintintstuff(int cpusize, MyList *CPatL, int Symmetry); + void intertransfer(MyList **src, MyList **dst, + MyList *VarList1 /* source */, MyList *VarList2 /*target */, + int Symmetry); + int interdata_packer(double *data, MyList *src, MyList *dst, + int rank_in, int dir, + MyList *VarLists /* source */, MyList *VarListd /* target */, + int Symmetry); + void Synch(MyList *VarList, int Symmetry); + void CS_Inter(MyList *VarList, int Symmetry); + void destroypsuList(MyList *ct); + int getdumydimension(int acsst, int posst); // -1 means no dumy dimension + void matchcheck(MyList *CPatL); + void shellname(char *sn, int i); + void Interp_Points(MyList *VarList, + int NN, double **XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry); + bool Interp_One_Point(MyList *VarList, + double *XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry); + void write_Pablo_file_ss(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename, int sst); + double L2Norm(var *vf); + void Find_Maximum(MyList *VarList, double *XX, double *Shellf); +}; + +#endif /* SHELLPATCH_H */ diff --git a/AMSS_NCKU_source/TwoPunctureABE.C b/AMSS_NCKU_source/TwoPunctureABE.C new file mode 100644 index 0000000..c59a01e --- /dev/null +++ b/AMSS_NCKU_source/TwoPunctureABE.C @@ -0,0 +1,221 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include "TwoPunctures.h" + +inline string &lTrim(string &ss) +{ + string::iterator p = find_if(ss.begin(), ss.end(), not1(ptr_fun(isspace))); + ss.erase(ss.begin(), p); + return ss; +} +inline string &rTrim(string &ss) +{ + string::reverse_iterator p = find_if(ss.rbegin(), ss.rend(), not1(ptr_fun(isspace))); + ss.erase(p.base(), ss.end()); + return ss; +} +inline string &Trim(string &st) +{ + lTrim(rTrim(st)); + return st; +} + +int parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind) +{ + int pos1, pos2; + string s0; + + ind = 0; + + // remove comments + str = str.substr(0, str.find("#")); + if (rTrim(str).empty()) + return 0; // continue; + + // parse {group, key, val} + pos1 = str.find("::"); + pos2 = str.find("="); + if (pos1 == string::npos || pos2 == string::npos) + return -1; + + s0 = str.substr(0, pos1); + sgrp = lTrim(s0); + s0 = str.substr(pos1 + 2, pos2 - pos1 - 2); + skey = rTrim(s0); + s0 = str.substr(pos2 + 1); + sval = Trim(s0); + + pos1 = sval.find("\""); + pos2 = sval.rfind("\""); + if (pos1 != string::npos) + { + sval = sval.substr(1, pos2 - 1); + } + + pos1 = skey.find("["); + pos2 = skey.find("]"); + if (pos1 != string::npos) + { + s0 = skey.substr(0, pos1); + ind = atoi(skey.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + skey = s0; + } + + return 1; +} +//======================================= +int main(int argc, char *argv[]) +{ + double mp, mm, b, Mp, Mm, admtol, Newtontol; + int nA, nB, nphi, Newtonmaxit; + double P_plusx, P_plusy, P_plusz; + double P_minusx, P_minusy, P_minusz; + double S_plusx, S_plusy, S_plusz; + double S_minusx, S_minusy, S_minusz; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + const char pname[] = "TwoPunctureinput.par"; + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + exit(0); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + exit(0); + } + else if (status == 0) + continue; + // we assume input in Brugmann's convention + if (sgrp == "ABE") + { + if (skey == "mm") + mm = atof(sval.c_str()); + else if (skey == "mp") + mp = atof(sval.c_str()); + else if (skey == "b") + b = atof(sval.c_str()); + else if (skey == "P_plusx") + P_plusy = -atof(sval.c_str()); + else if (skey == "P_plusy") + P_plusx = atof(sval.c_str()); + else if (skey == "P_plusz") + P_plusz = atof(sval.c_str()); + else if (skey == "P_minusx") + P_minusy = -atof(sval.c_str()); + else if (skey == "P_minusy") + P_minusx = atof(sval.c_str()); + else if (skey == "P_minusz") + P_minusz = atof(sval.c_str()); + else if (skey == "S_plusx") + S_plusy = -atof(sval.c_str()); + else if (skey == "S_plusy") + S_plusx = atof(sval.c_str()); + else if (skey == "S_plusz") + S_plusz = atof(sval.c_str()); + else if (skey == "S_minusx") + S_minusy = -atof(sval.c_str()); + else if (skey == "S_minusy") + S_minusx = atof(sval.c_str()); + else if (skey == "S_minusz") + S_minusz = atof(sval.c_str()); + else if (skey == "Mp") + Mp = atof(sval.c_str()); + else if (skey == "Mm") + Mm = atof(sval.c_str()); + else if (skey == "admtol") + admtol = atof(sval.c_str()); + else if (skey == "Newtontol") + Newtontol = atof(sval.c_str()); + else if (skey == "nA") + nA = atoi(sval.c_str()); + else if (skey == "nB") + nB = atoi(sval.c_str()); + else if (skey == "nphi") + nphi = atoi(sval.c_str()); + else if (skey == "Newtonmaxit") + Newtonmaxit = atoi(sval.c_str()); + } + } + inf.close(); + } + // echo parameters + { + cout << "///////////////////////////////////////////////////////////////" << endl; + cout << " mp = " << mp << endl; + cout << " mm = " << mm << endl; + cout << " b = " << b << endl; + cout << " P_plusx = " << P_plusx << endl; + cout << " P_plusy = " << P_plusy << endl; + cout << " P_plusz = " << P_plusz << endl; + cout << " P_minusx = " << P_minusx << endl; + cout << " P_minusy = " << P_minusy << endl; + cout << " P_minusz = " << P_minusz << endl; + cout << " S_plusx = " << S_plusx << endl; + cout << " S_plusy = " << S_plusy << endl; + cout << " S_plusz = " << S_plusz << endl; + cout << " S_minusx = " << S_minusx << endl; + cout << " S_minusy = " << S_minusy << endl; + cout << " S_minusz = " << S_minusz << endl; + cout << " Mp = " << Mp << endl; + cout << " Mm = " << Mm << endl; + cout << " admtol = " << admtol << endl; + cout << " Newtontol = " << Newtontol << endl; + cout << " nA = " << nA << endl; + cout << " nB = " << nB << endl; + cout << " nphi = " << nphi << endl; + cout << "Newtonmaxit = " << Newtonmaxit << endl; + cout << "///////////////////////////////////////////////////////////////" << endl; + } + //===========================the computation body==================================================== + TwoPunctures *ADM; + + ADM = new TwoPunctures(mp, mm, b, P_plusx, P_plusy, P_plusz, S_plusx, S_plusy, S_plusz, + P_minusx, P_minusy, P_minusz, S_minusx, S_minusy, S_minusz, + nA, nB, nphi, Mp, Mm, admtol, Newtontol, Newtonmaxit); + ADM->Solve(); + ADM->Save("Ansorg.psid"); + + delete ADM; + //=======================caculation done============================================================= + cout << "===============================================================" << endl; + cout << "Initial data is successfully producede!!" << endl; + + exit(0); +} diff --git a/AMSS_NCKU_source/TwoPunctures.C b/AMSS_NCKU_source/TwoPunctures.C new file mode 100644 index 0000000..2a9c710 --- /dev/null +++ b/AMSS_NCKU_source/TwoPunctures.C @@ -0,0 +1,2521 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include "TwoPunctures.h" + +TwoPunctures::TwoPunctures(double mp, double mm, double b, + double P_plusx, double P_plusy, double P_plusz, + double S_plusx, double S_plusy, double S_plusz, + double P_minusx, double P_minusy, double P_minusz, + double S_minusx, double S_minusy, double S_minusz, + int nA, int nB, int nphi, + double Mp, double Mm, double admtol, double Newtontol, + int Newtonmaxit) : par_m_plus(mp), par_m_minus(mm), par_b(b), npoints_A(nA), + npoints_B(nB), npoints_phi(nphi), target_M_plus(Mp), target_M_minus(Mm), + adm_tol(admtol), Newton_tol(Newtontol), Newton_maxit(Newtonmaxit) +{ + par_P_plus[0] = P_plusx; + par_P_plus[1] = P_plusy; + par_P_plus[2] = P_plusz; + par_P_minus[0] = P_minusx; + par_P_minus[1] = P_minusy; + par_P_minus[2] = P_minusz; + par_S_plus[0] = S_plusx; + par_S_plus[1] = S_plusy; + par_S_plus[2] = S_plusz; + par_S_minus[0] = S_minusx; + par_S_minus[1] = S_minusy; + par_S_minus[2] = S_minusz; + + int const nvar = 1, n1 = npoints_A, n2 = npoints_B, n3 = npoints_phi; + + ntotal = n1 * n2 * n3 * nvar; + + F = dvector(0, ntotal - 1); + allocate_derivs(&u, ntotal); + allocate_derivs(&v, ntotal); +} + +TwoPunctures::~TwoPunctures() +{ + free_dvector(F, 0, ntotal - 1); + free_derivs(&u, ntotal); + free_derivs(&v, ntotal); +} + +void TwoPunctures::Solve() +{ + + double mp = par_m_plus; + double mm = par_m_minus; + + enum GRID_SETUP_METHOD + { + GSM_Taylor_expansion, + GSM_evaluation + }; + enum GRID_SETUP_METHOD gsm; + + int antisymmetric_lapse, averaged_lapse, pmn_lapse, brownsville_lapse; + + int const nvar = 1, n1 = npoints_A, n2 = npoints_B, n3 = npoints_phi; + + int imin[3], imax[3]; + int const ntotal = n1 * n2 * n3 * nvar; + + // double admMass; + + /* initialise to 0 */ + for (int j = 0; j < ntotal; j++) + { + v.d0[j] = 0.0; + v.d1[j] = 0.0; + v.d2[j] = 0.0; + v.d3[j] = 0.0; + v.d11[j] = 0.0; + v.d12[j] = 0.0; + v.d13[j] = 0.0; + v.d22[j] = 0.0; + v.d23[j] = 0.0; + v.d33[j] = 0.0; + } + + double tmp, Mp_adm, Mm_adm, Mp_adm_err, Mm_adm_err, up, um; + + double M_p = target_M_plus; + double M_m = target_M_minus; + /* If bare masses are not given, iteratively solve for them given the + target ADM masses target_M_plus and target_M_minus and with initial + guesses given by par_m_plus and par_m_minus. */ + if (par_m_plus < 0 || par_m_minus < 0) + { + + par_m_plus = target_M_plus; + par_m_minus = target_M_minus; + cout << "Attempting to find bare masses." << endl; + cout << "Target ADM masses: M_p=" << M_p << " and M_m=" << M_m << endl; + cout << "ADM mass tolerance: " << adm_tol << endl; + + /* Loop until both ADM masses are within adm_tol of their target */ + do + { + cout << "Bare masses: mp=" << mp << ", mm=" << mm << endl; + Newton(nvar, n1, n2, n3, v, Newton_tol, 1); + + F_of_v(nvar, n1, n2, n3, v, F, u); + + up = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, par_b, 0., 0.); + um = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, -par_b, 0., 0.); + + /* Calculate the ADM masses from the current bare mass guess PRD 70, 064011 (2004) Eq.(83)*/ + Mp_adm = (1 + up) * mp + mp * mm / (4. * par_b); + Mm_adm = (1 + um) * mm + mp * mm / (4. * par_b); + + /* Check how far the current ADM masses are from the target */ + Mp_adm_err = fabs(M_p - Mp_adm); + Mm_adm_err = fabs(M_m - Mm_adm); + cout << "ADM mass error: M_p_err=" << Mp_adm_err << ", M_m_err=" << Mm_adm_err << endl; + + /* Invert the ADM mass equation and update the bare mass guess so that + it gives the correct target ADM masses */ + tmp = -4 * par_b * (1 + um + up + um * up) + + sqrt(16 * par_b * M_m * (1 + um) * (1 + up) + + pow(-M_m + M_p + 4 * par_b * (1 + um) * (1 + up), 2)); + par_m_plus = mp = (tmp + M_p - M_m) / (2. * (1 + up)); + par_m_minus = mm = (tmp - M_p + M_m) / (2. * (1 + um)); + + } while ((Mp_adm_err > adm_tol) || + (Mm_adm_err > adm_tol)); + + cout << "Found bare masses resulted Mp = " << Mp_adm << " and Mm = " << Mm_adm << endl; + } + + Newton(nvar, n1, n2, n3, v, Newton_tol, Newton_maxit); + + F_of_v(nvar, n1, n2, n3, v, F, u); + + up = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, par_b, 0., 0.); + um = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, -par_b, 0., 0.); + + /* Calculate the ADM masses from the current bare mass guess PRD 70, 064011 (2004) Eq.(83)*/ + Mp_adm = (1 + up) * mp + mp * mm / (4. * par_b); + Mm_adm = (1 + um) * mm + mp * mm / (4. * par_b); + + cout << "The two puncture masses are mp = " << mp << " and mm = " << mm << endl; + cout << " resulted Mp = " << Mp_adm << " and Mm = " << Mm_adm << endl; + + /* print out ADM mass, eq.: \Delta M_ADM=2*r*u=4*b*V for A=1,B=0,phi=0 PRD 70, 064011 (2004) Eq.(81)*/ + admMass = (mp + mm - 4 * par_b * PunctEvalAtArbitPosition(v.d0, 0, 1, 0, 0, nvar, n1, n2, n3)); + cout << "The total ADM mass is " << admMass << endl; + + target_M_plus = Mp_adm; + target_M_minus = Mm_adm; +} +void TwoPunctures::Save(char *fname) +{ + ofstream outfile; + outfile.open(fname, ios::trunc); + + time_t tnow; + time(&tnow); + struct tm *loc_time; + loc_time = localtime(&tnow); + outfile << "#File created on " << asctime(loc_time); + outfile << "#Newton_tol = " << Newton_tol << endl; + outfile << "#Mp = " << target_M_plus << endl; + outfile << "#Mm = " << target_M_minus << endl; + double D = 2 * par_b, x1, x2; + x1 = D * target_M_minus / (target_M_plus + target_M_minus); + x2 = -D * target_M_plus / (target_M_plus + target_M_minus); + // in order to relate Brugmann's convention, rotate xy + outfile << "bhmass1 = " << par_m_plus << endl; + outfile << "bhx1 = " << 0 << endl; + outfile << "bhy1 = " << x1 << endl; + outfile << "bhz1 = " << 0 << endl; + outfile << "bhpx1 = " << -par_P_plus[1] << endl; + outfile << "bhpy1 = " << par_P_plus[0] << endl; + outfile << "bhpz1 = " << par_P_plus[2] << endl; + outfile << "bhsx1 = " << -par_S_plus[1] << endl; + outfile << "bhsy1 = " << par_S_plus[0] << endl; + outfile << "bhsz1 = " << par_S_plus[2] << endl; + outfile << "bhmass2 = " << par_m_minus << endl; + outfile << "bhx2 = " << 0 << endl; + outfile << "bhy2 = " << x2 << endl; + outfile << "bhz2 = " << 0 << endl; + outfile << "bhpx2 = " << -par_P_minus[1] << endl; + outfile << "bhpy2 = " << par_P_minus[0] << endl; + outfile << "bhpz2 = " << par_P_minus[2] << endl; + outfile << "bhsx2 = " << -par_S_minus[1] << endl; + outfile << "bhsy2 = " << par_S_minus[0] << endl; + outfile << "bhsz2 = " << par_S_minus[2] << endl; + int const n1 = npoints_A, n2 = npoints_B, n3 = npoints_phi; + outfile << "data " << n1 << " " << n2 << " " << n3 << endl; + int ntotal = n1 * n2 * n3; + + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + for (int i = 0; i < ntotal; i++) + outfile << v.d0[i] << endl; + + outfile.close(); + + // add output to facilitate python reading of puncture data, by Xiaoqu 2024/12/04 + ofstream outfile2; + outfile2.open("puncture_parameters_new.txt", ios::trunc); + + // note that in this program the xy plane has been rotated + outfile2 << setw(18) << setprecision(10) << par_m_plus + << setw(18) << setprecision(10) << target_M_plus + << setw(18) << setprecision(10) << admMass << " # bare mass 1 mass 1 ADM mass" << endl; + outfile2 << setw(18) << setprecision(10) << 0.0 + << setw(18) << setprecision(10) << x1 + << setw(18) << setprecision(10) << 0.0 << " # position 1" << endl; + outfile2 << setw(18) << setprecision(10) << -par_P_plus[1] + << setw(18) << setprecision(10) << par_P_plus[0] + << setw(18) << setprecision(10) << par_P_plus[2] << " # momentum 1" << endl; + outfile2 << setw(18) << setprecision(10) << -par_S_plus[1] + << setw(18) << setprecision(10) << par_S_plus[0] + << setw(18) << setprecision(10) << par_S_plus[2] << " # angular mumentum 1" << endl; + outfile2 << setw(18) << setprecision(10) << par_m_minus + << setw(18) << setprecision(10) << target_M_minus + << setw(18) << setprecision(10) << admMass << " # bare mass 2 mass 2 ADM mass" << endl; + outfile2 << setw(18) << setprecision(10) << 0.0 + << setw(18) << setprecision(10) << x2 + << setw(18) << setprecision(10) << 0.0 << " # position 2" << endl; + outfile2 << setw(18) << setprecision(10) << -par_P_minus[1] + << setw(18) << setprecision(10) << par_P_minus[0] + << setw(18) << setprecision(10) << par_P_minus[2] << " # momentum 2" << endl; + outfile2 << setw(18) << setprecision(10) << -par_S_minus[1] + << setw(18) << setprecision(10) << par_S_minus[0] + << setw(18) << setprecision(10) << par_S_minus[2] << " # angular mumentum 2" << endl; + + outfile2.close(); +} + +void TwoPunctures::set_initial_guess(derivs v) +{ + + int nvar = 1, n1 = npoints_A, n2 = npoints_B, n3 = npoints_phi; + + double *s_x, *s_y, *s_z; // Cartesian x,y,z + double al, A, Am1, be, B, phi, R, r, X; + int ivar, i, j, k, i3D, indx; + derivs U; + FILE *debug_file; + + s_x = (double *)calloc(n1 * n2 * n3, sizeof(double)); + s_y = (double *)calloc(n1 * n2 * n3, sizeof(double)); + s_z = (double *)calloc(n1 * n2 * n3, sizeof(double)); + allocate_derivs(&U, nvar); + for (ivar = 0; ivar < nvar; ivar++) + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + for (k = 0; k < n3; k++) + { + i3D = Index(ivar, i, j, k, 1, n1, n2, n3); + + al = Pih * (2 * i + 1) / n1; + A = -cos(al); + be = Pih * (2 * j + 1) / n2; + B = -cos(be); + phi = 2. * Pi * k / n3; + + /* Calculation of (X,R)*/ + AB_To_XR(nvar, A, B, &X, &R, U); + /* Calculation of (x,r)*/ + C_To_c(nvar, X, R, &(s_x[i3D]), &r, U); + /* Calculation of (y,z)*/ + rx3_To_xyz(nvar, s_x[i3D], r, phi, &(s_y[i3D]), &(s_z[i3D]), U); + } + // Set_Initial_Guess_for_u(n1*n2*n3, v.d0, s_x, s_y, s_z); //extern fortran code to set initial guess + for (ivar = 0; ivar < nvar; ivar++) + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + for (k = 0; k < n3; k++) + { + indx = Index(ivar, i, j, k, 1, n1, n2, n3); + v.d0[indx] = 0; // set initial guess 0 + v.d0[indx] /= (-cos(Pih * (2 * i + 1) / n1) - 1.0); // PRD 70, 064011 (2004) Eq.(5), from u to U + } + Derivatives_AB3(nvar, n1, n2, n3, v); + if (0) + { + debug_file = fopen("initial.dat", "w"); + assert(debug_file); + for (ivar = 0; ivar < nvar; ivar++) + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + { + al = Pih * (2 * i + 1) / n1; + A = -cos(al); + Am1 = A - 1.0; + be = Pih * (2 * j + 1) / n2; + B = -cos(be); + phi = 0.0; + indx = Index(ivar, i, j, 0, 1, n1, n2, n3); + U.d0[0] = Am1 * v.d0[indx]; /* U*/ + U.d1[0] = v.d0[indx] + Am1 * v.d1[indx]; /* U_A*/ + U.d2[0] = Am1 * v.d2[indx]; /* U_B*/ + U.d3[0] = Am1 * v.d3[indx]; /* U_3*/ + U.d11[0] = 2 * v.d1[indx] + Am1 * v.d11[indx]; /* U_AA*/ + U.d12[0] = v.d2[indx] + Am1 * v.d12[indx]; /* U_AB*/ + U.d13[0] = v.d3[indx] + Am1 * v.d13[indx]; /* U_AB*/ + U.d22[0] = Am1 * v.d22[indx]; /* U_BB*/ + U.d23[0] = Am1 * v.d23[indx]; /* U_B3*/ + U.d33[0] = Am1 * v.d33[indx]; /* U_33*/ + /* Calculation of (X,R)*/ + AB_To_XR(nvar, A, B, &X, &R, U); + /* Calculation of (x,r)*/ + C_To_c(nvar, X, R, &(s_x[indx]), &r, U); + /* Calculation of (y,z)*/ + rx3_To_xyz(nvar, s_x[i3D], r, phi, &(s_y[indx]), &(s_z[indx]), U); + fprintf(debug_file, + "%.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g " + "%.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g\n", + (double)s_x[indx], (double)s_y[indx], + (double)A, (double)B, + (double)U.d0[0], + (double)(-cos(Pih * (2 * i + 1) / n1) - 1.0), + (double)U.d1[0], + (double)U.d2[0], + (double)U.d3[0], + (double)U.d11[0], + (double)U.d22[0], + (double)U.d33[0], + (double)v.d0[indx], + (double)v.d1[indx], + (double)v.d2[indx], + (double)v.d3[indx], + (double)v.d11[indx], + (double)v.d22[indx], + (double)v.d33[indx]); + } + fprintf(debug_file, "\n\n"); + for (i = n2 - 10; i < n2; i++) + { + double d; + indx = Index(0, 0, i, 0, 1, n1, n2, n3); + d = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, + s_x[indx], 0.0, 0.0); + fprintf(debug_file, "%.16g %.16g\n", + (double)s_x[indx], (double)d); + } + fprintf(debug_file, "\n\n"); + for (i = n2 - 10; i < n2 - 1; i++) + { + double d; + int ip = Index(0, 0, i + 1, 0, 1, n1, n2, n3); + indx = Index(0, 0, i, 0, 1, n1, n2, n3); + for (j = -10; j < 10; j++) + { + d = PunctIntPolAtArbitPosition(0, nvar, n1, n2, n3, v, + s_x[indx] + (s_x[ip] - s_x[indx]) * j / 10, + 0.0, 0.0); + fprintf(debug_file, "%.16g %.16g\n", + (double)(s_x[indx] + (s_x[ip] - s_x[indx]) * j / 10), (double)d); + } + } + fprintf(debug_file, "\n\n"); + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + { + X = 2 * (2.0 * i / n1 - 1.0); + R = 2 * (1.0 * j / n2); + if (X * X + R * R > 1.0) + { + C_To_c(nvar, X, R, &(s_x[indx]), &r, U); + rx3_To_xyz(nvar, s_x[i3D], r, phi, &(s_y[indx]), &(s_z[indx]), U); + *U.d0 = s_x[indx] * s_x[indx]; + *U.d1 = 2 * s_x[indx]; + *U.d2 = 0.0; + *U.d3 = 0.0; + *U.d11 = 2.0; + *U.d22 = 0.0; + *U.d33 = *U.d12 = *U.d23 = *U.d13 = 0.0; + C_To_c(nvar, X, R, &(s_x[indx]), &r, U); + fprintf(debug_file, + "%.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g\n", + (double)s_x[indx], (double)r, (double)X, (double)R, (double)U.d0[0], + (double)U.d1[0], + (double)U.d2[0], + (double)U.d3[0], + (double)U.d11[0], + (double)U.d22[0], + (double)U.d33[0]); + } + } + fclose(debug_file); + } + free(s_z); + free(s_y); + free(s_x); + free_derivs(&U, nvar); +} + +// some tools +/*---------------------------------------------------------------------------*/ +int TwoPunctures::index(int i, int j, int k, int l, int a, int b, int c, int d) +{ + int rr = 0; + rr = l + k * d + j * d * c + i * d * c * b; + return rr; +} +/*---------------------------------------------------------------------------*/ +int *TwoPunctures::ivector(long nl, long nh) +/* allocate an int vector with subscript range v[nl..nh] */ +{ + int *retval; + + retval = (int *)malloc(sizeof(int) * (nh - nl + 1)); + if (retval == NULL) + cout << "allocation failure in ivector()" << endl; + + return retval - nl; +} + +/*---------------------------------------------------------------------------*/ +double *TwoPunctures::dvector(long nl, long nh) +/* allocate a double vector with subscript range v[nl..nh] */ +{ + double *retval; + + retval = (double *)malloc(sizeof(double) * (nh - nl + 1)); + if (retval == NULL) + cout << "allocation failure in dvector()" << endl; + + return retval - nl; +} + +/*---------------------------------------------------------------------------*/ +int **TwoPunctures::imatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + int **retval; + + retval = (int **)malloc(sizeof(int *) * (nrh - nrl + 1)); + if (retval == NULL) + cout << "allocation failure (1) in imatrix()" << endl; + + /* get all memory for the matrix in on chunk */ + retval[0] = (int *)malloc(sizeof(int) * (nrh - nrl + 1) * (nch - ncl + 1)); + if (retval[0] == NULL) + cout << "allocation failure (2) in imatrix()" << endl; + + /* apply column and row offsets */ + retval[0] -= ncl; + retval -= nrl; + + /* slice chunk into rows */ + long width = (nch - ncl + 1); + for (long i = nrl + 1; i <= nrh; i++) + retval[i] = retval[i - 1] + width; + assert(retval[nrh] - retval[nrl] == (nrh - nrl) * width); + + return retval; +} + +/*---------------------------------------------------------------------------*/ +double **TwoPunctures::dmatrix(long nrl, long nrh, long ncl, long nch) +/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ +{ + double **retval; + + retval = (double **)malloc(sizeof(double *) * (nrh - nrl + 1)); + if (retval == NULL) + cout << "allocation failure (1) in dmatrix()" << endl; + + /* get all memory for the matrix in on chunk */ + retval[0] = (double *)malloc(sizeof(double) * (nrh - nrl + 1) * (nch - ncl + 1)); + if (retval[0] == NULL) + cout << "allocation failure (2) in dmatrix()" << endl; + + /* apply column and row offsets */ + retval[0] -= ncl; + retval -= nrl; + + /* slice chunk into rows */ + long width = (nch - ncl + 1); + for (long i = nrl + 1; i <= nrh; i++) + retval[i] = retval[i - 1] + width; + assert(retval[nrh] - retval[nrl] == (nrh - nrl) * width); + + return retval; +} + +/*---------------------------------------------------------------------------*/ +double ***TwoPunctures::d3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh) +/* allocate a double 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */ +{ + double ***retval; + + /* get memory for index structures */ + retval = (double ***)malloc(sizeof(double **) * (nrh - nrl + 1)); + if (retval == NULL) + cout << "allocation failure (1) in dmatrix()" << endl; + + retval[0] = (double **)malloc(sizeof(double *) * (nrh - nrl + 1) * (nch - ncl + 1)); + if (retval[0] == NULL) + cout << "allocation failure (2) in dmatrix()" << endl; + + /* get all memory for the tensor in on chunk */ + retval[0][0] = (double *)malloc(sizeof(double) * (nrh - nrl + 1) * (nch - ncl + 1) * (nrh - nrl + 1)); + if (retval[0][0] == NULL) + cout << "allocation failure (3) in dmatrix()" << endl; + + /* apply all offsets */ + retval[0][0] -= ndl; + retval[0] -= ncl; + retval -= nrl; + + /* slice chunk into rows and columns */ + long width = (nch - ncl + 1); + long depth = (ndh - ndl + 1); + for (long j = ncl + 1; j <= nch; j++) + { /* first row of columns */ + retval[nrl][j] = retval[nrl][j - 1] + depth; + } + assert(retval[nrl][nch] - retval[nrl][ncl] == (nch - ncl) * depth); + for (long i = nrl + 1; i <= nrh; i++) + { + retval[i] = retval[i - 1] + width; + retval[i][ncl] = retval[i - 1][ncl] + width * depth; /* first cell in column */ + for (long j = ncl + 1; j <= nch; j++) + { + retval[i][j] = retval[i][j - 1] + depth; + } + assert(retval[i][nch] - retval[i][ncl] == (nch - ncl) * depth); + } + assert(retval[nrh] - retval[nrl] == (nrh - nrl) * width); + assert(&retval[nrh][nch][ndh] - &retval[nrl][ncl][ndl] == (nrh - nrl + 1) * (nch - ncl + 1) * (ndh - ndl + 1) - 1); + + return retval; +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::free_ivector(int *v, long nl, long nh) +/* free an int vector allocated with ivector() */ +{ + free(v + nl); +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::free_dvector(double *v, long nl, long nh) +/* free an double vector allocated with dvector() */ +{ + free(v + nl); +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::free_imatrix(int **m, long nrl, long nrh, long ncl, long nch) +/* free an int matrix allocated by imatrix() */ +{ + free(m[nrl] + ncl); + free(m + nrl); +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch) +/* free a double matrix allocated by dmatrix() */ +{ + free(m[nrl] + ncl); + free(m + nrl); +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::free_d3tensor(double ***t, long nrl, long nrh, long ncl, long nch, + long ndl, long ndh) +/* free a double f3tensor allocated by f3tensor() */ +{ + free(t[nrl][ncl] + ndl); + free(t[nrl] + ncl); + free(t + nrl); +} + +/*--------------------------------------------------------------------------*/ +int TwoPunctures::minimum2(int i, int j) +{ + int result = i; + if (j < result) + result = j; + return result; +} + +/*-------------------------------------------------------------------------*/ +int TwoPunctures::minimum3(int i, int j, int k) +{ + int result = i; + if (j < result) + result = j; + if (k < result) + result = k; + return result; +} + +/*--------------------------------------------------------------------------*/ +int TwoPunctures::maximum2(int i, int j) +{ + int result = i; + if (j > result) + result = j; + return result; +} + +/*--------------------------------------------------------------------------*/ +int TwoPunctures::maximum3(int i, int j, int k) +{ + int result = i; + if (j > result) + result = j; + if (k > result) + result = k; + return result; +} + +/*--------------------------------------------------------------------------*/ +int TwoPunctures::pow_int(int mantisse, int exponent) +{ + int i, result = 1; + + for (i = 1; i <= exponent; i++) + result *= mantisse; + + return result; +} + +/*--------------------------------------------------------------------------*/ +void TwoPunctures::chebft_Zeros(double u[], int n, int inv) +/* eq. 5.8.7 and 5.8.8 at x = (5.8.4) of 2nd edition C++ NR */ +{ + int k, j, isignum; + double fac, sum, Pion, *c; + + c = dvector(0, n); + Pion = Pi / n; + if (inv == 0) + { + fac = 2.0 / n; + isignum = 1; + for (j = 0; j < n; j++) + { + sum = 0.0; + for (k = 0; k < n; k++) + sum += u[k] * cos(Pion * j * (k + 0.5)); + c[j] = fac * sum * isignum; + isignum = -isignum; + } + } + else + { + for (j = 0; j < n; j++) + { + sum = -0.5 * u[0]; + isignum = 1; + for (k = 0; k < n; k++) + { + sum += u[k] * cos(Pion * (j + 0.5) * k) * isignum; + isignum = -isignum; + } + c[j] = sum; + } + } + for (j = 0; j < n; j++) + u[j] = c[j]; + free_dvector(c, 0, n); +} + +/* --------------------------------------------------------------------------*/ +void TwoPunctures::chebft_Extremes(double u[], int n, int inv) +/* eq. 5.8.7 and 5.8.8 at x = (5.8.5) of 2nd edition C++ NR */ +{ + int k, j, isignum, N = n - 1; + double fac, sum, PioN, *c; + + c = dvector(0, N); + PioN = Pi / N; + if (inv == 0) + { + fac = 2.0 / N; + isignum = 1; + for (j = 0; j < n; j++) + { + sum = 0.5 * (u[0] + u[N] * isignum); + for (k = 1; k < N; k++) + sum += u[k] * cos(PioN * j * k); + c[j] = fac * sum * isignum; + isignum = -isignum; + } + c[N] = 0.5 * c[N]; + } + else + { + for (j = 0; j < n; j++) + { + sum = -0.5 * u[0]; + isignum = 1; + for (k = 0; k < n; k++) + { + sum += u[k] * cos(PioN * j * k) * isignum; + isignum = -isignum; + } + c[j] = sum; + } + } + for (j = 0; j < n; j++) + u[j] = c[j]; + free_dvector(c, 0, N); +} + +/* --------------------------------------------------------------------------*/ + +void TwoPunctures::chder(double *c, double *cder, int n) +{ + int j; + + cder[n] = 0.0; + cder[n - 1] = 0.0; + for (j = n - 2; j >= 0; j--) + cder[j] = cder[j + 2] + 2 * (j + 1) * c[j + 1]; +} + +/* --------------------------------------------------------------------------*/ +double TwoPunctures::chebev(double a, double b, double c[], int m, double x) +/* eq. 5.8.11 of C++ NR (2nd ed) */ +{ + int j; + double djp2, djp1, dj; /* d_{j+2}, d_{j+1} and d_j */ + double y; + + /* rescale input to lie within [-1,1] */ + y = 2 * (x - 0.5 * (b + a)) / (b - a); + + dj = djp1 = 0; + for (j = m - 1; j >= 1; j--) + { + /* advance the coefficients */ + djp2 = djp1; + djp1 = dj; + dj = 2 * y * djp1 - djp2 + c[j]; + } + + return y * dj - djp1 + 0.5 * c[0]; +} + +/* --------------------------------------------------------------------------*/ +void TwoPunctures::fourft(double *u, int N, int inv) +/* a (slow) Fourier transform, seems to be just eq. 12.1.6 and 12.1.9 of C++ NR (2nd ed) */ +{ + int l, k, iy, M; + double x, x1, fac, Pi_fac, *a, *b; + + M = N / 2; + a = dvector(0, M); + b = dvector(1, M); /* Actually: b=vector(1,M-1) but this is problematic if M=1*/ + fac = 1. / M; + Pi_fac = Pi * fac; + if (inv == 0) + { + for (l = 0; l <= M; l++) + { + a[l] = 0; + if (l > 0 && l < M) + b[l] = 0; + x1 = Pi_fac * l; + for (k = 0; k < N; k++) + { + x = x1 * k; + a[l] += fac * u[k] * cos(x); + if (l > 0 && l < M) + b[l] += fac * u[k] * sin(x); + } + } + u[0] = a[0]; + u[M] = a[M]; + for (l = 1; l < M; l++) + { + u[l] = a[l]; + u[l + M] = b[l]; + } + } + else + { + a[0] = u[0]; + a[M] = u[M]; + for (l = 1; l < M; l++) + { + a[l] = u[l]; + b[l] = u[M + l]; + } + iy = 1; + for (k = 0; k < N; k++) + { + u[k] = 0.5 * (a[0] + a[M] * iy); + x1 = Pi_fac * k; + for (l = 1; l < M; l++) + { + x = x1 * l; + u[k] += a[l] * cos(x) + b[l] * sin(x); + } + iy = -iy; + } + } + free_dvector(a, 0, M); + free_dvector(b, 1, M); +} + +/* -----------------------------------------*/ +void TwoPunctures::fourder(double u[], double du[], int N) +{ + int l, M, lpM; + + M = N / 2; + du[0] = 0.; + du[M] = 0.; + for (l = 1; l < M; l++) + { + lpM = l + M; + du[l] = u[lpM] * l; + du[lpM] = -u[l] * l; + } +} + +/* -----------------------------------------*/ +void TwoPunctures::fourder2(double u[], double d2u[], int N) +{ + int l, l2, M, lpM; + + d2u[0] = 0.; + M = N / 2; + for (l = 1; l <= M; l++) + { + l2 = l * l; + lpM = l + M; + d2u[l] = -u[l] * l2; + if (l < M) + d2u[lpM] = -u[lpM] * l2; + } +} + +/* ----------------------------------------- */ +double TwoPunctures::fourev(double *u, int N, double x) +{ + int l, M = N / 2; + double xl, result; + + result = 0.5 * (u[0] + u[M] * cos(x * M)); + for (l = 1; l < M; l++) + { + xl = x * l; + result += u[l] * cos(xl) + u[M + l] * sin(xl); + } + return result; +} + +/* ------------------------------------------------------------------------*/ +double TwoPunctures::norm1(double *v, int n) +{ + int i; + double result = -1; + + for (i = 0; i < n; i++) + if (fabs(v[i]) > result) + result = fabs(v[i]); + + return result; +} + +/* -------------------------------------------------------------------------*/ +double TwoPunctures::norm2(double *v, int n) +{ + int i; + double result = 0; + + for (i = 0; i < n; i++) + result += v[i] * v[i]; + + return sqrt(result); +} + +/* -------------------------------------------------------------------------*/ +double TwoPunctures::scalarproduct(double *v, double *w, int n) +{ + int i; + double result = 0; + + for (i = 0; i < n; i++) + result += v[i] * w[i]; + + return result; +} + +/* -------------------------------------------------------------------------*/ +/* Calculates the value of v at an arbitrary position (x,y,z)*/ +double TwoPunctures::PunctIntPolAtArbitPosition(int ivar, int nvar, int n1, + int n2, int n3, derivs v, double x, double y, + double z) +{ + double xs, ys, zs, rs2, phi, X, R, A, B, aux1, aux2, result, Ui; + + xs = x / par_b; + ys = y / par_b; + zs = z / par_b; + rs2 = ys * ys + zs * zs; + phi = atan2(z, y); + if (phi < 0) + phi += 2 * Pi; + + aux1 = 0.5 * (xs * xs + rs2 - 1); + aux2 = sqrt(aux1 * aux1 + rs2); + X = asinh(sqrt(aux1 + aux2)); + R = asin(min(1.0, sqrt(-aux1 + aux2))); + if (x < 0) + R = Pi - R; + + A = 2 * tanh(0.5 * X) - 1; + B = tan(0.5 * R - Piq); + + result = PunctEvalAtArbitPosition(v.d0, ivar, A, B, phi, nvar, n1, n2, n3); + + Ui = (A - 1) * result; + + return Ui; +} +/* Calculates the value of v at an arbitrary position (A,B,phi)*/ +double TwoPunctures::PunctEvalAtArbitPosition(double *v, int ivar, double A, double B, double phi, + int nvar, int n1, int n2, int n3) +{ + int i, j, k, N; + double *p, *values1, **values2, result; + + N = maximum3(n1, n2, n3); + p = dvector(0, N); + values1 = dvector(0, N); + values2 = dmatrix(0, N, 0, N); + + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + { + for (i = 0; i < n1; i++) + p[i] = v[ivar + nvar * (i + n1 * (j + n2 * k))]; + chebft_Zeros(p, n1, 0); + values2[j][k] = chebev(-1, 1, p, n1, A); + } + } + + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + p[j] = values2[j][k]; + chebft_Zeros(p, n2, 0); + values1[k] = chebev(-1, 1, p, n2, B); + } + + fourft(values1, n3, 0); + result = fourev(values1, n3, phi); + + free_dvector(p, 0, N); + free_dvector(values1, 0, N); + free_dmatrix(values2, 0, N, 0, N); + + return result; +} +/*-----------------------------------------------------------*/ +void TwoPunctures::AB_To_XR(int nvar, double A, double B, double *X, double *R, + derivs U) +/* On Entrance: U.d0[]=U[]; U.d1[] =U[]_A; U.d2[] =U[]_B; U.d3[] =U[]_3; */ +/* U.d11[]=U[]_AA; U.d12[]=U[]_AB; U.d13[]=U[]_A3; */ +/* U.d22[]=U[]_BB; U.d23[]=U[]_B3; U.d33[]=U[]_33; */ +/* At Exit: U.d0[]=U[]; U.d1[] =U[]_X; U.d2[] =U[]_R; U.d3[] =U[]_3; */ +/* U.d11[]=U[]_XX; U.d12[]=U[]_XR; U.d13[]=U[]_X3; */ +/* U.d22[]=U[]_RR; U.d23[]=U[]_R3; U.d33[]=U[]_33; */ +{ + double At = 0.5 * (A + 1), A_X, A_XX, B_R, B_RR; + int ivar; + + *X = 2 * atanh(At); + *R = Pih + 2 * atan(B); + + A_X = 1 - At * At; + A_XX = -At * A_X; + B_R = 0.5 * (1 + B * B); + B_RR = B * B_R; + + for (ivar = 0; ivar < nvar; ivar++) + { + U.d11[ivar] = A_X * A_X * U.d11[ivar] + A_XX * U.d1[ivar]; + U.d12[ivar] = A_X * B_R * U.d12[ivar]; + U.d13[ivar] = A_X * U.d13[ivar]; + U.d22[ivar] = B_R * B_R * U.d22[ivar] + B_RR * U.d2[ivar]; + U.d23[ivar] = B_R * U.d23[ivar]; + U.d1[ivar] = A_X * U.d1[ivar]; + U.d2[ivar] = B_R * U.d2[ivar]; + } +} +/*-----------------------------------------------------------*/ +void TwoPunctures::C_To_c(int nvar, double X, double R, double *x, double *r, + derivs U) +/* On Entrance: U.d0[]=U[]; U.d1[] =U[]_X; U.d2[] =U[]_R; U.d3[] =U[]_3; */ +/* U.d11[]=U[]_XX; U.d12[]=U[]_XR; U.d13[]=U[]_X3; */ +/* U.d22[]=U[]_RR; U.d23[]=U[]_R3; U.d33[]=U[]_33; */ +/* At Exit: U.d0[]=U[]; U.d1[] =U[]_x; U.d2[] =U[]_r; U.d3[] =U[]_3; */ +/* U.d11[]=U[]_xx; U.d12[]=U[]_xr; U.d13[]=U[]_x3; */ +/* U.d22[]=U[]_rr; U.d23[]=U[]_r3; U.d33[]=U[]_33; */ +{ + double C_c2, U_cb, U_CB; + complex C, C_c, C_cc, c, c_C, c_CC, U_c, U_cc, U_C, U_CC; + int ivar; + + C = complex(X, R); + + c = cosh(C) * par_b; /* c=b*cosh(C)*/ + c_C = sinh(C) * par_b; + c_CC = c; + + C_c = complex(1, 0) / c_C; + C_cc = -C_c * C_c * C_c * c_CC; + C_c2 = abs(C_c); + C_c2 = C_c2 * C_c2; + + for (ivar = 0; ivar < nvar; ivar++) + { + /* U_C = 0.5*(U_X3-i*U_R3)*/ + /* U_c = U_C*C_c = 0.5*(U_x3-i*U_r3)*/ + U_C = complex(0.5 * U.d13[ivar], -0.5 * U.d23[ivar]); + U_c = U_C * C_c; + U.d13[ivar] = 2. * real(U_c); + U.d23[ivar] = -2. * imag(U_c); + + /* U_C = 0.5*(U_X-i*U_R)*/ + /* U_c = U_C*C_c = 0.5*(U_x-i*U_r)*/ + U_C = complex(0.5 * U.d1[ivar], -0.5 * U.d2[ivar]); + U_c = U_C * C_c; + U.d1[ivar] = 2. * real(U_c); + U.d2[ivar] = -2. * imag(U_c); + + /* U_CC = 0.25*(U_XX-U_RR-2*i*U_XR)*/ + /* U_CB = d^2(U)/(dC*d\bar{C}) = 0.25*(U_XX+U_RR)*/ + U_CC = complex(0.25 * (U.d11[ivar] - U.d22[ivar]), -0.5 * U.d12[ivar]); + U_CB = 0.25 * (U.d11[ivar] + U.d22[ivar]); + + /* U_cc = C_cc*U_C+(C_c)^2*U_CC*/ + U_cb = U_CB * C_c2; + U_cc = C_cc * U_C + C_c * C_c * U_CC; + + /* U_xx = 2*(U_cb+Re[U_cc])*/ + /* U_rr = 2*(U_cb-Re[U_cc])*/ + /* U_rx = -2*Im[U_cc]*/ + U.d11[ivar] = 2 * (U_cb + real(U_cc)); + U.d22[ivar] = 2 * (U_cb - real(U_cc)); + U.d12[ivar] = -2 * imag(U_cc); + } + + *x = real(c); + *r = imag(c); +} +/*-----------------------------------------------------------*/ +void TwoPunctures::rx3_To_xyz(int nvar, double x, double r, double phi, + double *y, double *z, derivs U) +/* On Entrance: U.d0[]=U[]; U.d1[] =U[]_x; U.d2[] =U[]_r; U.d3[] =U[]_3; */ +/* U.d11[]=U[]_xx; U.d12[]=U[]_xr; U.d13[]=U[]_x3; */ +/* U.d22[]=U[]_rr; U.d23[]=U[]_r3; U.d33[]=U[]_33; */ +/* At Exit: U.d0[]=U[]; U.d1[] =U[]_x; U.d2[] =U[]_y; U.dz[] =U[]_z; */ +/* U.d11[]=U[]_xx; U.d12[]=U[]_xy; U.d1z[]=U[]_xz; */ +/* U.d22[]=U[]_yy; U.d2z[]=U[]_yz; U.dzz[]=U[]_zz; */ +{ + int jvar; + double + sin_phi = sin(phi), + cos_phi = cos(phi), + sin2_phi = sin_phi * sin_phi, + cos2_phi = cos_phi * cos_phi, + sin_2phi = 2 * sin_phi * cos_phi, + cos_2phi = cos2_phi - sin2_phi, r_inv = 1 / r, r_inv2 = r_inv * r_inv; + + *y = r * cos_phi; + *z = r * sin_phi; + + for (jvar = 0; jvar < nvar; jvar++) + { + double U_x = U.d1[jvar], U_r = U.d2[jvar], U_3 = U.d3[jvar], + U_xx = U.d11[jvar], U_xr = U.d12[jvar], U_x3 = U.d13[jvar], + U_rr = U.d22[jvar], U_r3 = U.d23[jvar], U_33 = U.d33[jvar]; + U.d1[jvar] = U_x; /* U_x*/ + U.d2[jvar] = U_r * cos_phi - U_3 * r_inv * sin_phi; /* U_y*/ + U.d3[jvar] = U_r * sin_phi + U_3 * r_inv * cos_phi; /* U_z*/ + U.d11[jvar] = U_xx; /* U_xx*/ + U.d12[jvar] = U_xr * cos_phi - U_x3 * r_inv * sin_phi; /* U_xy*/ + U.d13[jvar] = U_xr * sin_phi + U_x3 * r_inv * cos_phi; /* U_xz*/ + U.d22[jvar] = U_rr * cos2_phi + r_inv2 * sin2_phi * (U_33 + r * U_r) /* U_yy*/ + + sin_2phi * r_inv2 * (U_3 - r * U_r3); + U.d23[jvar] = 0.5 * sin_2phi * (U_rr - r_inv * U_r - r_inv2 * U_33) /* U_yz*/ + - cos_2phi * r_inv2 * (U_3 - r * U_r3); + U.d33[jvar] = U_rr * sin2_phi + r_inv2 * cos2_phi * (U_33 + r * U_r) /* U_zz*/ + - sin_2phi * r_inv2 * (U_3 - r * U_r3); + } +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::Derivatives_AB3(int nvar, int n1, int n2, int n3, derivs v) +{ + int i, j, k, ivar, N, *indx; + double *p, *dp, *d2p, *q, *dq, *r, *dr; + + N = maximum3(n1, n2, n3); + p = dvector(0, N); + dp = dvector(0, N); + d2p = dvector(0, N); + q = dvector(0, N); + dq = dvector(0, N); + r = dvector(0, N); + dr = dvector(0, N); + indx = ivector(0, N); + + for (ivar = 0; ivar < nvar; ivar++) + { + for (k = 0; k < n3; k++) + { /* Calculation of Derivatives w.r.t. A-Dir. */ + for (j = 0; j < n2; j++) + { /* (Chebyshev_Zeros)*/ + for (i = 0; i < n1; i++) + { + indx[i] = Index(ivar, i, j, k, nvar, n1, n2, n3); + p[i] = v.d0[indx[i]]; + } + chebft_Zeros(p, n1, 0); + chder(p, dp, n1); + chder(dp, d2p, n1); + chebft_Zeros(dp, n1, 1); + chebft_Zeros(d2p, n1, 1); + for (i = 0; i < n1; i++) + { + v.d1[indx[i]] = dp[i]; + v.d11[indx[i]] = d2p[i]; + } + } + } + for (k = 0; k < n3; k++) + { /* Calculation of Derivatives w.r.t. B-Dir. */ + for (i = 0; i < n1; i++) + { /* (Chebyshev_Zeros)*/ + for (j = 0; j < n2; j++) + { + indx[j] = Index(ivar, i, j, k, nvar, n1, n2, n3); + p[j] = v.d0[indx[j]]; + q[j] = v.d1[indx[j]]; + } + chebft_Zeros(p, n2, 0); + chebft_Zeros(q, n2, 0); + chder(p, dp, n2); + chder(dp, d2p, n2); + chder(q, dq, n2); + chebft_Zeros(dp, n2, 1); + chebft_Zeros(d2p, n2, 1); + chebft_Zeros(dq, n2, 1); + for (j = 0; j < n2; j++) + { + v.d2[indx[j]] = dp[j]; + v.d22[indx[j]] = d2p[j]; + v.d12[indx[j]] = dq[j]; + } + } + } + for (i = 0; i < n1; i++) + { /* Calculation of Derivatives w.r.t. phi-Dir. (Fourier)*/ + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + { + indx[k] = Index(ivar, i, j, k, nvar, n1, n2, n3); + p[k] = v.d0[indx[k]]; + q[k] = v.d1[indx[k]]; + r[k] = v.d2[indx[k]]; + } + fourft(p, n3, 0); + fourder(p, dp, n3); + fourder2(p, d2p, n3); + fourft(dp, n3, 1); + fourft(d2p, n3, 1); + fourft(q, n3, 0); + fourder(q, dq, n3); + fourft(dq, n3, 1); + fourft(r, n3, 0); + fourder(r, dr, n3); + fourft(dr, n3, 1); + for (k = 0; k < n3; k++) + { + v.d3[indx[k]] = dp[k]; + v.d33[indx[k]] = d2p[k]; + v.d13[indx[k]] = dq[k]; + v.d23[indx[k]] = dr[k]; + } + } + } + } + free_dvector(p, 0, N); + free_dvector(dp, 0, N); + free_dvector(d2p, 0, N); + free_dvector(q, 0, N); + free_dvector(dq, 0, N); + free_dvector(r, 0, N); + free_dvector(dr, 0, N); + free_ivector(indx, 0, N); +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::Newton(int const nvar, int const n1, int const n2, int const n3, + derivs v, double const tol, int const itmax) +{ + int ntotal = n1 * n2 * n3 * nvar, ii, it; + double *F, dmax, normres; + derivs u, dv; + + F = dvector(0, ntotal - 1); + allocate_derivs(&dv, ntotal); + allocate_derivs(&u, ntotal); + + it = 0; + dmax = 1; + while (dmax > tol && it < itmax) + { + if (it == 0) + { + F_of_v(nvar, n1, n2, n3, v, F, u); + dmax = norm_inf(F, ntotal); + } + for (int j = 0; j < ntotal; j++) + dv.d0[j] = 0; + + { + printf("Newton: it=%d \t |F|=%e\n", it, (double)dmax); + printf("bare mass: mp=%g \t mm=%g\n", (double)par_m_plus, (double)par_m_minus); + } + + fflush(stdout); + ii = bicgstab(nvar, n1, n2, n3, v, dv, 100, dmax * 1.e-3, &normres); + + for (int j = 0; j < ntotal; j++) + v.d0[j] -= dv.d0[j]; + F_of_v(nvar, n1, n2, n3, v, F, u); + dmax = norm_inf(F, ntotal); + it += 1; + } + if (itmax == 0) + { + F_of_v(nvar, n1, n2, n3, v, F, u); + dmax = norm_inf(F, ntotal); + } + + printf("Newton: it=%d \t |F|=%e \n", it, (double)dmax); + + fflush(stdout); + + free_dvector(F, 0, ntotal - 1); + free_derivs(&dv, ntotal); + free_derivs(&u, ntotal); +} +#define FAC sin(al) * sin(be) * sin(al) * sin(be) * sin(al) * sin(be) +/* --------------------------------------------------------------------------*/ +void TwoPunctures::F_of_v(int nvar, int n1, int n2, int n3, derivs v, double *F, + derivs u) +{ + /* Calculates the left hand sides of the non-linear equations F_m(v_n)=0*/ + /* and the function u (u.d0[]) as well as its derivatives*/ + /* (u.d1[], u.d2[], u.d3[], u.d11[], u.d12[], u.d13[], u.d22[], u.d23[], u.d33[])*/ + /* at interior points and at the boundaries "+/-"*/ + + int i, j, k, ivar, indx; + double al, be, A, B, X, R, x, r, phi, y, z, Am1, *values; + derivs U; + double *sources; + + values = dvector(0, nvar - 1); + allocate_derivs(&U, nvar); + + sources = (double *)calloc(n1 * n2 * n3, sizeof(double)); + if (0) + { + double *s_x, *s_y, *s_z; + int i3D; + s_x = (double *)calloc(n1 * n2 * n3, sizeof(double)); + s_y = (double *)calloc(n1 * n2 * n3, sizeof(double)); + s_z = (double *)calloc(n1 * n2 * n3, sizeof(double)); + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + for (k = 0; k < n3; k++) + { + i3D = Index(0, i, j, k, 1, n1, n2, n3); + + al = Pih * (2 * i + 1) / n1; + A = -cos(al); + be = Pih * (2 * j + 1) / n2; + B = -cos(be); + phi = 2. * Pi * k / n3; + + Am1 = A - 1; + for (ivar = 0; ivar < nvar; ivar++) + { + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + U.d0[ivar] = Am1 * v.d0[indx]; /* U*/ + U.d1[ivar] = v.d0[indx] + Am1 * v.d1[indx]; /* U_A*/ + U.d2[ivar] = Am1 * v.d2[indx]; /* U_B*/ + U.d3[ivar] = Am1 * v.d3[indx]; /* U_3*/ + U.d11[ivar] = 2 * v.d1[indx] + Am1 * v.d11[indx]; /* U_AA*/ + U.d12[ivar] = v.d2[indx] + Am1 * v.d12[indx]; /* U_AB*/ + U.d13[ivar] = v.d3[indx] + Am1 * v.d13[indx]; /* U_AB*/ + U.d22[ivar] = Am1 * v.d22[indx]; /* U_BB*/ + U.d23[ivar] = Am1 * v.d23[indx]; /* U_B3*/ + U.d33[ivar] = Am1 * v.d33[indx]; /* U_33*/ + } + /* Calculation of (X,R) and*/ + /* (U_X, U_R, U_3, U_XX, U_XR, U_X3, U_RR, U_R3, U_33)*/ + AB_To_XR(nvar, A, B, &X, &R, U); + /* Calculation of (x,r) and*/ + /* (U, U_x, U_r, U_3, U_xx, U_xr, U_x3, U_rr, U_r3, U_33)*/ + C_To_c(nvar, X, R, &(s_x[i3D]), &r, U); + /* Calculation of (y,z) and*/ + /* (U, U_x, U_y, U_z, U_xx, U_xy, U_xz, U_yy, U_yz, U_zz)*/ + rx3_To_xyz(nvar, s_x[i3D], r, phi, &(s_y[i3D]), &(s_z[i3D]), U); + } + // Set_Rho_ADM(cctkGH, n1*n2*n3, sources, s_x, s_y, s_z); //external fortran code + free(s_z); + free(s_y); + free(s_x); + } + else + for (i = 0; i < n1; i++) + for (j = 0; j < n2; j++) + for (k = 0; k < n3; k++) + sources[Index(0, i, j, k, 1, n1, n2, n3)] = 0.0; + + Derivatives_AB3(nvar, n1, n2, n3, v); + double psi, psi2, psi4, psi7, r_plus, r_minus; + FILE *debugfile = NULL; + if (0) + { + debugfile = fopen("res.dat", "w"); + assert(debugfile); + } + for (i = 0; i < n1; i++) + { + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + { + + al = Pih * (2 * i + 1) / n1; + A = -cos(al); + be = Pih * (2 * j + 1) / n2; + B = -cos(be); + phi = 2. * Pi * k / n3; + + Am1 = A - 1; + for (ivar = 0; ivar < nvar; ivar++) + { + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + U.d0[ivar] = Am1 * v.d0[indx]; /* U*/ + U.d1[ivar] = v.d0[indx] + Am1 * v.d1[indx]; /* U_A*/ + U.d2[ivar] = Am1 * v.d2[indx]; /* U_B*/ + U.d3[ivar] = Am1 * v.d3[indx]; /* U_3*/ + U.d11[ivar] = 2 * v.d1[indx] + Am1 * v.d11[indx]; /* U_AA*/ + U.d12[ivar] = v.d2[indx] + Am1 * v.d12[indx]; /* U_AB*/ + U.d13[ivar] = v.d3[indx] + Am1 * v.d13[indx]; /* U_AB*/ + U.d22[ivar] = Am1 * v.d22[indx]; /* U_BB*/ + U.d23[ivar] = Am1 * v.d23[indx]; /* U_B3*/ + U.d33[ivar] = Am1 * v.d33[indx]; /* U_33*/ + } + /* Calculation of (X,R) and*/ + /* (U_X, U_R, U_3, U_XX, U_XR, U_X3, U_RR, U_R3, U_33)*/ + AB_To_XR(nvar, A, B, &X, &R, U); + /* Calculation of (x,r) and*/ + /* (U, U_x, U_r, U_3, U_xx, U_xr, U_x3, U_rr, U_r3, U_33)*/ + C_To_c(nvar, X, R, &x, &r, U); + /* Calculation of (y,z) and*/ + /* (U, U_x, U_y, U_z, U_xx, U_xy, U_xz, U_yy, U_yz, U_zz)*/ + rx3_To_xyz(nvar, x, r, phi, &y, &z, U); + NonLinEquations(sources[Index(0, i, j, k, 1, n1, n2, n3)], + A, B, X, R, x, r, phi, y, z, U, values); + for (ivar = 0; ivar < nvar; ivar++) + { + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + F[indx] = values[ivar] * FAC; + /* if ((i<5) && ((j<5) || (j>n2-5)))*/ + /* F[indx] = 0.0;*/ + u.d0[indx] = U.d0[ivar]; /* U*/ + u.d1[indx] = U.d1[ivar]; /* U_x*/ + u.d2[indx] = U.d2[ivar]; /* U_y*/ + u.d3[indx] = U.d3[ivar]; /* U_z*/ + u.d11[indx] = U.d11[ivar]; /* U_xx*/ + u.d12[indx] = U.d12[ivar]; /* U_xy*/ + u.d13[indx] = U.d13[ivar]; /* U_xz*/ + u.d22[indx] = U.d22[ivar]; /* U_yy*/ + u.d23[indx] = U.d23[ivar]; /* U_yz*/ + u.d33[indx] = U.d33[ivar]; /* U_zz*/ + } + if (debugfile && (k == 0)) + { + r_plus = sqrt((x - par_b) * (x - par_b) + y * y + z * z); + r_minus = sqrt((x + par_b) * (x + par_b) + y * y + z * z); + psi = 1. + + 0.5 * par_m_plus / r_plus + + 0.5 * par_m_minus / r_minus + + U.d0[0]; + psi2 = psi * psi; + psi4 = psi2 * psi2; + psi7 = psi * psi2 * psi4; + fprintf(debugfile, + "%.16g %.16g %.16g %.16g %.16g %.16g %.16g %.16g\n", + (double)x, (double)y, (double)A, (double)B, + (double)(U.d11[0] + + U.d22[0] + + U.d33[0] + + /* 0.125 * BY_KKofxyz (x, y, z) / psi7 +*/ + (2.0 * Pi / psi2 / psi * sources[indx]) * FAC), + (double)((U.d11[0] + + U.d22[0] + + U.d33[0]) * + FAC), + (double)(-(2.0 * Pi / psi2 / psi * sources[indx]) * FAC), + (double)sources[indx] + /*(double)F[indx]*/ + ); + } + } + } + } + if (debugfile) + { + fclose(debugfile); + } + free(sources); + free_dvector(values, 0, nvar - 1); + free_derivs(&U, nvar); +} +/* --------------------------------------------------------------------------*/ +double TwoPunctures::norm_inf(double const *F, int const ntotal) +{ + double dmax = -1; + { + double dmax1 = -1; + for (int j = 0; j < ntotal; j++) + if (fabs(F[j]) > dmax1) + dmax1 = fabs(F[j]); + if (dmax1 > dmax) + dmax = dmax1; + } + return dmax; +} +/* --------------------------------------------------------------------------*/ +int TwoPunctures::bicgstab(int const nvar, int const n1, int const n2, int const n3, + derivs v, derivs dv, int const itmax, double const tol, + double *normres) +{ + int const output = 1; + int ntotal = n1 * n2 * n3 * nvar, ii; + double alpha = 0, beta = 0; + double rho = 0, rho1 = 1, rhotol = 1e-50; + double omega = 0, omegatol = 1e-50; + double *p, *rt, *s, *t, *r, *vv; + double **JFD; + int **cols, *ncols, maxcol = StencilSize * nvar; + double *F; + derivs u, ph, sh; + + F = dvector(0, ntotal - 1); + allocate_derivs(&u, ntotal); + + JFD = dmatrix(0, ntotal - 1, 0, maxcol - 1); + cols = imatrix(0, ntotal - 1, 0, maxcol - 1); + ncols = ivector(0, ntotal - 1); + + F_of_v(nvar, n1, n2, n3, v, F, u); + SetMatrix_JFD(nvar, n1, n2, n3, u, ncols, cols, JFD); + + /* temporary storage */ + r = dvector(0, ntotal - 1); + p = dvector(0, ntotal - 1); + allocate_derivs(&ph, ntotal); + /* ph = dvector(0, ntotal-1);*/ + rt = dvector(0, ntotal - 1); + s = dvector(0, ntotal - 1); + allocate_derivs(&sh, ntotal); + /* sh = dvector(0, ntotal-1);*/ + t = dvector(0, ntotal - 1); + vv = dvector(0, ntotal - 1); + + /* check */ + if (output == 1) + { + printf("bicgstab: itmax %d, tol %e\n", itmax, (double)tol); + fflush(stdout); + } + + /* compute initial residual rt = r = F - J*dv */ + J_times_dv(nvar, n1, n2, n3, dv, r, u); + for (int j = 0; j < ntotal; j++) + rt[j] = r[j] = F[j] - r[j]; + + *normres = norm2(r, ntotal); + if (output == 1) + { + printf("bicgstab: %5d %10.3e\n", 0, (double)*normres); + fflush(stdout); + } + + if (*normres <= tol) + return 0; + + /* cgs iteration */ + for (ii = 0; ii < itmax; ii++) + { + rho = scalarproduct(rt, r, ntotal); + if (fabs(rho) < rhotol) + break; + + /* compute direction vector p */ + if (ii == 0) + { + for (int j = 0; j < ntotal; j++) + p[j] = r[j]; + } + else + { + beta = (rho / rho1) * (alpha / omega); + for (int j = 0; j < ntotal; j++) + p[j] = r[j] + beta * (p[j] - omega * vv[j]); + } + + /* compute direction adjusting vector ph and scalar alpha */ + for (int j = 0; j < ntotal; j++) + ph.d0[j] = 0; + for (int j = 0; j < NRELAX; j++) /* solves JFD*ph = p by relaxation*/ + relax(ph.d0, nvar, n1, n2, n3, p, ncols, cols, JFD); + + J_times_dv(nvar, n1, n2, n3, ph, vv, u); /* vv=J*ph*/ + alpha = rho / scalarproduct(rt, vv, ntotal); + for (int j = 0; j < ntotal; j++) + s[j] = r[j] - alpha * vv[j]; + + /* early check of tolerance */ + *normres = norm2(s, ntotal); + if (*normres <= tol) + { + for (int j = 0; j < ntotal; j++) + dv.d0[j] += alpha * ph.d0[j]; + if (output == 1) + { + printf("bicgstab: %5d %10.3e %10.3e %10.3e %10.3e\n", + ii + 1, (double)*normres, (double)alpha, (double)beta, (double)omega); + fflush(stdout); + } + break; + } + + /* compute stabilizer vector sh and scalar omega */ + for (int j = 0; j < ntotal; j++) + sh.d0[j] = 0; + for (int j = 0; j < NRELAX; j++) /* solves JFD*sh = s by relaxation*/ + relax(sh.d0, nvar, n1, n2, n3, s, ncols, cols, JFD); + + J_times_dv(nvar, n1, n2, n3, sh, t, u); /* t=J*sh*/ + omega = scalarproduct(t, s, ntotal) / scalarproduct(t, t, ntotal); + + /* compute new solution approximation */ + for (int j = 0; j < ntotal; j++) + { + dv.d0[j] += alpha * ph.d0[j] + omega * sh.d0[j]; + r[j] = s[j] - omega * t[j]; + } + /* are we done? */ + *normres = norm2(r, ntotal); + if (output == 1) + { + printf("bicgstab: %5d %10.3e %10.3e %10.3e %10.3e\n", + ii + 1, (double)*normres, (double)alpha, (double)beta, (double)omega); + fflush(stdout); + } + if (*normres <= tol) + break; + rho1 = rho; + if (fabs(omega) < omegatol) + break; + } + + /* free temporary storage */ + free_dvector(r, 0, ntotal - 1); + free_dvector(p, 0, ntotal - 1); + /* free_dvector(ph, 0, ntotal-1);*/ + free_derivs(&ph, ntotal); + free_dvector(rt, 0, ntotal - 1); + free_dvector(s, 0, ntotal - 1); + /* free_dvector(sh, 0, ntotal-1);*/ + free_derivs(&sh, ntotal); + free_dvector(t, 0, ntotal - 1); + free_dvector(vv, 0, ntotal - 1); + + free_dvector(F, 0, ntotal - 1); + free_derivs(&u, ntotal); + + free_dmatrix(JFD, 0, ntotal - 1, 0, maxcol - 1); + free_imatrix(cols, 0, ntotal - 1, 0, maxcol - 1); + free_ivector(ncols, 0, ntotal - 1); + + /* iteration failed */ + if (ii > itmax) + return -1; + + /* breakdown */ + if (fabs(rho) < rhotol) + return -10; + if (fabs(omega) < omegatol) + return -11; + + /* success! */ + return ii + 1; +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::allocate_derivs(derivs *v, int n) +{ + int m = n - 1; + (*v).d0 = dvector(0, m); + (*v).d1 = dvector(0, m); + (*v).d2 = dvector(0, m); + (*v).d3 = dvector(0, m); + (*v).d11 = dvector(0, m); + (*v).d12 = dvector(0, m); + (*v).d13 = dvector(0, m); + (*v).d22 = dvector(0, m); + (*v).d23 = dvector(0, m); + (*v).d33 = dvector(0, m); +} + +/* --------------------------------------------------------------------------*/ +void TwoPunctures::free_derivs(derivs *v, int n) +{ + int m = n - 1; + free_dvector((*v).d0, 0, m); + free_dvector((*v).d1, 0, m); + free_dvector((*v).d2, 0, m); + free_dvector((*v).d3, 0, m); + free_dvector((*v).d11, 0, m); + free_dvector((*v).d12, 0, m); + free_dvector((*v).d13, 0, m); + free_dvector((*v).d22, 0, m); + free_dvector((*v).d23, 0, m); + free_dvector((*v).d33, 0, m); +} +/* --------------------------------------------------------------------------*/ +int TwoPunctures::Index(int ivar, int i, int j, int k, int nvar, int n1, int n2, int n3) +{ + int i1 = i, j1 = j, k1 = k; + + if (i1 < 0) + i1 = -(i1 + 1); + if (i1 >= n1) + i1 = 2 * n1 - (i1 + 1); + + if (j1 < 0) + j1 = -(j1 + 1); + if (j1 >= n2) + j1 = 2 * n2 - (j1 + 1); + + if (k1 < 0) + k1 = k1 + n3; + if (k1 >= n3) + k1 = k1 - n3; + + return ivar + nvar * (i1 + n1 * (j1 + n2 * k1)); +} +/*-----------------------------------------------------------*/ +/******** Nonlinear Equations ***********/ +/*-----------------------------------------------------------*/ +void TwoPunctures::NonLinEquations(double rho_adm, + double A, double B, double X, double R, + double x, double r, double phi, + double y, double z, derivs U, double *values) +{ + double r_plus, r_minus, psi, psi2, psi4, psi7; + double mu; + + r_plus = sqrt((x - par_b) * (x - par_b) + y * y + z * z); + r_minus = sqrt((x + par_b) * (x + par_b) + y * y + z * z); + + psi = 1. + 0.5 * par_m_plus / r_plus + 0.5 * par_m_minus / r_minus + U.d0[0]; + psi2 = psi * psi; + psi4 = psi2 * psi2; + psi7 = psi * psi2 * psi4; + + values[0] = U.d11[0] + U.d22[0] + U.d33[0] + 0.125 * BY_KKofxyz(x, y, z) / psi7 + 2.0 * Pi / psi2 / psi * rho_adm; +} +double TwoPunctures::BY_KKofxyz(double x, double y, double z) +{ + int i, j; + double r_plus, r2_plus, r3_plus, r_minus, r2_minus, r3_minus, np_Pp, nm_Pm, + Aij, AijAij, n_plus[3], n_minus[3], np_Sp[3], nm_Sm[3]; + + r2_plus = (x - par_b) * (x - par_b) + y * y + z * z; + r2_minus = (x + par_b) * (x + par_b) + y * y + z * z; + r_plus = sqrt(r2_plus); + r_minus = sqrt(r2_minus); + r3_plus = r_plus * r2_plus; + r3_minus = r_minus * r2_minus; + + n_plus[0] = (x - par_b) / r_plus; + n_minus[0] = (x + par_b) / r_minus; + n_plus[1] = y / r_plus; + n_minus[1] = y / r_minus; + n_plus[2] = z / r_plus; + n_minus[2] = z / r_minus; + + /* dot product: np_Pp = (n_+).(P_+); nm_Pm = (n_-).(P_-) */ + np_Pp = 0; + nm_Pm = 0; + for (i = 0; i < 3; i++) + { + np_Pp += n_plus[i] * par_P_plus[i]; + nm_Pm += n_minus[i] * par_P_minus[i]; + } + /* cross product: np_Sp[i] = [(n_+) x (S_+)]_i; nm_Sm[i] = [(n_-) x (S_-)]_i*/ + np_Sp[0] = n_plus[1] * par_S_plus[2] - n_plus[2] * par_S_plus[1]; + np_Sp[1] = n_plus[2] * par_S_plus[0] - n_plus[0] * par_S_plus[2]; + np_Sp[2] = n_plus[0] * par_S_plus[1] - n_plus[1] * par_S_plus[0]; + nm_Sm[0] = n_minus[1] * par_S_minus[2] - n_minus[2] * par_S_minus[1]; + nm_Sm[1] = n_minus[2] * par_S_minus[0] - n_minus[0] * par_S_minus[2]; + nm_Sm[2] = n_minus[0] * par_S_minus[1] - n_minus[1] * par_S_minus[0]; + AijAij = 0; + for (i = 0; i < 3; i++) + { + for (j = 0; j < 3; j++) + { /* Bowen-York-Curvature :*/ + Aij = + +1.5 * (par_P_plus[i] * n_plus[j] + par_P_plus[j] * n_plus[i] + np_Pp * n_plus[i] * n_plus[j]) / r2_plus + 1.5 * (par_P_minus[i] * n_minus[j] + par_P_minus[j] * n_minus[i] + nm_Pm * n_minus[i] * n_minus[j]) / r2_minus - 3.0 * (np_Sp[i] * n_plus[j] + np_Sp[j] * n_plus[i]) / r3_plus - 3.0 * (nm_Sm[i] * n_minus[j] + nm_Sm[j] * n_minus[i]) / r3_minus; + if (i == j) + Aij -= +1.5 * (np_Pp / r2_plus + nm_Pm / r2_minus); + AijAij += Aij * Aij; + } + } + + return AijAij; +} +void TwoPunctures::SetMatrix_JFD(int nvar, int n1, int n2, int n3, derivs u, + int *ncols, int **cols, double **Matrix) +{ + int column, row, mcol; + int i, i1, i_0, i_1, j, j1, j_0, j_1, k, k1, k_0, k_1, N1, N2, N3, + ivar, ivar1, ntotal = nvar * n1 * n2 * n3; + double *values; + derivs dv; + + values = dvector(0, nvar - 1); + allocate_derivs(&dv, ntotal); + + N1 = n1 - 1; + N2 = n2 - 1; + N3 = n3 - 1; + + for (i = 0; i < n1; i++) + { + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + { + for (ivar = 0; ivar < nvar; ivar++) + { + row = Index(ivar, i, j, k, nvar, n1, n2, n3); + ncols[row] = 0; + dv.d0[row] = 0; + } + } + } + } + for (i = 0; i < n1; i++) + { + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + { + for (ivar = 0; ivar < nvar; ivar++) + { + column = Index(ivar, i, j, k, nvar, n1, n2, n3); + dv.d0[column] = 1; + + i_0 = maximum2(0, i - 1); + i_1 = minimum2(N1, i + 1); + j_0 = maximum2(0, j - 1); + j_1 = minimum2(N2, j + 1); + k_0 = k - 1; + k_1 = k + 1; + /* i_0 = 0; + i_1 = N1; + j_0 = 0; + j_1 = N2; + k_0 = 0; + k_1 = N3;*/ + + for (i1 = i_0; i1 <= i_1; i1++) + { + for (j1 = j_0; j1 <= j_1; j1++) + { + for (k1 = k_0; k1 <= k_1; k1++) + { + JFD_times_dv(i1, j1, k1, nvar, n1, n2, n3, + dv, u, values); + for (ivar1 = 0; ivar1 < nvar; ivar1++) + { + if (values[ivar1] != 0) + { + row = Index(ivar1, i1, j1, k1, nvar, n1, n2, n3); + mcol = ncols[row]; + cols[row][mcol] = column; + Matrix[row][mcol] = values[ivar1]; + ncols[row] += 1; + } + } + } + } + } + + dv.d0[column] = 0; + } + } + } + } + free_derivs(&dv, ntotal); + free_dvector(values, 0, nvar - 1); +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::J_times_dv(int nvar, int n1, int n2, int n3, derivs dv, double *Jdv, derivs u) +{ /* Calculates the left hand sides of the non-linear equations F_m(v_n)=0*/ + /* and the function u (u.d0[]) as well as its derivatives*/ + /* (u.d1[], u.d2[], u.d3[], u.d11[], u.d12[], u.d13[], u.d22[], u.d23[], u.d33[])*/ + /* at interior points and at the boundaries "+/-"*/ + int i, j, k, ivar, indx; + double al, be, A, B, X, R, x, r, phi, y, z, Am1, *values; + derivs dU, U; + + Derivatives_AB3(nvar, n1, n2, n3, dv); + + for (i = 0; i < n1; i++) + { + values = dvector(0, nvar - 1); + allocate_derivs(&dU, nvar); + allocate_derivs(&U, nvar); + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + { + + al = Pih * (2 * i + 1) / n1; + A = -cos(al); + be = Pih * (2 * j + 1) / n2; + B = -cos(be); + phi = 2. * Pi * k / n3; + + Am1 = A - 1; + for (ivar = 0; ivar < nvar; ivar++) + { + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + dU.d0[ivar] = Am1 * dv.d0[indx]; /* dU*/ + dU.d1[ivar] = dv.d0[indx] + Am1 * dv.d1[indx]; /* dU_A*/ + dU.d2[ivar] = Am1 * dv.d2[indx]; /* dU_B*/ + dU.d3[ivar] = Am1 * dv.d3[indx]; /* dU_3*/ + dU.d11[ivar] = 2 * dv.d1[indx] + Am1 * dv.d11[indx]; /* dU_AA*/ + dU.d12[ivar] = dv.d2[indx] + Am1 * dv.d12[indx]; /* dU_AB*/ + dU.d13[ivar] = dv.d3[indx] + Am1 * dv.d13[indx]; /* dU_AB*/ + dU.d22[ivar] = Am1 * dv.d22[indx]; /* dU_BB*/ + dU.d23[ivar] = Am1 * dv.d23[indx]; /* dU_B3*/ + dU.d33[ivar] = Am1 * dv.d33[indx]; /* dU_33*/ + U.d0[ivar] = u.d0[indx]; /* U */ + U.d1[ivar] = u.d1[indx]; /* U_x*/ + U.d2[ivar] = u.d2[indx]; /* U_y*/ + U.d3[ivar] = u.d3[indx]; /* U_z*/ + U.d11[ivar] = u.d11[indx]; /* U_xx*/ + U.d12[ivar] = u.d12[indx]; /* U_xy*/ + U.d13[ivar] = u.d13[indx]; /* U_xz*/ + U.d22[ivar] = u.d22[indx]; /* U_yy*/ + U.d23[ivar] = u.d23[indx]; /* U_yz*/ + U.d33[ivar] = u.d33[indx]; /* U_zz*/ + } + /* Calculation of (X,R) and*/ + /* (dU_X, dU_R, dU_3, dU_XX, dU_XR, dU_X3, dU_RR, dU_R3, dU_33)*/ + AB_To_XR(nvar, A, B, &X, &R, dU); + /* Calculation of (x,r) and*/ + /* (dU, dU_x, dU_r, dU_3, dU_xx, dU_xr, dU_x3, dU_rr, dU_r3, dU_33)*/ + C_To_c(nvar, X, R, &x, &r, dU); + /* Calculation of (y,z) and*/ + /* (dU, dU_x, dU_y, dU_z, dU_xx, dU_xy, dU_xz, dU_yy, dU_yz, dU_zz)*/ + rx3_To_xyz(nvar, x, r, phi, &y, &z, dU); + LinEquations(A, B, X, R, x, r, phi, y, z, dU, U, values); + for (ivar = 0; ivar < nvar; ivar++) + { + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + Jdv[indx] = values[ivar] * FAC; + } + } + } + free_dvector(values, 0, nvar - 1); + free_derivs(&dU, nvar); + free_derivs(&U, nvar); + } +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::relax(double *dv, int const nvar, int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, int **cols, double **JFD) +{ + int i, j, k, n; + + for (k = 0; k < n3; k = k + 2) + { + for (n = 0; n < N_PlaneRelax; n++) + { + for (i = 2; i < n1; i = i + 2) + LineRelax_be(dv, i, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (i = 1; i < n1; i = i + 2) + LineRelax_be(dv, i, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (j = 1; j < n2; j = j + 2) + LineRelax_al(dv, j, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (j = 0; j < n2; j = j + 2) + LineRelax_al(dv, j, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + } + } + for (k = 1; k < n3; k = k + 2) + { + for (n = 0; n < N_PlaneRelax; n++) + { + for (i = 0; i < n1; i = i + 2) + LineRelax_be(dv, i, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (i = 1; i < n1; i = i + 2) + LineRelax_be(dv, i, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (j = 1; j < n2; j = j + 2) + LineRelax_al(dv, j, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + for (j = 0; j < n2; j = j + 2) + LineRelax_al(dv, j, k, nvar, n1, n2, n3, rhs, ncols, cols, JFD); + } + } +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::LineRelax_be(double *dv, + int const i, int const k, int const nvar, + int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, int **cols, + double **JFD) +{ + int j, m, Ic, Ip, Im, col, ivar; + + double *diag = new double[n2]; + double *e = new double[n2 - 1]; /* above diagonal */ + double *f = new double[n2 - 1]; /* below diagonal */ + double *b = new double[n2]; /* rhs */ + double *x = new double[n2]; /* solution vector */ + + // gsl_vector *diag = gsl_vector_alloc(n2); + // gsl_vector *e = gsl_vector_alloc(n2-1); /* above diagonal */ + // gsl_vector *f = gsl_vector_alloc(n2-1); /* below diagonal */ + // gsl_vector *b = gsl_vector_alloc(n2); /* rhs */ + // gsl_vector *x = gsl_vector_alloc(n2); /* solution vector */ + + for (ivar = 0; ivar < nvar; ivar++) + { + for (j = 0; j < n2 - 1; j++) + { + diag[j] = e[j] = f[j] = 0; + } + diag[n2 - 1] = 0; + + // gsl_vector_set_zero(diag); + // gsl_vector_set_zero(e); + // gsl_vector_set_zero(f); + for (j = 0; j < n2; j++) + { + Ip = Index(ivar, i, j + 1, k, nvar, n1, n2, n3); + Ic = Index(ivar, i, j, k, nvar, n1, n2, n3); + Im = Index(ivar, i, j - 1, k, nvar, n1, n2, n3); + b[j] = rhs[Ic]; + // gsl_vector_set(b,j,rhs[Ic]); + for (m = 0; m < ncols[Ic]; m++) + { + col = cols[Ic][m]; + if (col != Ip && col != Ic && col != Im) + b[j] -= JFD[Ic][m] * dv[col]; + // *gsl_vector_ptr(b, j) -= JFD[Ic][m] * dv[col]; + else + { + if (col == Im && j > 0) + f[j - 1] = JFD[Ic][m]; + // gsl_vector_set(f,j-1,JFD[Ic][m]); + if (col == Ic) + diag[j] = JFD[Ic][m]; + // gsl_vector_set(diag,j,JFD[Ic][m]); + if (col == Ip && j < n2 - 1) + e[j] = JFD[Ic][m]; + // gsl_vector_set(e,j,JFD[Ic][m]); + } + } + } + // A x = b + // A = ( d_0 e_0 0 0 ) + // ( f_0 d_1 e_1 0 ) + // ( 0 f_1 d_2 e_2 ) + // ( 0 0 f_2 d_3 ) + // + ThomasAlgorithm(n2, f, diag, e, x, b); + // gsl_linalg_solve_tridiag(diag, e, f, b, x); + for (j = 0; j < n2; j++) + { + Ic = Index(ivar, i, j, k, nvar, n1, n2, n3); + dv[Ic] = x[j]; + // dv[Ic] = gsl_vector_get(x, j); + } + } + + delete[] diag; + delete[] e; + delete[] f; + delete[] b; + delete[] x; + // gsl_vector_free(diag); + // gsl_vector_free(e); + // gsl_vector_free(f); + // gsl_vector_free(b); + // gsl_vector_free(x); +} +/* --------------------------------------------------------------------------*/ +void TwoPunctures::JFD_times_dv(int i, int j, int k, int nvar, int n1, int n2, + int n3, derivs dv, derivs u, double *values) +{ /* Calculates rows of the vector 'J(FD)*dv'.*/ + /* First row to be calculated: row = Index(0, i, j, k; nvar, n1, n2, n3)*/ + /* Last row to be calculated: row = Index(nvar-1, i, j, k; nvar, n1, n2, n3)*/ + /* These rows are stored in the vector JFDdv[0] ... JFDdv[nvar-1].*/ + int ivar, indx; + double al, be, A, B, X, R, x, r, phi, y, z, Am1; + double sin_al, sin_al_i1, sin_al_i2, sin_al_i3, cos_al; + double sin_be, sin_be_i1, sin_be_i2, sin_be_i3, cos_be; + double dV0, dV1, dV2, dV3, dV11, dV12, dV13, dV22, dV23, dV33, + ha, ga, ga2, hb, gb, gb2, hp, gp, gp2, gagb, gagp, gbgp; + derivs dU, U; + + allocate_derivs(&dU, nvar); + allocate_derivs(&U, nvar); + + if (k < 0) + k = k + n3; + if (k >= n3) + k = k - n3; + + ha = Pi / n1; /* ha: Stepsize with respect to (al)*/ + al = ha * (i + 0.5); + A = -cos(al); + ga = 1 / ha; + ga2 = ga * ga; + + hb = Pi / n2; /* hb: Stepsize with respect to (be)*/ + be = hb * (j + 0.5); + B = -cos(be); + gb = 1 / hb; + gb2 = gb * gb; + gagb = ga * gb; + + hp = 2 * Pi / n3; /* hp: Stepsize with respect to (phi)*/ + phi = hp * j; + gp = 1 / hp; + gp2 = gp * gp; + gagp = ga * gp; + gbgp = gb * gp; + + sin_al = sin(al); + sin_be = sin(be); + sin_al_i1 = 1 / sin_al; + sin_be_i1 = 1 / sin_be; + sin_al_i2 = sin_al_i1 * sin_al_i1; + sin_be_i2 = sin_be_i1 * sin_be_i1; + sin_al_i3 = sin_al_i1 * sin_al_i2; + sin_be_i3 = sin_be_i1 * sin_be_i2; + cos_al = -A; + cos_be = -B; + + Am1 = A - 1; + for (ivar = 0; ivar < nvar; ivar++) + { + int iccc = Index(ivar, i, j, k, nvar, n1, n2, n3), + ipcc = Index(ivar, i + 1, j, k, nvar, n1, n2, n3), + imcc = Index(ivar, i - 1, j, k, nvar, n1, n2, n3), + icpc = Index(ivar, i, j + 1, k, nvar, n1, n2, n3), + icmc = Index(ivar, i, j - 1, k, nvar, n1, n2, n3), + iccp = Index(ivar, i, j, k + 1, nvar, n1, n2, n3), + iccm = Index(ivar, i, j, k - 1, nvar, n1, n2, n3), + icpp = Index(ivar, i, j + 1, k + 1, nvar, n1, n2, n3), + icmp = Index(ivar, i, j - 1, k + 1, nvar, n1, n2, n3), + icpm = Index(ivar, i, j + 1, k - 1, nvar, n1, n2, n3), + icmm = Index(ivar, i, j - 1, k - 1, nvar, n1, n2, n3), + ipcp = Index(ivar, i + 1, j, k + 1, nvar, n1, n2, n3), + imcp = Index(ivar, i - 1, j, k + 1, nvar, n1, n2, n3), + ipcm = Index(ivar, i + 1, j, k - 1, nvar, n1, n2, n3), + imcm = Index(ivar, i - 1, j, k - 1, nvar, n1, n2, n3), + ippc = Index(ivar, i + 1, j + 1, k, nvar, n1, n2, n3), + impc = Index(ivar, i - 1, j + 1, k, nvar, n1, n2, n3), + ipmc = Index(ivar, i + 1, j - 1, k, nvar, n1, n2, n3), + immc = Index(ivar, i - 1, j - 1, k, nvar, n1, n2, n3); + /* Derivatives of (dv) w.r.t. (al,be,phi):*/ + dV0 = dv.d0[iccc]; + dV1 = 0.5 * ga * (dv.d0[ipcc] - dv.d0[imcc]); + dV2 = 0.5 * gb * (dv.d0[icpc] - dv.d0[icmc]); + dV3 = 0.5 * gp * (dv.d0[iccp] - dv.d0[iccm]); + dV11 = ga2 * (dv.d0[ipcc] + dv.d0[imcc] - 2 * dv.d0[iccc]); + dV22 = gb2 * (dv.d0[icpc] + dv.d0[icmc] - 2 * dv.d0[iccc]); + dV33 = gp2 * (dv.d0[iccp] + dv.d0[iccm] - 2 * dv.d0[iccc]); + dV12 = + 0.25 * gagb * (dv.d0[ippc] - dv.d0[ipmc] + dv.d0[immc] - dv.d0[impc]); + dV13 = + 0.25 * gagp * (dv.d0[ipcp] - dv.d0[imcp] + dv.d0[imcm] - dv.d0[ipcm]); + dV23 = + 0.25 * gbgp * (dv.d0[icpp] - dv.d0[icpm] + dv.d0[icmm] - dv.d0[icmp]); + /* Derivatives of (dv) w.r.t. (A,B,phi):*/ + dV11 = sin_al_i3 * (sin_al * dV11 - cos_al * dV1); + dV12 = sin_al_i1 * sin_be_i1 * dV12; + dV13 = sin_al_i1 * dV13; + dV22 = sin_be_i3 * (sin_be * dV22 - cos_be * dV2); + dV23 = sin_be_i1 * dV23; + dV1 = sin_al_i1 * dV1; + dV2 = sin_be_i1 * dV2; + /* Derivatives of (dU) w.r.t. (A,B,phi):*/ + dU.d0[ivar] = Am1 * dV0; + dU.d1[ivar] = dV0 + Am1 * dV1; + dU.d2[ivar] = Am1 * dV2; + dU.d3[ivar] = Am1 * dV3; + dU.d11[ivar] = 2 * dV1 + Am1 * dV11; + dU.d12[ivar] = dV2 + Am1 * dV12; + dU.d13[ivar] = dV3 + Am1 * dV13; + dU.d22[ivar] = Am1 * dV22; + dU.d23[ivar] = Am1 * dV23; + dU.d33[ivar] = Am1 * dV33; + + indx = Index(ivar, i, j, k, nvar, n1, n2, n3); + U.d0[ivar] = u.d0[indx]; /* U */ + U.d1[ivar] = u.d1[indx]; /* U_x*/ + U.d2[ivar] = u.d2[indx]; /* U_y*/ + U.d3[ivar] = u.d3[indx]; /* U_z*/ + U.d11[ivar] = u.d11[indx]; /* U_xx*/ + U.d12[ivar] = u.d12[indx]; /* U_xy*/ + U.d13[ivar] = u.d13[indx]; /* U_xz*/ + U.d22[ivar] = u.d22[indx]; /* U_yy*/ + U.d23[ivar] = u.d23[indx]; /* U_yz*/ + U.d33[ivar] = u.d33[indx]; /* U_zz*/ + } + /* Calculation of (X,R) and*/ + /* (dU_X, dU_R, dU_3, dU_XX, dU_XR, dU_X3, dU_RR, dU_R3, dU_33)*/ + AB_To_XR(nvar, A, B, &X, &R, dU); + /* Calculation of (x,r) and*/ + /* (dU, dU_x, dU_r, dU_3, dU_xx, dU_xr, dU_x3, dU_rr, dU_r3, dU_33)*/ + C_To_c(nvar, X, R, &x, &r, dU); + /* Calculation of (y,z) and*/ + /* (dU, dU_x, dU_y, dU_z, dU_xx, dU_xy, dU_xz, dU_yy, dU_yz, dU_zz)*/ + rx3_To_xyz(nvar, x, r, phi, &y, &z, dU); + LinEquations(A, B, X, R, x, r, phi, y, z, dU, U, values); + for (ivar = 0; ivar < nvar; ivar++) + values[ivar] *= FAC; + + free_derivs(&dU, nvar); + free_derivs(&U, nvar); +} +#undef FAC +/*-----------------------------------------------------------*/ +/******** Linear Equations ***********/ +/*-----------------------------------------------------------*/ +void TwoPunctures::LinEquations(double A, double B, double X, double R, + double x, double r, double phi, + double y, double z, derivs dU, derivs U, double *values) +{ + double r_plus, r_minus, psi, psi2, psi4, psi8; + + r_plus = sqrt((x - par_b) * (x - par_b) + y * y + z * z); + r_minus = sqrt((x + par_b) * (x + par_b) + y * y + z * z); + + psi = + 1. + 0.5 * par_m_plus / r_plus + 0.5 * par_m_minus / r_minus + U.d0[0]; + psi2 = psi * psi; + psi4 = psi2 * psi2; + psi8 = psi4 * psi4; + + values[0] = dU.d11[0] + dU.d22[0] + dU.d33[0] - 0.875 * BY_KKofxyz(x, y, z) / psi8 * dU.d0[0]; +} +/* -------------------------------------------------------------------------*/ +void TwoPunctures::LineRelax_al(double *dv, + int const j, int const k, int const nvar, + int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, + int **cols, double **JFD) +{ + int i, m, Ic, Ip, Im, col, ivar; + + double *diag = new double[n1]; + double *e = new double[n1 - 1]; /* above diagonal */ + double *f = new double[n1 - 1]; /* below diagonal */ + double *b = new double[n1]; /* rhs */ + double *x = new double[n1]; /* solution vector */ + + // gsl_vector *diag = gsl_vector_alloc(n1); + // gsl_vector *e = gsl_vector_alloc(n1-1); /* above diagonal */ + // gsl_vector *f = gsl_vector_alloc(n1-1); /* below diagonal */ + // gsl_vector *b = gsl_vector_alloc(n1); /* rhs */ + // gsl_vector *x = gsl_vector_alloc(n1); /* solution vector */ + + for (ivar = 0; ivar < nvar; ivar++) + { + for (i = 0; i < n1 - 1; i++) + { + diag[i] = e[i] = f[i] = 0; + } + diag[n1 - 1] = 0; + + // gsl_vector_set_zero(diag); + // gsl_vector_set_zero(e); + // gsl_vector_set_zero(f); + for (i = 0; i < n1; i++) + { + Ip = Index(ivar, i + 1, j, k, nvar, n1, n2, n3); + Ic = Index(ivar, i, j, k, nvar, n1, n2, n3); + Im = Index(ivar, i - 1, j, k, nvar, n1, n2, n3); + b[i] = rhs[Ic]; + // gsl_vector_set(b,i,rhs[Ic]); + for (m = 0; m < ncols[Ic]; m++) + { + col = cols[Ic][m]; + if (col != Ip && col != Ic && col != Im) + b[i] -= JFD[Ic][m] * dv[col]; + // *gsl_vector_ptr(b, i) -= JFD[Ic][m] * dv[col]; + else + { + if (col == Im && i > 0) + f[i - 1] = JFD[Ic][m]; + // gsl_vector_set(f,i-1,JFD[Ic][m]); + if (col == Ic) + diag[i] = JFD[Ic][m]; + // gsl_vector_set(diag,i,JFD[Ic][m]); + if (col == Ip && i < n1 - 1) + e[i] = JFD[Ic][m]; + // gsl_vector_set(e,i,JFD[Ic][m]); + } + } + } + ThomasAlgorithm(n1, f, diag, e, x, b); + // gsl_linalg_solve_tridiag(diag, e, f, b, x); + for (i = 0; i < n1; i++) + { + Ic = Index(ivar, i, j, k, nvar, n1, n2, n3); + dv[Ic] = x[i]; + // dv[Ic] = gsl_vector_get(x, i); + } + } + + delete[] diag; + delete[] e; + delete[] f; + delete[] b; + delete[] x; + + // gsl_vector_free(diag); + // gsl_vector_free(e); + // gsl_vector_free(f); + // gsl_vector_free(b); + // gsl_vector_free(x); +} +/* -------------------------------------------------------------------------*/ +// a[N], b[N-1], c[N-1], x[N], q[N] +// A x = q +// A = ( a_0 c_0 0 0 ) +// ( b_0 a_1 c_1 0 ) +// ( 0 b_1 a_2 c_2 ) +// ( 0 0 b_2 a_3 ) +//"Parallel Scientific Computing in C++ and MPI" P361 +void TwoPunctures::ThomasAlgorithm(int N, double *b, double *a, double *c, double *x, double *q) +{ + int i; + double *l, *u, *d, *y; + l = new double[N - 1]; + u = new double[N - 1]; + d = new double[N]; + y = new double[N]; + + /* LU Decomposition */ + d[0] = a[0]; + u[0] = c[0]; + + for (i = 0; i < N - 2; i++) + { + l[i] = b[i] / d[i]; + d[i + 1] = a[i + 1] - l[i] * u[i]; + u[i + 1] = c[i + 1]; + } + + l[N - 2] = b[N - 2] / d[N - 2]; + d[N - 1] = a[N - 1] - l[N - 2] * u[N - 2]; + + /* Forward Substitution [L][y] = [q] */ + y[0] = q[0]; + for (i = 1; i < N; i++) + y[i] = q[i] - l[i - 1] * y[i - 1]; + + /* Backward Substitution [U][x] = [y] */ + x[N - 1] = y[N - 1] / d[N - 1]; + + for (i = N - 2; i >= 0; i--) + x[i] = (y[i] - u[i] * x[i + 1]) / d[i]; + + delete[] l; + delete[] u; + delete[] d; + delete[] y; + + return; +} +// --------------------------------------------------------------------------*/ +// Calculates the value of v at an arbitrary position (x,y,z) if the spectral coefficients are know*/*/ +/* --------------------------------------------------------------------------*/ +/* Calculates the value of v at an arbitrary position (A,B,phi)*/ +double TwoPunctures::Spec_IntPolABphiFast(parameters par, double *v, int ivar, double A, double B, double phi) +{ + int i, j, k, N; + double *p, *values1, **values2, result; + + int nvar = par.nvar; + int n1 = par.n1; + int n2 = par.n2; + int n3 = par.n3; + N = maximum3(n1, n2, n3); + + p = dvector(0, N); + values1 = dvector(0, N); + values2 = dmatrix(0, N, 0, N); + + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + { + for (i = 0; i < n1; i++) + p[i] = v[ivar + nvar * (i + n1 * (j + n2 * k))]; + // chebft_Zeros (p, n1, 0); + values2[j][k] = chebev(-1, 1, p, n1, A); + } + } + + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + p[j] = values2[j][k]; + // chebft_Zeros (p, n2, 0); + values1[k] = chebev(-1, 1, p, n2, B); + } + + // fourft (values1, n3, 0); + result = fourev(values1, n3, phi); + + free_dvector(p, 0, N); + free_dvector(values1, 0, N); + free_dmatrix(values2, 0, N, 0, N); + + return result; + // */ + // return 0.; +} + +/* Calculates the value of v at an arbitrary position (x,y,z) given the spectral coefficients*/ +double TwoPunctures::Spec_IntPolFast(parameters par, int ivar, double *v, double x, double y, double z) +{ + double xs, ys, zs, rs2, phi, X, R, A, B, aux1, aux2, result, Ui; + + int nvar = par.nvar; + int n1 = par.n1; + int n2 = par.n2; + int n3 = par.n3; + double par_b = par.b; + + xs = x / par.b; + ys = y / par.b; + zs = z / par.b; + rs2 = ys * ys + zs * zs; + phi = atan2(z, y); + if (phi < 0) + phi += 2. * Pi; + + aux1 = 0.5 * (xs * xs + rs2 - 1.); + aux2 = sqrt(aux1 * aux1 + rs2); + + // Note from YT: aux2-aux1 can be equal to 1. When that happens, numerical + // truncation may make it slightly larger than 1. This makes + // R NAN! I also worry that aux2-aux1 and aux1+axu2 may become negative due to + // truncation error, which gives rise to NAN for X and R. + // The following few lines attempt to fix these. + double aux2_plus_aux1, aux2_minus_aux1; + if (aux1 < 0) + { + aux2_plus_aux1 = rs2 / (aux2 - aux1); + aux2_minus_aux1 = aux2 - aux1; + } + else + { + aux2_plus_aux1 = aux2 + aux1; + aux2_minus_aux1 = rs2 / (aux2 + aux1); + } + if (fabs(aux1) + fabs(aux2) < 1.e-20) + { + aux2_plus_aux1 = 0.0; + aux2_minus_aux1 = 0.0; + } + double sqrt_aux2_minus_aux1 = sqrt(fabs(aux2_minus_aux1)); + + // Note from YT: The following two lines have replaced by the 6 lines belows. + // X = asinhd(sqrt(aux1+aux2)); + // R = asin(sqrt(fabs(-aux1+aux2))); + + X = asinh(sqrt(aux2_plus_aux1)); + if (sqrt_aux2_minus_aux1 > 1.0) + { + R = 0.5 * Pi; + } + else + { + R = asin(sqrt_aux2_minus_aux1); + } + + if (x < 0) + R = Pi - R; + + A = 2. * tanh(0.5 * X) - 1.; + B = tan(0.5 * R - Piq); + + result = Spec_IntPolABphiFast(par, v, ivar, A, B, phi); + + Ui = (A - 1) * result; + + return Ui; +} + +// Evaluates the spectral expansion coefficients of v +void TwoPunctures::SpecCoef(parameters par, int ivar, double *v, double *cf) +{ + // Here v is a pointer to the values of the variable v at the collocation points + int i, j, k, N, n, l, m; + double *p, ***values3, ***values4; + + int nvar = par.nvar; + int n1 = par.n1; + int n2 = par.n2; + int n3 = par.n3; + + N = maximum3(n1, n2, n3); + p = dvector(0, N); + values3 = d3tensor(0, n1, 0, n2, 0, n3); + values4 = d3tensor(0, n1, 0, n2, 0, n3); + + // Caclulate values3[n,j,k] = a_n^{j,k} = (sum_i^(n1-1) f(A_i,B_j,phi_k) Tn(-A_i))/k_n , k_n = N/2 or N + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + { + for (i = 0; i < n1; i++) + p[i] = v[ivar + (i + n1 * (j + n2 * k))]; + chebft_Zeros(p, n1, 0); + for (n = 0; n < n1; n++) + { + values3[n][j][k] = p[n]; + } + } + } + + // Caclulate values4[n,l,k] = a_{n,l}^{k} = (sum_j^(n2-1) a_n^{j,k} Tn(B_j))/k_l , k_l = N/2 or N + + for (n = 0; n < n1; n++) + { + for (k = 0; k < n3; k++) + { + for (j = 0; j < n2; j++) + p[j] = values3[n][j][k]; + chebft_Zeros(p, n2, 0); + for (l = 0; l < n2; l++) + { + values4[n][l][k] = p[l]; + } + } + } + + // Caclulate coefficients a_{n,l,m} = (sum_k^(n3-1) a_{n,m}^{k} fourier(phi_k))/k_m , k_m = N/2 or N + for (i = 0; i < n1; i++) + { + for (j = 0; j < n2; j++) + { + for (k = 0; k < n3; k++) + p[k] = values4[i][j][k]; + fourft(p, n3, 0); + for (k = 0; k < n3; k++) + { + cf[ivar + (i + n1 * (j + n2 * k))] = p[k]; + } + } + } + + free_dvector(p, 0, N); + free_d3tensor(values3, 0, n1, 0, n2, 0, n3); + free_d3tensor(values4, 0, n1, 0, n2, 0, n3); +} diff --git a/AMSS_NCKU_source/TwoPunctures.h b/AMSS_NCKU_source/TwoPunctures.h new file mode 100644 index 0000000..22fb359 --- /dev/null +++ b/AMSS_NCKU_source/TwoPunctures.h @@ -0,0 +1,144 @@ + +#ifndef TWO_PUNCTURES_H +#define TWO_PUNCTURES_H + +#define StencilSize 19 +#define N_PlaneRelax 1 +#define NRELAX 200 +#define Step_Relax 1 + +#define Pi 3.14159265358979323846264338328 +#define Pih 1.57079632679489661923132169164 /* Pi/2*/ +#define Piq 0.78539816339744830961566084582 /* Pi/4*/ + +#define TINY 1.0e-20 + +class TwoPunctures +{ +public: + typedef struct DERIVS + { + double *d0, *d1, *d2, *d3, *d11, *d12, *d13, *d22, *d23, *d33; + } derivs; + + double *F; + derivs u, v; + +private: + double par_m_plus, par_m_minus, par_b; + double par_P_plus[3], par_P_minus[3]; + double par_S_plus[3], par_S_minus[3]; + + int npoints_A, npoints_B, npoints_phi; + + double target_M_plus, target_M_minus; + + double admMass; + + double adm_tol; + + double Newton_tol; + int Newton_maxit; + + int ntotal; + + struct parameters + { + int nvar, n1, n2, n3; + double b; + }; + +public: + TwoPunctures(double mp, double mm, double b, double P_plusx, double P_plusy, double P_plusz, + double S_plusx, double S_plusy, double S_plusz, + double P_minusx, double P_minusy, double P_minusz, + double S_minusx, double S_minusy, double S_minusz, + int nA, int nB, int nphi, + double Mp, double Mm, double admtol, double Newtontol, + int Newtonmaxit); + ~TwoPunctures(); + + void Solve(); + void set_initial_guess(derivs v); + int index(int i, int j, int k, int l, int a, int b, int c, int d); + int *ivector(long nl, long nh); + double *dvector(long nl, long nh); + int **imatrix(long nrl, long nrh, long ncl, long nch); + double **dmatrix(long nrl, long nrh, long ncl, long nch); + double ***d3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh); + void free_ivector(int *v, long nl, long nh); + void free_dvector(double *v, long nl, long nh); + void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch); + void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch); + void free_d3tensor(double ***t, long nrl, long nrh, long ncl, long nch, + long ndl, long ndh); + int minimum2(int i, int j); + int minimum3(int i, int j, int k); + int maximum2(int i, int j); + int maximum3(int i, int j, int k); + int pow_int(int mantisse, int exponent); + void chebft_Zeros(double u[], int n, int inv); + void chebft_Extremes(double u[], int n, int inv); + void chder(double *c, double *cder, int n); + double chebev(double a, double b, double c[], int m, double x); + void fourft(double *u, int N, int inv); + void fourder(double u[], double du[], int N); + void fourder2(double u[], double d2u[], int N); + double fourev(double *u, int N, double x); + double norm1(double *v, int n); + double norm2(double *v, int n); + double scalarproduct(double *v, double *w, int n); + double PunctIntPolAtArbitPosition(int ivar, int nvar, int n1, + int n2, int n3, derivs v, double x, double y, + double z); + double PunctEvalAtArbitPosition(double *v, int ivar, double A, double B, double phi, + int nvar, int n1, int n2, int n3); + void AB_To_XR(int nvar, double A, double B, double *X, double *R, + derivs U); + void C_To_c(int nvar, double X, double R, double *x, double *r, + derivs U); + void rx3_To_xyz(int nvar, double x, double r, double phi, + double *y, double *z, derivs U); + void Derivatives_AB3(int nvar, int n1, int n2, int n3, derivs v); + void Newton(int const nvar, int const n1, int const n2, int const n3, + derivs v, double const tol, int const itmax); + void F_of_v(int nvar, int n1, int n2, int n3, derivs v, double *F, + derivs u); + double norm_inf(double const *F, int const ntotal); + int bicgstab(int const nvar, int const n1, int const n2, int const n3, + derivs v, derivs dv, int const itmax, double const tol, + double *normres); + void allocate_derivs(derivs *v, int n); + void free_derivs(derivs *v, int n); + int Index(int ivar, int i, int j, int k, int nvar, int n1, int n2, int n3); + void NonLinEquations(double rho_adm, double A, double B, double X, double R, double x, double r, double phi, + double y, double z, derivs U, double *values); + double BY_KKofxyz(double x, double y, double z); + void SetMatrix_JFD(int nvar, int n1, int n2, int n3, derivs u, int *ncols, int **cols, double **Matrix); + void J_times_dv(int nvar, int n1, int n2, int n3, derivs dv, double *Jdv, derivs u); + void relax(double *dv, int const nvar, int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, int **cols, double **JFD); + void LineRelax_be(double *dv, + int const i, int const k, int const nvar, + int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, int **cols, + double **JFD); + void JFD_times_dv(int i, int j, int k, int nvar, int n1, int n2, + int n3, derivs dv, derivs u, double *values); + void LinEquations(double A, double B, double X, double R, + double x, double r, double phi, + double y, double z, derivs dU, derivs U, double *values); + void LineRelax_al(double *dv, + int const j, int const k, int const nvar, + int const n1, int const n2, int const n3, + double const *rhs, int const *ncols, + int **cols, double **JFD); + void ThomasAlgorithm(int N, double *b, double *a, double *c, double *x, double *q); + void Save(char *fname); + // provided by Vasileios Paschalidis (vpaschal@illinois.edu) + double Spec_IntPolABphiFast(parameters par, double *v, int ivar, double A, double B, double phi); + double Spec_IntPolFast(parameters par, int ivar, double *v, double x, double y, double z); + void SpecCoef(parameters par, int ivar, double *v, double *cf); +}; + +#endif /* TWO_PUNCTURES_H */ diff --git a/AMSS_NCKU_source/Z4c_class.C b/AMSS_NCKU_source/Z4c_class.C new file mode 100644 index 0000000..6f4cd27 --- /dev/null +++ b/AMSS_NCKU_source/Z4c_class.C @@ -0,0 +1,2865 @@ + +#ifdef newc +#include +#include +#include +using namespace std; +#else +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "Ansorg.h" +#include "fmisc.h" +#include "Parallel.h" +#include "Z4c_class.h" +#include "bssn_rhs.h" +#include "initial_puncture.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "getnp4.h" +#include "shellfunctions.h" +#include "cpbc.h" +#include "kodiss.h" +#include "parameters.h" + +#ifdef With_AHF +#include "derivatives.h" +#include "myglobal.h" +#endif + +//================================================================================================ + +// Define Z4c_class + +// This class inherits some members and methods from the parent `bssn_class` and modifies others. +// The modified members and methods are defined below (and in the header Z4c_class.h). +// The remaining members/methods are inherited from `bssn_class` (declared in bssn_class.h). + +Z4c_class::Z4c_class(double Couranti, double StartTimei, double TotalTimei, + double DumpTimei, double d2DumpTimei, + double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, + double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi) + : bssn_class(Couranti, StartTimei, TotalTimei, + DumpTimei, d2DumpTimei, CheckTimei, AnasTimei, + Symmetryi, checkruni, checkfilenamei, numepssi, numepsbi, numepshi, + a_levi, maxli, decni, maxrexi, drexi) +{ +} + +//================================================================================================ + + + +//================================================================================================ + +// this member function initializes the class + +//================================================================================================ + +void Z4c_class::Initialize() +{ + TZo = new var("TZo", ngfs++, 1, 1, 1); + TZ0 = new var("TZ0", ngfs++, 1, 1, 1); + TZ = new var("TZ", ngfs++, 1, 1, 1); + TZ1 = new var("TZ1", ngfs++, 1, 1, 1); + TZ_rhs = new var("TZ_rhs", ngfs++, 1, 1, 1); + + if (myrank == 0) + cout << "you have setted " << ngfs << " grid functions." << endl; + + OldStateList->insert(TZo); + StateList->insert(TZ0); + RHSList->insert(TZ_rhs); + SynchList_pre->insert(TZ); + SynchList_cor->insert(TZ1); + // DumpList->insert(TZ0); + ConstraintList->insert(TZ0); + + CheckPoint->addvariablelist(StateList); + CheckPoint->addvariablelist(OldStateList); + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + GH = new cgh(0, ngfs, Symmetry, pname, checkrun, ErrorMonitor); + if (checkrun) + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); + else + GH->compose_cgh(nprocs); + +#ifdef WithShell + SH = new ShellPatch(0, ngfs, pname, Symmetry, myrank, ErrorMonitor); + if (!checkrun) + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); + + if (checkrun) + CheckPoint->readcheck_sh(SH, myrank); +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; + + if (checkrun) + { + CheckPoint->read_Black_Hole_position(BH_num_input, BH_num, Porg0, Pmom, Spin, Mass, Porgbr, Porg, Porg1, Porg_rhs); + } + else + { + PhysTime = StartTime; + Setup_Black_Hole_position(); + } +} + +//================================================================================================ + + + + +//================================================================================================ + +// this member function is the destructor, used to delete variables + +//================================================================================================ + +Z4c_class::~Z4c_class() +{ + delete TZo; + delete TZ0; + delete TZ; + delete TZ1; + delete TZ_rhs; +} + +//================================================================================================ + + + + +//================================================================================================ + +// This member function defines a single time step evolution in the time evolution process + +//================================================================================================ + +#define MRBD 0 // 0: fix BD for meshrefinement level; 1: sommerfeld_bam for them; 2: sommerfeld_yo for them + +#ifndef CPBC +// for sommerfeld boundary + +void Z4c_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (MRBD == 0) + +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + +#elif (MRBD == 1) + // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#if (MRBD == 0) + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#elif (MRBD == 2) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_Z4c_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[TZ1->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (MRBD == 0) + +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + +#elif (MRBD == 1) + // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#if (MRBD == 0) + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#elif (MRBD == 2) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_Z4c_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[TZ1->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } + +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} +#else +// for constraint preserving boundary (CPBC) +#ifndef WithShell +#error "CPBC only supports Shell" +#endif + +// 0: extroplate rhs, 1: extroplate variable +// 2: extroplate variable but before RHS calculation +#define EXTO 1 + +// #define SMOOTHSHELL + +// change chi based on chitiny or not: 0: yes; 1: no +#define chinot 0 +void Z4c_class::Step(int lev, int YN) +{ + // Check_extrop(); + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double fbeps = -0.1; + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + +#if (chinot == 0) + if (f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } +#else + if (f_compute_rhs_Z4cnot(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre, chitiny)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } +#endif + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (MRBD == 1) + // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#if (MRBD == 0) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#elif (MRBD == 2) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } +#if (chinot == 0) + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#if 0 +// check rhs + { + Parallel::Dump_Data(GH->PatL[lev],RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check irhs for box"<PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (EXTO == 2) + // extroplate variable itself + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ0->sgfn], cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); +#endif + +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_Z4c_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, fbeps, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + // CPBC indeed for outter boudary while fix BD for inner boundary + f_david_milton_cpbc_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[TZ0->sgfn], cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ_rhs->sgfn], cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], +#if (EXTO == 0) + Symmetry, fbeps, sPp->data->sst); + // extroplate rhs + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ_rhs->sgfn], cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); + + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], cg->fgfs[varl0->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + varl0->data->SoA, Symmetry, numepsh, sPp->data->sst); +#elif (EXTO == 1 || EXTO == 2) + Symmetry, numepsh, sPp->data->sst); + + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } +#if (EXTO == 1) + // extroplate variable itself + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ->sgfn], cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); +#endif + } +#if (chinot == 0) + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); +#endif + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"<Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(SynchList_pre,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check SynchList_pre"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + +#ifdef SMOOTHSHELL + // smooth Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + MyList *varl = SynchList_pre; + while (varl) + { + f_kodis_shcr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl->data->sgfn], + varl->data->SoA, Symmetry, numepsh, sPp->data->sst); + varl = varl->next; + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + SH->Synch(SynchList_pre, Symmetry); + } +// end smooth +#endif + +#if 0 +// check SynchList_pre after Synch + { + SH->Dump_Data(SynchList_pre,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check SynchList_pre"< 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + +#if (chinot == 0) + if (f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[TZ1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } +#else + if (f_compute_rhs_Z4cnot(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[TZ1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor, chitiny)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } +#endif + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (MRBD == 1) + // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#if (MRBD == 0) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#elif (MRBD == 2) + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } +#if (chinot == 0) + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (EXTO == 2) + // extroplate variable itself + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ->sgfn], cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); +#endif + +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_Z4c_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[TZ1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, fbeps, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + // CPBC indeed for outter boudary while fix BD for inner boundary + f_david_milton_cpbc_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[TZ->sgfn], cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[TZ1->sgfn], cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], +#if (EXTO == 0) + Symmetry, fbeps, sPp->data->sst); + // extroplate rhs + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ1->sgfn], cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); + + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + f_kodis_sh(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl->data->SoA, Symmetry, numepsh, sPp->data->sst); +#elif (EXTO == 1 || EXTO == 2) + Symmetry, numepsh, sPp->data->sst); + + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } +#if (EXTO == 1) + // extroplate variable itself + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ1->sgfn], cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); +#endif + } +#if (chinot == 0) + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); +#endif + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } + +#ifdef SMOOTHSHELL + // smooth Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + MyList *varl = SynchList_cor; + while (varl) + { + f_kodis_shcr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl->data->sgfn], + varl->data->SoA, Symmetry, numepsh, sPp->data->sst); + varl = varl->next; + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + SH->Synch(SynchList_cor, Symmetry); + } +// end smooth +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } + +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +#if 0 + if(lev>6) + { + char str[50]; + MyList * DG_List=new MyList(Cons_Ham); + DG_List->insert(Cons_Px); DG_List->insert(Cons_Py); DG_List->insert(Cons_Px); + DG_List->insert(Cons_Gx); DG_List->insert(Cons_Gy); DG_List->insert(Cons_Gx); + printf(str,"lao%d",lev); + Parallel::Dump_Data(GH->PatL[6],DG_List,str,PhysTime,dT_lev); + DG_List->clearList(); + } +#endif +} +#endif +#undef MRBD + +//================================================================================================ + + + +//================================================================================================ + +// this member function is used to check the extroplation result + +//================================================================================================ + +void Z4c_class::Check_extrop() +{ + MyList *sPp; + + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_david_milton_extroplate_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[TZ0->sgfn], cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + sPp->data->bbox[2], sPp->data->bbox[5]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + + SH->Dump_Data(StateList, "extrop", 0, 1); + if (myrank == 0) + MPI_Abort(MPI_COMM_WORLD, 1); +} + +//================================================================================================ + + + +//================================================================================================ + +// this member function is used to compute and output constraint violation + +//================================================================================================ + +void Z4c_class::Constraint_Out() +{ + // here we have to use the same variable name as in the parent class + LastConsOut += dT * pow(0.5, Mymax(0, trfls)); + + if (LastConsOut >= AnasTime) + // Constraint violation + { + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + SH->Synch(ConstraintList, Symmetry); +#endif + + double ConV[8]; + +#ifdef WithShell + ConV[0] = SH->L2Norm(Cons_Ham); + ConV[1] = SH->L2Norm(Cons_Px); + ConV[2] = SH->L2Norm(Cons_Py); + ConV[3] = SH->L2Norm(Cons_Pz); + ConV[4] = SH->L2Norm(Cons_Gx); + ConV[5] = SH->L2Norm(Cons_Gy); + ConV[6] = SH->L2Norm(Cons_Gz); + ConV[7] = SH->L2Norm(TZ0); + ConVMonitor->writefile(PhysTime, 8, ConV); +#endif + for (int levi = 0; levi < GH->levels; levi++) + { + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz); + ConV[7] = Parallel::L2Norm(GH->PatL[levi]->data, TZ0); + ConVMonitor->writefile(PhysTime, 8, ConV); + /* + if(fabs(ConV[0])<0.00001) + { + MyList * DG_List=new MyList(Cons_Ham); + DG_List->insert(Cons_Px); DG_List->insert(Cons_Py); DG_List->insert(Cons_Px); + DG_List->insert(Cons_Gx); DG_List->insert(Cons_Gy); DG_List->insert(Cons_Gx); + Parallel::Dump_Data(GH->PatL[levi],DG_List,"jiu",0,1); + DG_List->clearList(); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } + */ + } + + LastConsOut = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// this member function is used to interpolate constraint data + +//================================================================================================ + +void Z4c_class::Interp_Constraint() +{ + // we do not support a_lev != 0 yet. + if (a_lev > 0) + return; + + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_Z4c(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + SH->Synch(ConstraintList, Symmetry); +#endif + // interpolate + double *x1, *y1, *z1; + const int n = 1000; + double lmax, lmin, dd; + lmin = 0; +#ifdef WithShell + lmax = SH->Rrange[1]; +#else + lmax = GH->bbox[0][0][4]; +#endif +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (lmax - lmin) / (n - 1); +#else +#ifdef Cell + dd = (lmax - lmin) / n; +#else +#error Not define Vertex nor Cell +#endif +#endif + x1 = new double[n]; + y1 = new double[n]; + z1 = new double[n]; + for (int i = 0; i < n; i++) + { + x1[i] = 0; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y1[i] = lmin + i * dd; +#else +#ifdef Cell + y1[i] = lmin + (i + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + z1[i] = 0; + } + + int InList = 0; + + MyList *varl = ConstraintList; + while (varl) + { + InList++; + varl = varl->next; + } + double *shellf; + shellf = new double[n * InList]; + for (int i = 0; i < n; i++) + { + double XX[3]; + XX[0] = x1[i]; + XX[1] = y1[i]; + XX[2] = z1[i]; + bool fg = GH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#ifdef WithShell + if (!fg) + fg = SH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#endif + if (!fg && myrank == 0) + { + cout << "bssn_class::Interp_Constraint meets wrong" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + ofstream outfile; + char filename[50]; + sprintf(filename, "%s/interp_constraint_%05d.dat", ErrorMonitor->out_dir.c_str(), int(PhysTime / dT + 0.5)); + // 0.5 for round off + + outfile.open(filename); + outfile << "# corrdinate, H_Res, Px_Res, Py_Res, Pz_Res, Gx_Res, Gy_Res, Gz_Res, ...." << endl; + for (int i = 0; i < n; i++) + { + outfile << setw(10) << setprecision(10) << y1[i]; + for (int j = 0; j < InList; j++) + outfile << " " << setw(16) << setprecision(15) << shellf[InList * i + j]; + outfile << endl; + } + + delete[] shellf; +} + +//================================================================================================ + + + +//================================================================================================ + +// this member function is used to compute constraint violation + +//================================================================================================ + +void Z4c_class::Compute_Constraint() +{ + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + int lev; + + for (lev = 0; lev < GH->levels; lev++) + { + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + lev = 0; + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_Z4c_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[TZ0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[TZ_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); +#endif +} + +//================================================================================================ + diff --git a/AMSS_NCKU_source/Z4c_class.h b/AMSS_NCKU_source/Z4c_class.h new file mode 100644 index 0000000..d279a1d --- /dev/null +++ b/AMSS_NCKU_source/Z4c_class.h @@ -0,0 +1,64 @@ + +#ifndef Z4c_CLASS_H +#define Z4c_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" +#include "surface_integral.h" + +#include "macrodef.h" + +#ifdef USE_GPU +#include "bssn_gpu_class.h" +#else +#include "bssn_class.h" +#endif + +class Z4c_class : public bssn_class +{ +public: + Z4c_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi); + ~Z4c_class(); + + void Initialize(); + void Check_extrop(); + // Since we have set zero to variables at very begining + // we can neglect TZ for initial data setting + void Step(int lev, int YN); + void Interp_Constraint(); + void Constraint_Out(); + void Compute_Constraint(); + +protected: + var *TZo; + var *TZ0; + var *TZ; + var *TZ1; + var *TZ_rhs; +}; +#endif /* Z4c_CLASS_H */ diff --git a/AMSS_NCKU_source/Z4c_rhs.f90 b/AMSS_NCKU_source/Z4c_rhs.f90 new file mode 100644 index 0000000..3b877ea --- /dev/null +++ b/AMSS_NCKU_source/Z4c_rhs.f90 @@ -0,0 +1,1705 @@ + + +#include "macrodef.fh" + + function compute_rhs_z4cnot(ex, T,X, Y, Z, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & +! co is not used here, we always compute constraint + Symmetry,Lev,eps,co,chitiny) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,co + real*8, intent(in ):: T,chitiny + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: TZ_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! when out, constraint violation + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont,compute_rhs_z4c + + real*8, dimension(ex(1),ex(2),ex(3)) :: chihere + + chihere = chi + call lowerboundset(ex,chihere,chitiny) + + gont = compute_rhs_z4c(ex, T,X, Y, Z, & + chihere, trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry,Lev,eps,co) + +#if (ABV == 0) + call ricci_gamma(ex, X, Y, Z, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) +#endif + call constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry) + + return + + end function compute_rhs_Z4cnot + +#if 1 + function compute_rhs_z4c(ex, T,X, Y, Z, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & +! co is not used here, we always compute constraint + Symmetry,Lev,eps,co) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,co + real*8, intent(in ):: T + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: TZ_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! when out, constraint violation + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: trKd + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO=0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0,F16=1.6d1 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0,F8=8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + +! constraint damping terms stuffs PRD 81, 084003 (2010) + real*8 :: kappa1,kappa2,kappa3,FF,eta + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz)+sum(dtSfx)+sum(dtSfy)+sum(dtSfz) & + +sum(TZ) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"Z4c_rhs.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"Z4c_rhs.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"Z4c_rhs.f90: find NaN in gxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"Z4c_rhs.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"Z4c_rhs.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"Z4c_rhs.f90: find NaN in gyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"Z4c_rhs.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"Z4c_rhs.f90: find NaN in gzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"Z4c_rhs.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"Z4c_rhs.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"Z4c_rhs.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"Z4c_rhs.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"Z4c_rhs.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"Z4c_rhs.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"Z4c_rhs.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"Z4c_rhs.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"Z4c_rhs.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"Z4c_rhs.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"Z4c_rhs.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"Z4c_rhs.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"Z4c_rhs.f90: find NaN in betaz" + if(sum(dtSfx).ne.sum(dtSfx))write(*,*)"Z4c_rhs.f90: find NaN in dtSfx" + if(sum(dtSfy).ne.sum(dtSfy))write(*,*)"Z4c_rhs.f90: find NaN in dtSfy" + if(sum(dtSfz).ne.sum(dtSfz))write(*,*)"Z4c_rhs.f90: find NaN in dtSfz" + if(sum(TZ).ne.sum(Tz))write(*,*)"Z4c_rhs.f90: find NaN in TZ" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + trKd = trK+TWO*TZ +!this beta^i_,j will be kept till the end of this routine + call fderivs(ex,betax,betaxx,betaxy,betaxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ex,betay,betayx,betayy,betayz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ex,betaz,betazx,betazy,betazz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + + div_beta = betaxx + betayy + betazz + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + chi_rhs = F2o3 *chin1*( alpn1 * trKd - div_beta ) !rhs for chi + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,Lev) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,Lev) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz +! gij_,kl will be stored till end of this routine + call fdderivs(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + call fdderivs(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + call fdderivs(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + call fdderivs(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,X,Y,Z,ANTI,ANTI,SYM ,symmetry,Lev) + call fdderivs(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,X,Y,Z,ANTI,SYM ,ANTI,symmetry,Lev) + call fdderivs(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,X,Y,Z,SYM ,ANTI,ANTI,symmetry,Lev) +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! the so called Gamma_d + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + +!!!!!!!!!!!!because gij_,k will be overwrite later, we calculate TWO*d_k Z^k here +! use Gamma^i as more as possible + Gmxcon = Gamx - Gamxa + Gmycon = Gamy - Gamya + Gmzcon = Gamz - Gamza + +!Maple generated code for g^ki*g^jm*g^ln*g_mn,k*g_ij,l +! Gami_,j are used as maple temp variables + Gamyy = 3*gupxz**2*gupzz*gxzz**2+gupxx*gupxz**2*gxxz**2+2*gxyx*gupxy**3*gxyy+ & + 2*gxyx*gupxy**3*gyyx+gupxx**2*gupzz*gxzx**2+3*gupxx*gupxy**2*gxyx**2+ & + 6*gxyx*gupxy*gupxz*gupyy*gyzy+gupxx**2*gupyy*gxyx**2+ & + 2*gxyz*gupxy*gupyz**2*gyyz+2*gxxz*gupxx**2*gupyz*gxyx+ & + gupxz**2*gupyy*gyzx**2+2*gxxy*gupxx*gupxy*gupxz*gxxz+ & + 2*gyzx*gupxy*gupxz*gupzz*gzzx+3*gupyy*gupyz**2*gyzy**2+ & + 2*gyyy*gupyz**3*gzzz+2*gxxz*gupxz**3*gxzz+ & + 4*gxzy*gupxx*gupxz*gupyy*gxyx+gupyy*gupyz**2*gyyz**2 + Gamxz = Gamyy+2*gxxz*gupxy**2*gupzz*gyzy+4*gxyz*gupxx*gupxy*gupxz*gxxx+ & + 6*gxzz*gupxy*gupyz*gupzz*gyzy+2*gxxy*gupxx*gupxz*gupyz*gxzz+ & + 3*gupxy**2*gupyy*gxyy**2+2*gxyz*gupxx*gupyy*gupzz*gyzx+ & + 4*gxyy*gupxx*gupyy*gupyz*gyzx+6*gxyy*gupxy*gupxz*gupyz*gxzz+ & + 4*gxzz*gupxx*gupyz*gupzz*gyzx+3*gupxx*gupxz**2*gxzx**2+ & + 4*gxyz*gupxx*gupxy*gupyz*gxyx+2*gxxz*gupxx*gupxz*gupyz*gxyz+ & + 2*gxxy*gupxy*gupxz*gupyz*gyzz+2*gxzx*gupxy*gupxz*gupyz*gyyz+ & + gupyz**2*gupzz*gzzy**2+gupxz**2*gupzz*gzzx**2+ & + gupyy*gupzz**2*gyzz**2+2*gyzy*gupyz**3*gzzy+gupxx*gupzz**2*gxzz**2 + Gamyy = Gamxz+gupxx*gupyz**2*gxzy**2+2*gxzx*gupxz**3*gzzx+ & + 3*gupyz**2*gupzz*gyzz**2+2*gyzy*gupyz**3*gyzz+gupyy**2*gupzz*gyzy**2+ & + gupxy**2*gupzz*gyzx**2+2*gyyz*gupyz**3*gyzz+gupxy**2*gupyy*gyyx**2+ & + gupxx*gupyz**2*gxyz**2+gupxx*gupyy**2*gxyy**2+ & + gupxy**2*gupzz*gxzy**2+2*gxzx*gupxz**3*gxzz+ & + 2*gyyx*gupxy*gupxz*gupyy*gyzx+gupxx*gupxy**2*gxxy**2+ & + 2*gxxx*gupxz**3*gzzz+2*gxxx*gupxy**3*gyyy+gupxz**2*gupyy*gxyz**2+ & + 2*gxyy*gupxy**3*gxxy + Gamxy = Gamyy+2*gxyy*gupxz*gupyy**2*gyzy+6*gxyy*gupxx*gupxy*gupyz*gxzx+ & + 4*gxyy*gupxy*gupxz*gupyy*gxyz+2*gyzx*gupxz*gupyy*gupzz*gzzy+ & + 2*gxzy*gupxy*gupxz*gupyy*gxyy+4*gxzy*gupxy*gupxz*gupzz*gxzz+ & + 2*gyyx*gupxz*gupyy*gupyz*gyzz+6*gxyx*gupxx*gupxz*gupyz*gxzz+ & + 2*gxyz*gupxy**2*gupzz*gxzy+2*gxyz*gupxy**2*gupyz*gxyy+ & + 2*gxyz*gupxy**2*gupxz*gxxy+2*gupxy*gupxz*gupyz*gxyz**2+ & + 4*gxyy*gupxz*gupyz**2*gzzz+2*gxyy*gupxy*gupyz**2*gzzy+ & + 4*gxyy*gupxy**2*gupyz*gxzy+2*gxyy*gupxy**2*gupxz*gxxz+ & + 4*gxyy*gupxx*gupxy**2*gxxx+2*gxyx*gupxy**2*gupxz*gxzy+ & + 2*gxyx*gupxy**2*gupyz*gyzy + Gamyy = Gamxy+2*gxyx*gupxx*gupxy**2*gxxy+4*gyzz*gupyz*gupzz**2*gzzz+ & + 4*gxzy*gupxx*gupxz*gupyz*gxzx+2*gxzy*gupxx*gupyy*gupzz*gyzx+ & + 4*gxxx*gupxx*gupxy*gupxz*gyzx+2*gxyx*gupxx**2*gupyz*gxzx+ & + 2*gxyx*gupxy**2*gupxz*gxyz+2*gxzy*gupxz*gupyy*gupyz*gyyz+ & + 4*gxzy*gupxy*gupyy*gupyz*gyyy+2*gxzy*gupxx*gupyy*gupyz*gyyx+ & + 2*gyyx*gupxy*gupxz*gupyy*gxzy+2*gyyx*gupxy*gupyy*gupyz*gyyz+ & + 2*gyyx*gupxy*gupyy*gupyz*gyzy+4*gxzy*gupxz*gupyy*gupzz*gyzz+ & + 2*gyyx*gupxy*gupxz*gupyz*gxzz+2*gxyz*gupxx*gupyy*gupzz*gxzy+ & + 2*gxyy*gupxz*gupyy*gupyz*gzzy + Gamxz = Gamyy+2*gxyy*gupxy*gupxz*gupyz*gzzx+2*gxyy*gupxy*gupxz*gupyy*gyzx+ & + 2*gxyy*gupxy*gupyy*gupyz*gyyz+2*gxyy*gupxx*gupyy*gupyz*gxzy+ & + 2*gxxy*gupxy**2*gupxz*gxzy+2*gxxy*gupxy**2*gupyz*gyzy+ & + 2*gxxy*gupxy**2*gupyy*gyyy+2*gxxy*gupxx**2*gupyz*gxzx+ & + 2*gxxy*gupxx**2*gupyy*gxyx+2*gxxx*gupxx*gupxz**2*gzzx+ & + 4*gxxx*gupxy*gupxz**2*gyzz+4*gxxx*gupxy**2*gupxz*gyzy+ & + 2*gxxx*gupxx*gupxy**2*gyyx+4*gxxx*gupxx*gupxz**2*gxzz+ & + 4*gxxx*gupxx**2*gupxz*gxzx+2*gxxx*gupxx**2*gupxz*gxxz+ & + 4*gxyz*gupxz*gupyz**2*gyzz+2*gxyz*gupxy*gupyz**2*gyzy+ & + 2*gxzy*gupxy*gupyy*gupzz*gyzy + Gamyy = Gamxz+2*gxyy*gupxx*gupyy*gupyz*gxyz+6*gxzz*gupxz*gupyz*gupzz*gyzz+ & + 4*gxzy*gupxz*gupyz*gupzz*gzzz+gupyy**3*gyyy**2+ & + 2*gxzy*gupxy*gupyz*gupzz*gzzy+2*gxzy*gupxx*gupyz*gupzz*gzzx+ & + 2*gxyz*gupxx*gupyz*gupzz*gxzz+2*gxzy*gupxx*gupyz*gupzz*gxzz+ & + 2*gyzy*gupxy*gupyz*gupzz*gzzx+2*gyzy*gupxz*gupyy*gupyz*gxzy+ & + 6*gyzy*gupyy*gupyz*gupzz*gyzz+4*gyzx*gupxz*gupyy*gupyz*gyzy+ & + 4*gyzx*gupxy*gupyz*gupzz*gyzz+2*gxxy*gupxx*gupxy*gupyy*gxyy+ & + 4*gyzx*gupxz*gupyz*gupzz*gzzz+2*gyzx*gupxy*gupyy*gupzz*gyzy+ & + 2*gyyz*gupyy*gupyz*gupzz*gzzy+2*gyyz*gupxy*gupyz*gupzz*gzzx + Gamxx = Gamyy+2*gyyz*gupyy*gupyz*gupzz*gyzz+2*gyyz*gupxy*gupyy*gupzz*gyzx+ & + 2*gyyz*gupxy*gupyz*gupzz*gxzz+2*gxxy*gupxx*gupxy*gupyz*gyzx+ & + 4*gyyy*gupxy*gupyy*gupyz*gyzx+2*gyyx*gupxy*gupxz*gupyz*gzzx+ & + 2*gxyz*gupxy*gupyz*gupzz*gyzz+2*gxxz*gupxz**2*gupzz*gzzz+ & + 2*gxxz*gupxz**2*gupyz*gyzz+2*gxxz*gupxy*gupxz**2*gxzy+ & + 2*gxxz*gupxx*gupxz**2*gxzx+2*gxxz*gupxy**2*gupyz*gyyy+ & + 2*gxxz*gupxx**2*gupzz*gxzx+2*gxxy*gupxz**2*gupyz*gzzz+ & + 2*gxxy*gupxz**2*gupyy*gyzz+2*gxxy*gupxy*gupxz**2*gxzz+ & + 2*gzzx*gupxz*gupyz*gupzz*gzzy+2*gyzz*gupxz*gupyz*gupzz*gzzx+ & + 2*gxzx*gupxx*gupxz*gupzz*gzzx+2*gyzx*gupxz*gupyy*gupzz*gyzz + Gamyy = Gamxx+gupzz**3*gzzz**2+2*gxzz*gupxy*gupxz*gupzz*gyzx+ & + 6*gxzx*gupxy*gupxz*gupyz*gyzy+2*gxxy*gupxy*gupxz*gupyz*gzzy+ & + 4*gxzz*gupxy*gupyz**2*gyyy+2*gxzy*gupxz*gupyz**2*gyzz+ & + 2*gxzy*gupxz**2*gupyz*gxzz+2*gxzy*gupxz**2*gupyy*gxyz+ & + 2*gupxy*gupxz*gupyz*gxzy**2+4*gxzx*gupxz**2*gupzz*gzzz+ & + 2*gxzx*gupxz**2*gupyz*gyzz+2*gxyz*gupxy*gupxz*gupzz*gzzx+ & + 2*gxyz*gupxz*gupyy*gupzz*gzzy+2*gxyx*gupxx*gupxz*gupyy*gxyz+ & + 2*gxzz*gupxz*gupyz**2*gyyz+2*gxxy*gupxx*gupxy*gupxz*gxzx+ & + 2*gyyx*gupxy**2*gupxz*gxzx + Gamxz = Gamyy+2*gxyx*gupxy*gupxz*gupyz*gzzy+2*gyzy*gupyy*gupyz*gupzz*gzzy+ & + 2*gxyx*gupxx*gupxz*gupyy*gyzx+2*gyyx*gupxy*gupyz**2*gyzz+ & + 2*gyyx*gupxy**2*gupyz*gyzx+2*gyyx*gupxz*gupyz**2*gzzz+ & + 2*gyyx*gupxy*gupyy**2*gyyy+2*gxyz*gupxy**2*gupzz*gyzx+ & + 2*gxyz*gupxy**2*gupyz*gyyx+2*gxyy*gupxy*gupyz**2*gyzz+ & + 2*gxyy*gupxy**2*gupyz*gyzx+2*gxyy*gupxy**2*gupyy*gyyx+ & + 2*gxyx*gupxy*gupxz**2*gzzx+2*gxyx*gupxy**2*gupyz*gyyz+ & + 4*gxzz*gupxz*gupzz**2*gzzz+2*gxzz*gupxy*gupzz**2*gzzy+ & + 2*gxzz*gupxx*gupzz**2*gzzx+6*gxyx*gupxx*gupxy*gupxz*gxzx+ & + 2*gxyz*gupxy*gupxz*gupyz*gyzx + Gamyy = Gamxz+2*gyyx*gupxz*gupyy**2*gyzy+2*gyyx*gupxz*gupyy*gupyz*gzzy+ & + 2*gxxz*gupxx*gupxy*gupyz*gxyy+2*gyzx*gupxz**2*gupyy*gxzy+ & + 4*gyzx*gupxy*gupxz**2*gxzx+2*gyzx*gupxz*gupyz**2*gyzz+ & + 2*gyzx*gupxz**2*gupyz*gxzz+2*gupxy*gupxz*gupyz*gyzx**2+ & + 2*gyyz*gupyz**2*gupzz*gzzz+2*gyyz*gupyy*gupyz**2*gyzy+ & + 2*gyyz*gupxy*gupyz**2*gyzx+2*gyyz*gupyy**2*gupzz*gyzy+ & + 2*gyyz*gupxy**2*gupzz*gxzx+2*gyyy*gupyy*gupyz**2*gzzy+ & + 2*gyyy*gupxy*gupyz**2*gzzx+4*gyyy*gupyy*gupyz**2*gyzz+ & + 4*gyyy*gupyy**2*gupyz*gyzy+2*gyyy*gupyy**2*gupyz*gyyz + Gamxy = Gamyy+2*gxyz*gupxz*gupyy*gupyz*gyzy+2*gxyz*gupxx*gupyy*gupyz*gyyx+ & + 2*gzzx*gupxz*gupzz**2*gzzz+2*gxzy*gupxy*gupxz*gupyz*gyzx+ & + 2*gyzz*gupyz**2*gupzz*gzzy+2*gyzy*gupxz*gupyz**2*gzzx+ & + 2*gyzx*gupxz*gupyz**2*gzzy+2*gyzx*gupxz**2*gupyz*gzzx+ & + 2*gxzz*gupxz**2*gupzz*gzzx+2*gxzz*gupxy*gupzz**2*gyzz+ & + 2*gxzy*gupxz*gupyz**2*gzzy+2*gxzy*gupxz**2*gupyz*gzzx+ & + 2*gxzx*gupxz**2*gupyz*gzzy+2*gyzz*gupyy*gupzz**2*gzzy+ & + 2*gyzz*gupxy*gupzz**2*gzzx+4*gyzy*gupyz**2*gupzz*gzzz+ & + 2*gyzy*gupxy*gupyz**2*gyzx+2*gyzy*gupxz*gupyz**2*gxzz+ & + 2*gxzy*gupxy*gupyz*gupzz*gyzz+2*gxyx*gupxx*gupxy*gupyz*gxzy + Gamyy = Gamxy+gupxx**3*gxxx**2+2*gzzy*gupyz*gupzz**2*gzzz+ & + 6*gxyx*gupxx*gupxy*gupyy*gxyy+2*gxzz*gupxz*gupyz* gupzz*gzzy+ & + 6*gxyx*gupxy*gupxz*gupyz*gyzz+2*gxzx*gupxy*gupxz**2*gxzy+ & + 2*gxyx*gupxx*gupxy*gupyy*gyyx+2*gxyx*gupxx*gupxz*gupyz*gzzx+ & + 2*gxyx*gupxx*gupxy*gupxz*gxxz+4*gxyx*gupxx**2*gupxy*gxxx+ & + 2*gxyx*gupxy*gupxz*gupyy*gyyz+6*gxyy*gupxy*gupyy*gupyz*gyzy+ & + 2*gxyx*gupxx*gupxy*gupyz*gyzx+6*gxyy*gupxz*gupyy*gupyz*gyzz+ & + 4*gxyz*gupxx*gupxy*gupzz*gxzx+2*gxyz*gupxy*gupxz*gupzz*gxzz+ & + 4*gxyx*gupxy**2*gupyy*gyyy+2*gxyz*gupxz*gupyy*gupyz*gyyz + Gamxz = Gamyy+4*gxyz*gupxy*gupyy*gupyz*gyyy+2*gxyx*gupxz**2*gupyy*gyzz+ & + 2*gxyz*gupxz*gupyy*gupzz*gyzz+2*gxyx*gupxy*gupxz**2*gxzz+ & + 4*gxyz*gupxy*gupyy*gupzz*gyzy+2*gxzx*gupxy**2*gupzz*gyzy+ & + 2*gxyz*gupxx*gupxz*gupyz*gxzx+4*gxyx*gupxz**2*gupyz*gzzz+ & + 4*gxzx*gupxy**2*gupyz*gyyy+2*gyyz*gupxy*gupyy*gupzz*gxzy+ & + 2*gxyz*gupxy*gupxz*gupyz*gxzy+2*gxyz*gupxx*gupyz*gupzz*gzzx+ & + 4*gxyy*gupxy*gupyy**2*gyyy+2*gxyy*gupxx*gupyy**2*gyyx+ & + 2*gxyy*gupxx*gupyz**2*gzzx+2*gxyz*gupxy*gupyz*gupzz*gzzy+ & + 2*gxyy*gupxz*gupyy**2*gyyz+4*gxyz*gupxz*gupyz*gupzz*gzzz+ & + 2*gxxy*gupxx*gupxz*gupyy*gxyz + Gamyy = Gamxz+2*gxzx*gupxy*gupxz**2*gxyz+2*gxxy*gupxy*gupxz*gupyy*gyzy+ & + 4*gxxx*gupxx*gupxy*gupxz*gxzy+2*gxxy*gupxy*gupxz*gupyy*gyyz+ & + 2*gxxy*gupxx*gupxz*gupyy*gyzx+2*gxxy*gupxx*gupxz*gupyz*gzzx+ & + 2*gxzx*gupxy**2*gupxz*gxyy+2*gxxy*gupxx*gupxy*gupyz*gxzy+ & + 2*gxyz*gupxy*gupxz**2*gxxz+2*gxxy*gupxx*gupxy*gupyy*gyyx+ & + 2*gxyz*gupxx*gupyz**2*gyzx+4*gxyz*gupxz**2*gupyz*gxzz+ & + 2*gxxz*gupxx*gupxy*gupzz*gxzy+2*gxxz*gupxx*gupxz*gupzz*gxzz+ & + 2*gxxx*gupxx**2*gupxy*gxxy+2*gxxz*gupxx*gupxy*gupyz*gyyx+ & + 2*gxxz*gupxy*gupxz*gupzz*gyzz+2*gxxz*gupxx*gupxy*gupzz*gyzx + TZ_rhs = Gamyy+2*gxxz*gupxy*gupxz*gupyz*gyyz+2*gxxz*gupxx*gupxz*gupyz*gyzx+ & + 2*gxxz*gupxx*gupxz*gupzz*gzzx+2*gxxz*gupxy*gupxz*gupyz*gyzy+ & + 2*gxzx*gupxx*gupxy*gupzz*gxzy+2*gxxz*gupxy*gupxz*gupzz*gzzy+ & + 6*gxzx*gupxy*gupxz*gupzz*gyzz+2*gxzx*gupxx*gupxy*gupzz*gyzx+ & + 2*gxzx*gupxx*gupxy*gupyz*gyyx+6*gxzx*gupxx*gupxz*gupzz*gxzz+ & + 2*gxxx*gupxy**2*gupxz*gyyz+2*gxzx*gupxy*gupxz*gupzz*gzzy+ & + 2*gxzx*gupxx*gupxz*gupyz*gyzx+2*gxxx*gupxy*gupxz**2*gzzy+ & + 4*gxzy*gupxy*gupyz**2*gyzy+2*gxzy*gupxx*gupyz**2*gyzx+ & + 2*gxzz*gupxx*gupyz**2*gyyx+4*gxyx*gupxy**2*gupxz*gyzx+ & + 2*gxyx*gupxz**2*gupyy*gzzy+2*gxyy*gupxx*gupyz**2*gxzz + +! Gami_,j will be kept till the end of this routine + call fderivs(ex,Gamx,Gamxx,Gamxy,Gamxz,X,Y,Z,ANTI,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,Gamy,Gamyx,Gamyy,Gamyz,X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,Gamz,Gamzx,Gamzy,Gamzz,X,Y,Z,SYM ,SYM ,ANTI,Symmetry,Lev) + + TZ_rhs = chix*Gmxcon+chiy*Gmycon+chiz*Gmzcon & + +chin1*(Gamxx+Gamyy+Gamzz - & + (TWO*(gupxz*gupyz*gyzxz+gupxx*gupyy*gxyxy+gupxy*gupyz*gxzyy+ & + gupxx*gupxy*gxxxy+gupxx*gupxz*gxxxz+gupxx*gupxy*gxyxx+ & + gupxx*gupyz*gxyxz+gupxx*gupxz*gxzxx+gupxx*gupyz*gxzxy+ & + gupxx*gupzz*gxzxz+gupxy*gupxz*gxxyz+gupxy*gupyy*gxyyy+ & + gupxy*gupyz*gxyyz+gupxy*gupxz*gxzxy+gupxy*gupzz*gxzyz+ & + gupxy*gupxz*gxyxz+gupxz*gupyy*gxyyz+gupxz*gupyz*gxyzz+ & + gupxz*gupyz*gxzyz+gupxz*gupzz*gxzzz+gupxy*gupyy*gyyxy+ & + gupxy*gupyz*gyyxz+gupxy*gupxz*gyzxx+gupxy*gupyz*gyzxy+ & + gupxy*gupzz*gyzxz+gupyy*gupyz*gyyyz+gupxz*gupyy*gyzxy+ & + gupyy*gupyz*gyzyy+gupyy*gupzz*gyzyz+gupyz*gupzz*gyzzz+ & + gupxz*gupyz*gzzxy+gupxz*gupzz*gzzxz+gupyz*gupzz*gzzyz+ & + gupxy*gupxy*gxyxy+gupxz*gupxz*gxzxz+gupyz*gupyz*gyzyz) & + +gupxx*gupxx*gxxxx+gupxy*gupxy*gxxyy+gupxz*gupxz*gxxzz+ & + gupxy*gupxy*gyyxx+gupyy*gupyy*gyyyy+gupyz*gupyz*gyyzz+ & + gupxz*gupxz*gzzxx+gupyz*gupyz*gzzyy+gupzz*gupzz*gzzzz)+& + (gxx*Gamxa*Gamxa+gyy*Gamya*Gamya+gzz*Gamza*Gamza +& + TWO*(gxy*Gamxa*Gamya+gxz*Gamxa*Gamza+gyz*Gamya*Gamza)) + TZ_rhs) + +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... +! Lap_,i will be kept till the end of this routine + call fderivs(ex,Lap,Lapx,Lapy,Lapz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) +! K_,i stored K_,i+TZ_,i/2 indeed, will be kept till the end of this routine + call fderivs(ex,trK,Kx,Ky,Kz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + call fderivs(ex,TZ,fxx,fxy,fxz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + Kx = Kx + fxx/TWO + Ky = Ky + fxy/TWO + Kz = Kz + fxz/TWO + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,& + X,Y,Z,ANTI,SYM, SYM ,Symmetry,Lev) + call fdderivs(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,& + X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fdderivs(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,& + X,Y,Z,SYM ,SYM, ANTI,Symmetry,Lev) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + Rxx = gupxx * gxxxx + gupyy * gxxyy + gupzz * gxxzz + & + ( gupxy * gxxxy + gupxz * gxxxz + gupyz * gxxyz ) * TWO + + Ryy = gupxx * gyyxx + gupyy * gyyyy + gupzz * gyyzz + & + ( gupxy * gyyxy + gupxz * gyyxz + gupyz * gyyyz ) * TWO + + Rzz = gupxx * gzzxx + gupyy * gzzyy + gupzz * gzzzz + & + ( gupxy * gzzxy + gupxz * gzzxz + gupyz * gzzyz ) * TWO + + Rxy = gupxx * gxyxx + gupyy * gxyyy + gupzz * gxyzz + & + ( gupxy * gxyxy + gupxz * gxyxz + gupyz * gxyyz ) * TWO + + Rxz = gupxx * gxzxx + gupyy * gxzyy + gupzz * gxzzz + & + ( gupxy * gxzxy + gupxz * gxzxz + gupyz * gxzyz ) * TWO + + Ryz = gupxx * gyzxx + gupyy * gyzyy + gupzz * gyzzz + & + ( gupxy * gyzxy + gupxz * gyzxz + gupyz * gyzyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + call fdderivs(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) + +! Add chi part to Ricci tensor: + + fxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + fyy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + fzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + fxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + fxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + fyz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO +! store R/chi in Hcon + Hcon = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + + Rxx = fxx + Ryy = fyy + Rzz = fzz + Rxy = fxy + Rxz = fxz + Ryz = fyz + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + +! covariant second derivatives of the lapse respect to physical metric + + call fdderivs(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM,SYM,SYM,symmetry,Lev) + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +! Add lapse and S_ij parts to Ricci tensor: + + fxx = EIGHT * PI * alpn1 * Sxx + fxx + fxy = EIGHT * PI * alpn1 * Sxy + fxy + fxz = EIGHT * PI * alpn1 * Sxz + fxz + fyy = EIGHT * PI * alpn1 * Syy + fyy + fyz = EIGHT * PI * alpn1 * Syz + fyz + fzz = EIGHT * PI * alpn1 * Szz + fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + f = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + + f = F1o3 * (Hcon*alpn1 - f) + + fxx = alpn1 * Rxx - fxx + fxy = alpn1 * Rxy - fxy + fxz = alpn1 * Rxz - fxz + fyy = alpn1 * Ryy - fyy + fyz = alpn1 * Ryz - fyz + fzz = alpn1 * Rzz - fzz + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trKd * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx ) - & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trKd * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy ) - & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trKd * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz ) - & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trKd * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trKd * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trKd * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trKd * trKd + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!!!gauge variable part + Lap_rhs = -TWO*alpn1*trK + +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#endif +!!!!!Z4 part +! H = trR + 2/3 * trKd^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + + Hcon = chin1*Hcon + F2o3 * trKd * trKd -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho +! M_j = gupki*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + call fderivs(ex,Axx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,lev) + call fderivs(ex,Axy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,lev) + call fderivs(ex,Axz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,lev) + call fderivs(ex,Ayy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,lev) + call fderivs(ex,Ayz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,lev) + call fderivs(ex,Azz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,lev) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 + Mxcon = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz + Mycon = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz + Mzcon = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz +! we have already considered TZ_,i in K_,i here, or to say here Micon = +! Micon+TZ_,i indeed + Mxcon = Mxcon - F2o3*Kx - F8*PI*sx + Mycon = Mycon - F2o3*Ky - F8*PI*sy + Mzcon = Mzcon - F2o3*Kz - F8*PI*sz + + f = TZ_rhs + + TZ_rhs = alpn1*Hcon/TWO +! delete TWO*Z^i_,i From Hcon' to get Hcon, this is wrong +! Hcon = Hcon - f + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI +!!!!!!!!!advection term part + call lopsided(ex,X,Y,Z,gxx,gxx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gxy,gxy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,gxz,gxz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,gyy,gyy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gyz,gyz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,gzz,gzz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Axx,Axx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Axy,Axy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,Axz,Axz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,Ayy,Ayy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Ayz,Ayz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,Azz,Azz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,chi,chi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,trK,trK_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Gamx,Gamx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,Gamy,Gamy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,Gamz,Gamz_rhs,betax,betay,betaz,Symmetry,SSA) + + call lopsided(ex,X,Y,Z,Lap,Lap_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,betax,betax_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,betay,betay_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,betaz,betaz_rhs,betax,betay,betaz,Symmetry,SSA) + call lopsided(ex,X,Y,Z,dtSfx,dtSfx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,dtSfy,dtSfy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,dtSfz,dtSfz_rhs,betax,betay,betaz,Symmetry,SSA) + + call lopsided(ex,X,Y,Z,TZ,TZ_rhs,betax,betay,betaz,Symmetry,SSS) + +! constraint damping terms + TZ_rhs = TZ_rhs - alpn1*(TWO+kappa2)*kappa1*TZ + trK_rhs = trK_rhs + alpn1*kappa1*(ONE-kappa2)*TZ + Gamx_rhs = Gamx_rhs - TWO*alpn1*kappa1*(Gamx-Gamxa) + Gamy_rhs = Gamy_rhs - TWO*alpn1*kappa1*(Gamy-Gamya) + Gamz_rhs = Gamz_rhs - TWO*alpn1*kappa1*(Gamz-Gamza) + +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis(ex,X,Y,Z,chi,chi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,trK,trK_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxx,gxx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxy,gxy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxz,gxz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,gyy,gyy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gyz,gyz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,gzz,gzz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axx,Axx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axy,Axy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axz,Axz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayy,Ayy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayz,Ayz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,Azz,Azz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamx,Gamx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamy,Gamy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamz,Gamz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,Lap,Lap_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,betax,betax_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,betay,betay_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,betaz,betaz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfx,dtSfx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfy,dtSfy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfz,dtSfz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,TZ,TZ_rhs,SSS,Symmetry,eps) + + endif + +#if (ABV == 0) + call ricci_gamma(ex, X, Y, Z, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) +#endif + + call constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry) + + gont = 0 + + return + + end function compute_rhs_Z4c +#endif + + +!! using David Z4c-rhs code +#if 0 + function compute_rhs_z4c(ex, T,X, Y, Z, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & +! co is not used here, we always compute constraint + Symmetry,Lev,eps,co) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,co + real*8, intent(in ):: T + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: TZ_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! when out, constraint violation + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chixx,chixy,chixz,chiyy,chiyz,chizz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: dBxx,dBxy,dBxz + real*8, dimension(ex(1),ex(2),ex(3)) :: dByx,dByy,dByz + real*8, dimension(ex(1),ex(2),ex(3)) :: dBzx,dBzy,dBzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,TZx,TZy,TZz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axyx,Axzx,Ayyx,Ayzx,Azzx + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxy,Axyy,Axzy,Ayyy,Ayzy,Azzy + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxz,Axyz,Axzz,Ayyz,Ayzz,Azzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO=0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0,F16=1.6d1 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0,F8=8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + integer :: i,j,k + +! constraint damping terms stuffs PRD 81, 084003 (2010) + real*8 :: kappa1,kappa2,kappa3,FF,eta + + real*8,parameter :: chiDivfloor=1.d-5 + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz)+sum(dtSfx)+sum(dtSfy)+sum(dtSfz) & + +sum(TZ) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"Z4c_rhs.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"Z4c_rhs.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"Z4c_rhs.f90: find NaN in gxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"Z4c_rhs.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"Z4c_rhs.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"Z4c_rhs.f90: find NaN in gyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"Z4c_rhs.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"Z4c_rhs.f90: find NaN in gzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"Z4c_rhs.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"Z4c_rhs.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"Z4c_rhs.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"Z4c_rhs.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"Z4c_rhs.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"Z4c_rhs.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"Z4c_rhs.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"Z4c_rhs.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"Z4c_rhs.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"Z4c_rhs.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"Z4c_rhs.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"Z4c_rhs.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"Z4c_rhs.f90: find NaN in betaz" + if(sum(dtSfx).ne.sum(dtSfx))write(*,*)"Z4c_rhs.f90: find NaN in dtSfx" + if(sum(dtSfy).ne.sum(dtSfy))write(*,*)"Z4c_rhs.f90: find NaN in dtSfy" + if(sum(dtSfz).ne.sum(dtSfz))write(*,*)"Z4c_rhs.f90: find NaN in dtSfz" + if(sum(TZ).ne.sum(Tz))write(*,*)"Z4c_rhs.f90: find NaN in TZ" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs(ex,betax,betaxx,betaxy,betaxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ex,betay,betayx,betayy,betayz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ex,betaz,betazx,betazy,betazz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + call fderivs(ex,dtSfx,dBxx,dBxy,dBxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ex,dtSfy,dByx,dByy,dByz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ex,dtSfz,dBzx,dBzy,dBzz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM,Symmetry,Lev) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM,ANTI,Symmetry,Lev) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM,ANTI,ANTI,Symmetry,Lev) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + + call fdderivs(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,X,Y,Z, SYM, SYM,SYM ,Symmetry,Lev) + call fdderivs(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,X,Y,Z, SYM, SYM,SYM ,Symmetry,Lev) + call fdderivs(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,X,Y,Z, SYM, SYM,SYM ,Symmetry,Lev) + call fdderivs(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + call fdderivs(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,Lev) + call fdderivs(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,Lev) + + call fderivs(ex,Gamx,Gamxx,Gamxy,Gamxz,X,Y,Z,ANTI,SYM ,SYM,Symmetry,Lev) + call fderivs(ex,Gamy,Gamyx,Gamyy,Gamyz,X,Y,Z,SYM ,ANTI,SYM,Symmetry,Lev) + call fderivs(ex,Gamz,Gamzx,Gamzy,Gamzz,X,Y,Z,SYM ,SYM,ANTI,Symmetry,Lev) + + call fderivs(ex,Lap,Lapx,Lapy,Lapz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,trK,Kx,Ky,Kz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + + call fderivs(ex,TZ,TZx,TZy,TZz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + + call fdderivs(ex,betax,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fdderivs(ex,betay,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fdderivs(ex,betaz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + + call fdderivs(ex,chi,chixx,chixy,chixz,chiyy,chiyz,chizz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + call fdderivs(ex,Lap,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + call fderivs(ex,Axx,Axxx,Axxy,Axxz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,Axy,Axyx,Axyy,Axyz,X,Y,Z,ANTI,ANTI,SYM,Symmetry,Lev) + call fderivs(ex,Axz,Axzx,Axzy,Axzz,X,Y,Z,ANTI,SYM,ANTI,Symmetry,Lev) + call fderivs(ex,Ayy,Ayyx,Ayyy,Ayyz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + call fderivs(ex,Ayz,Ayzx,Ayzy,Ayzz,X,Y,Z,SYM,ANTI,ANTI,Symmetry,Lev) + call fderivs(ex,Azz,Azzx,Azzy,Azzz,X,Y,Z, SYM, SYM,SYM,Symmetry,Lev) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + call z4c_rhs_point(Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + alpn1(i,j,k),dtSfx(i,j,k),dtSfy(i,j,k),dtSfz(i,j,k), & + betax(i,j,k),betay(i,j,k),betaz(i,j,k), & + chin1(i,j,k),chiDivfloor, & + Lapx(i,j,k), & + Axxx(i,j,k),Axyx(i,j,k),Axzx(i,j,k),Ayyx(i,j,k),Ayzx(i,j,k),Azzx(i,j,k), & + Lapy(i,j,k), & + Axxy(i,j,k),Axyy(i,j,k),Axzy(i,j,k),Ayyy(i,j,k),Ayzy(i,j,k),Azzy(i,j,k), & + Lapz(i,j,k), & + Axxz(i,j,k),Axyz(i,j,k),Axzz(i,j,k),Ayyz(i,j,k),Ayzz(i,j,k),Azzz(i,j,k), & + betaxx(i,j,k),dBxx(i,j,k),betayx(i,j,k),dByx(i,j,k),betazx(i,j,k),dBzx(i,j,k), & + betaxy(i,j,k),dBxy(i,j,k),betayy(i,j,k),dByy(i,j,k),betazy(i,j,k),dBzy(i,j,k), & + betaxz(i,j,k),dBxz(i,j,k),betayz(i,j,k),dByz(i,j,k),betazz(i,j,k),dBzz(i,j,k), & + chix(i,j,k),chiy(i,j,k),chiz(i,j,k), & + Lapxx(i,j,k),Lapxy(i,j,k),Lapxz(i,j,k),Lapyy(i,j,k),Lapyz(i,j,k),Lapzz(i,j,k), & + sfxxx(i,j,k),sfyxx(i,j,k),sfzxx(i,j,k), & + sfxxy(i,j,k),sfyxy(i,j,k),sfzxy(i,j,k), & + sfxxz(i,j,k),sfyxz(i,j,k),sfzxz(i,j,k), & + sfxyy(i,j,k),sfyyy(i,j,k),sfzyy(i,j,k), & + sfxyz(i,j,k),sfyyz(i,j,k),sfzyz(i,j,k), & + sfxzz(i,j,k),sfyzz(i,j,k),sfzzz(i,j,k), & + chixx(i,j,k),chixy(i,j,k),chixz(i,j,k),chiyy(i,j,k),chiyz(i,j,k),chizz(i,j,k), & + gxxxx(i,j,k),gxyxx(i,j,k),gxzxx(i,j,k),gyyxx(i,j,k),gyzxx(i,j,k),gzzxx(i,j,k), & + gxxxy(i,j,k),gxyxy(i,j,k),gxzxy(i,j,k),gyyxy(i,j,k),gyzxy(i,j,k),gzzxy(i,j,k), & + gxxxz(i,j,k),gxyxz(i,j,k),gxzxz(i,j,k),gyyxz(i,j,k),gyzxz(i,j,k),gzzxz(i,j,k), & + gxxyy(i,j,k),gxyyy(i,j,k),gxzyy(i,j,k),gyyyy(i,j,k),gyzyy(i,j,k),gzzyy(i,j,k), & + gxxyz(i,j,k),gxyyz(i,j,k),gxzyz(i,j,k),gyyyz(i,j,k),gyzyz(i,j,k),gzzyz(i,j,k), & + gxxzz(i,j,k),gxyzz(i,j,k),gxzzz(i,j,k),gyyzz(i,j,k),gyzzz(i,j,k),gzzzz(i,j,k), & + Gamxx(i,j,k),gxxx(i,j,k),gxyx(i,j,k),gxzx(i,j,k), & + Gamyx(i,j,k),gyyx(i,j,k),gyzx(i,j,k), & + Gamzx(i,j,k),gzzx(i,j,k), & + Gamxy(i,j,k),gxxy(i,j,k),gxyy(i,j,k),gxzy(i,j,k), & + Gamyy(i,j,k),gyyy(i,j,k),gyzy(i,j,k), & + Gamzy(i,j,k),gzzy(i,j,k), & + Gamxz(i,j,k),gxxz(i,j,k),gxyz(i,j,k),gxzz(i,j,k), & + Gamyz(i,j,k),gyyz(i,j,k),gyzz(i,j,k), & + Gamzz(i,j,k),gzzz(i,j,k), & + Kx(i,j,k),Ky(i,j,k),Kz(i,j,k), & + TZx(i,j,k),TZy(i,j,k),TZz(i,j,k), & + Gamx(i,j,k),gxx(i,j,k),gxy(i,j,k),gxz(i,j,k), & + Gamy(i,j,k),gyy(i,j,k),gyz(i,j,k), & + Gamz(i,j,k),gzz(i,j,k), & + kappa1,kappa2, & + trK(i,j,k), & + Axx_rhs(i,j,k),Axy_rhs(i,j,k),Axz_rhs(i,j,k),Ayy_rhs(i,j,k),Ayz_rhs(i,j,k),Azz_rhs(i,j,k), & + chi_rhs(i,j,k), & + Gamx_rhs(i,j,k),gxx_rhs(i,j,k),gxy_rhs(i,j,k),gxz_rhs(i,j,k), & + Gamy_rhs(i,j,k),gyy_rhs(i,j,k),gyz_rhs(i,j,k), & + Gamz_rhs(i,j,k),gzz_rhs(i,j,k),trK_rhs(i,j,k),TZ_rhs(i,j,k),TZ(i,j,k)) + enddo + enddo + enddo + +!!!!!gauge variable part + Lap_rhs = -TWO*alpn1*trK +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI +!!!!!!!!!advection term part + call lopsided(ex,X,Y,Z,gxx,gxx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gxy,gxy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,gxz,gxz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,gyy,gyy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gyz,gyz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,gzz,gzz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Axx,Axx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Axy,Axy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,Axz,Axz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,Ayy,Ayy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Ayz,Ayz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,Azz,Azz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,chi,chi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,trK,trK_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Gamx,Gamx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,Gamy,Gamy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,Gamz,Gamz_rhs,betax,betay,betaz,Symmetry,SSA) + + call lopsided(ex,X,Y,Z,Lap,Lap_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,betax,betax_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,betay,betay_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,betaz,betaz_rhs,betax,betay,betaz,Symmetry,SSA) + +#if (GAUGE == 0) + call lopsided(ex,X,Y,Z,dtSfx,dtSfx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,dtSfy,dtSfy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,dtSfz,dtSfz_rhs,betax,betay,betaz,Symmetry,SSA) +#endif + + call lopsided(ex,X,Y,Z,TZ,TZ_rhs,betax,betay,betaz,Symmetry,SSS) +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + + call kodis(ex,X,Y,Z,chi,chi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,trK,trK_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,dxx,gxx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxy,gxy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxz,gxz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,dyy,gyy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gyz,gyz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,dzz,gzz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axx,Axx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axy,Axy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axz,Axz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayy,Ayy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayz,Ayz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,Azz,Azz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamx,Gamx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamy,Gamy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamz,Gamz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,Lap,Lap_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,betax,betax_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,betay,betay_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,betaz,betaz_rhs,SSA,Symmetry,eps) +#if (GAUGE == 0) + call kodis(ex,X,Y,Z,dtSfx,dtSfx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfy,dtSfy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfz,dtSfz_rhs,SSA,Symmetry,eps) +#endif + call kodis(ex,X,Y,Z,TZ,TZ_rhs,SSS,Symmetry,eps) + + endif + +#if (ABV == 0) + call ricci_gamma(ex, X, Y, Z, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) +#endif + + call constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry) + + gont = 0 + + return + + end function compute_rhs_Z4c +#endif diff --git a/AMSS_NCKU_source/Z4c_rhs_ss.f90 b/AMSS_NCKU_source/Z4c_rhs_ss.f90 new file mode 100644 index 0000000..173a1e9 --- /dev/null +++ b/AMSS_NCKU_source/Z4c_rhs_ss.f90 @@ -0,0 +1,2038 @@ + + +#include "macrodef.fh" + +#if 1 + function compute_rhs_z4c_ss(ex, T,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & +! co is not used here, we always compute constraint + Symmetry,Lev,eps,sst,co) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,co + real*8, intent(in ):: T + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: TZ_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! when out, constraint violation + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: trKd + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO=0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0,F16=1.6d1 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0,F8=8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + +! constraint damping terms stuffs PRD 81, 084003 (2010) + real*8 :: kappa1,kappa2,kappa3,FF,eta + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz)+sum(dtSfx)+sum(dtSfy)+sum(dtSfz) & + +sum(TZ) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"Z4c_rhs_ss.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"Z4c_rhs_ss.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"Z4c_rhs_ss.f90: find NaN in gyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"Z4c_rhs_ss.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"Z4c_rhs_ss.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"Z4c_rhs_ss.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"Z4c_rhs_ss.f90: find NaN in betaz" + if(sum(dtSfx).ne.sum(dtSfx))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfx" + if(sum(dtSfy).ne.sum(dtSfy))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfy" + if(sum(dtSfz).ne.sum(dtSfz))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfz" + if(sum(TZ).ne.sum(Tz))write(*,*)"Z4c_rhs_ss.f90: find NaN in TZ" + gont = 1 + return + endif + + PI = dacos(-ONE) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + trKd = trK+TWO*TZ +! advection term will all be replaced by center difference +!this beta^i_,j will be kept till the end of this routine + call fderivs_shc(ex,betax,betaxx,betaxy,betaxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,betay,betayx,betayy,betayz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,betaz,betazx,betazy,betazz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + div_beta = betaxx + betayy + betazz + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + chi_rhs = F2o3 *chin1*( alpn1 * trKd - div_beta ) !rhs for chi + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz +! gij_,kl will be stored till end of this routine + call fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! the so called Gamma_d + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + +!!!!!!!!!!!!because gij_,k will be overwrite later, we calculate TWO*d_k Z^k here +! use Gamma^i as more as possible + Gmxcon = Gamx - Gamxa + Gmycon = Gamy - Gamya + Gmzcon = Gamz - Gamza + +!Maple generated code for g^ki*g^jm*g^ln*g_mn,k*g_ij,l +! Gami_,j are used as maple temp variables + Gamyy = 3*gupxz**2*gupzz*gxzz**2+gupxx*gupxz**2*gxxz**2+2*gxyx*gupxy**3*gxyy+ & + 2*gxyx*gupxy**3*gyyx+gupxx**2*gupzz*gxzx**2+3*gupxx*gupxy**2*gxyx**2+ & + 6*gxyx*gupxy*gupxz*gupyy*gyzy+gupxx**2*gupyy*gxyx**2+ & + 2*gxyz*gupxy*gupyz**2*gyyz+2*gxxz*gupxx**2*gupyz*gxyx+ & + gupxz**2*gupyy*gyzx**2+2*gxxy*gupxx*gupxy*gupxz*gxxz+ & + 2*gyzx*gupxy*gupxz*gupzz*gzzx+3*gupyy*gupyz**2*gyzy**2+ & + 2*gyyy*gupyz**3*gzzz+2*gxxz*gupxz**3*gxzz+ & + 4*gxzy*gupxx*gupxz*gupyy*gxyx+gupyy*gupyz**2*gyyz**2 + Gamxz = Gamyy+2*gxxz*gupxy**2*gupzz*gyzy+4*gxyz*gupxx*gupxy*gupxz*gxxx+ & + 6*gxzz*gupxy*gupyz*gupzz*gyzy+2*gxxy*gupxx*gupxz*gupyz*gxzz+ & + 3*gupxy**2*gupyy*gxyy**2+2*gxyz*gupxx*gupyy*gupzz*gyzx+ & + 4*gxyy*gupxx*gupyy*gupyz*gyzx+6*gxyy*gupxy*gupxz*gupyz*gxzz+ & + 4*gxzz*gupxx*gupyz*gupzz*gyzx+3*gupxx*gupxz**2*gxzx**2+ & + 4*gxyz*gupxx*gupxy*gupyz*gxyx+2*gxxz*gupxx*gupxz*gupyz*gxyz+ & + 2*gxxy*gupxy*gupxz*gupyz*gyzz+2*gxzx*gupxy*gupxz*gupyz*gyyz+ & + gupyz**2*gupzz*gzzy**2+gupxz**2*gupzz*gzzx**2+ & + gupyy*gupzz**2*gyzz**2+2*gyzy*gupyz**3*gzzy+gupxx*gupzz**2*gxzz**2 + Gamyy = Gamxz+gupxx*gupyz**2*gxzy**2+2*gxzx*gupxz**3*gzzx+ & + 3*gupyz**2*gupzz*gyzz**2+2*gyzy*gupyz**3*gyzz+gupyy**2*gupzz*gyzy**2+ & + gupxy**2*gupzz*gyzx**2+2*gyyz*gupyz**3*gyzz+gupxy**2*gupyy*gyyx**2+ & + gupxx*gupyz**2*gxyz**2+gupxx*gupyy**2*gxyy**2+ & + gupxy**2*gupzz*gxzy**2+2*gxzx*gupxz**3*gxzz+ & + 2*gyyx*gupxy*gupxz*gupyy*gyzx+gupxx*gupxy**2*gxxy**2+ & + 2*gxxx*gupxz**3*gzzz+2*gxxx*gupxy**3*gyyy+gupxz**2*gupyy*gxyz**2+ & + 2*gxyy*gupxy**3*gxxy + Gamxy = Gamyy+2*gxyy*gupxz*gupyy**2*gyzy+6*gxyy*gupxx*gupxy*gupyz*gxzx+ & + 4*gxyy*gupxy*gupxz*gupyy*gxyz+2*gyzx*gupxz*gupyy*gupzz*gzzy+ & + 2*gxzy*gupxy*gupxz*gupyy*gxyy+4*gxzy*gupxy*gupxz*gupzz*gxzz+ & + 2*gyyx*gupxz*gupyy*gupyz*gyzz+6*gxyx*gupxx*gupxz*gupyz*gxzz+ & + 2*gxyz*gupxy**2*gupzz*gxzy+2*gxyz*gupxy**2*gupyz*gxyy+ & + 2*gxyz*gupxy**2*gupxz*gxxy+2*gupxy*gupxz*gupyz*gxyz**2+ & + 4*gxyy*gupxz*gupyz**2*gzzz+2*gxyy*gupxy*gupyz**2*gzzy+ & + 4*gxyy*gupxy**2*gupyz*gxzy+2*gxyy*gupxy**2*gupxz*gxxz+ & + 4*gxyy*gupxx*gupxy**2*gxxx+2*gxyx*gupxy**2*gupxz*gxzy+ & + 2*gxyx*gupxy**2*gupyz*gyzy + Gamyy = Gamxy+2*gxyx*gupxx*gupxy**2*gxxy+4*gyzz*gupyz*gupzz**2*gzzz+ & + 4*gxzy*gupxx*gupxz*gupyz*gxzx+2*gxzy*gupxx*gupyy*gupzz*gyzx+ & + 4*gxxx*gupxx*gupxy*gupxz*gyzx+2*gxyx*gupxx**2*gupyz*gxzx+ & + 2*gxyx*gupxy**2*gupxz*gxyz+2*gxzy*gupxz*gupyy*gupyz*gyyz+ & + 4*gxzy*gupxy*gupyy*gupyz*gyyy+2*gxzy*gupxx*gupyy*gupyz*gyyx+ & + 2*gyyx*gupxy*gupxz*gupyy*gxzy+2*gyyx*gupxy*gupyy*gupyz*gyyz+ & + 2*gyyx*gupxy*gupyy*gupyz*gyzy+4*gxzy*gupxz*gupyy*gupzz*gyzz+ & + 2*gyyx*gupxy*gupxz*gupyz*gxzz+2*gxyz*gupxx*gupyy*gupzz*gxzy+ & + 2*gxyy*gupxz*gupyy*gupyz*gzzy + Gamxz = Gamyy+2*gxyy*gupxy*gupxz*gupyz*gzzx+2*gxyy*gupxy*gupxz*gupyy*gyzx+ & + 2*gxyy*gupxy*gupyy*gupyz*gyyz+2*gxyy*gupxx*gupyy*gupyz*gxzy+ & + 2*gxxy*gupxy**2*gupxz*gxzy+2*gxxy*gupxy**2*gupyz*gyzy+ & + 2*gxxy*gupxy**2*gupyy*gyyy+2*gxxy*gupxx**2*gupyz*gxzx+ & + 2*gxxy*gupxx**2*gupyy*gxyx+2*gxxx*gupxx*gupxz**2*gzzx+ & + 4*gxxx*gupxy*gupxz**2*gyzz+4*gxxx*gupxy**2*gupxz*gyzy+ & + 2*gxxx*gupxx*gupxy**2*gyyx+4*gxxx*gupxx*gupxz**2*gxzz+ & + 4*gxxx*gupxx**2*gupxz*gxzx+2*gxxx*gupxx**2*gupxz*gxxz+ & + 4*gxyz*gupxz*gupyz**2*gyzz+2*gxyz*gupxy*gupyz**2*gyzy+ & + 2*gxzy*gupxy*gupyy*gupzz*gyzy + Gamyy = Gamxz+2*gxyy*gupxx*gupyy*gupyz*gxyz+6*gxzz*gupxz*gupyz*gupzz*gyzz+ & + 4*gxzy*gupxz*gupyz*gupzz*gzzz+gupyy**3*gyyy**2+ & + 2*gxzy*gupxy*gupyz*gupzz*gzzy+2*gxzy*gupxx*gupyz*gupzz*gzzx+ & + 2*gxyz*gupxx*gupyz*gupzz*gxzz+2*gxzy*gupxx*gupyz*gupzz*gxzz+ & + 2*gyzy*gupxy*gupyz*gupzz*gzzx+2*gyzy*gupxz*gupyy*gupyz*gxzy+ & + 6*gyzy*gupyy*gupyz*gupzz*gyzz+4*gyzx*gupxz*gupyy*gupyz*gyzy+ & + 4*gyzx*gupxy*gupyz*gupzz*gyzz+2*gxxy*gupxx*gupxy*gupyy*gxyy+ & + 4*gyzx*gupxz*gupyz*gupzz*gzzz+2*gyzx*gupxy*gupyy*gupzz*gyzy+ & + 2*gyyz*gupyy*gupyz*gupzz*gzzy+2*gyyz*gupxy*gupyz*gupzz*gzzx + Gamxx = Gamyy+2*gyyz*gupyy*gupyz*gupzz*gyzz+2*gyyz*gupxy*gupyy*gupzz*gyzx+ & + 2*gyyz*gupxy*gupyz*gupzz*gxzz+2*gxxy*gupxx*gupxy*gupyz*gyzx+ & + 4*gyyy*gupxy*gupyy*gupyz*gyzx+2*gyyx*gupxy*gupxz*gupyz*gzzx+ & + 2*gxyz*gupxy*gupyz*gupzz*gyzz+2*gxxz*gupxz**2*gupzz*gzzz+ & + 2*gxxz*gupxz**2*gupyz*gyzz+2*gxxz*gupxy*gupxz**2*gxzy+ & + 2*gxxz*gupxx*gupxz**2*gxzx+2*gxxz*gupxy**2*gupyz*gyyy+ & + 2*gxxz*gupxx**2*gupzz*gxzx+2*gxxy*gupxz**2*gupyz*gzzz+ & + 2*gxxy*gupxz**2*gupyy*gyzz+2*gxxy*gupxy*gupxz**2*gxzz+ & + 2*gzzx*gupxz*gupyz*gupzz*gzzy+2*gyzz*gupxz*gupyz*gupzz*gzzx+ & + 2*gxzx*gupxx*gupxz*gupzz*gzzx+2*gyzx*gupxz*gupyy*gupzz*gyzz + Gamyy = Gamxx+gupzz**3*gzzz**2+2*gxzz*gupxy*gupxz*gupzz*gyzx+ & + 6*gxzx*gupxy*gupxz*gupyz*gyzy+2*gxxy*gupxy*gupxz*gupyz*gzzy+ & + 4*gxzz*gupxy*gupyz**2*gyyy+2*gxzy*gupxz*gupyz**2*gyzz+ & + 2*gxzy*gupxz**2*gupyz*gxzz+2*gxzy*gupxz**2*gupyy*gxyz+ & + 2*gupxy*gupxz*gupyz*gxzy**2+4*gxzx*gupxz**2*gupzz*gzzz+ & + 2*gxzx*gupxz**2*gupyz*gyzz+2*gxyz*gupxy*gupxz*gupzz*gzzx+ & + 2*gxyz*gupxz*gupyy*gupzz*gzzy+2*gxyx*gupxx*gupxz*gupyy*gxyz+ & + 2*gxzz*gupxz*gupyz**2*gyyz+2*gxxy*gupxx*gupxy*gupxz*gxzx+ & + 2*gyyx*gupxy**2*gupxz*gxzx + Gamxz = Gamyy+2*gxyx*gupxy*gupxz*gupyz*gzzy+2*gyzy*gupyy*gupyz*gupzz*gzzy+ & + 2*gxyx*gupxx*gupxz*gupyy*gyzx+2*gyyx*gupxy*gupyz**2*gyzz+ & + 2*gyyx*gupxy**2*gupyz*gyzx+2*gyyx*gupxz*gupyz**2*gzzz+ & + 2*gyyx*gupxy*gupyy**2*gyyy+2*gxyz*gupxy**2*gupzz*gyzx+ & + 2*gxyz*gupxy**2*gupyz*gyyx+2*gxyy*gupxy*gupyz**2*gyzz+ & + 2*gxyy*gupxy**2*gupyz*gyzx+2*gxyy*gupxy**2*gupyy*gyyx+ & + 2*gxyx*gupxy*gupxz**2*gzzx+2*gxyx*gupxy**2*gupyz*gyyz+ & + 4*gxzz*gupxz*gupzz**2*gzzz+2*gxzz*gupxy*gupzz**2*gzzy+ & + 2*gxzz*gupxx*gupzz**2*gzzx+6*gxyx*gupxx*gupxy*gupxz*gxzx+ & + 2*gxyz*gupxy*gupxz*gupyz*gyzx + Gamyy = Gamxz+2*gyyx*gupxz*gupyy**2*gyzy+2*gyyx*gupxz*gupyy*gupyz*gzzy+ & + 2*gxxz*gupxx*gupxy*gupyz*gxyy+2*gyzx*gupxz**2*gupyy*gxzy+ & + 4*gyzx*gupxy*gupxz**2*gxzx+2*gyzx*gupxz*gupyz**2*gyzz+ & + 2*gyzx*gupxz**2*gupyz*gxzz+2*gupxy*gupxz*gupyz*gyzx**2+ & + 2*gyyz*gupyz**2*gupzz*gzzz+2*gyyz*gupyy*gupyz**2*gyzy+ & + 2*gyyz*gupxy*gupyz**2*gyzx+2*gyyz*gupyy**2*gupzz*gyzy+ & + 2*gyyz*gupxy**2*gupzz*gxzx+2*gyyy*gupyy*gupyz**2*gzzy+ & + 2*gyyy*gupxy*gupyz**2*gzzx+4*gyyy*gupyy*gupyz**2*gyzz+ & + 4*gyyy*gupyy**2*gupyz*gyzy+2*gyyy*gupyy**2*gupyz*gyyz + Gamxy = Gamyy+2*gxyz*gupxz*gupyy*gupyz*gyzy+2*gxyz*gupxx*gupyy*gupyz*gyyx+ & + 2*gzzx*gupxz*gupzz**2*gzzz+2*gxzy*gupxy*gupxz*gupyz*gyzx+ & + 2*gyzz*gupyz**2*gupzz*gzzy+2*gyzy*gupxz*gupyz**2*gzzx+ & + 2*gyzx*gupxz*gupyz**2*gzzy+2*gyzx*gupxz**2*gupyz*gzzx+ & + 2*gxzz*gupxz**2*gupzz*gzzx+2*gxzz*gupxy*gupzz**2*gyzz+ & + 2*gxzy*gupxz*gupyz**2*gzzy+2*gxzy*gupxz**2*gupyz*gzzx+ & + 2*gxzx*gupxz**2*gupyz*gzzy+2*gyzz*gupyy*gupzz**2*gzzy+ & + 2*gyzz*gupxy*gupzz**2*gzzx+4*gyzy*gupyz**2*gupzz*gzzz+ & + 2*gyzy*gupxy*gupyz**2*gyzx+2*gyzy*gupxz*gupyz**2*gxzz+ & + 2*gxzy*gupxy*gupyz*gupzz*gyzz+2*gxyx*gupxx*gupxy*gupyz*gxzy + Gamyy = Gamxy+gupxx**3*gxxx**2+2*gzzy*gupyz*gupzz**2*gzzz+ & + 6*gxyx*gupxx*gupxy*gupyy*gxyy+2*gxzz*gupxz*gupyz* gupzz*gzzy+ & + 6*gxyx*gupxy*gupxz*gupyz*gyzz+2*gxzx*gupxy*gupxz**2*gxzy+ & + 2*gxyx*gupxx*gupxy*gupyy*gyyx+2*gxyx*gupxx*gupxz*gupyz*gzzx+ & + 2*gxyx*gupxx*gupxy*gupxz*gxxz+4*gxyx*gupxx**2*gupxy*gxxx+ & + 2*gxyx*gupxy*gupxz*gupyy*gyyz+6*gxyy*gupxy*gupyy*gupyz*gyzy+ & + 2*gxyx*gupxx*gupxy*gupyz*gyzx+6*gxyy*gupxz*gupyy*gupyz*gyzz+ & + 4*gxyz*gupxx*gupxy*gupzz*gxzx+2*gxyz*gupxy*gupxz*gupzz*gxzz+ & + 4*gxyx*gupxy**2*gupyy*gyyy+2*gxyz*gupxz*gupyy*gupyz*gyyz + Gamxz = Gamyy+4*gxyz*gupxy*gupyy*gupyz*gyyy+2*gxyx*gupxz**2*gupyy*gyzz+ & + 2*gxyz*gupxz*gupyy*gupzz*gyzz+2*gxyx*gupxy*gupxz**2*gxzz+ & + 4*gxyz*gupxy*gupyy*gupzz*gyzy+2*gxzx*gupxy**2*gupzz*gyzy+ & + 2*gxyz*gupxx*gupxz*gupyz*gxzx+4*gxyx*gupxz**2*gupyz*gzzz+ & + 4*gxzx*gupxy**2*gupyz*gyyy+2*gyyz*gupxy*gupyy*gupzz*gxzy+ & + 2*gxyz*gupxy*gupxz*gupyz*gxzy+2*gxyz*gupxx*gupyz*gupzz*gzzx+ & + 4*gxyy*gupxy*gupyy**2*gyyy+2*gxyy*gupxx*gupyy**2*gyyx+ & + 2*gxyy*gupxx*gupyz**2*gzzx+2*gxyz*gupxy*gupyz*gupzz*gzzy+ & + 2*gxyy*gupxz*gupyy**2*gyyz+4*gxyz*gupxz*gupyz*gupzz*gzzz+ & + 2*gxxy*gupxx*gupxz*gupyy*gxyz + Gamyy = Gamxz+2*gxzx*gupxy*gupxz**2*gxyz+2*gxxy*gupxy*gupxz*gupyy*gyzy+ & + 4*gxxx*gupxx*gupxy*gupxz*gxzy+2*gxxy*gupxy*gupxz*gupyy*gyyz+ & + 2*gxxy*gupxx*gupxz*gupyy*gyzx+2*gxxy*gupxx*gupxz*gupyz*gzzx+ & + 2*gxzx*gupxy**2*gupxz*gxyy+2*gxxy*gupxx*gupxy*gupyz*gxzy+ & + 2*gxyz*gupxy*gupxz**2*gxxz+2*gxxy*gupxx*gupxy*gupyy*gyyx+ & + 2*gxyz*gupxx*gupyz**2*gyzx+4*gxyz*gupxz**2*gupyz*gxzz+ & + 2*gxxz*gupxx*gupxy*gupzz*gxzy+2*gxxz*gupxx*gupxz*gupzz*gxzz+ & + 2*gxxx*gupxx**2*gupxy*gxxy+2*gxxz*gupxx*gupxy*gupyz*gyyx+ & + 2*gxxz*gupxy*gupxz*gupzz*gyzz+2*gxxz*gupxx*gupxy*gupzz*gyzx + TZ_rhs = Gamyy+2*gxxz*gupxy*gupxz*gupyz*gyyz+2*gxxz*gupxx*gupxz*gupyz*gyzx+ & + 2*gxxz*gupxx*gupxz*gupzz*gzzx+2*gxxz*gupxy*gupxz*gupyz*gyzy+ & + 2*gxzx*gupxx*gupxy*gupzz*gxzy+2*gxxz*gupxy*gupxz*gupzz*gzzy+ & + 6*gxzx*gupxy*gupxz*gupzz*gyzz+2*gxzx*gupxx*gupxy*gupzz*gyzx+ & + 2*gxzx*gupxx*gupxy*gupyz*gyyx+6*gxzx*gupxx*gupxz*gupzz*gxzz+ & + 2*gxxx*gupxy**2*gupxz*gyyz+2*gxzx*gupxy*gupxz*gupzz*gzzy+ & + 2*gxzx*gupxx*gupxz*gupyz*gyzx+2*gxxx*gupxy*gupxz**2*gzzy+ & + 4*gxzy*gupxy*gupyz**2*gyzy+2*gxzy*gupxx*gupyz**2*gyzx+ & + 2*gxzz*gupxx*gupyz**2*gyyx+4*gxyx*gupxy**2*gupxz*gyzx+ & + 2*gxyx*gupxz**2*gupyy*gzzy+2*gxyy*gupxx*gupyz**2*gxzz + +! Gami_,j will be kept till the end of this routine + call fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + TZ_rhs = chix*Gmxcon+chiy*Gmycon+chiz*Gmzcon & + +chin1*(Gamxx+Gamyy+Gamzz - & + (TWO*(gupxz*gupyz*gyzxz+gupxx*gupyy*gxyxy+gupxy*gupyz*gxzyy+ & + gupxx*gupxy*gxxxy+gupxx*gupxz*gxxxz+gupxx*gupxy*gxyxx+ & + gupxx*gupyz*gxyxz+gupxx*gupxz*gxzxx+gupxx*gupyz*gxzxy+ & + gupxx*gupzz*gxzxz+gupxy*gupxz*gxxyz+gupxy*gupyy*gxyyy+ & + gupxy*gupyz*gxyyz+gupxy*gupxz*gxzxy+gupxy*gupzz*gxzyz+ & + gupxy*gupxz*gxyxz+gupxz*gupyy*gxyyz+gupxz*gupyz*gxyzz+ & + gupxz*gupyz*gxzyz+gupxz*gupzz*gxzzz+gupxy*gupyy*gyyxy+ & + gupxy*gupyz*gyyxz+gupxy*gupxz*gyzxx+gupxy*gupyz*gyzxy+ & + gupxy*gupzz*gyzxz+gupyy*gupyz*gyyyz+gupxz*gupyy*gyzxy+ & + gupyy*gupyz*gyzyy+gupyy*gupzz*gyzyz+gupyz*gupzz*gyzzz+ & + gupxz*gupyz*gzzxy+gupxz*gupzz*gzzxz+gupyz*gupzz*gzzyz+ & + gupxy*gupxy*gxyxy+gupxz*gupxz*gxzxz+gupyz*gupyz*gyzyz) & + +gupxx*gupxx*gxxxx+gupxy*gupxy*gxxyy+gupxz*gupxz*gxxzz+ & + gupxy*gupxy*gyyxx+gupyy*gupyy*gyyyy+gupyz*gupyz*gyyzz+ & + gupxz*gupxz*gzzxx+gupyz*gupyz*gzzyy+gupzz*gupzz*gzzzz)+& + (gxx*Gamxa*Gamxa+gyy*Gamya*Gamya+gzz*Gamza*Gamza +& + TWO*(gxy*Gamxa*Gamya+gxz*Gamxa*Gamza+gyz*Gamya*Gamza)) + TZ_rhs) + +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... +! Lap_,i will be kept till the end of this routine + call fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +! K_,i stored K_,i+TZ_,i/2 indeed, will be kept till the end of this routine + call fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,TZ,fxx,fxy,fxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + Kx = Kx + fxx/TWO + Ky = Ky + fxy/TWO + Kz = Kz + fxz/TWO + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs_shc(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + Rxx = gupxx * gxxxx + gupyy * gxxyy + gupzz * gxxzz + & + ( gupxy * gxxxy + gupxz * gxxxz + gupyz * gxxyz ) * TWO + + Ryy = gupxx * gyyxx + gupyy * gyyyy + gupzz * gyyzz + & + ( gupxy * gyyxy + gupxz * gyyxz + gupyz * gyyyz ) * TWO + + Rzz = gupxx * gzzxx + gupyy * gzzyy + gupzz * gzzzz + & + ( gupxy * gzzxy + gupxz * gzzxz + gupyz * gzzyz ) * TWO + + Rxy = gupxx * gxyxx + gupyy * gxyyy + gupzz * gxyzz + & + ( gupxy * gxyxy + gupxz * gxyxz + gupyz * gxyyz ) * TWO + + Rxz = gupxx * gxzxx + gupyy * gxzyy + gupzz * gxzzz + & + ( gupxy * gxzxy + gupxz * gxzxz + gupyz * gxzyz ) * TWO + + Ryz = gupxx * gyzxx + gupyy * gyzyy + gupzz * gyzzz + & + ( gupxy * gyzxy + gupxz * gyzxz + gupyz * gyzyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + call fdderivs_shc(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) + +! Add chi part to Ricci tensor: + + fxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + fyy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + fzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + fxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + fxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + fyz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO +! store R/chi in Hcon + Hcon = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + + Rxx = fxx + Ryy = fyy + Rzz = fzz + Rxy = fxy + Rxz = fxz + Ryz = fyz + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + +! covariant second derivatives of the lapse respect to physical metric + + call fdderivs_shc(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +! Add lapse and S_ij parts to Ricci tensor: + + fxx = EIGHT * PI * alpn1 * Sxx + fxx + fxy = EIGHT * PI * alpn1 * Sxy + fxy + fxz = EIGHT * PI * alpn1 * Sxz + fxz + fyy = EIGHT * PI * alpn1 * Syy + fyy + fyz = EIGHT * PI * alpn1 * Syz + fyz + fzz = EIGHT * PI * alpn1 * Szz + fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + f = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + + f = F1o3 * (Hcon*alpn1 - f) + + fxx = alpn1 * Rxx - fxx + fxy = alpn1 * Rxy - fxy + fxz = alpn1 * Rxz - fxz + fyy = alpn1 * Ryy - fyy + fyz = alpn1 * Ryz - fyz + fzz = alpn1 * Rzz - fzz + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trKd * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx ) - & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trKd * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy ) - & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trKd * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz ) - & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trKd * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trKd * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trKd * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trKd * trKd + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!!!gauge variable part + Lap_rhs = -TWO*alpn1*trK +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#endif +!!!!!Z4 part +! H = trR + 2/3 * trKd^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + + Hcon = chin1*Hcon + F2o3 * trKd * trKd -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho +! M_j = gupki*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + + call fderivs_shc(ex,Axx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 + Mxcon = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz + Mycon = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz + Mzcon = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz +! we have already considered TZ_,i in K_,i here, or to say here Micon = +! Micon+TZ_,i indeed + Mxcon = Mxcon - F2o3*Kx - F8*PI*sx + Mycon = Mycon - F2o3*Ky - F8*PI*sy + Mzcon = Mzcon - F2o3*Kz - F8*PI*sz + + f = TZ_rhs + + TZ_rhs = alpn1*Hcon/TWO +! delete TWO*Z^i_,i From Hcon' to get Hcon, this is wrong +! Hcon = Hcon - f + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI +!!!!!!!!!advection term part +!g_ij + call fderivs_shc(ex,dxx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxx_rhs = gxx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxy_rhs = gxy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxz_rhs = gxz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dyy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyy_rhs = gyy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gyz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyz_rhs = gyz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dzz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gzz_rhs = gzz_rhs + betax*fxx+betay*fxy+betaz*fxz +!A_ij + call fderivs_shc(ex,Axx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axx_rhs = Axx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axy_rhs = Axy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axz_rhs = Axz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayy_rhs = Ayy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayz_rhs = Ayz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Azz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Azz_rhs = Azz_rhs + betax*fxx+betay*fxy+betaz*fxz +!chi and trK + call fderivs_shc(ex,chi,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + chi_rhs = chi_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,trK,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + trK_rhs = trK_rhs + betax*fxx+betay*fxy+betaz*fxz +!Gam^i + call fderivs_shc(ex,Gamx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamx_rhs = Gamx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamy_rhs = Gamy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamz_rhs = Gamz_rhs + betax*fxx+betay*fxy+betaz*fxz +!gauge variables + call fderivs_shc(ex,Lap,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Lap_rhs = Lap_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betax,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betax_rhs = betax_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betay,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betay_rhs = betay_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betaz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betaz_rhs = betaz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfx_rhs = dtSfx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfy_rhs = dtSfy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfz_rhs = dtSfz_rhs + betax*fxx+betay*fxy+betaz*fxz +!Z4c variables + call fderivs_shc(ex,TZ,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + TZ_rhs = TZ_rhs + betax*fxx+betay*fxy+betaz*fxz + +! constraint damping terms + TZ_rhs = TZ_rhs - alpn1*(TWO+kappa2)*kappa1*TZ + trK_rhs = trK_rhs + alpn1*kappa1*(ONE-kappa2)*TZ + Gamx_rhs = Gamx_rhs - TWO*alpn1*kappa1*(Gamx-Gamxa) + Gamy_rhs = Gamy_rhs - TWO*alpn1*kappa1*(Gamy-Gamya) + Gamz_rhs = Gamz_rhs - TWO*alpn1*kappa1*(Gamz-Gamza) + +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,TZ,TZ_rhs,SSS,Symmetry,eps,sst) + endif + +#if (ABV == 1) + call ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + call constraint_bssn_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry,Lev,sst) +#endif + + gont = 0 + + return + + end function compute_rhs_Z4c_ss +#endif + + +!! using David Z4c-rhs code +#if 0 + function compute_rhs_z4c_ss(ex, T,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + TZ_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & +! co is not used here, we always compute constraint + Symmetry,Lev,eps,sst,co) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,co + real*8, intent(in ):: T + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: TZ_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! when out, constraint violation + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chixx,chixy,chixz,chiyy,chiyz,chizz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: dtSfxx,dtSfxy,dtSfxz + real*8, dimension(ex(1),ex(2),ex(3)) :: dtSfyx,dtSfyy,dtSfyz + real*8, dimension(ex(1),ex(2),ex(3)) :: dtSfzx,dtSfzy,dtSfzz + real*8, dimension(ex(1),ex(2),ex(3)) :: dBxx,dBxy,dBxz + real*8, dimension(ex(1),ex(2),ex(3)) :: dByx,dByy,dByz + real*8, dimension(ex(1),ex(2),ex(3)) :: dBzx,dBzy,dBzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,TZx,TZy,TZz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axyx,Axzx,Ayyx,Ayzx,Azzx + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxy,Axyy,Axzy,Ayyy,Ayzy,Azzy + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxz,Axyz,Axzz,Ayyz,Ayzz,Azzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX,dY,dZ,PI + real*8, parameter :: ZEO=0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0,F16=1.6d1 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0,F8=8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + integer :: i,j,k + +! constraint damping terms stuffs PRD 81, 084003 (2010) + real*8 :: kappa1,kappa2,kappa3,FF,eta + + real*8,parameter :: chiDivfloor=1.d-5 + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz)+sum(dtSfx)+sum(dtSfy)+sum(dtSfz) & + +sum(TZ) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"Z4c_rhs_ss.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"Z4c_rhs_ss.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"Z4c_rhs_ss.f90: find NaN in gyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"Z4c_rhs_ss.f90: find NaN in gzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"Z4c_rhs_ss.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"Z4c_rhs_ss.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"Z4c_rhs_ss.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"Z4c_rhs_ss.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"Z4c_rhs_ss.f90: find NaN in betaz" + if(sum(dtSfx).ne.sum(dtSfx))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfx" + if(sum(dtSfy).ne.sum(dtSfy))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfy" + if(sum(dtSfz).ne.sum(dtSfz))write(*,*)"Z4c_rhs_ss.f90: find NaN in dtSfz" + if(sum(TZ).ne.sum(Tz))write(*,*)"Z4c_rhs_ss.f90: find NaN in TZ" + gont = 1 + return + endif + + PI = dacos(-ONE) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs_shc(ex,dtSfx,dBxx,dBxy,dBxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dtSfy,dByx,dByy,dByz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dtSfz,dBzx,dBzy,dBzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,betax,betaxx,betaxy,betaxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,betay,betayx,betayy,betayz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,betaz,betazx,betazy,betazz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +#if (GAUGE == 0) + call fderivs_shc(ex,dtSfx,dtSfxx,dtSfxy,dtSfxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dtSfy,dtSfyx,dtSfyy,dtSfyz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dtSfz,dtSfzx,dtSfzy,dtSfzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +#endif + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +! gij_,kl will be stored till end of this routine + call fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + +! Gami_,j will be kept till the end of this routine + call fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +! Right hand side for Gam^i without shift terms... +! Lap_,i will be kept till the end of this routine + call fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +! K_,i stored K_,i+TZ_,i/2 indeed, will be kept till the end of this routine + call fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fdderivs_shc(ex,betax,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betay,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betaz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call fdderivs_shc(ex,chi,chixx,chixy,chixz,chiyy,chiyz,chizz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call fdderivs_shc(ex,Lap,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + call z4c_rhs_point(Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + alpn1(i,j,k),dtSfx(i,j,k),dtSfy(i,j,k),dtSfz(i,j,k), & + betax(i,j,k),betay(i,j,k),betaz(i,j,k), & + chin1(i,j,k),chiDivfloor, & + Lapx(i,j,k), & + Axxx(i,j,k),Axyx(i,j,k),Axzx(i,j,k),Ayyx(i,j,k),Ayzx(i,j,k),Azzx(i,j,k), & + Lapy(i,j,k), & + Axxy(i,j,k),Axyy(i,j,k),Axzy(i,j,k),Ayyy(i,j,k),Ayzy(i,j,k),Azzy(i,j,k), & + Lapz(i,j,k), & + Axxz(i,j,k),Axyz(i,j,k),Axzz(i,j,k),Ayyz(i,j,k),Ayzz(i,j,k),Azzz(i,j,k), & + betaxx(i,j,k),dBxx(i,j,k),betayx(i,j,k),dByx(i,j,k),betazx(i,j,k),dBzx(i,j,k), & + betaxy(i,j,k),dBxy(i,j,k),betayy(i,j,k),dByy(i,j,k),betazy(i,j,k),dBzy(i,j,k), & + betaxz(i,j,k),dBxz(i,j,k),betayz(i,j,k),dByz(i,j,k),betazz(i,j,k),dBzz(i,j,k), & + chix(i,j,k),chiy(i,j,k),chiz(i,j,k), & + Lapxx(i,j,k),Lapxy(i,j,k),Lapxz(i,j,k),Lapyy(i,j,k),Lapyz(i,j,k),Lapzz(i,j,k), & + sfxxx(i,j,k),sfyxx(i,j,k),sfzxx(i,j,k), & + sfxxy(i,j,k),sfyxy(i,j,k),sfzxy(i,j,k), & + sfxxz(i,j,k),sfyxz(i,j,k),sfzxz(i,j,k), & + sfxyy(i,j,k),sfyyy(i,j,k),sfzyy(i,j,k), & + sfxyz(i,j,k),sfyyz(i,j,k),sfzyz(i,j,k), & + sfxzz(i,j,k),sfyzz(i,j,k),sfzzz(i,j,k), & + chixx(i,j,k),chixy(i,j,k),chixz(i,j,k),chiyy(i,j,k),chiyz(i,j,k),chizz(i,j,k), & + gxxxx(i,j,k),gxyxx(i,j,k),gxzxx(i,j,k),gyyxx(i,j,k),gyzxx(i,j,k),gzzxx(i,j,k), & + gxxxy(i,j,k),gxyxy(i,j,k),gxzxy(i,j,k),gyyxy(i,j,k),gyzxy(i,j,k),gzzxy(i,j,k), & + gxxxz(i,j,k),gxyxz(i,j,k),gxzxz(i,j,k),gyyxz(i,j,k),gyzxz(i,j,k),gzzxz(i,j,k), & + gxxyy(i,j,k),gxyyy(i,j,k),gxzyy(i,j,k),gyyyy(i,j,k),gyzyy(i,j,k),gzzyy(i,j,k), & + gxxyz(i,j,k),gxyyz(i,j,k),gxzyz(i,j,k),gyyyz(i,j,k),gyzyz(i,j,k),gzzyz(i,j,k), & + gxxzz(i,j,k),gxyzz(i,j,k),gxzzz(i,j,k),gyyzz(i,j,k),gyzzz(i,j,k),gzzzz(i,j,k), & + Gamxx(i,j,k),gxxx(i,j,k),gxyx(i,j,k),gxzx(i,j,k), & + Gamyx(i,j,k),gyyx(i,j,k),gyzx(i,j,k), & + Gamzx(i,j,k),gzzx(i,j,k), & + Gamxy(i,j,k),gxxy(i,j,k),gxyy(i,j,k),gxzy(i,j,k), & + Gamyy(i,j,k),gyyy(i,j,k),gyzy(i,j,k), & + Gamzy(i,j,k),gzzy(i,j,k), & + Gamxz(i,j,k),gxxz(i,j,k),gxyz(i,j,k),gxzz(i,j,k), & + Gamyz(i,j,k),gyyz(i,j,k),gyzz(i,j,k), & + Gamzz(i,j,k),gzzz(i,j,k), & + Kx(i,j,k),Ky(i,j,k),Kz(i,j,k), & + TZx(i,j,k),TZy(i,j,k),TZz(i,j,k), & + Gamx(i,j,k),gxx(i,j,k),gxy(i,j,k),gxz(i,j,k), & + Gamy(i,j,k),gyy(i,j,k),gyz(i,j,k), & + Gamz(i,j,k),gzz(i,j,k), & + kappa1,kappa2, & + trK(i,j,k), & + Axx_rhs(i,j,k),Axy_rhs(i,j,k),Axz_rhs(i,j,k),Ayy_rhs(i,j,k),Ayz_rhs(i,j,k),Azz_rhs(i,j,k), & + chi_rhs(i,j,k), & + Gamx_rhs(i,j,k),gxx_rhs(i,j,k),gxy_rhs(i,j,k),gxz_rhs(i,j,k), & + Gamy_rhs(i,j,k),gyy_rhs(i,j,k),gyz_rhs(i,j,k), & + Gamz_rhs(i,j,k),gzz_rhs(i,j,k),trK_rhs(i,j,k),TZ_rhs(i,j,k),TZ(i,j,k)) + enddo + enddo + enddo + +!!!!!gauge variable part + Lap_rhs = -TWO*alpn1*trK +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part +!g_ij + gxx_rhs = gxx_rhs + (betax*gxxx+betay*gxxy+betaz*gxxz) + gxy_rhs = gxy_rhs + (betax*gxyx+betay*gxyy+betaz*gxyz) + gxz_rhs = gxz_rhs + (betax*gxzx+betay*gxzy+betaz*gxzz) + gyy_rhs = gyy_rhs + (betax*gyyx+betay*gyyy+betaz*gyyz) + gyz_rhs = gyz_rhs + (betax*gyzx+betay*gyzy+betaz*gyzz) + gzz_rhs = gzz_rhs + (betax*gzzx+betay*gzzy+betaz*gzzz) +!A_ij + Axx_rhs = Axx_rhs + (betax*Axxx+betay*Axxy+betaz*Axxz) + Axy_rhs = Axy_rhs + (betax*Axyx+betay*Axyy+betaz*Axyz) + Axz_rhs = Axz_rhs + (betax*Axzx+betay*Axzy+betaz*Axzz) + Ayy_rhs = Ayy_rhs + (betax*Ayyx+betay*Ayyy+betaz*Ayyz) + Ayz_rhs = Ayz_rhs + (betax*Ayzx+betay*Ayzy+betaz*Ayzz) + Azz_rhs = Azz_rhs + (betax*Azzx+betay*Azzy+betaz*Azzz) +!chi and trK + chi_rhs = chi_rhs + (betax*chix+betay*chiy+betaz*chiz) + trK_rhs = trK_rhs + (betax*Kx+betay*Ky+betaz*Kz) +!Gam^i + Gamx_rhs = Gamx_rhs + (betax*Gamxx+betay*Gamxy+betaz*Gamxz) + Gamy_rhs = Gamy_rhs + (betax*Gamyx+betay*Gamyy+betaz*Gamyz) + Gamz_rhs = Gamz_rhs + (betax*Gamzx+betay*Gamzy+betaz*Gamzz) +!Z4c variables + TZ_rhs = TZ_rhs + (betax*TZx+betay*TZy+betaz*TZz) +!!!!!gauge variables + Lap_rhs = Lap_rhs + (betax*Lapx+betay*Lapy+betaz*Lapz) + + betax_rhs = betax_rhs + (betax*betaxx+betay*betaxy+betaz*betaxz) + betay_rhs = betay_rhs + (betax*betayx+betay*betayy+betaz*betayz) + betaz_rhs = betaz_rhs + (betax*betazx+betay*betazy+betaz*betazz) +#if (GAUGE == 0) + dtSfx_rhs = dtSfx_rhs + (betax*dtSfxx+betay*dtSfxy+betaz*dtSfxz) + dtSfy_rhs = dtSfy_rhs + (betax*dtSfyx+betay*dtSfyy+betaz*dtSfyz) + dtSfz_rhs = dtSfz_rhs + (betax*dtSfzx+betay*dtSfzy+betaz*dtSfzz) +#endif + +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) +#if (GAUGE == 0) + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) +#endif + + call kodis_sh(ex,crho,sigma,R,TZ,TZ_rhs,SSS,Symmetry,eps,sst) + endif + +#if (ABV == 1) + call ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + call constraint_bssn_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Hcon,Mxcon,Mycon,Mzcon,Gmxcon,Gmycon,Gmzcon, & + Symmetry,Lev,sst) +#endif + + gont = 0 + + return + + end function compute_rhs_Z4c_ss +#endif diff --git a/AMSS_NCKU_source/adm_constraint.f90 b/AMSS_NCKU_source/adm_constraint.f90 new file mode 100644 index 0000000..ab5f005 --- /dev/null +++ b/AMSS_NCKU_source/adm_constraint.f90 @@ -0,0 +1,382 @@ + +!-------------------------------------------------------------------------------! +! computed constraint for ADM formalism ! +!-------------------------------------------------------------------------------! + subroutine constraint_adm(ex, X, Y, Z,& + dxx,gxy,gxz,dyy,gyz,dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + ham_Res, movx_Res, movy_Res, movz_Res, & + Symmetry) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,trK,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzyy, Gamzyz, Gamzzz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + call adm_ricci_gamma(ex, X, Y, Z, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + trK = gupxx * Kxx + gupyy * Kyy + gupzz * Kzz & + + TWO * (gupxy * Kxy + gupxz * Kxz + gupyz * Kyz) + +! ham_Res = trR + K^2 - K_ij * K^ij - 16 * PI * rho + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = ham_Res + trK * trK -(& + gupxx * ( & + gupxx * Kxx * Kxx + gupyy * Kxy * Kxy + gupzz * Kxz * Kxz + & + TWO * (gupxy * Kxx * Kxy + gupxz * Kxx * Kxz + gupyz * Kxy * Kxz) ) + & + gupyy * ( & + gupxx * Kxy * Kxy + gupyy * Kyy * Kyy + gupzz * Kyz * Kyz + & + TWO * (gupxy * Kxy * Kyy + gupxz * Kxy * Kyz + gupyz * Kyy * Kyz) ) + & + gupzz * ( & + gupxx * Kxz * Kxz + gupyy * Kyz * Kyz + gupzz * Kzz * Kzz + & + TWO * (gupxy * Kxz * Kyz + gupxz * Kxz * Kzz + gupyz * Kyz * Kzz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Kxx * Kxy + gupyy * Kxy * Kyy + gupzz * Kxz * Kyz + & + gupxy * (Kxx * Kyy + Kxy * Kxy) + & + gupxz * (Kxx * Kyz + Kxz * Kxy) + & + gupyz * (Kxy * Kyz + Kxz * Kyy) ) + & + gupxz * ( & + gupxx * Kxx * Kxz + gupyy * Kxy * Kyz + gupzz * Kxz * Kzz + & + gupxy * (Kxx * Kyz + Kxy * Kxz) + & + gupxz * (Kxx * Kzz + Kxz * Kxz) + & + gupyz * (Kxy * Kzz + Kxz * Kyz) ) + & + gupyz * ( & + gupxx * Kxy * Kxz + gupyy * Kyy * Kyz + gupzz * Kyz * Kzz + & + gupxy * (Kxy * Kyz + Kyy * Kxz) + & + gupxz * (Kxy * Kzz + Kyz * Kxz) + & + gupyz * (Kyy * Kzz + Kyz * Kyz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*D_k K_ij - d_j trK - 8 PI s_j where D respect to physical metric +! store D_i K_jk + call fderivs(ex,Kxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Kxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Kxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Kyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Kyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Kzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + gxxx = gxxx - ( Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz & + + Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz) + gxyx = gxyx - ( Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz & + + Gamxxx * Kxy + Gamyxx * Kyy + Gamzxx * Kyz) + gxzx = gxzx - ( Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz & + + Gamxxx * Kxz + Gamyxx * Kyz + Gamzxx * Kzz) + gyyx = gyyx - ( Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz & + + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz) + gyzx = gyzx - ( Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz & + + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz) + gzzx = gzzx - ( Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz & + + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz) + gxxy = gxxy - ( Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz & + + Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz) + gxyy = gxyy - ( Gamxyy * Kxx + Gamyyy * Kxy + Gamzyy * Kxz & + + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz) + gxzy = gxzy - ( Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz & + + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz) + gyyy = gyyy - ( Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz & + + Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz) + gyzy = gyzy - ( Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz & + + Gamxyy * Kxz + Gamyyy * Kyz + Gamzyy * Kzz) + gzzy = gzzy - ( Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz & + + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz) + gxxz = gxxz - ( Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz & + + Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz) + gxyz = gxyz - ( Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz & + + Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz) + gxzz = gxzz - ( Gamxzz * Kxx + Gamyzz * Kxy + Gamzzz * Kxz & + + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz) + gyyz = gyyz - ( Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz & + + Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz) + gyzz = gyzz - ( Gamxzz * Kxy + Gamyzz * Kyy + Gamzzz * Kyz & + + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz) + gzzz = gzzz - ( Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz & + + Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz) +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + + call fderivs(ex,trK,fx,fy,fz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + +movx_Res = movx_Res - fx - F8*PI*sx +movy_Res = movy_Res - fy - F8*PI*sy +movz_Res = movz_Res - fz - F8*PI*sz + + return + + end subroutine constraint_adm +!-------------------------------------------------------------------------------! +! computed constraint for ADM formalism for shell ! +!-------------------------------------------------------------------------------! + subroutine constraint_adm_ss(ex,crho,sigma,R, X, Y, Z,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Symmetry,Lev,sst) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! second kind of Christofel symble Gamma^i_jk respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,trK,fx,fy,fz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + call adm_ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + trK = gupxx * Kxx + gupyy * Kyy + gupzz * Kzz & + + TWO * (gupxy * Kxy + gupxz * Kxz + gupyz * Kyz) + +! ham_Res = trR + K^2 - K_ij * K^ij - 16 * PI * rho + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = ham_Res + trK * trK -(& + gupxx * ( & + gupxx * Kxx * Kxx + gupyy * Kxy * Kxy + gupzz * Kxz * Kxz + & + TWO * (gupxy * Kxx * Kxy + gupxz * Kxx * Kxz + gupyz * Kxy * Kxz) ) + & + gupyy * ( & + gupxx * Kxy * Kxy + gupyy * Kyy * Kyy + gupzz * Kyz * Kyz + & + TWO * (gupxy * Kxy * Kyy + gupxz * Kxy * Kyz + gupyz * Kyy * Kyz) ) + & + gupzz * ( & + gupxx * Kxz * Kxz + gupyy * Kyz * Kyz + gupzz * Kzz * Kzz + & + TWO * (gupxy * Kxz * Kyz + gupxz * Kxz * Kzz + gupyz * Kyz * Kzz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Kxx * Kxy + gupyy * Kxy * Kyy + gupzz * Kxz * Kyz + & + gupxy * (Kxx * Kyy + Kxy * Kxy) + & + gupxz * (Kxx * Kyz + Kxz * Kxy) + & + gupyz * (Kxy * Kyz + Kxz * Kyy) ) + & + gupxz * ( & + gupxx * Kxx * Kxz + gupyy * Kxy * Kyz + gupzz * Kxz * Kzz + & + gupxy * (Kxx * Kyz + Kxy * Kxz) + & + gupxz * (Kxx * Kzz + Kxz * Kxz) + & + gupyz * (Kxy * Kzz + Kxz * Kyz) ) + & + gupyz * ( & + gupxx * Kxy * Kxz + gupyy * Kyy * Kyz + gupzz * Kyz * Kzz + & + gupxy * (Kxy * Kyz + Kyy * Kxz) + & + gupxz * (Kxy * Kzz + Kyz * Kxz) + & + gupyz * (Kyy * Kzz + Kyz * Kyz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*D_k K_ij - d_j trK - 8 PI s_j where D respect to physical metric +! store D_i K_jk + call fderivs_shc(ex,Kxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Kxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Kxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Kyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Kyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Kzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxxx = gxxx - ( Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz & + + Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz) + gxyx = gxyx - ( Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz & + + Gamxxx * Kxy + Gamyxx * Kyy + Gamzxx * Kyz) + gxzx = gxzx - ( Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz & + + Gamxxx * Kxz + Gamyxx * Kyz + Gamzxx * Kzz) + gyyx = gyyx - ( Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz & + + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz) + gyzx = gyzx - ( Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz & + + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz) + gzzx = gzzx - ( Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz & + + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz) + gxxy = gxxy - ( Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz & + + Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz) + gxyy = gxyy - ( Gamxyy * Kxx + Gamyyy * Kxy + Gamzyy * Kxz & + + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz) + gxzy = gxzy - ( Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz & + + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz) + gyyy = gyyy - ( Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz & + + Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz) + gyzy = gyzy - ( Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz & + + Gamxyy * Kxz + Gamyyy * Kyz + Gamzyy * Kzz) + gzzy = gzzy - ( Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz & + + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz) + gxxz = gxxz - ( Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz & + + Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz) + gxyz = gxyz - ( Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz & + + Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz) + gxzz = gxzz - ( Gamxzz * Kxx + Gamyzz * Kxy + Gamzzz * Kxz & + + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz) + gyyz = gyyz - ( Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz & + + Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz) + gyzz = gyzz - ( Gamxzz * Kxy + Gamyzz * Kyy + Gamzzz * Kyz & + + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz) + gzzz = gzzz - ( Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz & + + Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz) +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + + call fderivs_shc(ex,trK,fx,fy,fz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +movx_Res = movx_Res - fx - F8*PI*sx +movy_Res = movy_Res - fy - F8*PI*sy +movz_Res = movz_Res - fz - F8*PI*sz + + return + + end subroutine constraint_adm_ss diff --git a/AMSS_NCKU_source/adm_ricci_gamma.f90 b/AMSS_NCKU_source/adm_ricci_gamma.f90 new file mode 100644 index 0000000..3d0eca9 --- /dev/null +++ b/AMSS_NCKU_source/adm_ricci_gamma.f90 @@ -0,0 +1,306 @@ + +! for ADM variables + subroutine adm_ricci_gamma(ex, X, Y, Z, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: HALF = 0.5D0, F2o3 = 2.d0/3.d0, F3o2 = 1.5d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + call kind1_connection(ex, & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, ass_Gamzyy, ass_Gamzyz, ass_Gamzzz) +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call kind2_connection(ex, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, ass_Gamzyy, ass_Gamzyz, ass_Gamzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + + call fdderivs(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fdderivs(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fdderivs(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fdderivs(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,X,Y,Z,SYM, SYM ,SYM ,Symmetry,0) + call fdderivs(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fdderivs(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + call adm_riemann(ex, & + gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + ass_Gamxxx,ass_Gamxxy,ass_Gamxxz, ass_Gamxyy,ass_Gamxyz,ass_Gamxzz, & + ass_Gamyxx,ass_Gamyxy,ass_Gamyxz, ass_Gamyyy,ass_Gamyyz,ass_Gamyzz, & + ass_Gamzxx,ass_Gamzxy,ass_Gamzxz, ass_Gamzyy,ass_Gamzyz,ass_Gamzzz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + + call adm_ricci(ex, & + gupxx , gupxy , gupxz , gupyy , gupyz , gupzz , & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz, & + Rxx , Rxy , Rxz , Ryy , Ryz , Rzz) + + return + + end subroutine adm_ricci_gamma +!---------------------------------------------------------------------------- + subroutine adm_ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: HALF = 0.5D0, F2o3 = 2.d0/3.d0, F3o2 = 1.5d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call kind1_connection(ex, & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, ass_Gamzyy, ass_Gamzyz, ass_Gamzzz) +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call kind2_connection(ex, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, ass_Gamzyy, ass_Gamzyz, ass_Gamzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + + call fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call adm_riemann(ex, & + gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + ass_Gamxxx,ass_Gamxxy,ass_Gamxxz, ass_Gamxyy,ass_Gamxyz,ass_Gamxzz, & + ass_Gamyxx,ass_Gamyxy,ass_Gamyxz, ass_Gamyyy,ass_Gamyyz,ass_Gamyzz, & + ass_Gamzxx,ass_Gamzxy,ass_Gamzxz, ass_Gamzyy,ass_Gamzyz,ass_Gamzzz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + + call adm_ricci(ex, & + gupxx , gupxy , gupxz , gupyy , gupyz , gupzz , & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz, & + Rxx , Rxy , Rxz , Ryy , Ryz , Rzz) + + return + + end subroutine adm_ricci_gamma_ss diff --git a/AMSS_NCKU_source/array.C b/AMSS_NCKU_source/array.C new file mode 100644 index 0000000..830c2ce --- /dev/null +++ b/AMSS_NCKU_source/array.C @@ -0,0 +1,186 @@ +#include +#include // NULL +#include // size_t + +#include "cctk.h" + +#include "stdc.h" +#include "util.h" +#include "array.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + + template + array1d::array1d(int min_i_in, int max_i_in, + T *array_in /* = NULL */, + int stride_i_in /* = 0 */) + : array_(array_in), + offset_(0), // temp value, changed below + stride_i_(stride_i_in), + min_i_(min_i_in), max_i_(max_i_in), + we_own_array_(array_in == NULL) + { + if (stride_i_ == 0) + then stride_i_ = 1; + + // must use unchecked subscripting here since setup isn't done yet + offset_ = -subscript_unchecked(min_i_); // RHS uses offset_ = 0 + assert(subscript_unchecked(min_i_) == 0); + max_subscript_ = subscript_unchecked(max_i_); + + if (we_own_array_) + then + { + // allocate it + const int N_allocate = N_i(); + array_ = new T[N_allocate]; + } + + // explicitly initialize array (new[] *doesn't* do this automagically) + for (int i = min_i(); i <= max_i(); ++i) + { + operator()(i) = T(0); + } + } + + // + // This function destroys an array1d object. + // + template + array1d::~array1d() + { + if (we_own_array_) + then delete[] array_; + } + + // + // This function constructs an array2d object. + // + template + array2d::array2d(int min_i_in, int max_i_in, + int min_j_in, int max_j_in, + T *array_in /* = NULL */, + int stride_i_in /* = 0 */, int stride_j_in /* = 0 */) + : array_(array_in), + offset_(0), // temp value, changed below + stride_i_(stride_i_in), stride_j_(stride_j_in), + min_i_(min_i_in), max_i_(max_i_in), + min_j_(min_j_in), max_j_(max_j_in), + we_own_array_(array_in == NULL) + { + if (stride_j_ == 0) + then stride_j_ = 1; + if (stride_i_ == 0) + then stride_i_ = N_j(); + + // must use unchecked subscripting here since setup isn't done yet + offset_ = -subscript_unchecked(min_i_, min_j_); // RHS uses offset_ = 0 + assert(subscript_unchecked(min_i_, min_j_) == 0); + max_subscript_ = subscript_unchecked(max_i_, max_j_); + + if (we_own_array_) + then + { + // allocate it + const int N_allocate = N_i() * N_j(); + array_ = new T[N_allocate]; + } + + // explicitly initialize array (new[] *doesn't* do this automagically) + for (int i = min_i(); i <= max_i(); ++i) + { + for (int j = min_j(); j <= max_j(); ++j) + { + operator()(i, j) = T(0); + } + } + } + + // + // This function destroys an array2d object. + // + template + array2d::~array2d() + { + if (we_own_array_) + then delete[] array_; + } + + // + // This function constructs an array3d object. + // + template + array3d::array3d(int min_i_in, int max_i_in, + int min_j_in, int max_j_in, + int min_k_in, int max_k_in, + T *array_in /* = NULL */, + int stride_i_in /* = 0 */, int stride_j_in /* = 0 */, + int stride_k_in /* = 0 */) + : array_(array_in), + offset_(0), // temp value, changed below + stride_i_(stride_i_in), stride_j_(stride_j_in), + stride_k_(stride_k_in), + min_i_(min_i_in), max_i_(max_i_in), + min_j_(min_j_in), max_j_(max_j_in), + min_k_(min_k_in), max_k_(max_k_in), + we_own_array_(array_in == NULL) + { + if (stride_k_ == 0) + then stride_k_ = 1; + if (stride_j_ == 0) + then stride_j_ = N_k(); + if (stride_i_ == 0) + then stride_i_ = N_j() * N_k(); + + // must use unchecked subscripting here since setup isn't done yet + offset_ = -subscript_unchecked(min_i_, min_j_, min_k_); // RHS uses offset_ = 0 + assert(subscript_unchecked(min_i_, min_j_, min_k_) == 0); + max_subscript_ = subscript_unchecked(max_i_, max_j_, max_k_); + + if (we_own_array_) + then + { + // allocate it + const int N_allocate = N_i() * N_j() * N_k(); + array_ = new T[N_allocate]; + } + + // explicitly initialize array (new[] *doesn't* do this automagically) + for (int i = min_i(); i <= max_i(); ++i) + { + for (int j = min_j(); j <= max_j(); ++j) + { + for (int k = min_k(); k <= max_k(); ++k) + { + operator()(i, j, k) = T(0); + } + } + } + } + // + // This function destroys an array3d object. + // + template + array3d::~array3d() + { + if (we_own_array_) + then delete[] array_; + } + + template class array1d; + + // FIXME: we shouldn't have to instantiate these both, the const one + // is actually trivially derivable from the non-const one. :( + template class array1d; + template class array1d; + + template class array1d; + template class array2d; + template class array2d; + template class array3d; + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/array.h b/AMSS_NCKU_source/array.h new file mode 100644 index 0000000..463fc5f --- /dev/null +++ b/AMSS_NCKU_source/array.h @@ -0,0 +1,292 @@ +#ifndef AHFINDERDIRECT__ARRAY_HH +#define AHFINDERDIRECT__ARRAY_HH + +namespace AHFinderDirect +{ + namespace jtutil + { + + //****************************************************************************** + + template + class array1d + { + public: + int min_i() const { return min_i_; } + int max_i() const { return max_i_; } + int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); } + bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); } + + int subscript_unchecked(int i) const + { + return offset_ + stride_i_ * i; + } + int subscript(int i) const + { + assert(is_valid_i(i)); + const int posn = subscript_unchecked(i); + assert(posn >= 0); + assert(posn <= max_subscript_); + return posn; + } + int subscript_offset() const { return offset_; } + int subscript_stride_i() const { return stride_i_; } + + // normal-use access functions + // ... rvalue + const T &operator()(int i) const { return array_[subscript(i)]; } + // ... lvalue + T &operator()(int i) { return array_[subscript(i)]; } + + // get access to internal 0-origin 1D storage array + // (low-level, dangerous, use with caution!) + // ... semantics of N_array() may not be what you want + // if strides specify noncontiguous storage + int N_array() const { return max_subscript_ + stride_i_; } + const T *data_array() const { return const_cast(array_); } + T *data_array() { return array_; } + + // constructor, destructor + // ... constructor initializes all array elements to T(0.0) + // ... omitted strides default to C storage order + array1d(int min_i_in, int max_i_in, + T *array_in = NULL, // caller-provided storage array + // if non-NULL + int stride_i_in = 0); + ~array1d(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + array1d(const array1d &rhs); + array1d &operator=(const array1d &rhs); + + private: + // n.b. we declare the array pointer first in the class + // ==> it's probably at 0 offset + // ==> we may get slightly faster array access + T *array_; // --> new-allocated 1D storage array + + // subscripting info + // n.b. put this next in class so it should be in the same + // cpu cache line as array_ ==> faster array access + int offset_, stride_i_; + + // min/max array bounds + const int min_i_, max_i_; + int max_subscript_; + + // n.b. put this at end of class since performance doesn't matter + bool we_own_array_; // true ==> array_ --> new[] array which we own + // false ==> array_ --> client-owned storage + }; + + //****************************************************************************** + + template + class array2d + { + public: + // array info + int min_i() const { return min_i_; } + int max_i() const { return max_i_; } + int min_j() const { return min_j_; } + int max_j() const { return max_j_; } + int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); } + int N_j() const { return jtutil::how_many_in_range(min_j_, max_j_); } + bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); } + bool is_valid_j(int j) const { return (j >= min_j_) && (j <= max_j_); } + bool is_valid_ij(int i, int j) const + { + return is_valid_i(i) && is_valid_j(j); + } + + int subscript_unchecked(int i, int j) const + { + return offset_ + stride_i_ * i + stride_j_ * j; + } + int subscript(int i, int j) const + { + // n.b. we want each assert() here to be on a separate + // source line, so an assert() failure message can + // pinpoint *which* index is bad + assert(is_valid_i(i)); + assert(is_valid_j(j)); + const int posn = subscript_unchecked(i, j); + assert(posn >= 0); + assert(posn <= max_subscript_); + return posn; + } + int subscript_offset() const { return offset_; } + int subscript_stride_i() const { return stride_i_; } + int subscript_stride_j() const { return stride_j_; } + + // normal-use access functions + // ... rvalue + const T &operator()(int i, int j) const + { + return array_[subscript(i, j)]; + } + // ... lvalue + T &operator()(int i, int j) + { + return array_[subscript(i, j)]; + } + + // get access to internal 0-origin 1D storage array + // (low-level, dangerous, use with caution!) + // ... semantics of N_array() may not be what you want + // if strides specify noncontiguous storage + int N_array() const { return max_subscript_ + stride_j_; } + const T *data_array() const { return const_cast(array_); } + T *data_array() { return array_; } + + // constructor, destructor + // ... constructor initializes all array elements to T(0.0) + // ... omitted strides default to C storage order + array2d(int min_i_in, int max_i_in, + int min_j_in, int max_j_in, + T *array_in = NULL, // caller-provided storage array + // if non-NULL + int stride_i_in = 0, int stride_j_in = 0); + ~array2d(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + array2d(const array2d &rhs); + array2d &operator=(const array2d &rhs); + + private: + // n.b. we declare the array pointer first in the class + // ==> it's probably at 0 offset + // ==> we may get slightly faster array access + T *array_; // --> new-allocated 1D storage array + + // subscripting info + // n.b. put this next in class so it should be in the same + // cpu cache line as array_ ==> faster array access + int offset_, stride_i_, stride_j_; + + // min/max array bounds + const int min_i_, max_i_; + const int min_j_, max_j_; + int max_subscript_; + + // n.b. put this at end of class since performance doesn't matter + bool we_own_array_; // true ==> array_ --> new[] array which we own + // false ==> array_ --> client-owned storage + }; + + //****************************************************************************** + + template + class array3d + { + public: + // array info + int min_i() const { return min_i_; } + int max_i() const { return max_i_; } + int min_j() const { return min_j_; } + int max_j() const { return max_j_; } + int min_k() const { return min_k_; } + int max_k() const { return max_k_; } + int N_i() const { return jtutil::how_many_in_range(min_i_, max_i_); } + int N_j() const { return jtutil::how_many_in_range(min_j_, max_j_); } + int N_k() const { return jtutil::how_many_in_range(min_k_, max_k_); } + bool is_valid_i(int i) const { return (i >= min_i_) && (i <= max_i_); } + bool is_valid_j(int j) const { return (j >= min_j_) && (j <= max_j_); } + bool is_valid_k(int k) const { return (k >= min_k_) && (k <= max_k_); } + bool is_valid_ijk(int i, int j, int k) const + { + return is_valid_i(i) && is_valid_j(j) && is_valid_k(k); + } + + int subscript_unchecked(int i, int j, int k) const + { + return offset_ + stride_i_ * i + stride_j_ * j + stride_k_ * k; + } + int subscript(int i, int j, int k) const + { + // n.b. we want each assert() here to be on a separate + // source line, so an assert() failure message can + // pinpoint *which* index is bad + assert(is_valid_i(i)); + assert(is_valid_j(j)); + assert(is_valid_k(k)); + const int posn = subscript_unchecked(i, j, k); + assert(posn >= 0); + assert(posn <= max_subscript_); + return posn; + } + int subscript_offset() const { return offset_; } + int subscript_stride_i() const { return stride_i_; } + int subscript_stride_j() const { return stride_j_; } + int subscript_stride_k() const { return stride_k_; } + + // normal-use access functions + // ... rvalue + const T &operator()(int i, int j, int k) const + { + return array_[subscript(i, j, k)]; + } + // ... lvalue + T &operator()(int i, int j, int k) + { + return array_[subscript(i, j, k)]; + } + + // get access to internal 0-origin 1D storage array + // (low-level, dangerous, use with caution!) + // ... semantics of N_array() may not be what you want + // if strides specify noncontiguous storage + int N_array() const { return max_subscript_ + stride_k_; } + const T *data_array() const { return const_cast(array_); } + T *data_array() { return array_; } + + // constructor, destructor + // ... constructor initializes all array elements to T(0.0) + // ... omitted strides default to C storage order + array3d(int min_i_in, int max_i_in, + int min_j_in, int max_j_in, + int min_k_in, int max_k_in, + T *array_in = NULL, // caller-provided storage array + // if non-NULL + int stride_i_in = 0, int stride_j_in = 0, int stride_k_in = 0); + ~array3d(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + array3d(const array3d &rhs); + array3d &operator=(const array3d &rhs); + + private: + // n.b. we declare the array pointer first in the class + // ==> it's probably at 0 offset + // ==> we may get slightly faster array access + T *array_; // --> new-allocated 1D storage array + + // subscripting info + // n.b. put this next in class so it should be in the same + // cpu cache line as array_ ==> faster array access + int offset_, stride_i_, stride_j_, stride_k_; + + // min/max array bounds + const int min_i_, max_i_; + const int min_j_, max_j_; + const int min_k_, max_k_; + int max_subscript_; + + // n.b. put this at end of class since performance doesn't matter + bool we_own_array_; // true ==> array_ --> new[] array which we own + // false ==> array_ --> client-owned storage + }; + + } // namespace jtutil +} // namespace AHFinderDirect + +#endif /* AHFINDERDIRECT__ARRAY_HH */ diff --git a/AMSS_NCKU_source/bssn2adm.f90 b/AMSS_NCKU_source/bssn2adm.f90 new file mode 100644 index 0000000..ad7d6ba --- /dev/null +++ b/AMSS_NCKU_source/bssn2adm.f90 @@ -0,0 +1,40 @@ + +!-------------------------------------------------------------------------------! +! convert bssn variables to ADM variables ! +!-------------------------------------------------------------------------------! + subroutine bssn2adm(ex,chi,trK, & + gxx,gxy,gxz,gyy,gyz,gzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + adm_gxx,adm_gxy,adm_gxz,adm_gyy,adm_gyz,adm_gzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3) + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::chi,trK + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::gxx,gxy,gxz,gyy,gyz,gzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::Axx,Axy,Axz,Ayy,Ayz,Azz + + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: adm_gxx,adm_gxy,adm_gxz,adm_gyy,adm_gyz,adm_gzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + + real*8, parameter :: F1o3=1.d0/3.d0 + + adm_gxx = gxx/chi + adm_gxy = gxy/chi + adm_gxz = gxz/chi + adm_gyy = gyy/chi + adm_gyz = gyz/chi + adm_gzz = gzz/chi + + Kxx = Axx/chi+F1o3*trK*adm_gxx + Kxy = Axy/chi+F1o3*trK*adm_gxy + Kxz = Axz/chi+F1o3*trK*adm_gxz + Kyy = Ayy/chi+F1o3*trK*adm_gyy + Kyz = Ayz/chi+F1o3*trK*adm_gyz + Kzz = Azz/chi+F1o3*trK*adm_gzz + + return + + end subroutine bssn2adm diff --git a/AMSS_NCKU_source/bssnEM_class.C b/AMSS_NCKU_source/bssnEM_class.C new file mode 100644 index 0000000..e06b701 --- /dev/null +++ b/AMSS_NCKU_source/bssnEM_class.C @@ -0,0 +1,2325 @@ + +#ifdef newc +#include +#include +#include +using namespace std; +#else +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "Ansorg.h" +#include "fmisc.h" +#include "Parallel.h" +#include "bssnEM_class.h" +#include "bssn_rhs.h" +#include "empart.h" +#include "initial_puncture.h" +#include "initial_maxwell.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "getnp4.h" +#include "getnpem2.h" +#include "shellfunctions.h" +#include "parameters.h" + +#ifdef With_AHF +#include "derivatives.h" +#include "myglobal.h" +#endif + +//================================================================================================ + +// Define bssnEM_class + +// It inherits some members and methods from the parent class bssn_class and modifies others. +// The modified members and methods are defined below (and in the header bssnEM_class.h). +// The remaining members are inherited from the parent class bssn_class (declared in bssn_class.h). + +//================================================================================================ + +bssnEM_class::bssnEM_class(double Couranti, double StartTimei, double TotalTimei, + double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, + double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi) + : bssn_class(Couranti, StartTimei, TotalTimei, + DumpTimei, d2DumpTimei, CheckTimei, AnasTimei, + Symmetryi, checkruni, checkfilenamei, numepssi, numepsbi, numepshi, + a_levi, maxli, decni, maxrexi, drexi) +{ + // setup Monitors + { + char str[50]; + stringstream a_stream; + a_stream.setf(ios::left); + a_stream.str(""); + a_stream << setw(15) << "# time"; + for (int pl = 1; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + Phi2Monitor = new monitor("bssn_phi2.dat", myrank, a_stream.str()); // myrank has been setup in bssn_class.C + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + for (int pl = 0; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + Phi1Monitor = new monitor("bssn_phi1.dat", myrank, a_stream.str()); // myrank has been setup in bssn_class.C + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function initializes the class + +//================================================================================================ + +void bssnEM_class::Initialize() +{ + Exo = new var("Exo", ngfs++, -1, 1, 1); + Eyo = new var("Eyo", ngfs++, 1, -1, 1); + Ezo = new var("Ezo", ngfs++, 1, 1, -1); + // note B is an axi vector + Bxo = new var("Bxo", ngfs++, 1, -1, -1); + Byo = new var("Byo", ngfs++, -1, 1, -1); + Bzo = new var("Bzo", ngfs++, -1, -1, 1); + Kpsio = new var("Kpsio", ngfs++, 1, 1, 1); + Kphio = new var("Kphio", ngfs++, 1, 1, 1); + + Ex0 = new var("Ex0", ngfs++, -1, 1, 1); + Ey0 = new var("Ey0", ngfs++, 1, -1, 1); + Ez0 = new var("Ez0", ngfs++, 1, 1, -1); + Bx0 = new var("Bx0", ngfs++, 1, -1, -1); + By0 = new var("By0", ngfs++, -1, 1, -1); + Bz0 = new var("Bz0", ngfs++, -1, -1, 1); + Kpsi0 = new var("Kpsi0", ngfs++, 1, 1, 1); + Kphi0 = new var("Kphi0", ngfs++, 1, 1, 1); + + Ex = new var("Ex", ngfs++, -1, 1, 1); + Ey = new var("Ey", ngfs++, 1, -1, 1); + Ez = new var("Ez", ngfs++, 1, 1, -1); + Bx = new var("Bx", ngfs++, 1, -1, -1); + By = new var("By", ngfs++, -1, 1, -1); + Bz = new var("Bz", ngfs++, -1, -1, 1); + Kpsi = new var("Kpsi", ngfs++, 1, 1, 1); + Kphi = new var("Kphi", ngfs++, 1, 1, 1); + + Ex1 = new var("Ex1", ngfs++, -1, 1, 1); + Ey1 = new var("Ey1", ngfs++, 1, -1, 1); + Ez1 = new var("Ez1", ngfs++, 1, 1, -1); + Bx1 = new var("Bx1", ngfs++, 1, -1, -1); + By1 = new var("By1", ngfs++, -1, 1, -1); + Bz1 = new var("Bz1", ngfs++, -1, -1, 1); + Kpsi1 = new var("Kpsi1", ngfs++, 1, 1, 1); + Kphi1 = new var("Kphi1", ngfs++, 1, 1, 1); + + Ex_rhs = new var("Ex_rhs", ngfs++, -1, 1, 1); + Ey_rhs = new var("Ey_rhs", ngfs++, 1, -1, 1); + Ez_rhs = new var("Ez_rhs", ngfs++, 1, 1, -1); + Bx_rhs = new var("Bx_rhs", ngfs++, 1, -1, -1); + By_rhs = new var("By_rhs", ngfs++, -1, 1, -1); + Bz_rhs = new var("Bz_rhs", ngfs++, -1, -1, 1); + Kpsi_rhs = new var("Kpsi_rhs", ngfs++, 1, 1, 1); + Kphi_rhs = new var("Kphi_rhs", ngfs++, 1, 1, 1); + + qchar = new var("qchar", ngfs++, 1, 1, 1); + Jx = new var("Jx", ngfs++, -1, 1, 1); + Jy = new var("Jy", ngfs++, 1, -1, 1); + Jz = new var("Jz", ngfs++, 1, 1, -1); + + Rphi2 = new var("Rphi2", ngfs++, 1, 1, 1); // Etheta - Bphi in fact, so no symmetry at all + Iphi2 = new var("Iphi2", ngfs++, -1, -1, -1); // Ephi - Btheta in fact, so no symmetry at all + + Rphi1 = new var("Rphi1", ngfs++, 1, 1, 1); // Er in fact + Iphi1 = new var("Iphi1", ngfs++, 1, 1, 1); // Br in fact + + if (myrank == 0) + cout << "you have setted " << ngfs << " grid functions." << endl; + + OldStateList->insert(Kpsio); + OldStateList->insert(Kphio); + OldStateList->insert(Exo); + OldStateList->insert(Eyo); + OldStateList->insert(Ezo); + OldStateList->insert(Bxo); + OldStateList->insert(Byo); + OldStateList->insert(Bzo); + + StateList->insert(Kpsi0); + StateList->insert(Kphi0); + StateList->insert(Ex0); + StateList->insert(Ey0); + StateList->insert(Ez0); + StateList->insert(Bx0); + StateList->insert(By0); + StateList->insert(Bz0); + + RHSList->insert(Kpsi_rhs); + RHSList->insert(Kphi_rhs); + RHSList->insert(Ex_rhs); + RHSList->insert(Ey_rhs); + RHSList->insert(Ez_rhs); + RHSList->insert(Bx_rhs); + RHSList->insert(By_rhs); + RHSList->insert(Bz_rhs); + + SynchList_pre->insert(Kpsi); + SynchList_pre->insert(Kphi); + SynchList_pre->insert(Ex); + SynchList_pre->insert(Ey); + SynchList_pre->insert(Ez); + SynchList_pre->insert(Bx); + SynchList_pre->insert(By); + SynchList_pre->insert(Bz); + + SynchList_cor->insert(Kpsi1); + SynchList_cor->insert(Kphi1); + SynchList_cor->insert(Ex1); + SynchList_cor->insert(Ey1); + SynchList_cor->insert(Ez1); + SynchList_cor->insert(Bx1); + SynchList_cor->insert(By1); + SynchList_cor->insert(Bz1); + + DumpList->insert(Rphi2); + DumpList->insert(Iphi2); + DumpList->insert(Rphi1); + DumpList->insert(Iphi1); + DumpList->insert(Ex0); + DumpList->insert(Bx0); + + CheckPoint->addvariablelist(StateList); + CheckPoint->addvariablelist(OldStateList); + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + GH = new cgh(0, ngfs, Symmetry, pname, checkrun, ErrorMonitor); + if (checkrun) + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); + else + GH->compose_cgh(nprocs); + +#ifdef WithShell + SH = new ShellPatch(0, ngfs, pname, Symmetry, myrank, ErrorMonitor); + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); + + if (checkrun) + CheckPoint->readcheck_sh(SH, myrank); +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; + + if (checkrun) + { + CheckPoint->read_Black_Hole_position(BH_num_input, BH_num, Porg0, Pmom, Spin, Mass, Porgbr, Porg, Porg1, Porg_rhs); + } + else + { + PhysTime = StartTime; + Setup_Black_Hole_position(); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// Destructor: free allocated variables + +//================================================================================================ + +bssnEM_class::~bssnEM_class() +{ + delete Kpsio; + delete Kphio; + delete Exo; + delete Eyo; + delete Ezo; + delete Bxo; + delete Byo; + delete Bzo; + + delete Kpsi0; + delete Kphi0; + delete Ex0; + delete Ey0; + delete Ez0; + delete Bx0; + delete By0; + delete Bz0; + + delete Kpsi; + delete Kphi; + delete Ex; + delete Ey; + delete Ez; + delete Bx; + delete By; + delete Bz; + + delete Kpsi1; + delete Kphi1; + delete Ex1; + delete Ey1; + delete Ez1; + delete Bx1; + delete By1; + delete Bz1; + + delete Kpsi_rhs; + delete Kphi_rhs; + delete Ex_rhs; + delete Ey_rhs; + delete Ez_rhs; + delete Bx_rhs; + delete By_rhs; + delete Bz_rhs; + + delete qchar; + delete Jx; + delete Jy; + delete Jz; + + delete Rphi2; + delete Iphi2; + + delete Rphi1; + delete Iphi1; + + delete Phi2Monitor; + + delete Phi1Monitor; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function reads TwoPuncture initial data produced by the Ansorg solver + +//================================================================================================ + +// Read initial data solved by Ansorg, PRD 70, 064011 (2004) + +void bssnEM_class::Read_Ansorg() +{ + if (checkrun) + { + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); +#ifdef WithShell + CheckPoint->readcheck_sh(SH, myrank); +#endif + } + else + { + if (myrank == 0) + cout << "Read initial data from Ansorg's solver," + << " please be sure the input parameters for black holes are puncture parameters!!" << endl; + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here, *Qchar; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom = new double[3 * BH_NM]; + Spin = new double[3 * BH_NM]; + Mass = new double[BH_NM]; + Qchar = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass[sind] = atof(sval.c_str()); + else if (skey == "Qchar") + { + Qchar[sind] = atof(sval.c_str()); + if (myrank == 0) + cout << "black hole #" << sind << " has elctric charge " << Qchar[sind] << endl; + } + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + int order = 6; + Ansorg read_ansorg("Ansorg.psid", order); + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->X[0][i], cg->X[1][j], cg->X[2][k]); + + f_get_ansorg_nbhs_em(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + Mass, Qchar, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->fgfs[Pp->data->fngfs + ShellPatch::gx][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]]); + + f_get_ansorg_nbhs_ss_em(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + Mass, Qchar, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + delete[] Porg_here; +// dump read_in initial data +// for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); +// check initial constraint +#if 0 + for(int lev=0;levlevels;lev++) Step(lev,0); + if(myrank == 0) MPI_Abort(MPI_COMM_WORLD,1); +#endif + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets electrovac initial data via analytic functions. +// Note: the description below applies only to head-on collision cases. + +//================================================================================================ + +// Set up initial data given by PRD 80, 104022 (2009) +void bssnEM_class::Setup_Initial_Data() +{ + if (checkrun) + { + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); +#ifdef WithShell + CheckPoint->readcheck_sh(SH, myrank); +#endif + } + else + { + if (myrank == 0) + cout << "Setup initial data for head on identical charge-mass ratio black holes." << endl; + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here, *Qchar_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + Qchar_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Qchar") + { + Qchar_here[sind] = atof(sval.c_str()); + if (myrank == 0) + cout << "black hole #" << sind << " has elctric charge " << Qchar_here[sind] << endl; + } + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhsem(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + Mass_here, Qchar_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhsem_ss(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + Mass_here, Qchar_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Qchar_here; + delete[] Pmom_here; + delete[] Spin_here; + // dump read_in initial data + // for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function configures a single time-step evolution + +//================================================================================================ + +void bssnEM_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if ( + f_compute_rhs_empart(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[trK0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + cg->fgfs[Jx->sgfn], cg->fgfs[Jy->sgfn], cg->fgfs[Jz->sgfn], + cg->fgfs[qchar->sgfn], + cg->fgfs[Ex_rhs->sgfn], cg->fgfs[Ey_rhs->sgfn], cg->fgfs[Ez_rhs->sgfn], + cg->fgfs[Bx_rhs->sgfn], cg->fgfs[By_rhs->sgfn], cg->fgfs[Bz_rhs->sgfn], + cg->fgfs[Kpsi_rhs->sgfn], cg->fgfs[Kphi_rhs->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + Symmetry, lev, ndeps) || + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +// check initial constraint +#if 0 + Parallel::Dump_Data(GH->PatL[lev],DumpList,0,PhysTime,dT_lev); +#endif + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if ( + f_compute_rhs_empart_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[trK0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + cg->fgfs[Jx->sgfn], cg->fgfs[Jy->sgfn], cg->fgfs[Jz->sgfn], + cg->fgfs[qchar->sgfn], + cg->fgfs[Ex_rhs->sgfn], cg->fgfs[Ey_rhs->sgfn], cg->fgfs[Ez_rhs->sgfn], + cg->fgfs[Bx_rhs->sgfn], cg->fgfs[By_rhs->sgfn], cg->fgfs[Bz_rhs->sgfn], + cg->fgfs[Kpsi_rhs->sgfn], cg->fgfs[Kphi_rhs->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst) || + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } +#if 1 + // falloff boundary condition + { + int n = 2; + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ex->sgfn], n, Ex->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ey->sgfn], n, Ey->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ez->sgfn], n, Ez->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Bx->sgfn], n, Bx->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[By->sgfn], n, By->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Bz->sgfn], n, Bz->SoA, Symmetry); + n = 3; + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Kpsi->sgfn], n, Kpsi->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Kphi->sgfn], n, Kphi->SoA, Symmetry); + } +#endif + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff_EM(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if ( + f_compute_rhs_empart(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[trK->sgfn], + cg->fgfs[Ex->sgfn], cg->fgfs[Ey->sgfn], cg->fgfs[Ez->sgfn], + cg->fgfs[Bx->sgfn], cg->fgfs[By->sgfn], cg->fgfs[Bz->sgfn], + cg->fgfs[Kpsi->sgfn], cg->fgfs[Kphi->sgfn], + cg->fgfs[Jx->sgfn], cg->fgfs[Jy->sgfn], cg->fgfs[Jz->sgfn], + cg->fgfs[qchar->sgfn], + cg->fgfs[Ex1->sgfn], cg->fgfs[Ey1->sgfn], cg->fgfs[Ez1->sgfn], + cg->fgfs[Bx1->sgfn], cg->fgfs[By1->sgfn], cg->fgfs[Bz1->sgfn], + cg->fgfs[Kpsi1->sgfn], cg->fgfs[Kphi1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + Symmetry, lev, ndeps) || + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if ( + f_compute_rhs_empart_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Lap->sgfn], cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], + cg->fgfs[Sfz->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[Ex->sgfn], cg->fgfs[Ey->sgfn], cg->fgfs[Ez->sgfn], + cg->fgfs[Bx->sgfn], cg->fgfs[By->sgfn], cg->fgfs[Bz->sgfn], + cg->fgfs[Kpsi->sgfn], cg->fgfs[Kphi->sgfn], + cg->fgfs[Jx->sgfn], cg->fgfs[Jy->sgfn], cg->fgfs[Jz->sgfn], + cg->fgfs[qchar->sgfn], + cg->fgfs[Ex1->sgfn], cg->fgfs[Ey1->sgfn], cg->fgfs[Ez1->sgfn], + cg->fgfs[Bx1->sgfn], cg->fgfs[By1->sgfn], cg->fgfs[Bz1->sgfn], + cg->fgfs[Kpsi1->sgfn], cg->fgfs[Kphi1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst) || + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } +#if 1 + // falloff boundary condition + { + int n = 2; + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ex1->sgfn], n, Ex1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ey1->sgfn], n, Ey1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Ez1->sgfn], n, Ez1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Bx1->sgfn], n, Bx1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[By1->sgfn], n, By1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Bz1->sgfn], n, Bz1->SoA, Symmetry); + n = 3; + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Kpsi1->sgfn], n, Kpsi1->SoA, Symmetry); + f_falloff_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[Kphi1->sgfn], n, Kphi1->SoA, Symmetry); + } +#endif + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } + +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes the electromagnetic radiation scalar Phi2 + +//================================================================================================ + +void bssnEM_class::Compute_Phi2(int lev) +{ + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_getnpem2(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Rphi2->sgfn], cg->fgfs[Iphi2->sgfn], + Symmetry); + f_getnpem1(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Rphi1->sgfn], cg->fgfs[Iphi1->sgfn], + Symmetry); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_getnpem2_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Rphi2->sgfn], cg->fgfs[Iphi2->sgfn], + Symmetry, Pp->data->sst); + f_getnpem1_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Rphi1->sgfn], cg->fgfs[Iphi1->sgfn], + Symmetry, Pp->data->sst); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#endif + + MyList *DG_List = new MyList(Rphi2); + DG_List->insert(Iphi2); + DG_List->insert(Rphi1); + DG_List->insert(Iphi1); + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + SH->Synch(DG_List, Symmetry); + } +#endif + DG_List->clearList(); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function analyzes electromagnetic field data + +//================================================================================================ + +void bssnEM_class::AnalysisStuff_EM(int lev, double dT_lev) +{ + LastAnas += dT_lev; + + if (LastAnas >= AnasTime) + { + Compute_Phi2(lev); + double *RP, *IP; + int NN = 0; + // for phi2 + for (int pl = 1; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; + double Rex = maxrex; + for (int i = 0; i < decn; i++) + { +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + // Waveshell->surf_Wave(Rex,lev,GH, Rphi2, Iphi2,1,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, GH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 1, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem2_point); + } + else + { + // Waveshell->surf_Wave(Rex,lev,SH, Rphi2, Iphi2,1,maxl,NN,RP,IP,ErrorMonitor); + // Waveshell->surf_Wave(Rex,lev,SH, Ex0,Ey0,Ez0,Bx0,By0,Bz0,phi0,gxx0,gxy0,gxz0,gyy0,gyz0,gzz0,1,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, SH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 1, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem2_point); + } +#else + // Waveshell->surf_Wave(Rex,lev,GH, Rphi2, Iphi2,1,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, GH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 1, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem2_point); +#endif + Phi2Monitor->writefile(PhysTime, NN, RP, IP); + Rex = Rex - drex; + } + delete[] RP; + delete[] IP; + + // for phi1 + NN = 0; + for (int pl = 0; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; + Rex = maxrex; + for (int i = 0; i < decn; i++) + { +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + // Waveshell->surf_Wave(Rex,lev,GH, Rphi1, Iphi1,0,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, GH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 0, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem1_point); + } + else + { + // Waveshell->surf_Wave(Rex,lev,SH, Rphi1, Iphi1,0,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, SH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 0, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem1_point); + } +#else + // Waveshell->surf_Wave(Rex,lev,GH, Rphi1, Iphi1,0,maxl,NN,RP,IP,ErrorMonitor); + Waveshell->surf_Wave(Rex, lev, GH, + Ex0, Ey0, Ez0, Bx0, By0, Bz0, phi0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + 0, maxl, NN, RP, IP, ErrorMonitor, + f_getnpem1_point); +#endif + Phi1Monitor->writefile(PhysTime, NN, RP, IP); + Rex = Rex - drex; + } + delete[] RP; + delete[] IP; + } + + AnalysisStuff(lev, dT_lev); // LastAnas need and only need control here + + // Is this a shared variable? Should it be reset after each analysis? + LastAnas = 0; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function interpolates constraint data + +//================================================================================================ + +void bssnEM_class::Interp_Constraint() +{ + // we do not support a_lev != 0 yet. + if (a_lev > 0) + return; + + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_empart(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[trK0->sgfn], + cg->fgfs[Ex0->sgfn], cg->fgfs[Ey0->sgfn], cg->fgfs[Ez0->sgfn], + cg->fgfs[Bx0->sgfn], cg->fgfs[By0->sgfn], cg->fgfs[Bz0->sgfn], + cg->fgfs[Kpsi0->sgfn], cg->fgfs[Kphi0->sgfn], + cg->fgfs[Jx->sgfn], cg->fgfs[Jy->sgfn], cg->fgfs[Jz->sgfn], + cg->fgfs[qchar->sgfn], + cg->fgfs[Ex_rhs->sgfn], cg->fgfs[Ey_rhs->sgfn], cg->fgfs[Ez_rhs->sgfn], + cg->fgfs[Bx_rhs->sgfn], cg->fgfs[By_rhs->sgfn], cg->fgfs[Bz_rhs->sgfn], + cg->fgfs[Kpsi_rhs->sgfn], cg->fgfs[Kphi_rhs->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + Symmetry, lev, ndeps) || + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + SH->Synch(ConstraintList, Symmetry); +#endif + // interpolate + double *x1, *y1, *z1; + const int n = 1000; + double lmax, lmin, dd; + lmin = 0; +#ifdef WithShell + lmax = SH->Rrange[1]; +#else + lmax = GH->bbox[0][0][4]; +#endif +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (lmax - lmin) / (n - 1); +#else +#ifdef Cell + dd = (lmax - lmin) / n; +#else +#error Not define Vertex nor Cell +#endif +#endif + x1 = new double[n]; + y1 = new double[n]; + z1 = new double[n]; + for (int i = 0; i < n; i++) + { + x1[i] = 0; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y1[i] = lmin + i * dd; +#else +#ifdef Cell + y1[i] = lmin + (i + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + z1[i] = 0; + } + + int InList = 0; + + MyList *varl = ConstraintList; + while (varl) + { + InList++; + varl = varl->next; + } + double *shellf; + shellf = new double[n * InList]; + for (int i = 0; i < n; i++) + { + double XX[3]; + XX[0] = x1[i]; + XX[1] = y1[i]; + XX[2] = z1[i]; + bool fg = GH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#ifdef WithShell + if (!fg) + fg = SH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#endif + if (!fg && myrank == 0) + { + cout << "bssn_class::Interp_Constraint meets wrong" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + ofstream outfile; + char filename[50]; + sprintf(filename, "%s/interp_constraint_%05d.dat", ErrorMonitor->out_dir.c_str(), int(PhysTime / dT + 0.5)); + // 0.5 for round off + + outfile.open(filename); + outfile << "# corrdinate, H_Res, Px_Res, Py_Res, Pz_Res, Gx_Res, Gy_Res, Gz_Res, ...." << endl; + for (int i = 0; i < n; i++) + { + outfile << setw(10) << setprecision(10) << y1[i]; + for (int j = 0; j < InList; j++) + outfile << " " << setw(16) << setprecision(15) << shellf[InList * i + j]; + outfile << endl; + } + + delete[] shellf; +} + +//================================================================================================ + diff --git a/AMSS_NCKU_source/bssnEM_class.h b/AMSS_NCKU_source/bssnEM_class.h new file mode 100644 index 0000000..2bff672 --- /dev/null +++ b/AMSS_NCKU_source/bssnEM_class.h @@ -0,0 +1,69 @@ + +#ifndef BSSNEM_CLASS_H +#define BSSNEM_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" +#include "surface_integral.h" + +#include "macrodef.h" + +#ifdef USE_GPU +#include "bssn_gpu_class.h" +#else +#include "bssn_class.h" +#endif + +class bssnEM_class : public bssn_class +{ +public: + bssnEM_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi); + ~bssnEM_class(); + + void Initialize(); + void Read_Ansorg(); + void Setup_Initial_Data(); + void Step(int lev, int YN); + void Compute_Phi2(int lev); + void AnalysisStuff_EM(int lev, double dT_lev); + void Interp_Constraint(); + +protected: + var *Exo, *Eyo, *Ezo, *Bxo, *Byo, *Bzo, *Kpsio, *Kphio; + var *Ex0, *Ey0, *Ez0, *Bx0, *By0, *Bz0, *Kpsi0, *Kphi0; + var *Ex, *Ey, *Ez, *Bx, *By, *Bz, *Kpsi, *Kphi; + var *Ex1, *Ey1, *Ez1, *Bx1, *By1, *Bz1, *Kpsi1, *Kphi1; + var *Ex_rhs, *Ey_rhs, *Ez_rhs, *Bx_rhs, *By_rhs, *Bz_rhs, *Kpsi_rhs, *Kphi_rhs; + var *Jx, *Jy, *Jz, *qchar; + var *Rphi2, *Iphi2; + var *Rphi1, *Iphi1; + + monitor *Phi2Monitor; + monitor *Phi1Monitor; +}; +#endif /* BSSNEM_CLASS_H */ diff --git a/AMSS_NCKU_source/bssnEScalar_class.C b/AMSS_NCKU_source/bssnEScalar_class.C new file mode 100644 index 0000000..c1e71cd --- /dev/null +++ b/AMSS_NCKU_source/bssnEScalar_class.C @@ -0,0 +1,2477 @@ + +#ifdef newc +#include +#include +#include +using namespace std; +#else +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "Ansorg.h" +#include "fmisc.h" +#include "Parallel.h" +#include "bssnEScalar_class.h" +#include "bssn_rhs.h" +#include "initial_puncture.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "getnp4.h" +#include "shellfunctions.h" +#include "parameters.h" + +#ifdef With_AHF +#include "derivatives.h" +#include "myglobal.h" +#endif + +//================================================================================================ + +// Define bssnEScalar_class + +// It inherits some members and methods from the parent class bssn_class and modifies others. +// The modified members and methods are defined below (and in the header bssnEScalar_class.h). +// The remaining members are inherited from the parent class bssn_class (declared in bssn_class.h). + +//================================================================================================ + +bssnEScalar_class::bssnEScalar_class(double Couranti, double StartTimei, double TotalTimei, + double DumpTimei, double d2DumpTimei, + double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, + double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi) + : bssn_class(Couranti, StartTimei, TotalTimei, + DumpTimei, d2DumpTimei, CheckTimei, AnasTimei, + Symmetryi, checkruni, checkfilenamei, numepssi, numepsbi, numepshi, + a_levi, maxli, decni, maxrexi, drexi) +{ + // setup Monitors + { + char str[50]; + stringstream a_stream; + a_stream.setf(ios::left); + a_stream.str(""); + a_stream << setw(15) << "# time x y z maxs"; + MaxScalar_Monitor = new monitor("bssn_maxs.dat", myrank, a_stream.str()); + // myrank has been setup in bssn_class.C + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function initializes the class + +//================================================================================================ + +void bssnEScalar_class::Initialize() +{ + Sphio = new var("Sphio", ngfs++, 1, 1, 1); + Spio = new var("Spio", ngfs++, 1, 1, 1); + Sphi0 = new var("Sphi0", ngfs++, 1, 1, 1); + Spi0 = new var("Spi0", ngfs++, 1, 1, 1); + Sphi = new var("Sphi", ngfs++, 1, 1, 1); + Spi = new var("Spi", ngfs++, 1, 1, 1); + Sphi1 = new var("Sphi1", ngfs++, 1, 1, 1); + Spi1 = new var("Spi1", ngfs++, 1, 1, 1); + Sphi_rhs = new var("Sphi_rhs", ngfs++, 1, 1, 1); + Spi_rhs = new var("Spi_rhs", ngfs++, 1, 1, 1); + + // constraint violation monitor variables + Cons_fR = new var("Cons_fR", ngfs++, 1, 1, 1); + + if (myrank == 0) + cout << "you have setted " << ngfs << " grid functions." << endl; + + OldStateList->insert(Sphio); + OldStateList->insert(Spio); + StateList->insert(Sphi0); + StateList->insert(Spi0); + RHSList->insert(Sphi_rhs); + RHSList->insert(Spi_rhs); + SynchList_pre->insert(Sphi); + SynchList_pre->insert(Spi); + SynchList_cor->insert(Sphi1); + SynchList_cor->insert(Spi1); + + ConstraintList->insert(Cons_Gz); + + DumpList->insert(Sphi0); + DumpList->insert(Spi0); + DumpList->insert(Cons_fR); + + CheckPoint->addvariablelist(StateList); + CheckPoint->addvariablelist(OldStateList); + + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + // read parameter from file + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + + GH = new cgh(0, ngfs, Symmetry, pname, checkrun, ErrorMonitor); + if (checkrun) + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); + else + GH->compose_cgh(nprocs); + +#ifdef WithShell + SH = new ShellPatch(0, ngfs, pname, Symmetry, myrank, ErrorMonitor); + if (!checkrun) + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); + + if (checkrun) + CheckPoint->readcheck_sh(SH, myrank); +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; + + if (checkrun) + { + CheckPoint->read_Black_Hole_position(BH_num_input, BH_num, Porg0, Pmom, Spin, Mass, Porgbr, Porg, Porg1, Porg_rhs); + } + else + { + PhysTime = StartTime; + Setup_Black_Hole_position(); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// Destructor: free allocated variables + +//================================================================================================ + +bssnEScalar_class::~bssnEScalar_class() +{ + delete Sphio; + delete Spio; + delete Sphi0; + delete Spi0; + delete Sphi; + delete Spi; + delete Sphi1; + delete Spi1; + delete Sphi_rhs; + delete Spi_rhs; + + delete Cons_fR; + + delete MaxScalar_Monitor; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function reads TwoPuncture initial data produced by the Ansorg solver + +//================================================================================================ + +// Read initial data solved by Ansorg, PRD 70, 064011 (2004) + +void bssnEScalar_class::Read_Ansorg() +{ + if (!checkrun) + { + if (myrank == 0) + cout << "Read initial data from Ansorg's solver," + << " please be sure the input parameters for black holes are puncture parameters!!" + << endl; + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " + << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom = new double[3 * BH_NM]; + Spin = new double[3 * BH_NM]; + Mass = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + int order = 6; + Ansorg read_ansorg("Ansorg.psid", order); + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->X[0][i], cg->X[1][j], cg->X[2][k]); + + f_get_ansorg_nbhs_escalar(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + Mass, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->fgfs[Pp->data->fngfs + ShellPatch::gx][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]]); + + f_get_ansorg_nbhs_ss_escalar(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + Mass, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + delete[] Porg_here; + // dump read_in initial data + // for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function reads initial data produced by Pablo Galaviz's Olliptic program + +//================================================================================================ + +// Read initial data solved by Pablo's Olliptic Phys.Rev.D 82 024005 (2010) + +void bssnEScalar_class::Read_Pablo() +{ + if (!checkrun) + { + if (myrank == 0) + cout << "Read initial data from Pablo's solver," + << " please be sure the input parameters for black holes are puncture parameters!!" + << endl; + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom = new double[3 * BH_NM]; + Spin = new double[3 * BH_NM]; + Mass = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + bool flag = false; + int DIM = dim; + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + int grd = 0; + while (Pp) + { + double *databuffer = (double *)malloc(sizeof(double) + * Pp->data->shape[0] * Pp->data->shape[1] * Pp->data->shape[2]); + if (!databuffer) + { + cout << "bssnEScalar_class::Read_Pablo: on node# " << myrank + << ", out of memory when reading Pablo's data in" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + char filename[100]; + sprintf(filename, "Lev%02d-%02d.mgid_m", lev, grd); + if (read_Pablo_file((int *)Pp->data->shape, databuffer, filename)) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_copy(DIM, cg->bbox, cg->bbox + DIM, cg->shape, cg->fgfs[phi0->sgfn], + Pp->data->bbox, Pp->data->bbox + DIM, Pp->data->shape, databuffer, + cg->bbox, cg->bbox + DIM); + + f_get_ansorg_nbhs_escalar(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + Mass, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + } + else + { + sprintf(filename, "Lev%02d-%02d.mgid", lev, grd); + if (myrank == 0) + write_Pablo_file((int *)Pp->data->shape, + Pp->data->bbox[0], Pp->data->bbox[3], + Pp->data->bbox[1], Pp->data->bbox[4], + Pp->data->bbox[2], Pp->data->bbox[5], + filename); + flag = true; + } + free(databuffer); + Pp = Pp->next; + grd++; + } + } + +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + double *databuffer = (double *)malloc(sizeof(double) * Pp->data->shape[0] * Pp->data->shape[1] * Pp->data->shape[2]); + if (!databuffer) + { + cout << "bssnEScalar_class::Read_Pablo: on node# " << myrank << ", out of memory when reading Pablo's data in" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + char filename[100], shn[10]; + SH->shellname(shn, Pp->data->sst); + sprintf(filename, "LevSH-%s.mgid_m", shn); + if (read_Pablo_file((int *)Pp->data->shape, databuffer, filename)) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_copy(DIM, cg->bbox, cg->bbox + DIM, cg->shape, cg->fgfs[phi0->sgfn], + Pp->data->bbox, Pp->data->bbox + DIM, Pp->data->shape, databuffer, + cg->bbox, cg->bbox + DIM); + + f_get_ansorg_nbhs_ss_escalar(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + Mass, Porg_here, Pmom, Spin, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + } + else + { + sprintf(filename, "LevSH-%s.mgid", shn); + if (myrank == 0) + SH->write_Pablo_file_ss((int *)Pp->data->shape, + Pp->data->bbox[0], Pp->data->bbox[3], + Pp->data->bbox[1], Pp->data->bbox[4], + Pp->data->bbox[2], Pp->data->bbox[5], + filename, Pp->data->sst); + flag = true; + } + free(databuffer); + Pp = Pp->next; + } +#endif + + delete[] Porg_here; + if (flag && myrank == 0) + MPI_Abort(MPI_COMM_WORLD, 1); + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT); + SH->Dump_Data(StateList, 0, PhysTime, dT); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function configures a single time-step evolution + +//================================================================================================ + +void bssnEScalar_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_escalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_escalar_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff_EScalar(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_escalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[Sphi->sgfn], cg->fgfs[Spi->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[Sphi1->sgfn], cg->fgfs[Spi1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_escalar_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[Sphi->sgfn], cg->fgfs[Spi->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[Sphi1->sgfn], cg->fgfs[Spi1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } + +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes the gravitational-wave scalar Psi4 + +//================================================================================================ + +void bssnEScalar_class::Compute_Psi4(int lev) +{ + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + // the input arguments Gamma^i_jk and R_ij do not need synch, because we do not need to derivate them + f_getnp4scalar(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#elif (Psi4type == 1) + f_getnp4oldscalar(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#else +#error "not recognized Psi4type" +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + f_getnp4scalar_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#elif (Psi4type == 1) + f_getnp4oldscalar_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#else +#error "not recognized Psi4type" +#endif + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#endif + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); +#ifdef WithShell + if (lev == 0) + { + SH->Synch(DG_List, Symmetry); + } +#endif + DG_List->clearList(); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function analyzes and inspects scalar field data + +//================================================================================================ + +void bssnEScalar_class::AnalysisStuff_EScalar(int lev, double dT_lev) +{ + LastAnas += dT_lev; + + if (lev > 0) + { + cout << "AnalysisStuff_EScala only supports level 0, but lev = " << lev << endl; + + AnalysisStuff(lev, dT_lev); + + return; + } + + if (LastAnas >= AnasTime) + { + MyList *DG_List = new MyList(Sphi0); + double XX[3], maxs[1]; + + double XXh[3], maxsh[1]; + for (int levh = GH->levels - 1; levh >= 0; levh--) + { + MyList *Pp = GH->PatL[levh]; + + maxsh[0] = -1; // for sure be rewriten + while (Pp) + { + double XXhh[3], maxshh[1]; + Pp->data->Find_Maximum(DG_List, XXhh, maxshh); + if (maxsh[0] < maxshh[0]) + { + for (int i = 0; i < 3; i++) + XXh[i] = XXhh[i]; + maxsh[0] = maxshh[0]; + } + Pp = Pp->next; + } + + if (levh == GH->levels - 1) + { + for (int i = 0; i < 3; i++) + XX[i] = XXh[i]; + maxs[0] = maxsh[0]; + } + else if (maxs[0] < maxsh[0]) + { + bool fg = true; + Pp = GH->PatL[levh + 1]; + + while (Pp && fg) + { + if (Pp->data->Find_Point(XXh)) + fg = false; // we only take finner level + Pp = Pp->next; + } + if (fg) + { + for (int i = 0; i < 3; i++) + XX[i] = XXh[i]; + maxs[0] = maxsh[0]; + } + } + } + +#ifdef WithShell + SH->Find_Maximum(DG_List, XXh, maxsh); + + if (maxs[0] < maxsh[0]) + { + bool fg = true; + MyList *Pp = GH->PatL[0]; + + while (Pp && fg) + { + if (Pp->data->Find_Point(XXh)) + fg = false; + Pp = Pp->next; + } + if (fg) + { + for (int i = 0; i < 3; i++) + XX[i] = XXh[i]; + maxs[0] = maxsh[0]; + } + } +#endif + + double RD[4]; + for (int i = 0; i < 3; i++) + RD[i] = XX[i]; + RD[3] = maxs[0]; + MaxScalar_Monitor->writefile(PhysTime, 4, RD); + + DG_List->clearList(); + } + + AnalysisStuff(lev, dT_lev); // LastAnas need and only need control here + + LastAnas = 0; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function interpolates constraint data + +//================================================================================================ + +void bssnEScalar_class::Interp_Constraint() +{ + // we do not support a_lev != 0 yet. + if (a_lev > 0) + return; + + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (lev > 0) + f_compute_rhs_bssn_escalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + f_compute_constraint_fr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Cons_fR->sgfn]); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + // ShellPatch part + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_compute_constraint_fr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Cons_fR->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + + SH->Synch(ConstraintList, Symmetry); +#endif + // interpolate + double *x1, *y1, *z1; + const int n = 1000; + double lmax, lmin, dd; + lmin = 0; +#ifdef WithShell + lmax = SH->Rrange[1]; +#else + lmax = GH->bbox[0][0][4]; +#endif +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (lmax - lmin) / (n - 1); +#else +#ifdef Cell + dd = (lmax - lmin) / n; +#else +#error Not define Vertex nor Cell +#endif +#endif + x1 = new double[n]; + y1 = new double[n]; + z1 = new double[n]; + for (int i = 0; i < n; i++) + { + x1[i] = 0; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y1[i] = lmin + i * dd; +#else +#ifdef Cell + y1[i] = lmin + (i + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + z1[i] = 0; + } + + int InList = 0; + + MyList *varl = ConstraintList; + while (varl) + { + InList++; + varl = varl->next; + } + double *shellf; + shellf = new double[n * InList]; + for (int i = 0; i < n; i++) + { + double XX[3]; + XX[0] = x1[i]; + XX[1] = y1[i]; + XX[2] = z1[i]; + bool fg = GH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#ifdef WithShell + if (!fg) + fg = SH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#endif + if (!fg && myrank == 0) + { + cout << "bssn_class::Interp_Constraint meets wrong" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + ofstream outfile; + char filename[50]; + sprintf(filename, "%s/interp_constraint_%05d.dat", ErrorMonitor->out_dir.c_str(), int(PhysTime / dT + 0.5)); + // 0.5 for round off + + outfile.open(filename); + outfile << "# corrdinate, H_Res, Px_Res, Py_Res, Pz_Res, Gx_Res, Gy_Res, Gz_Res, fR_Res, ...." << endl; + for (int i = 0; i < n; i++) + { + outfile << setw(10) << setprecision(10) << y1[i]; + for (int j = 0; j < InList; j++) + outfile << " " << setw(16) << setprecision(15) << shellf[InList * i + j]; + outfile << endl; + } + + delete[] shellf; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes and outputs constraint violations + +//================================================================================================ + +void bssnEScalar_class::Constraint_Out() +{ + // Use the same variables as in the parent class here + // Otherwise the correct time will not be passed + LastConsOut += dT * pow(0.5, Mymax(0, trfls)); + + if (LastConsOut >= AnasTime) + // Constraint violation + { + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (lev > 0) + f_compute_rhs_bssn_escalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + f_compute_constraint_fr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Cons_fR->sgfn]); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + // ShellPatch part + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_compute_constraint_fr(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sphi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Cons_fR->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + + SH->Synch(ConstraintList, Symmetry); +#endif + + double ConV[8]; + +#ifdef WithShell + ConV[0] = SH->L2Norm(Cons_Ham); + ConV[1] = SH->L2Norm(Cons_Px); + ConV[2] = SH->L2Norm(Cons_Py); + ConV[3] = SH->L2Norm(Cons_Pz); + ConV[4] = SH->L2Norm(Cons_Gx); + ConV[5] = SH->L2Norm(Cons_Gy); + ConV[6] = SH->L2Norm(Cons_Gz); + ConV[7] = SH->L2Norm(Cons_fR); + ConVMonitor->writefile(PhysTime, 8, ConV); +#endif + for (int levi = 0; levi < GH->levels; levi++) + { + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz); + ConV[7] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_fR); + ConVMonitor->writefile(PhysTime, 8, ConV); + /* + if(fabs(ConV[0])<0.00001) + { + MyList * DG_List=new MyList(Cons_Ham); + DG_List->insert(Cons_Px); DG_List->insert(Cons_Py); DG_List->insert(Cons_Px); + DG_List->insert(Cons_Gx); DG_List->insert(Cons_Gy); DG_List->insert(Cons_Gx); + Parallel::Dump_Data(GH->PatL[levi],DG_List,"jiu",0,1); + DG_List->clearList(); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } + */ + } + + LastConsOut = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// Read scalar-tensor theory parameters +// Modified by Xiaoqu +// Read multiple values at once +// Original function read values one by one (tedious) + +//================================================================================================ + +extern "C" +{ + +#ifdef fortran1 + void set_escalar_parameter +#endif +#ifdef fortran2 + void SET_ESCALAR_PARAMETER +#endif +#ifdef fortran3 + void set_escalar_parameter_ +#endif + + (double &a2, double &phi0, double &r0, double &sigma0, double &l2) + { + + static bool file_status = true; + // Use a static boolean to avoid re-reading the parameter file + // This kind of variable appears to be shared; once read, other processes remember its state + // After reading the parameter file, `file_status` is automatically set to false + + static double aa2; + static double ll2; + static double pphi0; + static double rr0; + static double ssigma0; + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + // read parameter from file + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + + if (file_status) + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << " for inputing information of EScalar" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "FR" && skey == "a2") + aa2 = atof(sval.c_str()); + else if (sgrp == "FR" && skey == "l2") + ll2 = atof(sval.c_str()); + else if (sgrp == "FR" && skey == "phi0") + pphi0 = atof(sval.c_str()); + else if (sgrp == "FR" && skey == "r0") + rr0 = atof(sval.c_str()); + else if (sgrp == "FR" && skey == "sigma0") + ssigma0 = atof(sval.c_str()); + } + + inf.close(); // if not closed, it will fail when you try to open it next time. + + // After reading the parameter file, `file_status` is set to false + file_status = false; + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << endl; + cout << " you have set a2 = " << aa2 << endl; + cout << " you have set l2 = " << ll2 << endl; + cout << " you have set phi0 = " << pphi0 << endl; + cout << " you have set r0 = " << rr0 << endl; + cout << " you have set sigma0 = " << ssigma0 << endl; + cout << endl; + } + } + + a2 = aa2; + phi0 = pphi0; + r0 = rr0; + sigma0 = ssigma0; + l2 = ll2; + } +} + + +// Original function read values one by one (tedious) + +extern "C" +{ + +#ifdef fortran1 + void seta2 +#endif +#ifdef fortran2 + void SETA2 +#endif +#ifdef fortran3 + void + seta2_ +#endif + (double &a2) + { + static bool fga2 = true; + static double aa2; + + if (fga2) + { + char s[1000], *t; + FILE *fp; + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + fp = fopen(pname, "r"); + if (!fp) + { + cout << "could not open " << pname << " for reading a2" << endl; + } + while (fgets(s, 1000, fp)) + { + t = strstr(s, "FR::a2 "); + if (t == s) + { + sscanf(s + 8, "%lf", &aa2); + break; + } + } + + fclose(fp); // if not closed, it will fail when you try to open it next time. + fga2 = false; + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + printf("you have set a2 = %0.4lg\n", aa2); + } + } + + a2 = aa2; + } +} + +extern "C" +{ + +#ifdef fortran1 + void setphi0 +#endif +#ifdef fortran2 + void SETPHI0 +#endif +#ifdef fortran3 + void + setphi0_ +#endif + (double &phi0) + { + static bool fgphi0 = true; + static double pphi0; + + if (fgphi0) + { + char s[1000], *t; + FILE *fp; + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + fp = fopen(pname, "r"); + if (!fp) + { + cout << "could not open " << pname << " for reading phi0" << endl; + } + while (fgets(s, 1000, fp)) + { + t = strstr(s, "FR::phi0 "); + if (t == s) + { + sscanf(s + 10, "%lf", &pphi0); + break; + } + } + + fclose(fp); // if not closed, it will fail when you try to open it next time. + fgphi0 = false; + + int myrank = 0; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + printf("you have set phi0 = %0.4lg\n", pphi0); + } + } + + phi0 = pphi0; + } +} + +//================================================================================================ + diff --git a/AMSS_NCKU_source/bssnEScalar_class.h b/AMSS_NCKU_source/bssnEScalar_class.h new file mode 100644 index 0000000..3e26005 --- /dev/null +++ b/AMSS_NCKU_source/bssnEScalar_class.h @@ -0,0 +1,70 @@ + +#ifndef BSSNESCALAR_CLASS_H +#define BSSNESCALAR_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" +#include "surface_integral.h" + +#include "macrodef.h" + +#ifdef USE_GPU +#include "bssn_gpu_class.h" +#else +#include "bssn_class.h" +#endif + +class bssnEScalar_class : public bssn_class +{ +public: + bssnEScalar_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi); + ~bssnEScalar_class(); + + void Initialize(); + void Read_Ansorg(); + void Read_Pablo(); + void Compute_Psi4(int lev); + void Step(int lev, int YN); + void AnalysisStuff_EScalar(int lev, double dT_lev); + void Interp_Constraint(); + void Constraint_Out(); + +protected: + var *Sphio, *Spio; + var *Sphi0, *Spi0; + var *Sphi, *Spi; + var *Sphi1, *Spi1; + var *Sphi_rhs, *Spi_rhs; + + var *Cons_fR; + + monitor *MaxScalar_Monitor; +}; + +#endif /* BSSNESCALAR_CLASS_H */ + diff --git a/AMSS_NCKU_source/bssnEScalar_rhs.f90 b/AMSS_NCKU_source/bssnEScalar_rhs.f90 new file mode 100644 index 0000000..79327c7 --- /dev/null +++ b/AMSS_NCKU_source/bssnEScalar_rhs.f90 @@ -0,0 +1,2311 @@ + + +!! note that the potential for scalar field in F(R) gravity +!! is defined in the file Set_Rho_ADM.f90 + +#include "macrodef.fh" + +! rhs for scalar and GR variables +! here we consider vacuum spacetime only + function compute_rhs_bssn_escalar(ex, T,X, Y, Z, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + Sphi , Spi , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + Sphi_rhs , Spi_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,eps,co) result(gont) +! calculate constraint violation when co=0 + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,co + real*8, intent(in ):: T + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8,intent(in) :: eps + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO=0.d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + double precision,parameter::FF = 0.75d0,eta=2.d0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + real*8, parameter :: F16=1.6d1,F8=8.d0 + + integer :: i,j,k + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz) & + +sum(Sphi)+sum(Spi) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"bssn.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"bssn.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"bssn.f90: find NaN in dxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"bssn.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"bssn.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"bssn.f90: find NaN in dyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"bssn.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"bssn.f90: find NaN in dzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"bssn.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"bssn.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"bssn.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"bssn.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"bssn.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"bssn.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"bssn.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"bssn.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"bssn.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"bssn.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"bssn.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"bssn.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"bssn.f90: find NaN in betaz" + if(sum(Sphi).ne.sum(Sphi))write(*,*)"bssn.f90: find NaN in Sphi" + if(sum(Spi).ne.sum(Spi))write(*,*)"bssn.f90: find NaN in Spi" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs(ex,betax,betaxx,betaxy,betaxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ex,betay,betayx,betayy,betayz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ex,betaz,betazx,betazy,betazz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + + div_beta = betaxx + betayy + betazz + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + chi_rhs = F2o3 *chin1*( alpn1 * trK - div_beta ) !rhs for chi + + call fderivs(ex,Lap,Lapx,Lapy,Lapz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +#if 1 + Sphi_rhs = alpn1 * Spi !rhs for Scalar phi +!rhs for Spi + call fderivs(ex,Sphi,Kx,Ky,Kz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + Spi_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO - & + ((Gamx+(gupxx*chix+gupxy*chiy+gupxz*chiz)/TWO/chin1)*Kx & + + (Gamy+(gupxy*chix+gupyy*chiy+gupyz*chiz)/TWO/chin1)*Ky & + + (Gamz+(gupxz*chix+gupyz*chiy+gupzz*chiz)/TWO/chin1)*Kz) + Spi_rhs = Spi_rhs*alpn1 + & + (gupxx*Lapx*Kx + gupxy*Lapx*Ky + gupxz*Lapx*Kz& + +gupxy*Lapy*Kx + gupyy*Lapy*Ky + gupyz*Lapy*Kz& + +gupxz*Lapz*Kx + gupyz*Lapz*Ky + gupzz*Lapz*Kz) + + call frpotential(ex,Sphi,f,S) + Spi_rhs = Spi_rhs*chin1 + alpn1*(trK*Spi - S) +! matter content of scalar field T_ab + rho = chin1*((gupxx * Kx * Kx + gupyy * Ky * Ky + gupzz * Kz * Kz)/TWO + & + gupxy * Kx * Ky + gupxz * Kx * Kz + gupyz * Ky * Kz ) & + + Spi*Spi/TWO+f + Sx = -Spi*Kx + Sy = -Spi*Ky + Sz = -Spi*Kz + f = (rho - Spi*Spi)/chin1 + Sxx = Kx*Kx-f*gxx + Sxy = Kx*Ky-f*gxy + Sxz = Kx*Kz-f*gxz + Syy = Ky*Ky-f*gyy + Syz = Ky*Kz-f*gyz + Szz = Kz*Kz-f*gzz +#else + rho = ZEO + Sx = ZEO + Sy = ZEO + Sz = ZEO + Sxx = ZEO + Sxy = ZEO + Sxz = ZEO + Syy = ZEO + Syz = ZEO + Szz = ZEO +#endif + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,Lev) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,Lev) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + if(co == 0)then +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gamx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gamy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gamz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + endif + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... + call fderivs(ex,trK,Kx,Ky,Kz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,& + X,Y,Z,ANTI,SYM, SYM ,Symmetry,Lev) + call fdderivs(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,& + X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fdderivs(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,& + X,Y,Z,SYM ,SYM, ANTI,Symmetry,Lev) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs(ex,Gamx,Gamxx,Gamxy,Gamxz,X,Y,Z,ANTI,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,Gamy,Gamyx,Gamyy,Gamyz,X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,Gamz,Gamzx,Gamzy,Gamzz,X,Y,Z,SYM ,SYM ,ANTI,Symmetry,Lev) + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI, ANTI,SYM ,symmetry,Lev) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI ,SYM ,ANTI,symmetry,Lev) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,ANTI ,ANTI,symmetry,Lev) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + +! now prepare to get physical second kind of connection + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + +! covariant second derivatives of the lapse respect to physical metric + call fdderivs(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM,SYM,SYM,symmetry,Lev) + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! mater content only appears in the right hand side of trK and A_ij which are +! comming now +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +! Add lapse and S_ij parts to Ricci tensor: + + fxx = alpn1 * (Rxx - EIGHT * PI * Sxx) - fxx + fxy = alpn1 * (Rxy - EIGHT * PI * Sxy) - fxy + fxz = alpn1 * (Rxz - EIGHT * PI * Sxz) - fxz + fyy = alpn1 * (Ryy - EIGHT * PI * Syy) - fyy + fyz = alpn1 * (Ryz - EIGHT * PI * Syz) - fyz + fzz = alpn1 * (Rzz - EIGHT * PI * Szz) - fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + + f = F1o3 *( gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) ) + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trK * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx )- & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trK * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy )- & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trK * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz )- & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trK * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trK * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trK * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trK * trK + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!! gauge variable part + + Lap_rhs = -TWO*alpn1*trK + + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part + + call lopsided(ex,X,Y,Z,gxx,gxx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gxy,gxy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,gxz,gxz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,gyy,gyy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gyz,gyz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,gzz,gzz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Axx,Axx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Axy,Axy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,Axz,Axz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,Ayy,Ayy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Ayz,Ayz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,Azz,Azz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,chi,chi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,trK,trK_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Gamx,Gamx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,Gamy,Gamy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,Gamz,Gamz_rhs,betax,betay,betaz,Symmetry,SSA) +!! + call lopsided(ex,X,Y,Z,Lap,Lap_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,betax,betax_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,betay,betay_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,betaz,betaz_rhs,betax,betay,betaz,Symmetry,SSA) + + call lopsided(ex,X,Y,Z,dtSfx,dtSfx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,dtSfy,dtSfy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,dtSfz,dtSfz_rhs,betax,betay,betaz,Symmetry,SSA) +#if 1 +!! + call lopsided(ex,X,Y,Z,Sphi,Sphi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Spi , Spi_rhs,betax,betay,betaz,Symmetry,SSS) +#endif + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis(ex,X,Y,Z,chi,chi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,trK,trK_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,dxx,gxx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxy,gxy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxz,gxz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,dyy,gyy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gyz,gyz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,dzz,gzz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axx,Axx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axy,Axy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axz,Axz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayy,Ayy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayz,Ayz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,Azz,Azz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamx,Gamx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamy,Gamy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamz,Gamz_rhs,SSA,Symmetry,eps) + + call kodis(ex,X,Y,Z,Lap,Lap_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,betax,betax_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,betay,betay_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,betaz,betaz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfx,dtSfx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfy,dtSfy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfz,dtSfz_rhs,SSA,Symmetry,eps) + +#if 1 + call kodis(ex,X,Y,Z,Sphi,Sphi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Spi ,Spi_rhs ,SSS,Symmetry,eps) +#endif + endif + +#if 0 + Sphi_rhs = ZEO + Spi_rhs = ZEO +#endif + + if(co == 0)then +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + call fderivs(ex,Axx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Axz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Ayy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Ayz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Azz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +movx_Res = movx_Res - F2o3*Kx - F8*PI*sx +movy_Res = movy_Res - F2o3*Ky - F8*PI*sy +movz_Res = movz_Res - F2o3*Kz - F8*PI*sz + endif + + gont = 0 + + return + + end function compute_rhs_bssn_escalar +!! for shell part + function compute_rhs_bssn_escalar_ss(ex, T,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + Sphi , Spi , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + Sphi_rhs , Spi_rhs , & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,eps,sst,co) result(gont) +! calculate constraint violation when co=0 + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,co + real*8, intent(in ):: T + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8,intent(in) :: eps + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO=0.d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + double precision,parameter::FF = 0.75d0,eta=2.d0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + real*8, parameter :: F16=1.6d1,F8=8.d0 + + integer :: i,j,k + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz) & + +sum(Sphi)+sum(Spi) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"bssn.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"bssn.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"bssn.f90: find NaN in dxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"bssn.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"bssn.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"bssn.f90: find NaN in dyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"bssn.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"bssn.f90: find NaN in dzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"bssn.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"bssn.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"bssn.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"bssn.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"bssn.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"bssn.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"bssn.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"bssn.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"bssn.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"bssn.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"bssn.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"bssn.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"bssn.f90: find NaN in betaz" + if(sum(Sphi).ne.sum(Sphi))write(*,*)"bssn.f90: find NaN in Sphi" + if(sum(Spi).ne.sum(Spi))write(*,*)"bssn.f90: find NaN in Spi" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = crho(2) - crho(1) + dY = sigma(2) - sigma(1) + dZ = R(2) - R(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs_shc(ex,betax,betaxx,betaxy,betaxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,betay,betayx,betayy,betayz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,betaz,betazx,betazy,betazz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + div_beta = betaxx + betayy + betazz + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + chi_rhs = F2o3 *chin1*( alpn1 * trK - div_beta ) !rhs for chi + + call fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +#if 1 + Sphi_rhs = alpn1 * Spi !rhs for Scalar phi +!rhs for Spi + call fderivs_shc(ex,Sphi,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fdderivs_shc(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Spi_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO - & + ((Gamx+(gupxx*chix+gupxy*chiy+gupxz*chiz)/TWO/chin1)*Kx & + + (Gamy+(gupxy*chix+gupyy*chiy+gupyz*chiz)/TWO/chin1)*Ky & + + (Gamz+(gupxz*chix+gupyz*chiy+gupzz*chiz)/TWO/chin1)*Kz) + Spi_rhs = Spi_rhs*alpn1 + & + (gupxx*Lapx*Kx + gupxy*Lapx*Ky + gupxz*Lapx*Kz& + +gupxy*Lapy*Kx + gupyy*Lapy*Ky + gupyz*Lapy*Kz& + +gupxz*Lapz*Kx + gupyz*Lapz*Ky + gupzz*Lapz*Kz) + + call frpotential(ex,Sphi,f,S) + Spi_rhs = Spi_rhs*chin1 + alpn1*(trK*Spi - S) +! matter content of scalar field T_ab + rho = chin1*((gupxx * Kx * Kx + gupyy * Ky * Ky + gupzz * Kz * Kz)/TWO + & + gupxy * Kx * Ky + gupxz * Kx * Kz + gupyz * Ky * Kz ) & + + Spi*Spi/TWO+f + Sx = -Spi*Kx + Sy = -Spi*Ky + Sz = -Spi*Kz + f = (rho - Spi*Spi)/chin1 + Sxx = Kx*Kx-f*gxx + Sxy = Kx*Ky-f*gxy + Sxz = Kx*Kz-f*gxz + Syy = Ky*Ky-f*gyy + Syz = Ky*Kz-f*gyz + Szz = Kz*Kz-f*gzz +#else + rho = ZEO + Sx = ZEO + Sy = ZEO + Sz = ZEO + Sxx = ZEO + Sxy = ZEO + Sxz = ZEO + Syy = ZEO + Syz = ZEO + Szz = ZEO +#endif + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + if(co == 0)then +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gamx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gamy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gamz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + endif + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... + call fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs_shc(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs_shc(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs_shc(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + +! now prepare to get physical second kind of connection + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + +! covariant second derivatives of the lapse respect to physical metric + call fdderivs_shc(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! mater content only appears in the right hand side of trK and A_ij which are +! comming now +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +! Add lapse and S_ij parts to Ricci tensor: + + fxx = alpn1 * (Rxx - EIGHT * PI * Sxx) - fxx + fxy = alpn1 * (Rxy - EIGHT * PI * Sxy) - fxy + fxz = alpn1 * (Rxz - EIGHT * PI * Sxz) - fxz + fyy = alpn1 * (Ryy - EIGHT * PI * Syy) - fyy + fyz = alpn1 * (Ryz - EIGHT * PI * Syz) - fyz + fzz = alpn1 * (Rzz - EIGHT * PI * Szz) - fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + + f = F1o3 *( gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) ) + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trK * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx )- & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trK * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy )- & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trK * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz )- & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trK * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trK * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trK * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trK * trK + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!! gauge variable part + + Lap_rhs = -TWO*alpn1*trK + + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part +!g_ij + call fderivs_shc(ex,dxx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxx_rhs = gxx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxy_rhs = gxy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxz_rhs = gxz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dyy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyy_rhs = gyy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gyz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyz_rhs = gyz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dzz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gzz_rhs = gzz_rhs + betax*fxx+betay*fxy+betaz*fxz +!A_ij + call fderivs_shc(ex,Axx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axx_rhs = Axx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axy_rhs = Axy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axz_rhs = Axz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayy_rhs = Ayy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayz_rhs = Ayz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Azz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Azz_rhs = Azz_rhs + betax*fxx+betay*fxy+betaz*fxz +!chi and trK + call fderivs_shc(ex,chi,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + chi_rhs = chi_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,trK,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + trK_rhs = trK_rhs + betax*fxx+betay*fxy+betaz*fxz +!Gam^i + call fderivs_shc(ex,Gamx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamx_rhs = Gamx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamy_rhs = Gamy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamz_rhs = Gamz_rhs + betax*fxx+betay*fxy+betaz*fxz +!gauge variables + call fderivs_shc(ex,Lap,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Lap_rhs = Lap_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betax,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betax_rhs = betax_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betay,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betay_rhs = betay_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betaz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betaz_rhs = betaz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfx_rhs = dtSfx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfy_rhs = dtSfy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfz_rhs = dtSfz_rhs + betax*fxx+betay*fxy+betaz*fxz +#if 1 +!! + call fderivs_shc(ex,Sphi,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Sphi_rhs = Sphi_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Spi,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Spi_rhs = Spi_rhs + betax*fxx+betay*fxy+betaz*fxz +#endif + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis(ex,X,Y,Z,chi,chi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,trK,trK_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,dxx,gxx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxy,gxy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxz,gxz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,dyy,gyy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gyz,gyz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,dzz,gzz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axx,Axx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axy,Axy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axz,Axz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayy,Ayy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayz,Ayz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,Azz,Azz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamx,Gamx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamy,Gamy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamz,Gamz_rhs,SSA,Symmetry,eps) + + call kodis(ex,X,Y,Z,Lap,Lap_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,betax,betax_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,betay,betay_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,betaz,betaz_rhs,SSA,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfx,dtSfx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfy,dtSfy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfz,dtSfz_rhs,SSA,Symmetry,eps) + +#if 1 + call kodis(ex,X,Y,Z,Sphi,Sphi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Spi ,Spi_rhs ,SSS,Symmetry,eps) +#endif + endif + +#if 0 + Sphi_rhs = ZEO + Spi_rhs = ZEO +#endif + + if(co == 0)then +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + + call fderivs_shc(ex,Axx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +movx_Res = movx_Res - F2o3*Kx - F8*PI*sx +movy_Res = movy_Res - F2o3*Ky - F8*PI*sy +movz_Res = movz_Res - F2o3*Kz - F8*PI*sz + endif + + gont = 0 + + return + + end function compute_rhs_bssn_escalar_ss +!----------------------------------------------------------------------------- +! +! compute constraint introduced by dynamical equation reduction of fR +! this routine is valid for both box and shell +! +!----------------------------------------------------------------------------- + + subroutine compute_constraint_fr(ex, X, Y, Z, & + chi, trK, rho, Sphi,& + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Sxx,Sxy,Sxz,Syy,Syz,Szz,& + Cons_fr) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,rho,Sphi +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! matter + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: Sxx,Sxy,Sxz,Syy,Syz,Szz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Cons_fr + +! 4D Ricci scalar + real*8, dimension(ex(1),ex(2),ex(3)) :: RR + real*8,parameter :: ONE=1.d0,THR=3.d0,FOU=4.d0 + real*8 :: PI + + PI = dacos(-ONE) + + call get4ricciscalar(ex, X, Y, Z, & + chi, trK, rho, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Sxx,Sxy,Sxz,Syy,Syz,Szz,& + RR) + call frfprim(ex,RR,Cons_fr) + + Cons_fr = Sphi-dsqrt(THR/PI)/FOU*dlog(Cons_fr) + + return + + end subroutine compute_constraint_fr diff --git a/AMSS_NCKU_source/bssn_class.C b/AMSS_NCKU_source/bssn_class.C new file mode 100644 index 0000000..fc6c88e --- /dev/null +++ b/AMSS_NCKU_source/bssn_class.C @@ -0,0 +1,8463 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "Ansorg.h" +#include "fmisc.h" +#include "Parallel.h" +#include "bssn_class.h" +#include "bssn_rhs.h" +#include "initial_puncture.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "getnp4.h" +#include "shellfunctions.h" +#include "parameters.h" + +#ifdef With_AHF +#include "derivatives.h" +#include "myglobal.h" +#endif + +#include "perf.h" + +#include "derivatives.h" +#include "ricci_gamma.h" + +//================================================================================================ + +// define bssn_class + +//================================================================================================ + +bssn_class::bssn_class(double Couranti, double StartTimei, double TotalTimei, + double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, + double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi) + : Courant(Couranti), StartTime(StartTimei), TotalTime(TotalTimei), + DumpTime(DumpTimei), d2DumpTime(d2DumpTimei), CheckTime(CheckTimei), AnasTime(AnasTimei), + Symmetry(Symmetryi), checkrun(checkruni), numepss(numepssi), numepsb(numepsbi), numepsh(numepshi), +#ifdef With_AHF + xc(0), yc(0), zc(0), xr(0), yr(0), zr(0), trigger(0), dTT(0), dumpid(0), +#endif + a_lev(a_levi), maxl(maxli), decn(decni), maxrex(maxrexi), drex(drexi), + CheckPoint(0) + // CheckPoint(0) +{ + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + // setup Monitors + { + stringstream a_stream; + a_stream.setf(ios::left); + a_stream << "# Error log information"; + ErrorMonitor = new monitor("Error.log", myrank, a_stream.str()); + ErrorMonitor->print_message("Warning: we always assume intput parameter in cell center style."); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + char str[50]; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + Psi4Monitor = new monitor("bssn_psi4.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + BHMonitor = new monitor("bssn_BH.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time ADMmass ADMPx ADMPy ADMPz ADMSx ADMSy ADMSz"; + MAPMonitor = new monitor("bssn_ADMQs.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time Ham Px Py Pz Gx Gy Gz"; + ConVMonitor = new monitor("bssn_constraint.dat", myrank, a_stream.str()); + } + // setup sphere integration engine + Waveshell = new surface_integral(Symmetry); + + trfls = 0; + chitiny = 0; + // read parameter from file + { + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "chitiny") + chitiny = atof(sval.c_str()); + else if (sgrp == "BSSN" && skey == "time refinement start from level") + trfls = atoi(sval.c_str()); +#ifdef With_AHF + else if (sgrp == "AHF" && skey == "AHfindevery") + AHfindevery = atoi(sval.c_str()); + else if (sgrp == "AHF" && skey == "AHdumptime") + AHdumptime = atof(sval.c_str()); +#endif + } + inf.close(); + } + if (myrank == 0) + { + // echo information of lower bound of chi + cout << " chitiny = " << chitiny << endl; + cout << " time refinement start from level #" << trfls << endl; +#ifdef With_AHF + cout << " parameters for AHF:" << endl; + cout << " AHfindevery = " << AHfindevery << endl; + cout << " AHdumptime = " << AHdumptime << endl; +#endif + } + + chitiny = chitiny - 1; // because we have subtracted one from chi + + strcpy(checkfilename, checkfilenamei); + + ngfs = 0; + phio = new var("phio", ngfs++, 1, 1, 1); + trKo = new var("trKo", ngfs++, 1, 1, 1); + gxxo = new var("gxxo", ngfs++, 1, 1, 1); + gxyo = new var("gxyo", ngfs++, -1, -1, 1); + gxzo = new var("gxzo", ngfs++, -1, 1, -1); + gyyo = new var("gyyo", ngfs++, 1, 1, 1); + gyzo = new var("gyzo", ngfs++, 1, -1, -1); + gzzo = new var("gzzo", ngfs++, 1, 1, 1); + Axxo = new var("Axxo", ngfs++, 1, 1, 1); + Axyo = new var("Axyo", ngfs++, -1, -1, 1); + Axzo = new var("Axzo", ngfs++, -1, 1, -1); + Ayyo = new var("Ayyo", ngfs++, 1, 1, 1); + Ayzo = new var("Ayzo", ngfs++, 1, -1, -1); + Azzo = new var("Azzo", ngfs++, 1, 1, 1); + Gmxo = new var("Gmxo", ngfs++, -1, 1, 1); + Gmyo = new var("Gmyo", ngfs++, 1, -1, 1); + Gmzo = new var("Gmzo", ngfs++, 1, 1, -1); + Lapo = new var("Lapo", ngfs++, 1, 1, 1); + Sfxo = new var("Sfxo", ngfs++, -1, 1, 1); + Sfyo = new var("Sfyo", ngfs++, 1, -1, 1); + Sfzo = new var("Sfzo", ngfs++, 1, 1, -1); + dtSfxo = new var("dtSfxo", ngfs++, -1, 1, 1); + dtSfyo = new var("dtSfyo", ngfs++, 1, -1, 1); + dtSfzo = new var("dtSfzo", ngfs++, 1, 1, -1); + + phi0 = new var("phi0", ngfs++, 1, 1, 1); + trK0 = new var("trK0", ngfs++, 1, 1, 1); + gxx0 = new var("gxx0", ngfs++, 1, 1, 1); + gxy0 = new var("gxy0", ngfs++, -1, -1, 1); + gxz0 = new var("gxz0", ngfs++, -1, 1, -1); + gyy0 = new var("gyy0", ngfs++, 1, 1, 1); + gyz0 = new var("gyz0", ngfs++, 1, -1, -1); + gzz0 = new var("gzz0", ngfs++, 1, 1, 1); + Axx0 = new var("Axx0", ngfs++, 1, 1, 1); + Axy0 = new var("Axy0", ngfs++, -1, -1, 1); + Axz0 = new var("Axz0", ngfs++, -1, 1, -1); + Ayy0 = new var("Ayy0", ngfs++, 1, 1, 1); + Ayz0 = new var("Ayz0", ngfs++, 1, -1, -1); + Azz0 = new var("Azz0", ngfs++, 1, 1, 1); + Gmx0 = new var("Gmx0", ngfs++, -1, 1, 1); + Gmy0 = new var("Gmy0", ngfs++, 1, -1, 1); + Gmz0 = new var("Gmz0", ngfs++, 1, 1, -1); + Lap0 = new var("Lap0", ngfs++, 1, 1, 1); + Sfx0 = new var("Sfx0", ngfs++, -1, 1, 1); + Sfy0 = new var("Sfy0", ngfs++, 1, -1, 1); + Sfz0 = new var("Sfz0", ngfs++, 1, 1, -1); + dtSfx0 = new var("dtSfx0", ngfs++, -1, 1, 1); + dtSfy0 = new var("dtSfy0", ngfs++, 1, -1, 1); + dtSfz0 = new var("dtSfz0", ngfs++, 1, 1, -1); + + phi = new var("phi", ngfs++, 1, 1, 1); + trK = new var("trK", ngfs++, 1, 1, 1); + gxx = new var("gxx", ngfs++, 1, 1, 1); + gxy = new var("gxy", ngfs++, -1, -1, 1); + gxz = new var("gxz", ngfs++, -1, 1, -1); + gyy = new var("gyy", ngfs++, 1, 1, 1); + gyz = new var("gyz", ngfs++, 1, -1, -1); + gzz = new var("gzz", ngfs++, 1, 1, 1); + Axx = new var("Axx", ngfs++, 1, 1, 1); + Axy = new var("Axy", ngfs++, -1, -1, 1); + Axz = new var("Axz", ngfs++, -1, 1, -1); + Ayy = new var("Ayy", ngfs++, 1, 1, 1); + Ayz = new var("Ayz", ngfs++, 1, -1, -1); + Azz = new var("Azz", ngfs++, 1, 1, 1); + Gmx = new var("Gmx", ngfs++, -1, 1, 1); + Gmy = new var("Gmy", ngfs++, 1, -1, 1); + Gmz = new var("Gmz", ngfs++, 1, 1, -1); + Lap = new var("Lap", ngfs++, 1, 1, 1); + Sfx = new var("Sfx", ngfs++, -1, 1, 1); + Sfy = new var("Sfy", ngfs++, 1, -1, 1); + Sfz = new var("Sfz", ngfs++, 1, 1, -1); + dtSfx = new var("dtSfx", ngfs++, -1, 1, 1); + dtSfy = new var("dtSfy", ngfs++, 1, -1, 1); + dtSfz = new var("dtSfz", ngfs++, 1, 1, -1); + + phi1 = new var("phi1", ngfs++, 1, 1, 1); + trK1 = new var("trK1", ngfs++, 1, 1, 1); + gxx1 = new var("gxx1", ngfs++, 1, 1, 1); + gxy1 = new var("gxy1", ngfs++, -1, -1, 1); + gxz1 = new var("gxz1", ngfs++, -1, 1, -1); + gyy1 = new var("gyy1", ngfs++, 1, 1, 1); + gyz1 = new var("gyz1", ngfs++, 1, -1, -1); + gzz1 = new var("gzz1", ngfs++, 1, 1, 1); + Axx1 = new var("Axx1", ngfs++, 1, 1, 1); + Axy1 = new var("Axy1", ngfs++, -1, -1, 1); + Axz1 = new var("Axz1", ngfs++, -1, 1, -1); + Ayy1 = new var("Ayy1", ngfs++, 1, 1, 1); + Ayz1 = new var("Ayz1", ngfs++, 1, -1, -1); + Azz1 = new var("Azz1", ngfs++, 1, 1, 1); + Gmx1 = new var("Gmx1", ngfs++, -1, 1, 1); + Gmy1 = new var("Gmy1", ngfs++, 1, -1, 1); + Gmz1 = new var("Gmz1", ngfs++, 1, 1, -1); + Lap1 = new var("Lap1", ngfs++, 1, 1, 1); + Sfx1 = new var("Sfx1", ngfs++, -1, 1, 1); + Sfy1 = new var("Sfy1", ngfs++, 1, -1, 1); + Sfz1 = new var("Sfz1", ngfs++, 1, 1, -1); + dtSfx1 = new var("dtSfx1", ngfs++, -1, 1, 1); + dtSfy1 = new var("dtSfy1", ngfs++, 1, -1, 1); + dtSfz1 = new var("dtSfz1", ngfs++, 1, 1, -1); + + phi_rhs = new var("phi_rhs", ngfs++, 1, 1, 1); + trK_rhs = new var("trK_rhs", ngfs++, 1, 1, 1); + gxx_rhs = new var("gxx_rhs", ngfs++, 1, 1, 1); + gxy_rhs = new var("gxy_rhs", ngfs++, -1, -1, 1); + gxz_rhs = new var("gxz_rhs", ngfs++, -1, 1, -1); + gyy_rhs = new var("gyy_rhs", ngfs++, 1, 1, 1); + gyz_rhs = new var("gyz_rhs", ngfs++, 1, -1, -1); + gzz_rhs = new var("gzz_rhs", ngfs++, 1, 1, 1); + Axx_rhs = new var("Axx_rhs", ngfs++, 1, 1, 1); + Axy_rhs = new var("Axy_rhs", ngfs++, -1, -1, 1); + Axz_rhs = new var("Axz_rhs", ngfs++, -1, 1, -1); + Ayy_rhs = new var("Ayy_rhs", ngfs++, 1, 1, 1); + Ayz_rhs = new var("Ayz_rhs", ngfs++, 1, -1, -1); + Azz_rhs = new var("Azz_rhs", ngfs++, 1, 1, 1); + Gmx_rhs = new var("Gmx_rhs", ngfs++, -1, 1, 1); + Gmy_rhs = new var("Gmy_rhs", ngfs++, 1, -1, 1); + Gmz_rhs = new var("Gmz_rhs", ngfs++, 1, 1, -1); + Lap_rhs = new var("Lap_rhs", ngfs++, 1, 1, 1); + Sfx_rhs = new var("Sfx_rhs", ngfs++, -1, 1, 1); + Sfy_rhs = new var("Sfy_rhs", ngfs++, 1, -1, 1); + Sfz_rhs = new var("Sfz_rhs", ngfs++, 1, 1, -1); + dtSfx_rhs = new var("dtSfx_rhs", ngfs++, -1, 1, 1); + dtSfy_rhs = new var("dtSfy_rhs", ngfs++, 1, -1, 1); + dtSfz_rhs = new var("dtSfz_rhs", ngfs++, 1, 1, -1); + + rho = new var("rho", ngfs++, 1, 1, 1); + Sx = new var("Sx", ngfs++, -1, 1, 1); + Sy = new var("Sy", ngfs++, 1, -1, 1); + Sz = new var("Sz", ngfs++, 1, 1, -1); + Sxx = new var("Sxx", ngfs++, 1, 1, 1); + Sxy = new var("Sxy", ngfs++, -1, -1, 1); + Sxz = new var("Sxz", ngfs++, -1, 1, -1); + Syy = new var("Syy", ngfs++, 1, 1, 1); + Syz = new var("Syz", ngfs++, 1, -1, -1); + Szz = new var("Szz", ngfs++, 1, 1, 1); + + Gamxxx = new var("Gamxxx", ngfs++, -1, 1, 1); + Gamxxy = new var("Gamxxy", ngfs++, 1, -1, 1); + Gamxxz = new var("Gamxxz", ngfs++, 1, 1, -1); + Gamxyy = new var("Gamxyy", ngfs++, -1, 1, 1); + Gamxyz = new var("Gamxyz", ngfs++, -1, -1, -1); + Gamxzz = new var("Gamxzz", ngfs++, -1, 1, 1); + Gamyxx = new var("Gamyxx", ngfs++, 1, -1, 1); + Gamyxy = new var("Gamyxy", ngfs++, -1, 1, 1); + Gamyxz = new var("Gamyxz", ngfs++, -1, -1, -1); + Gamyyy = new var("Gamyyy", ngfs++, 1, -1, 1); + Gamyyz = new var("Gamyyz", ngfs++, 1, 1, -1); + Gamyzz = new var("Gamyzz", ngfs++, 1, -1, 1); + Gamzxx = new var("Gamzxx", ngfs++, 1, 1, -1); + Gamzxy = new var("Gamzxy", ngfs++, -1, -1, -1); + Gamzxz = new var("Gamzxz", ngfs++, -1, 1, 1); + Gamzyy = new var("Gamzyy", ngfs++, 1, 1, -1); + Gamzyz = new var("Gamzyz", ngfs++, 1, -1, 1); + Gamzzz = new var("Gamzzz", ngfs++, 1, 1, -1); + + Rxx = new var("Rxx", ngfs++, 1, 1, 1); + Rxy = new var("Rxy", ngfs++, -1, -1, 1); + Rxz = new var("Rxz", ngfs++, -1, 1, -1); + Ryy = new var("Ryy", ngfs++, 1, 1, 1); + Ryz = new var("Ryz", ngfs++, 1, -1, -1); + Rzz = new var("Rzz", ngfs++, 1, 1, 1); + + // refer to PRD, 77, 024027 (2008) + Rpsi4 = new var("Rpsi4", ngfs++, 1, 1, 1); + Ipsi4 = new var("Ipsi4", ngfs++, -1, -1, -1); + t1Rpsi4 = new var("t1Rpsi4", ngfs++, 1, 1, 1); + t1Ipsi4 = new var("t1Ipsi4", ngfs++, -1, -1, -1); + t2Rpsi4 = new var("t2Rpsi4", ngfs++, 1, 1, 1); + t2Ipsi4 = new var("t2Ipsi4", ngfs++, -1, -1, -1); + + // constraint violation monitor variables + Cons_Ham = new var("Cons_Ham", ngfs++, 1, 1, 1); + Cons_Px = new var("Cons_Px", ngfs++, -1, 1, 1); + Cons_Py = new var("Cons_Py", ngfs++, 1, -1, 1); + Cons_Pz = new var("Cons_Pz", ngfs++, 1, 1, -1); + Cons_Gx = new var("Cons_Gx", ngfs++, -1, 1, 1); + Cons_Gy = new var("Cons_Gy", ngfs++, 1, -1, 1); + Cons_Gz = new var("Cons_Gz", ngfs++, 1, 1, -1); + +#ifdef Point_Psi4 + phix = new var("phix", ngfs++, -1, 1, 1); + phiy = new var("phiy", ngfs++, 1, -1, 1); + phiz = new var("phiz", ngfs++, 1, 1, -1); + trKx = new var("trKx", ngfs++, -1, 1, 1); + trKy = new var("trKy", ngfs++, 1, -1, 1); + trKz = new var("trKz", ngfs++, 1, 1, -1); + Axxx = new var("Axxx", ngfs++, -1, 1, 1); + Axxy = new var("Axxy", ngfs++, 1, -1, 1); + Axxz = new var("Axxz", ngfs++, 1, 1, -1); + Axyx = new var("Axyx", ngfs++, 1, -1, 1); + Axyy = new var("Axyy", ngfs++, -1, 1, 1); + Axyz = new var("Axyz", ngfs++, -1, -1, -1); + Axzx = new var("Axzx", ngfs++, 1, 1, -1); + Axzy = new var("Axzy", ngfs++, -1, -1, -1); + Axzz = new var("Axzz", ngfs++, -1, 1, 1); + Ayyx = new var("Ayyx", ngfs++, -1, 1, 1); + Ayyy = new var("Ayyy", ngfs++, 1, -1, 1); + Ayyz = new var("Ayyz", ngfs++, 1, 1, -1); + Ayzx = new var("Ayzx", ngfs++, -1, -1, -1); + Ayzy = new var("Ayzy", ngfs++, 1, 1, -1); + Ayzz = new var("Ayzz", ngfs++, 1, -1, 1); + Azzx = new var("Azzx", ngfs++, -1, 1, 1); + Azzy = new var("Azzy", ngfs++, 1, -1, 1); + Azzz = new var("Azzz", ngfs++, 1, 1, -1); +#endif + + // specific properspeed for 1+log slice + { + const double vl = sqrt(2); + trKo->setpropspeed(vl); + trK0->setpropspeed(vl); + trK->setpropspeed(vl); + trK1->setpropspeed(vl); + trK_rhs->setpropspeed(vl); + + phio->setpropspeed(vl); + phi0->setpropspeed(vl); + phi->setpropspeed(vl); + phi1->setpropspeed(vl); + phi_rhs->setpropspeed(vl); + + Lapo->setpropspeed(vl); + Lap0->setpropspeed(vl); + Lap->setpropspeed(vl); + Lap1->setpropspeed(vl); + Lap_rhs->setpropspeed(vl); + } + + OldStateList = new MyList(phio); + OldStateList->insert(trKo); + OldStateList->insert(gxxo); + OldStateList->insert(gxyo); + OldStateList->insert(gxzo); + OldStateList->insert(gyyo); + OldStateList->insert(gyzo); + OldStateList->insert(gzzo); + OldStateList->insert(Axxo); + OldStateList->insert(Axyo); + OldStateList->insert(Axzo); + OldStateList->insert(Ayyo); + OldStateList->insert(Ayzo); + OldStateList->insert(Azzo); + OldStateList->insert(Gmxo); + OldStateList->insert(Gmyo); + OldStateList->insert(Gmzo); + OldStateList->insert(Lapo); + OldStateList->insert(Sfxo); + OldStateList->insert(Sfyo); + OldStateList->insert(Sfzo); + OldStateList->insert(dtSfxo); + OldStateList->insert(dtSfyo); + OldStateList->insert(dtSfzo); + + StateList = new MyList(phi0); + StateList->insert(trK0); + StateList->insert(gxx0); + StateList->insert(gxy0); + StateList->insert(gxz0); + StateList->insert(gyy0); + StateList->insert(gyz0); + StateList->insert(gzz0); + StateList->insert(Axx0); + StateList->insert(Axy0); + StateList->insert(Axz0); + StateList->insert(Ayy0); + StateList->insert(Ayz0); + StateList->insert(Azz0); + StateList->insert(Gmx0); + StateList->insert(Gmy0); + StateList->insert(Gmz0); + StateList->insert(Lap0); + StateList->insert(Sfx0); + StateList->insert(Sfy0); + StateList->insert(Sfz0); + StateList->insert(dtSfx0); + StateList->insert(dtSfy0); + StateList->insert(dtSfz0); + + RHSList = new MyList(phi_rhs); + RHSList->insert(trK_rhs); + RHSList->insert(gxx_rhs); + RHSList->insert(gxy_rhs); + RHSList->insert(gxz_rhs); + RHSList->insert(gyy_rhs); + RHSList->insert(gyz_rhs); + RHSList->insert(gzz_rhs); + RHSList->insert(Axx_rhs); + RHSList->insert(Axy_rhs); + RHSList->insert(Axz_rhs); + RHSList->insert(Ayy_rhs); + RHSList->insert(Ayz_rhs); + RHSList->insert(Azz_rhs); + RHSList->insert(Gmx_rhs); + RHSList->insert(Gmy_rhs); + RHSList->insert(Gmz_rhs); + RHSList->insert(Lap_rhs); + RHSList->insert(Sfx_rhs); + RHSList->insert(Sfy_rhs); + RHSList->insert(Sfz_rhs); + RHSList->insert(dtSfx_rhs); + RHSList->insert(dtSfy_rhs); + RHSList->insert(dtSfz_rhs); + + SynchList_pre = new MyList(phi); + SynchList_pre->insert(trK); + SynchList_pre->insert(gxx); + SynchList_pre->insert(gxy); + SynchList_pre->insert(gxz); + SynchList_pre->insert(gyy); + SynchList_pre->insert(gyz); + SynchList_pre->insert(gzz); + SynchList_pre->insert(Axx); + SynchList_pre->insert(Axy); + SynchList_pre->insert(Axz); + SynchList_pre->insert(Ayy); + SynchList_pre->insert(Ayz); + SynchList_pre->insert(Azz); + SynchList_pre->insert(Gmx); + SynchList_pre->insert(Gmy); + SynchList_pre->insert(Gmz); + SynchList_pre->insert(Lap); + SynchList_pre->insert(Sfx); + SynchList_pre->insert(Sfy); + SynchList_pre->insert(Sfz); + SynchList_pre->insert(dtSfx); + SynchList_pre->insert(dtSfy); + SynchList_pre->insert(dtSfz); + + SynchList_cor = new MyList(phi1); + SynchList_cor->insert(trK1); + SynchList_cor->insert(gxx1); + SynchList_cor->insert(gxy1); + SynchList_cor->insert(gxz1); + SynchList_cor->insert(gyy1); + SynchList_cor->insert(gyz1); + SynchList_cor->insert(gzz1); + SynchList_cor->insert(Axx1); + SynchList_cor->insert(Axy1); + SynchList_cor->insert(Axz1); + SynchList_cor->insert(Ayy1); + SynchList_cor->insert(Ayz1); + SynchList_cor->insert(Azz1); + SynchList_cor->insert(Gmx1); + SynchList_cor->insert(Gmy1); + SynchList_cor->insert(Gmz1); + SynchList_cor->insert(Lap1); + SynchList_cor->insert(Sfx1); + SynchList_cor->insert(Sfy1); + SynchList_cor->insert(Sfz1); + SynchList_cor->insert(dtSfx1); + SynchList_cor->insert(dtSfy1); + SynchList_cor->insert(dtSfz1); + + DumpList = new MyList(phi0); + DumpList->insert(trK0); + DumpList->insert(gxx0); + DumpList->insert(gxy0); + DumpList->insert(gxz0); + DumpList->insert(gyy0); + DumpList->insert(gyz0); + DumpList->insert(gzz0); + // DumpList->insert(Axx0); + // DumpList->insert(Axy0); + // DumpList->insert(Axz0); + // DumpList->insert(Ayy0); + // DumpList->insert(Ayz0); + // DumpList->insert(Azz0); + // DumpList->insert(Gmx0); + // DumpList->insert(Gmy0); + // DumpList->insert(Gmz0); + DumpList->insert(Lap0); + // DumpList->insert(Sfx0); + // DumpList->insert(Sfy0); + // DumpList->insert(Sfz0); + // DumpList->insert(dtSfx0); + // DumpList->insert(dtSfy0); + // DumpList->insert(dtSfz0); + // DumpList->insert(Rpsi4); + // DumpList->insert(Ipsi4); + DumpList->insert(Cons_Ham); + DumpList->insert(Cons_Px); + DumpList->insert(Cons_Py); + DumpList->insert(Cons_Pz); + // DumpList->insert(Cons_Gx); + // DumpList->insert(Cons_Gy); + // DumpList->insert(Cons_Gz); + + ConstraintList = new MyList(Cons_Ham); + ConstraintList->insert(Cons_Px); + ConstraintList->insert(Cons_Py); + ConstraintList->insert(Cons_Pz); + ConstraintList->insert(Cons_Gx); + ConstraintList->insert(Cons_Gy); + ConstraintList->insert(Cons_Gz); +#ifdef With_AHF + // setup kinds of var list + // List for AparentHorizonFinderDirect + // special attension is payed to symmetry type + // gij gij,x gij,y gij,z + AHList = new MyList(gxx0); + AHList->insert(Gamxxx); + AHList->insert(Gamyxx); + AHList->insert(Gamzxx); + AHList->insert(gxy0); + AHList->insert(Gamxxy); + AHList->insert(Gamyxy); + AHList->insert(Gamzxy); + AHList->insert(gxz0); + AHList->insert(Gamxxz); + AHList->insert(Gamyxz); + AHList->insert(Gamzxz); + AHList->insert(gyy0); + AHList->insert(Gamxyy); + AHList->insert(Gamyyy); + AHList->insert(Gamzyy); + AHList->insert(gyz0); + AHList->insert(Gamxyz); + AHList->insert(Gamyyz); + AHList->insert(Gamzyz); + AHList->insert(gzz0); + AHList->insert(Gamxzz); + AHList->insert(Gamyzz); + AHList->insert(Gamzzz); + // phi phi,x phi,y phi,z + AHList->insert(phi0); + AHList->insert(dtSfx_rhs); + AHList->insert(dtSfy_rhs); + AHList->insert(dtSfz_rhs); + // Aij + AHList->insert(Axx0); + AHList->insert(Axy0); + AHList->insert(Axz0); + AHList->insert(Ayy0); + AHList->insert(Ayz0); + AHList->insert(Azz0); + // trK + AHList->insert(trK0); + // gij,x gij,y gij,z + AHDList = new MyList(Gamxxx); + AHDList->insert(Gamyxx); + AHDList->insert(Gamzxx); + AHDList->insert(Gamxxy); + AHDList->insert(Gamyxy); + AHDList->insert(Gamzxy); + AHDList->insert(Gamxxz); + AHDList->insert(Gamyxz); + AHDList->insert(Gamzxz); + AHDList->insert(Gamxyy); + AHDList->insert(Gamyyy); + AHDList->insert(Gamzyy); + AHDList->insert(Gamxyz); + AHDList->insert(Gamyyz); + AHDList->insert(Gamzyz); + AHDList->insert(Gamxzz); + AHDList->insert(Gamyzz); + AHDList->insert(Gamzzz); + // phi,x phi,y phi,z + AHDList->insert(dtSfx_rhs); + AHDList->insert(dtSfy_rhs); + AHDList->insert(dtSfz_rhs); + + GaugeList = new MyList(Lap0); + GaugeList->insert(Sfx0); + GaugeList->insert(Sfy0); + GaugeList->insert(Sfz0); +#endif + + + + // Note: the first checkpoint-class variable is `bool` while the local variable is `int`; + // an explicit conversion may be required in some contexts. + // bool checkrun00 = checkrun; + // Note: the second checkpoint-class variable is `const char*` while the local variable is `char*`; + // an explicit conversion may be required. + // const char* checkfilename00 = checkfilename; + + CheckPoint = new checkpoint(checkrun, checkfilename, myrank); + + if (myrank==0) { + cout << " BSSN class successfully created " << endl; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function initializes the class + +//================================================================================================ + +void bssn_class::Initialize() +{ + if (myrank == 0) + cout << " you have setted " << ngfs << " grid functions." << endl; + + CheckPoint->addvariablelist(StateList); + CheckPoint->addvariablelist(OldStateList); + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + GH = new cgh(0, ngfs, Symmetry, pname, checkrun, ErrorMonitor); + if (checkrun) + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); + else + GH->compose_cgh(nprocs); +#ifdef WithShell + SH = new ShellPatch(0, ngfs, pname, Symmetry, myrank, ErrorMonitor); + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + // SH->compose_shr(nprocs); //sh is faster than shr + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); + + if (checkrun) + CheckPoint->readcheck_sh(SH, myrank); +#else + SH = 0; +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; + + if (checkrun) + { + CheckPoint->read_Black_Hole_position(BH_num_input, BH_num, Porg0, Pmom, Spin, Mass, Porgbr, Porg, Porg1, Porg_rhs); + setpbh(BH_num, Porg0, Mass, BH_num_input); + } + else + { + PhysTime = StartTime; + Setup_Black_Hole_position(); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function is the destructor; it releases allocated variables + +//================================================================================================ + +bssn_class::~bssn_class() +{ +#ifdef With_AHF + AHList->clearList(); + AHDList->clearList(); + GaugeList->clearList(); + if (lastahdumpid) + delete[] lastahdumpid; + if (findeveryl) + delete[] findeveryl; + + if (xc) + { + delete[] xc; + delete[] yc; + delete[] zc; + delete[] xr; + delete[] yr; + delete[] zr; + delete[] trigger; + delete[] dumpid; + delete[] dTT; + } + + AHFinderDirect::AHFinderDirect_cleanup(); +#endif + + StateList->clearList(); + RHSList->clearList(); + OldStateList->clearList(); + SynchList_pre->clearList(); + SynchList_cor->clearList(); + DumpList->clearList(); + ConstraintList->clearList(); + + delete phio; + delete trKo; + delete gxxo; + delete gxyo; + delete gxzo; + delete gyyo; + delete gyzo; + delete gzzo; + delete Axxo; + delete Axyo; + delete Axzo; + delete Ayyo; + delete Ayzo; + delete Azzo; + delete Gmxo; + delete Gmyo; + delete Gmzo; + delete Lapo; + delete Sfxo; + delete Sfyo; + delete Sfzo; + delete dtSfxo; + delete dtSfyo; + delete dtSfzo; + + delete phi0; + delete trK0; + delete gxx0; + delete gxy0; + delete gxz0; + delete gyy0; + delete gyz0; + delete gzz0; + delete Axx0; + delete Axy0; + delete Axz0; + delete Ayy0; + delete Ayz0; + delete Azz0; + delete Gmx0; + delete Gmy0; + delete Gmz0; + delete Lap0; + delete Sfx0; + delete Sfy0; + delete Sfz0; + delete dtSfx0; + delete dtSfy0; + delete dtSfz0; + + delete phi; + delete trK; + delete gxx; + delete gxy; + delete gxz; + delete gyy; + delete gyz; + delete gzz; + delete Axx; + delete Axy; + delete Axz; + delete Ayy; + delete Ayz; + delete Azz; + delete Gmx; + delete Gmy; + delete Gmz; + delete Lap; + delete Sfx; + delete Sfy; + delete Sfz; + delete dtSfx; + delete dtSfy; + delete dtSfz; + + delete phi1; + delete trK1; + delete gxx1; + delete gxy1; + delete gxz1; + delete gyy1; + delete gyz1; + delete gzz1; + delete Axx1; + delete Axy1; + delete Axz1; + delete Ayy1; + delete Ayz1; + delete Azz1; + delete Gmx1; + delete Gmy1; + delete Gmz1; + delete Lap1; + delete Sfx1; + delete Sfy1; + delete Sfz1; + delete dtSfx1; + delete dtSfy1; + delete dtSfz1; + + delete phi_rhs; + delete trK_rhs; + delete gxx_rhs; + delete gxy_rhs; + delete gxz_rhs; + delete gyy_rhs; + delete gyz_rhs; + delete gzz_rhs; + delete Axx_rhs; + delete Axy_rhs; + delete Axz_rhs; + delete Ayy_rhs; + delete Ayz_rhs; + delete Azz_rhs; + delete Gmx_rhs; + delete Gmy_rhs; + delete Gmz_rhs; + delete Lap_rhs; + delete Sfx_rhs; + delete Sfy_rhs; + delete Sfz_rhs; + delete dtSfx_rhs; + delete dtSfy_rhs; + delete dtSfz_rhs; + + delete rho; + delete Sx; + delete Sy; + delete Sz; + delete Sxx; + delete Sxy; + delete Sxz; + delete Syy; + delete Syz; + delete Szz; + + delete Gamxxx; + delete Gamxxy; + delete Gamxxz; + delete Gamxyy; + delete Gamxyz; + delete Gamxzz; + delete Gamyxx; + delete Gamyxy; + delete Gamyxz; + delete Gamyyy; + delete Gamyyz; + delete Gamyzz; + delete Gamzxx; + delete Gamzxy; + delete Gamzxz; + delete Gamzyy; + delete Gamzyz; + delete Gamzzz; + + delete Rxx; + delete Rxy; + delete Rxz; + delete Ryy; + delete Ryz; + delete Rzz; + + delete Rpsi4; + delete Ipsi4; + delete t1Rpsi4; + delete t1Ipsi4; + delete t2Rpsi4; + delete t2Ipsi4; + + delete Cons_Ham; + delete Cons_Px; + delete Cons_Py; + delete Cons_Pz; + delete Cons_Gx; + delete Cons_Gy; + delete Cons_Gz; + +#ifdef Point_Psi4 + delete phix; + delete phiy; + delete phiz; + delete trKx; + delete trKy; + delete trKz; + delete Axxx; + delete Axxy; + delete Axxz; + delete Axyx; + delete Axyy; + delete Axyz; + delete Axzx; + delete Axzy; + delete Axzz; + delete Ayyx; + delete Ayyy; + delete Ayyz; + delete Ayzx; + delete Ayzy; + delete Ayzz; + delete Azzx; + delete Azzy; + delete Azzz; +#endif + + delete GH; +#ifdef WithShell + delete SH; +#endif + + for (int i = 0; i < BH_num; i++) + { + delete[] Porg0[i]; + delete[] Porgbr[i]; + delete[] Porg[i]; + delete[] Porg1[i]; + delete[] Porg_rhs[i]; + } + + delete[] Porg0; + delete[] Porgbr; + delete[] Porg; + delete[] Porg1; + delete[] Porg_rhs; + + delete[] Mass; + delete[] Spin; + delete[] Pmom; + + delete ErrorMonitor; + delete Psi4Monitor; + delete BHMonitor; + delete MAPMonitor; + delete ConVMonitor; + delete Waveshell; + + delete CheckPoint; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes initial data using Lousto's analytic method + +//================================================================================================ + +void bssn_class::Setup_Initial_Data_Lousto() +{ + if (!checkrun) + { + if (myrank == 0) + { + cout << endl; + cout << " Setup initial data with Lousto's analytical formula. " << endl; + cout << endl; + } + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + // Use Lousto's analytic formulas to compute initial data + f_get_lousto_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT); +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhs_sh(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + // dump read_in initial data + SH->Dump_Data(StateList, 0, PhysTime, dT); +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // exit(0); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes initial data using Cao's analytic formulas + +//================================================================================================ + +void bssn_class::Setup_Initial_Data_Cao() +{ + if (!checkrun) + { + if (myrank == 0) + { + cout << endl; + cout << " Setup initial data with Cao's analytical formula. " << endl; + cout << endl; + } + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + // Use Cao's analytic formulas to compute initial data + f_get_initial_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT); +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhs_sh(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + // dump read_in initial data + SH->Dump_Data(StateList, 0, PhysTime, dT); +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // exit(0); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes Kerr-Schild initial data via an analytic method + +//================================================================================================ + +void bssn_class::Setup_KerrSchild() +{ + if (!checkrun) + { + if (myrank == 0) + { + cout << endl; + cout << " Setup initial data with Kerr-Schild formula. " << endl; + cout << endl; + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_kerrschild(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + int lev = 0, fngfs = Pp->data->fngfs; + + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_kerrschild_ss(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn]); + /* + f_fderivs_shc(cg->shape,cg->fgfs[phi0->sgfn], + cg->fgfs[Sfx_rhs->sgfn], + cg->fgfs[Sfy_rhs->sgfn], + cg->fgfs[Sfz_rhs->sgfn], + cg->X[0],cg->X[1],cg->X[2], + phi0->SoA[0],phi0->SoA[1],phi0->SoA[2], + Symmetry,lev,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz]); + f_fdderivs_shc(cg->shape,cg->fgfs[phi0->sgfn], + cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn], + cg->X[0],cg->X[1],cg->X[2], + phi0->SoA[0],phi0->SoA[1],phi0->SoA[2], + Symmetry,lev,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz], + cg->fgfs[fngfs+ShellPatch::drhodxx], + cg->fgfs[fngfs+ShellPatch::drhodxy], + cg->fgfs[fngfs+ShellPatch::drhodxz], + cg->fgfs[fngfs+ShellPatch::drhodyy], + cg->fgfs[fngfs+ShellPatch::drhodyz], + cg->fgfs[fngfs+ShellPatch::drhodzz], + cg->fgfs[fngfs+ShellPatch::dsigmadxx], + cg->fgfs[fngfs+ShellPatch::dsigmadxy], + cg->fgfs[fngfs+ShellPatch::dsigmadxz], + cg->fgfs[fngfs+ShellPatch::dsigmadyy], + cg->fgfs[fngfs+ShellPatch::dsigmadyz], + cg->fgfs[fngfs+ShellPatch::dsigmadzz], + cg->fgfs[fngfs+ShellPatch::dRdxx], + cg->fgfs[fngfs+ShellPatch::dRdxy], + cg->fgfs[fngfs+ShellPatch::dRdxz], + cg->fgfs[fngfs+ShellPatch::dRdyy], + cg->fgfs[fngfs+ShellPatch::dRdyz], + cg->fgfs[fngfs+ShellPatch::dRdzz]); + */ + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + // dump read_in initial data + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); + // SH->Dump_Data(StateList,0,PhysTime,dT); + // exit(0); + + /* + { + MyList * DG_List=new MyList(Sfx_rhs); + DG_List->insert(Sfy_rhs); + DG_List->insert(Sfz_rhs); + DG_List->insert(Axx_rhs); + DG_List->insert(Axy_rhs); + DG_List->insert(Axz_rhs); + DG_List->insert(Ayy_rhs); + DG_List->insert(Ayz_rhs); + DG_List->insert(Azz_rhs); + SH->Synch(DG_List,Symmetry); + SH->Dump_Data(DG_List,0,PhysTime,dT); + DG_List->clearList(); + exit(0); + } + */ + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function reads initial data produced by Pablo Galaviz's Olliptic program + +//================================================================================================ + +// Read initial data solved by Pablo's Olliptic Phys.Rev.D 82 024005 (2010) + +//|---------------------------------------------------------------------------- +// read ASCII file with the style of Pablo +//|---------------------------------------------------------------------------- +bool bssn_class::read_Pablo_file(int *ext, double *datain, char *filename) +{ + if (myrank == 0) + { + cout << endl; + cout << " Setup initial data with Pablo_file. " << endl; + cout << endl; + } + + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + double x, y, z; + //|--->open in put file + ifstream infile; + infile.open(filename); + if (!infile) + { + cout << "bssn_class: read_Pablo_file can't open " << filename << " for input." << endl; + return false; + } + for (k = 0; k < nz; k++) + for (j = 0; j < ny; j++) + for (i = 0; i < nx; i++) + { + infile >> x >> y >> z >> datain[i + j * nx + k * nx * ny]; + } + + infile.close(); + + return true; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function writes initial data file in the style of Pablo Galaviz's Olliptic program + +//================================================================================================ + +//|---------------------------------------------------------------------------- +// write ASCII file with the style of Pablo +//|---------------------------------------------------------------------------- +void bssn_class::write_Pablo_file(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename) +{ + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + double *X, *Y, *Z; + X = new double[nx]; + Y = new double[ny]; + Z = new double[nz]; + double dX, dY, dZ; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dX = (xmax - xmin) / (nx - 1); + for (i = 0; i < nx; i++) + X[i] = xmin + i * dX; + dY = (ymax - ymin) / (ny - 1); + for (j = 0; j < ny; j++) + Y[j] = ymin + j * dY; + dZ = (zmax - zmin) / (nz - 1); + for (k = 0; k < nz; k++) + Z[k] = zmin + k * dZ; +#else +#ifdef Cell + dX = (xmax - xmin) / nx; + for (i = 0; i < nx; i++) + X[i] = xmin + (i + 0.5) * dX; + dY = (ymax - ymin) / ny; + for (j = 0; j < ny; j++) + Y[j] = ymin + (j + 0.5) * dY; + dZ = (zmax - zmin) / nz; + for (k = 0; k < nz; k++) + Z[k] = zmin + (k + 0.5) * dZ; +#else +#error Not define Vertex nor Cell +#endif +#endif + //|--->open out put file + ofstream outfile; + outfile.open(filename); + if (!outfile) + { + cout << "bssn_class: write_Pablo_file can't open " << filename << " for output." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + for (k = 0; k < nz; k++) + for (j = 0; j < ny; j++) + for (i = 0; i < nx; i++) + { + outfile << X[i] << " " << Y[j] << " " << Z[k] << " " + << 0 << endl; + } + outfile.close(); + + delete[] X; + delete[] Y; + delete[] Z; +} + +//================================================================================================ + + + +//================================================================================================ + +// Read initial data solved by Ansorg, PRD 70, 064011 (2004) + +void bssn_class::Read_Ansorg() +{ + if (!checkrun) + { + if (myrank == 0) + { + cout << endl; + cout << " Read initial data from Ansorg's solver," + << " please be sure the input parameters for black holes are puncture parameters!! " << endl; + cout << endl; + } + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + + int order = 6; + Ansorg read_ansorg("Ansorg.psid", order); + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->X[0][i], cg->X[1][j], cg->X[2][k]); + + f_get_ansorg_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->fgfs[Pp->data->fngfs + ShellPatch::gx][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]]); + + f_get_ansorg_nbhs_ss(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); +#if 0 +// for check fderivs_sh + f_fderivs_sh(cg->shape,cg->fgfs[Ayz0->sgfn], + cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn], + cg->X[0],cg->X[1],cg->X[2], + Ayz0->SoA[0],Ayz0->SoA[1],Ayz0->SoA[2], + Symmetry,Pp->data->sst,Pp->data->sst); +#endif +#if 0 +// for check fderivs_shc + int fngfs = Pp->data->fngfs; + f_fderivs_shc(cg->shape,cg->fgfs[Ayz0->sgfn], + cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn], + cg->X[0],cg->X[1],cg->X[2], + Ayz0->SoA[0],Ayz0->SoA[1],Ayz0->SoA[2], + Symmetry,Pp->data->sst,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz]); +#endif + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + + Compute_Constraint(); + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT); +#ifdef WithShell + SH->Dump_Data(DumpList, 0, PhysTime, dT); +#endif + // if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets up the time evolution for the entire process + +//================================================================================================ + +void bssn_class::Evolve(int Steps) +{ + clock_t prev_clock, curr_clock; + double LastDump = 0.0, LastCheck = 0.0, Last2dDump = 0.0; + LastAnas = 0; +#if 0 +//initial checkpoint for special uasge + { + CheckPoint->write_Black_Hole_position(BH_num_input,BH_num,Porg0,Porgbr,Mass); + CheckPoint->writecheck_cgh(PhysTime,GH); +#ifdef WithShell + CheckPoint->writecheck_sh(PhysTime,SH); +#endif + CheckPoint->write_bssn(LastDump,Last2dDump,LastAnas); + misc::tillherecheck("complete initialization preparation"); // we need synchronization here + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } +#endif + // for step 0 constraint interpolation + Interp_Constraint(true); + +#ifdef With_AHF + // setup apparent horizon finder direct of thornburg + { + HN_num = BH_num; + for (int ia = 0; ia < BH_num; ia++) + for (int ib = ia + 1; ib < BH_num; ib++) + HN_num++; + + AHFinderDirect::AHFinderDirect_setup(AHList, GaugeList, + this, + Symmetry, HN_num, &PhysTime); + + lastahdumpid = new int[HN_num]; + findeveryl = new int[HN_num]; + xc = new double[HN_num]; + yc = new double[HN_num]; + zc = new double[HN_num]; + xr = new double[HN_num]; + yr = new double[HN_num]; + zr = new double[HN_num]; + dTT = new double[HN_num]; + trigger = new bool[HN_num]; + dumpid = new int[HN_num]; + + for (int ihn = 0; ihn < HN_num; ihn++) + { + lastahdumpid[ihn] = 0; + findeveryl[ihn] = AHfindevery; + } + } +#endif + + if (checkrun) + CheckPoint->read_bssn(LastDump, Last2dDump, LastAnas); + + double dT_mon = dT * pow(0.5, Mymax(0, trfls)); + + /* + #ifdef With_AHF + //initial apparent horizon finding + { + double gam; + double massmin=Mass[0]; + for(int ihn=1;ihnlevels; lev++) + GH->Lt[lev] = PhysTime; + + GH->settrfls(trfls); + + for (int ncount = 1; ncount < Steps + 1; ncount++) + { + // special for large mass ratio consideration + // if(fabs(Porg0[0][0]-Porg0[1][0])+fabs(Porg0[0][1]-Porg0[1][1])+fabs(Porg0[0][2]-Porg0[1][2])<1e-6) + // { GH->levels=GH->movls; } + + if (myrank == 0) + curr_clock = clock(); +#if (PSTR == 0) + RecursiveStep(0); +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + AnalysisStuff(a_lev, dT_mon); + ParallelStep(); +#endif + + // misc::tillherecheck("before Constraint_Out"); + + Constraint_Out(); // this will affect the Dump_List + + LastDump += dT_mon; + Last2dDump += dT_mon; + LastCheck += dT_mon; + + // When LastDump >= DumpTime, output corresponding binary data + if (LastDump >= DumpTime) + { + // misc::tillherecheck("before Dump_Data"); + + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT_mon); +#ifdef WithShell + SH->Dump_Data(DumpList, 0, PhysTime, dT_mon); +#endif + + LastDump = 0; + + if (myrank == 0) + { + cout << " Dump done. " << endl; + } + } + + // When Last2dDump >= d2DumpTime, output corresponding 2D data + if (Last2dDump >= d2DumpTime) + { + // misc::tillherecheck("before 2dDump_Data"); + + for (int lev = 0; lev < GH->levels; lev++) + Parallel::d2Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT_mon); + + Last2dDump = 0; + + if (myrank == 0) + { + cout << " 2d Dump done. " << endl; + } + } + + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << endl; + cout << " Timestep # " << ncount << ": integrating to time: " << PhysTime << " " + << " Computer used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + // cout << endl; + } + + if (PhysTime >= TotalTime) + break; + +#if (REGLEV == 1) + GH->Regrid(Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_mon, StartTime, dT_mon / 2), ErrorMonitor); +#endif + +#if (REGLEV == 0 && (PSTR == 1 || PSTR == 2)) +// GH->Regrid_fake(Symmetry,BH_num,Porgbr,Porg0, +// SynchList_cor,OldStateList,StateList,SynchList_pre, +// fgt(PhysTime-dT_mon,StartTime,dT_mon/2),ErrorMonitor); +#endif + + // Retrieve memory usage information used during computation; master process prints it + bssn_perf.MemoryUsage(¤t_min, ¤t_avg, ¤t_max, + &peak_min, &peak_avg, &peak_max, nprocs); + if (myrank == 0) + { + printf(" Memory usage: current %0.4lg/%0.4lg/%0.4lgMB, " + "peak %0.4lg/%0.4lg/%0.4lgMB\n", + (double)current_min / (1024.0 * 1024.0), + (double)current_avg / (1024.0 * 1024.0), + (double)current_max / (1024.0 * 1024.0), + (double)peak_min / (1024.0 * 1024.0), + (double)peak_avg / (1024.0 * 1024.0), + (double)peak_max / (1024.0 * 1024.0)); + cout << endl; + } + + // Output puncture positions at each step + if (myrank == 0) + { + for (int i_count=0; i_count= CheckTime, perform runtime checks and output status data + if (LastCheck >= CheckTime) + { + LastCheck = 0; + + CheckPoint->write_Black_Hole_position(BH_num_input, BH_num, Porg0, Porgbr, Mass); + CheckPoint->writecheck_cgh(PhysTime, GH); +#ifdef WithShell + CheckPoint->writecheck_sh(PhysTime, SH); +#endif + CheckPoint->write_bssn(LastDump, Last2dDump, LastAnas); + } + } + /* + #ifdef With_AHF + // final apparent horizon finding + { + double gam; + for(int ihn=0;ihnCS_Inter(StateList, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + +#endif + + // Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT_lev); + } + +#if 0 + if(lev>0) Parallel::Restrict_after(GH->PatL[lev-1],GH->PatL[lev],StateList,StateList,Symmetry); +#endif + +#if (REGLEV == 0) + GH->Regrid_Onelevel(lev, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), ErrorMonitor); +#endif +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function implements recursive time-stepping across AMR levels +// This variant handles the cases PSTR == 1 and PSTR == 2 + +//================================================================================================ + +#elif (PSTR == 1 || PSTR == 2) +void bssn_class::RecursiveStep(int lev) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + + int NoIterations = 1, YN; + if (lev <= trfls) + NoIterations = 1; + else + NoIterations = 2; + + for (int i = 0; i < NoIterations; i++) + { + // if(myrank==0) cout<<"level now = "<mylev; + MPI_Status status; + // receive + if (lev < GH->levels - 1) + { + if (myrank == GH->start_rank[lev]) + { + MPI_Recv(tporgo, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev + 1], 1, MPI_COMM_WORLD, &status); + // cout<Commlev[lev]); + + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + Porg0[i][j] = tporg[3 * i + j]; + + // if(myrank==GH->start_rank[lev]) cout< 0 && myrank == GH->start_rank[lev]) + { + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + tporg[3 * i + j] = Porg0[i][j]; + + MPI_Send(tporg, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev - 1], 1, MPI_COMM_WORLD); + } + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + delete[] tporg; + delete[] tporgo; +#if (REGLEV == 0) + GH->Regrid_Onelevel(GH->mylev, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), ErrorMonitor); +#endif +} + +//================================================================================================ + + + +//================================================================================================ + +// ParallelStep performs time evolution across AMR levels (parallelized) +// This is an alternate implementation + +//================================================================================================ + +#else +void bssn_class::ParallelStep() +{ + // stringstream a_stream; + // a_stream.setf(ios::left); + + double *tporg, *tporgo; + tporg = new double[3 * BH_num]; + tporgo = new double[3 * BH_num]; + + int lev = GH->mylev; + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + double dT_levp1 = dT * pow(0.5, Mymax(lev + 1, trfls)); + double dT_levm1 = dT * pow(0.5, Mymax(lev - 1, trfls)); + + int NoIterations = 1, YN; + if (lev <= trfls) + NoIterations = 1; + else + NoIterations = int(pow(2.0, lev - trfls)); + + for (int i = 0; i < NoIterations; i++) + { + // if(myrank==GH->start_rank[lev]) cout<<"level now = "<Commlev[lev],GH->start_rank[lev],a_stream.str()); + Step(lev, YN); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + +#if (AGM == 2) + if (GH->levels == 1) + { + Enforce_algcon(lev, 0); + } +#endif + + GH->Lt[lev] += dT_lev; + + PhysTime += dT_lev; + +#if (AGM == 2) + if (lev > 0) + { + Enforce_algcon(lev, 0); + if (YN == 1) + Enforce_algcon(lev - 1, 0); + } +#endif + +#if (RPS == 1) + // mesh refinement boundary part + // + // till here the PhysTime has updated dT_lev + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + if (lev < GH->levels - 1) + { + if (lev + 1 <= trfls) + { + // RestrictProlong_aux(lev,1,fgt(PhysTime-dT_lev,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + RestrictProlong(lev + 1, 1, fgt(PhysTime - dT_lev, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + } + else + { + // if(myrank==GH->start_rank[lev]) cout<mylev<<", "<Commlev[lev],GH->start_rank[lev],"between RestrictProlong"); + + // RestrictProlong_aux(lev,0,fgt(PhysTime-dT_lev,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + // RestrictProlong_aux(lev,1,fgt(PhysTime-dT_levp1,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + RestrictProlong(lev + 1, 0, fgt(PhysTime - dT_lev, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + RestrictProlong(lev + 1, 1, fgt(PhysTime - dT_levp1, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + } + } + + // if(myrank==GH->start_rank[lev]) cout<mylev<<", "<Commlev[lev],GH->start_rank[lev],a_stream.str()); + + RestrictProlong(lev, YN, fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), StateList, OldStateList, SynchList_cor); + // RestrictProlong(lev,YN,false,StateList,OldStateList,SynchList_cor); + +// if(myrank==GH->start_rank[lev]) cout<mylev<Commlev[lev],GH->start_rank[lev],a_stream.str()); +#endif + + // Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT_lev); + + { + MPI_Status status; + // receive + if (lev < GH->levels - 1) + { + if (myrank == GH->start_rank[lev]) + { + MPI_Recv(tporgo, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev + 1], 1, MPI_COMM_WORLD, &status); + // cout<Commlev[lev]); + + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + Porg0[i][j] = tporg[3 * i + j]; + + // if(myrank==GH->start_rank[lev]) cout< 0 && YN == 1 && myrank == GH->start_rank[lev]) + { + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + tporg[3 * i + j] = Porg0[i][j]; + + MPI_Send(tporg, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev - 1], 1, MPI_COMM_WORLD); + } + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + } +#if (REGLEV == 0) + // for higher level + if (lev < GH->levels - 1) + { + if (lev + 1 >= GH->movls) + { + // GH->Regrid_Onelevel_aux(lev,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev + 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_levp1, StartTime, dT_levp1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for higher level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + + // for this level + if (YN == 1) + { + GH->Regrid_Onelevel(lev, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + + // for lower level + if (lev - 1 >= GH->movls) + { + if (lev - 1 <= trfls) + { + if (YN == 1) + { + // GH->Regrid_Onelevel_aux(lev-2,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev - 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_levm1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for lower level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + else + { + if (i % 4 == 3) + { + // GH->Regrid_Onelevel_aux(lev-2,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev - 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_levm1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for lower level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + } +#endif + } + +#ifdef WithShell + SHStep(); + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + +#if (RPS == 1) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(StateList, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + } +#endif + +#endif + +#if 0 + if(lev>0) Parallel::Restrict_after(GH->PatL[lev-1],GH->PatL[lev],StateList,StateList,Symmetry); +#endif + + delete[] tporg; + delete[] tporgo; +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// ParallelStep performs time evolution across AMR levels (parallelized) +// This is another implementation, for the case PSTR == 3 + +//================================================================================================ + +#elif (PSTR == 3) +#warning "remember do not use Shell" +void bssn_class::ParallelStep() +{ + // stringstream a_stream; + // a_stream.setf(ios::left); + + double *tporg, *tporgo; + tporg = new double[3 * BH_num]; + tporgo = new double[3 * BH_num]; + + int lev = GH->mylev; + double dT_lev = dT * pow(0.5, Mymax(GH->levels - 1, trfls)); + if (lev == 1) + { + lev = GH->levels - 1; + for (int i = 0; i < misc::MYpow2(lev); i++) + { + Step(lev, i % 2); + PhysTime += dT_lev; + // if(myrank==nprocs-1) cout<<"OOO level now = "<levels - 2; + for (int i = 1; i < misc::MYpow2(lev + 1); i++) + { + RecursiveStep(lev, i); + PhysTime += dT_lev; + if (i % 2 == 0) + { + // if(myrank==0) cout<<"level now = "<mylev; + if (lev == -1) + lev = 0; + else + lev = GH->levels - 1; + + { + MPI_Status status; + // receive + if (lev == 0) + { + if (myrank == GH->start_rank[lev]) + { + MPI_Recv(tporgo, 3 * BH_num, MPI_DOUBLE, GH->start_rank[GH->levels - 1], 1, MPI_COMM_WORLD, &status); + // cout<Commlev[lev]); + + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + Porg0[i][j] = tporg[3 * i + j]; + + // if(myrank==GH->start_rank[lev]) cout<start_rank[lev]) + { + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + tporg[3 * i + j] = Porg0[i][j]; + + MPI_Send(tporg, 3 * BH_num, MPI_DOUBLE, GH->start_rank[0], 1, MPI_COMM_WORLD); + } + } + + delete[] tporg; + delete[] tporgo; +} + +//================================================================================================ + + + + +//================================================================================================ + +// This member function implements recursive time-stepping across AMR levels + +//================================================================================================ + +void bssn_class::RecursiveStep(int lev, int num) // in all 2^(lev+1)-1 steps +{ + if (trfls > 0) + cout << "error: bssn_class::RecursiveStep does not support trfls > 0 yet" << endl; + + if (num / 2 * 2 == num) + RecursiveStep(lev - 1, num / 2); + else + { + Step(lev, 0); + double dT_lev = dT * pow(0.5, Mymax(lev + 1, trfls)); + if (myrank == 0) + cout << "level now = " << lev + 1 << ", " << (num - 1) % 2 << ", " + << fgt(PhysTime - dT_lev, StartTime, dT_lev / 2) << endl; + RestrictProlong(lev + 1, (num - 1) % 2, fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), StateList, OldStateList, SynchList_cor); + } +} +#endif + +//================================================================================================ + + + + +//================================================================================================ + +// This member function configures a single time-step evolution for each grid level. +// Applicable for the case PSTR == 0 + +//================================================================================================ + +#if (PSTR == 0) +#if 1 +void bssn_class::Step(int lev, int YN) +{ + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" + << iter_count << " variables at t = " + << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} + +//================================================================================================ + + + + +//================================================================================================ + +// This member function implements single-step time evolution for each AMR level (alternate) + +//================================================================================================ + +// ICN for bam comparison + +#else +void bssn_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " + << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 3; iter_count++) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// This member function implements single-step time evolution for each AMR level +// Variant for the case PSTR == 0 + +//================================================================================================ + +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) +void bssn_class::Step(int lev, int YN) +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Predictor rhs calculation"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector"); + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"head of Corrector"); + + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector error check"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Corrector sync"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Corrector of black hole position"); +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after pre cor swap"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"tail of corrector"); + } +#if (RPS == 0) + // mesh refinement boundary part + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before RestrictProlong"); + RestrictProlong(lev, YN, BB); +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + // if(myrank==GH->start_rank[lev]) + // cout<start_rank[lev]) cout<mylev<Commlev[lev],GH->start_rank[lev],"complet GH Step"); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function configures a single time-step evolution for the spherical-shell grid portion. + +//================================================================================================ + +#ifdef WithShell +void bssn_class::SHStep() +{ + int lev = 0; + // #if (PSTR == 1 || PSTR == 2) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + // #endif + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + + // #if (PSTR == 1 || PSTR == 2) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + // #endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + +#if (PSTR == 1 || PSTR == 2) +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor's error check"); +#endif + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } + + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#if (RPS == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds! " << endl; + } + } +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +} +#endif +#endif + +//================================================================================================ + + + +//================================================================================================ + +// 0: do not use mixing two levels data for OutBD; 1: do use + +#define MIXOUTB 0 +void bssn_class::RestrictProlong(int lev, int YN, bool BB, + MyList *SL, MyList *OL, MyList *corL) +// we assume +// StateList 1 ----------- +// +// OldStateList 0 ----------- +// +// SynchList_cor old ----------- +{ +#if (PSTR == 1 || PSTR == 2) +// stringstream a_stream; +// a_stream.setf(ios::left); +#endif + + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, SL, OL, corL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, SL, OL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + +#if (PSTR == 1 || PSTR == 2) +// Pp->data->checkPatch(0,GH->start_rank[GH->mylev]); +#endif + Pp = Pp->next; + } + +#if (PSTR == 1 || PSTR == 2) +// Pp=GH->PatL[lev]; +// while(Pp) +// { +// Pp->data->checkPatch(0,GH->start_rank[GH->mylev]); +// Pp=Pp->next; +// } + +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 before Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SL, GH->bdsul[lev], Symmetry); +#endif + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after OutBdLow2Hi"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } + else // no time refinement levels and for all same time levels + { + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 before Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->rsul[lev], Symmetry); +#endif + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 before Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SL, Symmetry); + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SL, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SL, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->bdsul[lev], Symmetry); +#endif + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 after OutBdLow2Hi"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } + + Parallel::Sync(GH->PatL[lev], SL, Symmetry); + +#if (PSTR == 1 || PSTR == 2) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } +} + +//================================================================================================ + + + +//================================================================================================ + +// auxiliary operation, input lev means original lev-1 + +void bssn_class::RestrictProlong_aux(int lev, int YN, bool BB, + MyList *SL, MyList *OL, MyList *corL) +// we assume +// StateList 1 ----------- +// +// OldStateList 0 ----------- +// +// SynchList_cor old ----------- +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"starting RestrictProlong_aux"); + + if (lev >= GH->levels - 1) + return; + lev = lev + 1; + + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, SL, OL, corL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, SL, OL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SL, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SL, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SL, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SL, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->bdsul[lev], Symmetry); +#endif + } + + Parallel::Sync(GH->PatL[lev], SL, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::RestrictProlong(int lev, int YN, bool BB) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + // we assume for fine + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // for coarse + // StateList 1 ----------- + // + // OldStateList 0 ----------- + // + // SynchList_cor old ----------- + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + if (myrank == 0) + cout << "/=: " << GH->Lt[lev - 1] << "," << GH->Lt[lev] + dT_lev << endl; + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { + if (myrank == 0) + cout << "===: " << GH->Lt[lev - 1] << "," << GH->Lt[lev] + dT_lev << endl; +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],StateList,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], StateList, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::ProlongRestrict(int lev, int YN, bool BB) +{ + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],StateList,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], StateList, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + +#if 0 +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); +#elif (RPB == 1) +// Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,GH->rsul[lev],Symmetry); +#endif +#else + Parallel::Restrict_after(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); +#endif + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} +#undef MIXOUTB + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes the gravitational-wave quantity Psi4 + +//================================================================================================ + +void bssn_class::Compute_Psi4(int lev) +{ + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + +#if 0 // test showes this operation does not help +for(int ilev = GH->levels-1;ilev>=lev;ilev--) +{ + MyList *Pp=GH->PatL[ilev]; +#else + MyList *Pp = GH->PatL[lev]; +#endif + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + if (0) // if Gamma^i_jk and R_ij can be reused from the rhs calculation + f_ricci_gamma(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + Symmetry); + // the input arguments Gamma^i_jk and R_ij do not need synch, because we do not need to derivate them + f_getnp4(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#elif (Psi4type == 1) + f_getnp4old(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#else +#error "not recognized Psi4type" +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#if 0 + Parallel::Sync(GH->PatL[ilev],DG_List,Symmetry); +} +// because of double level data change, you can not do this in above loop +// prolong restrict Psi4 +for(int ilev=GH->levels-1;ilev>lev;ilev--) + RestrictProlong(ilev,1,false,DG_List,DG_List,DG_List); +#else + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); +#endif + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + if (0) // if Gamma^i_jk and R_ij can be reused from the rhs calculation + f_ricci_gamma_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + Symmetry, lev, Pp->data->sst); + + f_getnp4_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#elif (Psi4type == 1) + f_getnp4old_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#else +#error "not recognized Psi4type" +#endif + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + + SH->Synch(DG_List, Symmetry); +#if 0 +// interpolate Psi4 + SH->CS_Inter(DG_List,Symmetry); +#endif + } +#endif + + DG_List->clearList(); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"end of Compute_Psi4"); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets the black holes' initial puncture positions + +//================================================================================================ + +void bssn_class::Setup_Black_Hole_position() +{ + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_num_input = BH_num = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + // set up the data for black holes + // these arrays will be deleted when bssn_class is deleted + Pmom = new double[3 * BH_num]; + Spin = new double[3 * BH_num]; + Mass = new double[BH_num]; + Porg0 = new double *[BH_num]; + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + for (int i = 0; i < BH_num; i++) + { + Porg0[i] = new double[3]; + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_num) + { + if (skey == "Mass") + Mass[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg0[sind][0] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg0[sind][1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg0[sind][2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // echo information of Black holes + if (myrank == 0) + { + cout << endl; + cout << " initial information of " << BH_num << " Black Hole(s) " << endl; + cout << setw(12) << "Mass" + << setw(12) << "x" + << setw(12) << "y" + << setw(12) << "z" + << setw(16) << "Px" + << setw(16) << "Py" + << setw(12) << "Pz" + << setw(12) << "Sx" + << setw(12) << "Sy" + << setw(12) << "Sz" << endl; + for (int i = 0; i < BH_num; i++) + { + cout << setw(12) << Mass[i] + << setw(12) << Porg0[i][0] + << setw(12) << Porg0[i][1] + << setw(12) << Porg0[i][2] + << setw(16) << Pmom[i * 3] + << setw(16) << Pmom[i * 3 + 1] + << setw(12) << Pmom[i * 3 + 2] + << setw(12) << Spin[i * 3] + << setw(12) << Spin[i * 3 + 1] + << setw(12) << Spin[i * 3 + 2] << endl; + } + } + + int maxl = 1; + int levels; + int *grids; + double bbox[6]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "bssn_class::Setup_Black_Hole_position: Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "levels") + { + levels = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + grids = new int[levels]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "bssn_class::Setup_Black_Hole_position: Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1, sind2, sind3); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "grids" && sind1 < levels) + grids[sind1] = atoi(sval.c_str()); + if (sgrp == "cgh" && skey == "bbox" && sind1 == 0 && sind2 == 0) + bbox[sind3] = atof(sval.c_str()); + } + inf.close(); + } + for (int i = 0; i < levels; i++) + if (maxl < grids[i]) + maxl = grids[i]; + + delete[] grids; + + if (BH_num > maxl) + { + int BH_numc = BH_num; + for (int i = 0; i < BH_num; i++) + if (Porg0[i][0] < bbox[0] || Porg0[i][0] > bbox[3] || + Porg0[i][1] < bbox[1] || Porg0[i][1] > bbox[4] || + Porg0[i][2] < bbox[2] || Porg0[i][2] > bbox[5]) + { + delete[] Porg0[i]; + Porg0[i] = 0; + BH_numc--; + } + + if (BH_num > BH_numc) + { + maxl = BH_numc; + int bhi; + double *tmp; + + tmp = Pmom; + Pmom = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + for (int j = 0; j < 3; j++) + Pmom[3 * bhi + j] = tmp[3 * i + j]; + bhi++; + } + delete[] tmp; + + tmp = Spin; + Spin = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + for (int j = 0; j < 3; j++) + Spin[3 * bhi + j] = tmp[3 * i + j]; + bhi++; + } + delete[] tmp; + + tmp = Mass; + Mass = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + Mass[bhi] = tmp[i]; + bhi++; + } + delete[] tmp; + + double **ttmp; + ttmp = Porg0; + Porg0 = new double *[maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (ttmp[i]) + { + Porg0[bhi] = ttmp[i]; + bhi++; + } + delete[] ttmp; + + for (int i = 0; i < BH_num; i++) + { + delete[] Porgbr[i]; + delete[] Porg[i]; + delete[] Porg1[i]; + delete[] Porg_rhs[i]; + } + delete[] Porgbr; + delete[] Porg; + delete[] Porg1; + delete[] Porg_rhs; + + BH_num = maxl; + + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + + for (int i = 0; i < BH_num; i++) + { + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + } + } + } + + for (int i = 0; i < BH_num; i++) + { + for (int j = 0; j < dim; j++) + Porgbr[i][j] = Porg0[i][j]; + } + + setpbh(BH_num, Porg0, Mass, BH_num_input); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes black hole positions + +//================================================================================================ + +#if 0 +// old code + +void bssn_class::compute_Porg_rhs(double **BH_PS,double **BH_RHS,var *forx,var *fory,var *forz,int lev) +{ + const int InList = 3; + + MyList * DG_List=new MyList(forx); + DG_List->insert(fory); DG_List->insert(forz); + + int n; + double *x1,*y1,*z1; + double *shellf; + shellf=new double[3*BH_num]; + double *pox[3]; + for(int i=0;i<3;i++) pox[i] = new double[BH_num]; + for( n = 0; n < BH_num; n++) + { + pox[0][n] = BH_PS[n][0]; + pox[1][n] = BH_PS[n][1]; + pox[2][n] = BH_PS[n][2]; + } + + if(!Parallel::PatList_Interp_Points(GH->PatL[lev],DG_List,BH_num,pox,shellf,Symmetry)) + { + ErrorMonitor->outfile<<"fail to find black holes at t = "<outfile<<"(x,y,z) = ("<clearList(); + delete[] shellf; + for(int i=0;i<3;i++) delete[] pox[i]; +} + +#else + +// new code considering diferent levels for different black hole + +void bssn_class::compute_Porg_rhs(double **BH_PS, double **BH_RHS, var *forx, var *fory, var *forz, int ilev) +{ + const int InList = 3; + + MyList *DG_List = new MyList(forx); + DG_List->insert(fory); + DG_List->insert(forz); + + double *x1, *y1, *z1; + double *shellf; + shellf = new double[3]; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[1]; + + for (int n = 0; n < BH_num; n++) + { + pox[0][0] = BH_PS[n][0]; + pox[1][0] = BH_PS[n][1]; + pox[2][0] = BH_PS[n][2]; + + int lev = ilev; + +#if (PSTR == 0) + while (!Parallel::PatList_Interp_Points(GH->PatL[lev], DG_List, 1, pox, shellf, Symmetry)) +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) + while (!Parallel::PatList_Interp_Points(GH->PatL[lev], DG_List, 1, pox, shellf, Symmetry, GH->Commlev[lev])) +#endif + { + lev--; + if (lev < 0) + { + ErrorMonitor->outfile << "fail to find black holes at t = " << PhysTime << endl; + for (n = 0; n < BH_num; n++) + ErrorMonitor->outfile << "(x,y,z) = (" + << pox[0][n] << "," << pox[1][n] << "," << pox[2][n] + << ")" << endl; + break; + } + } + + if (lev >= 0) + { + BH_RHS[n][0] = -shellf[0]; + BH_RHS[n][1] = -shellf[1]; + BH_RHS[n][2] = -shellf[2]; + } + } + + DG_List->clearList(); + delete[] shellf; + for (int i = 0; i < 3; i++) + delete[] pox[i]; +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes gravitational-wave related quantities and performs analysis + +//================================================================================================ + +void bssn_class::AnalysisStuff(int lev, double dT_lev) +{ + LastAnas += dT_lev; + + if (LastAnas >= AnasTime) + { +#ifdef Point_Psi4 +#error "not support parallel levels yet" + // Gam_ijk and R_ij have been calculated in Interp_Constraint() + double SYM = 1, ANT = -1; + for (int levh = lev; levh < GH->levels; levh++) + { + MyList *Pp = GH->PatL[levh]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_fderivs(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[phix->sgfn], cg->fgfs[phiy->sgfn], cg->fgfs[phiz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[trK0->sgfn], + cg->fgfs[trKx->sgfn], cg->fgfs[trKy->sgfn], cg->fgfs[trKz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axx0->sgfn], + cg->fgfs[Axxx->sgfn], cg->fgfs[Axxy->sgfn], cg->fgfs[Axxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axy0->sgfn], + cg->fgfs[Axyx->sgfn], cg->fgfs[Axyy->sgfn], cg->fgfs[Axyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, ANT, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axz0->sgfn], + cg->fgfs[Axzx->sgfn], cg->fgfs[Axzy->sgfn], cg->fgfs[Axzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, SYM, ANT, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Ayy0->sgfn], + cg->fgfs[Ayyx->sgfn], cg->fgfs[Ayyy->sgfn], cg->fgfs[Ayyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Ayz0->sgfn], + cg->fgfs[Ayzx->sgfn], cg->fgfs[Ayzy->sgfn], cg->fgfs[Ayzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, ANT, ANT, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Azz0->sgfn], + cg->fgfs[Azzx->sgfn], cg->fgfs[Azzy->sgfn], cg->fgfs[Azzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_fderivs_shc(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[phix->sgfn], cg->fgfs[phiy->sgfn], cg->fgfs[phiz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + phi0->SoA[0], phi0->SoA[1], phi0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[trK0->sgfn], + cg->fgfs[trKx->sgfn], cg->fgfs[trKy->sgfn], cg->fgfs[trKz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + trK0->SoA[0], trK0->SoA[1], trK0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axx0->sgfn], + cg->fgfs[Axxx->sgfn], cg->fgfs[Axxy->sgfn], cg->fgfs[Axxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axx0->SoA[0], Axx0->SoA[1], Axx0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axy0->sgfn], + cg->fgfs[Axyx->sgfn], cg->fgfs[Axyy->sgfn], cg->fgfs[Axyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axy0->SoA[0], Axy0->SoA[1], Axy0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axz0->sgfn], + cg->fgfs[Axzx->sgfn], cg->fgfs[Axzy->sgfn], cg->fgfs[Axzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axz0->SoA[0], Axz0->SoA[1], Axz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Ayy0->sgfn], + cg->fgfs[Ayyx->sgfn], cg->fgfs[Ayyy->sgfn], cg->fgfs[Ayyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Ayy0->SoA[0], Ayy0->SoA[1], Ayy0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Ayz0->sgfn], + cg->fgfs[Ayzx->sgfn], cg->fgfs[Ayzy->sgfn], cg->fgfs[Ayzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Ayz0->SoA[0], Ayz0->SoA[1], Ayz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Azz0->sgfn], + cg->fgfs[Azzx->sgfn], cg->fgfs[Azzy->sgfn], cg->fgfs[Azzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Azz0->SoA[0], Azz0->SoA[1], Azz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#endif + } +#else + Compute_Psi4(lev); +#endif + double *RP, *IP, *RoutMAP; + int NN = 0; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; + RoutMAP = new double[7]; + double Rex = maxrex; + for (int i = 0; i < decn; i++) + { +#ifdef Point_Psi4 + Waveshell->surf_Wave(Rex, GH, SH, + phi, trK, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + phix, phiy, phiz, + trKx, trKy, trKz, + Axxx, Axxy, Axxz, + Axyx, Axyy, Axyz, + Axzx, Axzy, Axzz, + Ayyx, Ayyy, Ayyz, + Ayzx, Ayzy, Ayzz, + Azzx, Azzy, Azzz, + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz, + 2, maxl, NN, RP, IP, ErrorMonitor); +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } + else + { + Waveshell->surf_MassPAng(Rex, lev, SH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } +#else + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); +#endif +#else +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before surface integral"); +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } + else + { + Waveshell->surf_Wave(Rex, lev, SH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, SH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } +#else +#if (PSTR == 0) + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); +#elif (PSTR == 1 || PSTR == 2) + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor, GH->Commlev[lev]); + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after surf_Wave"); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor, GH->Commlev[lev]); +#endif +#endif +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"end surface integral"); +#endif + if (i == 0) + { + ADMMass = RoutMAP[0]; + } +#if (PSTR == 1 || PSTR == 2) + if (GH->start_rank[a_lev] > 0) + { + MPI_Status status; + // receive + if (myrank == 0) + { + MPI_Recv(RP, NN, MPI_DOUBLE, GH->start_rank[a_lev], 1, MPI_COMM_WORLD, &status); + MPI_Recv(IP, NN, MPI_DOUBLE, GH->start_rank[a_lev], 2, MPI_COMM_WORLD, &status); + MPI_Recv(RoutMAP, 7, MPI_DOUBLE, GH->start_rank[a_lev], 3, MPI_COMM_WORLD, &status); + } + // send + if (myrank == GH->start_rank[a_lev]) + { + MPI_Send(RP, NN, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD); + MPI_Send(IP, NN, MPI_DOUBLE, 0, 2, MPI_COMM_WORLD); + MPI_Send(RoutMAP, 7, MPI_DOUBLE, 0, 3, MPI_COMM_WORLD); + } + } +#endif + Psi4Monitor->writefile(PhysTime, NN, RP, IP); + MAPMonitor->writefile(PhysTime, 7, RoutMAP); + Rex = Rex - drex; + } + delete[] RP; + delete[] IP; + delete[] RoutMAP; + + // black hole's position + { + double *pox; + pox = new double[dim * BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + for (int i = 0; i < dim; i++) + pox[dim * bhi + i] = Porg0[bhi][i]; + BHMonitor->writefile(PhysTime, dim * BH_num, pox); + delete[] pox; + } + + LastAnas = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes and outputs constraint violations + +//================================================================================================ + +void bssn_class::Constraint_Out() +{ + LastConsOut += dT * pow(0.5, Mymax(0, trfls)); + + if (LastConsOut >= AnasTime) + // Constraint violation + { + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) // if the constrait quantities can be reused from the step rhs calculation + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + if (0) // if the constrait quantities can be reused from the step rhs calculation + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + double TRK4 = PhysTime; + int pre = 0; + int lev = 0; + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); +#endif + + double ConV[7]; +#if (PSTR == 1 || PSTR == 2) + double ConV_h[7]; +#endif + +#ifdef WithShell + ConV[0] = SH->L2Norm(Cons_Ham); + ConV[1] = SH->L2Norm(Cons_Px); + ConV[2] = SH->L2Norm(Cons_Py); + ConV[3] = SH->L2Norm(Cons_Pz); + ConV[4] = SH->L2Norm(Cons_Gx); + ConV[5] = SH->L2Norm(Cons_Gy); + ConV[6] = SH->L2Norm(Cons_Gz); + ConVMonitor->writefile(PhysTime, 7, ConV); +#endif + for (int levi = 0; levi < GH->levels; levi++) + { +#if (PSTR == 0) + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz); +#elif (PSTR == 1 || PSTR == 2) + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham, GH->Commlev[levi]); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px, GH->Commlev[levi]); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py, GH->Commlev[levi]); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz, GH->Commlev[levi]); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx, GH->Commlev[levi]); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy, GH->Commlev[levi]); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz, GH->Commlev[levi]); + // misc::tillherecheck("before collect data to cpu0"); + // MPI_ALLREDUCE( sendbuf, recvbuf, count, datatype, op, comm), sendbu and recvbuf must be different + if (levi > 0) + { + if (GH->mylev == levi && myrank == GH->start_rank[levi]) + for (int i = 0; i < 7; i++) + ConV_h[i] = ConV[i]; + else + for (int i = 0; i < 7; i++) + ConV_h[i] = 0; + MPI_Allreduce(ConV_h, ConV, 7, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + } +#endif + ConVMonitor->writefile(PhysTime, 7, ConV); + /* + if(fabs(ConV[0])<0.00001) + { + MyList * DG_List=new MyList(Cons_Ham); + DG_List->insert(Cons_Px); DG_List->insert(Cons_Py); DG_List->insert(Cons_Px); + DG_List->insert(Cons_Gx); DG_List->insert(Cons_Gy); DG_List->insert(Cons_Gx); + Parallel::Dump_Data(GH->PatL[levi],DG_List,"jiu",0,1); + DG_List->clearList(); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } + */ + } + + Interp_Constraint(false); + + LastConsOut = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes derivatives required for apparent-horizon calculations + +//================================================================================================ + +#ifdef With_AHF +void bssn_class::AH_Prepare_derivatives() +{ + double SYM = 1.0, ANT = -1.0; + int ZEO = 0; + + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_fderivs(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxx0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamzxx->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxy0->sgfn], + cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamzxy->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, ANT, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxz0->sgfn], + cg->fgfs[Gamxxz->sgfn], cg->fgfs[Gamyxz->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, SYM, ANT, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gyy0->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamzyy->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gyz0->sgfn], + cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamzyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, ANT, ANT, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gzz0->sgfn], + cg->fgfs[Gamxzz->sgfn], cg->fgfs[Gamyzz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + Parallel::Sync(GH->PatL[lev], AHDList, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function interpolates apparent-horizon data + +//================================================================================================ + +bool bssn_class::AH_Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetryi) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double pox[3]; + for (int i = 0; i < NN; i++) + { + for (int j = 0; j < 3; j++) + pox[j] = XX[j][i]; + int lev = GH->levels - 1; + bool notfound = true; + + while (notfound) + { + if (lev < 0) + { +#ifdef WithShell + if (SH->Interp_One_Point(VarList, pox, Shellf + i * num_var, Symmetryi)) + { + return true; + } + if (myrank == 0) + { + cout << " bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh and shell domain!" << endl; + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << " bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh and shell domain!" << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); +#else + if (myrank == 0) + { + cout << " bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh domain!" << endl; + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << " bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh domain!" << endl; + } + MPI_Abort(MPI_COMM_WORLD, 1); +#endif + return false; + } + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + if (Pp->data->Interp_ONE_Point(VarList, pox, Shellf + i * num_var, Symmetryi)) + { + notfound = false; + break; + } + Pp = Pp->next; + } + lev--; + } + } + return true; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes apparent horizons + +//================================================================================================ + +void bssn_class::AH_Step_Find(int lev, double dT_lev) +{ + if ((lev == GH->levels - 1)) + { + int ncount = int(PhysTime / dT_lev); + bool tf = false; + for (int ihn = 0; ihn < HN_num; ihn++) + { + if (ncount % findeveryl[ihn] == 0) + { + tf = true; + break; + } + } + if (tf) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + prev_clock = clock(); + const int cdumpid = int(PhysTime / AHdumptime) + 1; + for (int ihn = 0; ihn < HN_num; ihn++) + dumpid[ihn] = cdumpid; + + double gam; + for (int ihn = 0; ihn < BH_num; ihn++) + { + xc[ihn] = Porg0[ihn][0]; + yc[ihn] = Porg0[ihn][1]; + zc[ihn] = Porg0[ihn][2]; + gam = fabs(Pmom[ihn * 3]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + xr[ihn] = Mass[ihn] * gam; + gam = fabs(Pmom[ihn * 3 + 1]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + yr[ihn] = Mass[ihn] * gam; + gam = fabs(Pmom[ihn * 3 + 2]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + zr[ihn] = Mass[ihn] * gam; + dTT[ihn] = -1; + + if (ncount % findeveryl[ihn] == 0) + { + trigger[ihn] = true; + dTT[ihn] = findeveryl[ihn] * dT_lev; + } + else + trigger[ihn] = false; + if (trigger[ihn] && (dumpid[ihn] > lastahdumpid[ihn])) + lastahdumpid[ihn] = dumpid[ihn]; + else + dumpid[ihn] = 0; + } + int ihn = BH_num; + for (int ia = 0; ia < BH_num; ia++) + for (int ib = ia + 1; ib < BH_num; ib++) + { + xc[ihn] = (Porg0[ia][0] + Porg0[ib][0]) / 2; + yc[ihn] = (Porg0[ia][1] + Porg0[ib][1]) / 2; + zc[ihn] = (Porg0[ia][2] + Porg0[ib][2]) / 2; + + xr[ihn] = yr[ihn] = zr[ihn] = Mass[ia] + Mass[ib]; + + dTT[ihn] = -1; + + if (fabs(Porg0[ia][0] - Porg0[ib][0]) < 2 * xr[ihn] && + fabs(Porg0[ia][1] - Porg0[ib][1]) < 2 * xr[ihn] && + fabs(Porg0[ia][2] - Porg0[ib][2]) < 2 * xr[ihn] && + (ncount % findeveryl[ihn] == 0)) + { + trigger[ihn] = true; + dTT[ihn] = findeveryl[ihn] * dT_lev; + } + else + trigger[ihn] = false; + + if (trigger[ihn] && (dumpid[ihn] > lastahdumpid[ihn])) + lastahdumpid[ihn] = dumpid[ihn]; + else + dumpid[ihn] = 0; + + ihn++; + } +#if (ABEtype == 1) + if (PhysTime > 10) + { + ihn--; + trigger[ihn] = true; + xr[ihn] = yr[ihn] = zr[ihn] = 50; + // if(myrank==0) for(ihn=0;ihn 0) + return; + + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) // if the constrait quantities can be reused from the step rhs calculation + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + if (0) // if the constrait quantities can be reused from the step rhs calculation + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + double TRK4 = PhysTime; + int pre = 0; + int lev = 0; + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); +#endif + } + // interpolate + double *x1, *y1, *z1; + const int n = 1000; + double lmax, lmin, dd; + lmin = 0; +#ifdef WithShell + lmax = SH->Rrange[1]; +#else + lmax = GH->bbox[0][0][4]; +#endif +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (lmax - lmin) / (n - 1); +#else +#ifdef Cell + dd = (lmax - lmin) / n; +#else +#error Not define Vertex nor Cell +#endif +#endif + x1 = new double[n]; + y1 = new double[n]; + z1 = new double[n]; + for (int i = 0; i < n; i++) + { + x1[i] = 0; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y1[i] = lmin + i * dd; +#else +#ifdef Cell + y1[i] = lmin + (i + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + z1[i] = 0; + } + + int InList = 0; + + MyList *varl = ConstraintList; + while (varl) + { + InList++; + varl = varl->next; + } + double *shellf; + shellf = new double[n * InList]; + for (int i = 0; i < n; i++) + { + double XX[3]; + XX[0] = x1[i]; + XX[1] = y1[i]; + XX[2] = z1[i]; + bool fg = GH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#ifdef WithShell + if (!fg) + fg = SH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#endif + if (!fg && myrank == 0) + { + cout << "bssn_class::Interp_Constraint meets wrong" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + if (myrank == 0) + { + ofstream outfile; + char filename[50]; + sprintf(filename, "%s/interp_constraint_%05d.dat", ErrorMonitor->out_dir.c_str(), int(PhysTime / dT + 0.5)); + // 0.5 for round off + + outfile.open(filename); + outfile << "# corrdinate, H_Res, Px_Res, Py_Res, Pz_Res, Gx_Res, Gy_Res, Gz_Res, ...." << endl; + for (int i = 0; i < n; i++) + { + outfile << setw(10) << setprecision(10) << y1[i]; + for (int j = 0; j < InList; j++) + outfile << " " << setw(16) << setprecision(15) << shellf[InList * i + j]; + outfile << endl; + } + outfile.close(); + } + + delete[] shellf; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes constraint violations + +//================================================================================================ + +void bssn_class::Compute_Constraint() +{ + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + int lev; + + for (lev = 0; lev < GH->levels; lev++) + { + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } + // prolong restrict constraint quantities + for (lev = GH->levels - 1; lev > 0; lev--) + RestrictProlong(lev, 1, false, ConstraintList, ConstraintList, ConstraintList); + +#ifdef WithShell + lev = 0; + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); + // interpolate constraint quantities + SH->CS_Inter(ConstraintList, Symmetry); +#endif +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::testRestrict() +{ + MyList *DG_List = new MyList(phi0); + int lev = 0; + double ZEO = 0, ONE = 1; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 1; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ONE); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], DG_List, DG_List, Symmetry); + Parallel::Sync(GH->PatL[lev - 1], DG_List, Symmetry); + + Parallel::Dump_Data(GH->PatL[lev - 1], DG_List, 0, PhysTime, dT); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT); + + DG_List->clearList(); + exit(0); +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::testOutBd() +{ + MyList *DG_List = new MyList(phi0); + int lev = 1; + double ZEO = 0, ONE = 1; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 0; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ONE); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 1; + MyList *Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, DG_List, DG_List, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); + + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT); + Parallel::Dump_Data(GH->PatL[lev - 1], DG_List, 0, PhysTime, dT); + + DG_List->clearList(); + exit(0); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function enforces/checks the traceless condition + +//================================================================================================ + +void bssn_class::Enforce_algcon(int lev, int fg) +{ + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (fg == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); + else + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + if (lev == 0) + { + MyList *sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (fg == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); + else + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function monitors stdin for an 'abort' input + +//================================================================================================ + +bool bssn_class::check_Stdin_Abort() +{ + + fd_set readfds; + + struct timeval timeout; + + FD_ZERO(&readfds); + FD_SET(STDIN_FILENO, &readfds); + + // Set timeout to 0 — perform a non-blocking check + timeout.tv_sec = 0; + timeout.tv_usec = 0; + + int activity = select(STDIN_FILENO + 1, &readfds, nullptr, nullptr, &timeout); + + if (activity > 0 && FD_ISSET(STDIN_FILENO, &readfds)) { + string input_abort; + if (cin >> input_abort) { + if (input_abort == "stop") { + return true; + } + } + } + + return false; +} + +//================================================================================================ + diff --git a/AMSS_NCKU_source/bssn_class.h b/AMSS_NCKU_source/bssn_class.h new file mode 100644 index 0000000..740d3aa --- /dev/null +++ b/AMSS_NCKU_source/bssn_class.h @@ -0,0 +1,198 @@ + +#ifndef BSSN_CLASS_H +#define BSSN_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" +#include "surface_integral.h" +#include "checkpoint.h" + +extern void setpbh(int iBHN, double **iPBH, double *iMass, int rBHN); + +class bssn_class +{ +public: + int ngfs; + int nprocs, myrank; + cgh *GH; + ShellPatch *SH; + double PhysTime; + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, d2DumpTime, CheckTime; + double LastAnas, LastConsOut; + double Courant; + double numepss, numepsb, numepsh; + int Symmetry; + int maxl, decn; + double maxrex, drex; + int trfls, a_lev; + + double dT; + double chitiny; + + double **Porg0, **Porgbr, **Porg, **Porg1, **Porg_rhs; + int BH_num, BH_num_input; + double *Mass, *Pmom, *Spin; + double ADMMass; + + var *phio, *trKo; + var *gxxo, *gxyo, *gxzo, *gyyo, *gyzo, *gzzo; + var *Axxo, *Axyo, *Axzo, *Ayyo, *Ayzo, *Azzo; + var *Gmxo, *Gmyo, *Gmzo; + var *Lapo, *Sfxo, *Sfyo, *Sfzo; + var *dtSfxo, *dtSfyo, *dtSfzo; + + var *phi0, *trK0; + var *gxx0, *gxy0, *gxz0, *gyy0, *gyz0, *gzz0; + var *Axx0, *Axy0, *Axz0, *Ayy0, *Ayz0, *Azz0; + var *Gmx0, *Gmy0, *Gmz0; + var *Lap0, *Sfx0, *Sfy0, *Sfz0; + var *dtSfx0, *dtSfy0, *dtSfz0; + + var *phi, *trK; + var *gxx, *gxy, *gxz, *gyy, *gyz, *gzz; + var *Axx, *Axy, *Axz, *Ayy, *Ayz, *Azz; + var *Gmx, *Gmy, *Gmz; + var *Lap, *Sfx, *Sfy, *Sfz; + var *dtSfx, *dtSfy, *dtSfz; + + var *phi1, *trK1; + var *gxx1, *gxy1, *gxz1, *gyy1, *gyz1, *gzz1; + var *Axx1, *Axy1, *Axz1, *Ayy1, *Ayz1, *Azz1; + var *Gmx1, *Gmy1, *Gmz1; + var *Lap1, *Sfx1, *Sfy1, *Sfz1; + var *dtSfx1, *dtSfy1, *dtSfz1; + + var *phi_rhs, *trK_rhs; + var *gxx_rhs, *gxy_rhs, *gxz_rhs, *gyy_rhs, *gyz_rhs, *gzz_rhs; + var *Axx_rhs, *Axy_rhs, *Axz_rhs, *Ayy_rhs, *Ayz_rhs, *Azz_rhs; + var *Gmx_rhs, *Gmy_rhs, *Gmz_rhs; + var *Lap_rhs, *Sfx_rhs, *Sfy_rhs, *Sfz_rhs; + var *dtSfx_rhs, *dtSfy_rhs, *dtSfz_rhs; + + var *rho, *Sx, *Sy, *Sz, *Sxx, *Sxy, *Sxz, *Syy, *Syz, *Szz; + + var *Gamxxx, *Gamxxy, *Gamxxz, *Gamxyy, *Gamxyz, *Gamxzz; + var *Gamyxx, *Gamyxy, *Gamyxz, *Gamyyy, *Gamyyz, *Gamyzz; + var *Gamzxx, *Gamzxy, *Gamzxz, *Gamzyy, *Gamzyz, *Gamzzz; + + var *Rxx, *Rxy, *Rxz, *Ryy, *Ryz, *Rzz; + + var *Rpsi4, *Ipsi4; + var *t1Rpsi4, *t1Ipsi4, *t2Rpsi4, *t2Ipsi4; + + var *Cons_Ham, *Cons_Px, *Cons_Py, *Cons_Pz, *Cons_Gx, *Cons_Gy, *Cons_Gz; + +#ifdef Point_Psi4 + var *phix, *phiy, *phiz; + var *trKx, *trKy, *trKz; + var *Axxx, *Axxy, *Axxz; + var *Axyx, *Axyy, *Axyz; + var *Axzx, *Axzy, *Axzz; + var *Ayyx, *Ayyy, *Ayyz; + var *Ayzx, *Ayzy, *Ayzz; + var *Azzx, *Azzy, *Azzz; +#endif + // FIXME: uc = StateList, up = OldStateList, upp = SynchList_cor; so never touch these three data + MyList *StateList, *SynchList_pre, *SynchList_cor, *RHSList; + MyList *OldStateList, *DumpList; + MyList *ConstraintList; + + monitor *ErrorMonitor, *Psi4Monitor, *BHMonitor, *MAPMonitor; + monitor *ConVMonitor; + surface_integral *Waveshell; + checkpoint *CheckPoint; + +public: + bssn_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi); + ~bssn_class(); + + void Evolve(int Steps); + void RecursiveStep(int lev); +#if (PSTR == 3) + void RecursiveStep(int lev, int num); +#endif +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + void ParallelStep(); + void SHStep(); +#endif + void RestrictProlong(int lev, int YN, bool BB, MyList *SL, MyList *OL, MyList *corL); + void RestrictProlong_aux(int lev, int YN, bool BB, MyList *SL, MyList *OL, MyList *corL); + void RestrictProlong(int lev, int YN, bool BB); + void ProlongRestrict(int lev, int YN, bool BB); + void Setup_Black_Hole_position(); + void compute_Porg_rhs(double **BH_PS, double **BH_RHS, var *forx, var *fory, var *forz, int lev); + bool read_Pablo_file(int *ext, double *datain, char *filename); + void write_Pablo_file(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename); + void AnalysisStuff(int lev, double dT_lev); + void Setup_KerrSchild(); + void Enforce_algcon(int lev, int fg); + + void testRestrict(); + void testOutBd(); + + bool check_Stdin_Abort(); + + virtual void Setup_Initial_Data_Cao(); + virtual void Setup_Initial_Data_Lousto(); + virtual void Initialize(); + virtual void Read_Ansorg(); + virtual void Read_Pablo() {}; + virtual void Compute_Psi4(int lev); + virtual void Step(int lev, int YN); + virtual void Interp_Constraint(bool infg); + virtual void Constraint_Out(); + virtual void Compute_Constraint(); + +#ifdef With_AHF +protected: + MyList *AHList, *AHDList, *GaugeList; + int AHfindevery; + double AHdumptime; + int *lastahdumpid, HN_num; // number of possible horizons + int *findeveryl; + double *xc, *yc, *zc, *xr, *yr, *zr; + bool *trigger; + double *dTT; + int *dumpid; + +public: + void AH_Prepare_derivatives(); + bool AH_Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetryi); + void AH_Step_Find(int lev, double dT_lev); +#endif +}; +#endif /* BSSN_CLASS_H */ diff --git a/AMSS_NCKU_source/bssn_constraint.f90 b/AMSS_NCKU_source/bssn_constraint.f90 new file mode 100644 index 0000000..cef113a --- /dev/null +++ b/AMSS_NCKU_source/bssn_constraint.f90 @@ -0,0 +1,787 @@ + + +#include "macrodef.fh" + +#if (ABV == 0) +!! using BSSN variables +!-------------------------------------------------------------------------------! +! computed constraint for bssn formalism ! +!-------------------------------------------------------------------------------! + subroutine constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! second kind of Christofel symble Gamma^i_jk respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chin1,chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chin1 = chi+ONE +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gmx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gmy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gmz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! M_j = gupki*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Axz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Ayy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Ayz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Azz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +!store K,i in chi,i + call fderivs(ex,trK,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + +movx_Res = movx_Res - F2o3*chix - F8*PI*sx +movy_Res = movy_Res - F2o3*chiy - F8*PI*sy +movz_Res = movz_Res - F2o3*chiz - F8*PI*sz + + return + + end subroutine constraint_bssn +!-------------------------------------------------------------------------------! +! computed constraint for bssn formalism for shell ! +!-------------------------------------------------------------------------------! + subroutine constraint_bssn_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,sst) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! second kind of Christofel symble Gamma^i_jk respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chin1,chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chin1 = chi+ONE +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gmx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gmy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gmz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! M_j = gupki*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +!store K,i in chi,i + call fderivs_shc(ex,trK,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +movx_Res = movx_Res - F2o3*chix - F8*PI*sx +movy_Res = movy_Res - F2o3*chiy - F8*PI*sy +movz_Res = movz_Res - F2o3*chiz - F8*PI*sz + + return + + end subroutine constraint_bssn_ss +#elif (ABV == 1) +!! using ADM variables +!-------------------------------------------------------------------------------! +! computed constraint for bssn formalism ! +!-------------------------------------------------------------------------------! + subroutine constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! second kind of Christofel symble Gamma^i_jk respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: adm_dxx,adm_dyy,adm_dzz,adm_gxy,adm_gxz,adm_gyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kyy,Kzz,Kxy,Kxz,Kyz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chin1 = chi+ONE +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gmx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gmy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gmz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + + call bssn2adm(ex,chin1,trK,gxx,gxy,gxz,gyy,gyz,gzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz) + adm_dxx = adm_dxx - ONE + adm_dyy = adm_dyy - ONE + adm_dzz = adm_dzz - ONE + + call constraint_adm(ex, X, Y, Z,& + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + ham_Res, movx_Res, movy_Res, movz_Res, & + Symmetry) + + return + + end subroutine constraint_bssn +!-------------------------------------------------------------------------------! +! computed constraint for bssn formalism for shell ! +!-------------------------------------------------------------------------------! + subroutine constraint_bssn_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,sst) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! second kind of Christofel symble Gamma^i_jk respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +!~~~~~~> Other variables: +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! first order derivative of metric, @_k g_ij + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: adm_dxx,adm_dyy,adm_dzz,adm_gxy,adm_gxz,adm_gyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kyy,Kzz,Kxy,Kxz,Kyz + + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: PI + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chin1 = chi+ONE +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gmx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gmy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gmz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + + call bssn2adm(ex,chin1,trK,gxx,gxy,gxz,gyy,gyz,gzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz) + adm_dxx = adm_dxx - ONE + adm_dyy = adm_dyy - ONE + adm_dzz = adm_dzz - ONE + + call constraint_adm_ss(ex,crho,sigma,R, X, Y, Z,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Symmetry,Lev,sst) + + return + + end subroutine constraint_bssn_ss +#else +#error "not recognized ABV" +#endif diff --git a/AMSS_NCKU_source/bssn_gpu.cu b/AMSS_NCKU_source/bssn_gpu.cu new file mode 100644 index 0000000..e67ae18 --- /dev/null +++ b/AMSS_NCKU_source/bssn_gpu.cu @@ -0,0 +1,2908 @@ +// includes, system +#include +#include +#include +#include +#include +#include +#include +//#include "cutil.h" +#include +#include +using namespace std; + +//includes, bssn +#include "gpu_mem.h" +#include "bssn_gpu.h" +#ifdef RESULT_CHECK +#include +#endif + +void compare_result_gpu(int ftag1,double * datac,int data_num){ + double * data = (double*)malloc(sizeof(double)*data_num); + cudaMemcpy(data, datac, data_num * sizeof(double), cudaMemcpyDeviceToHost); + compare_result(ftag1,data,data_num); + free(data); +} + +__global__ void test_const_address(double * testd){ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + if(_t == 0) + testd[0] = F1o3; +} + +__global__ void enforce_ga(double * trA){ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + //int ps; //TOTRY: i,j,k; double value; + + while(_t < _3D_SIZE[0]) + { + M_ gxx[_t] = M_ dxx[_t] + 1; + M_ gyy[_t] = M_ dyy[_t] + 1; + M_ gzz[_t] = M_ dzz[_t] + 1; + // for M_ g; + M_ gupzz[_t] = M_ gxx[_t] * M_ gyy[_t] * M_ gzz[_t] + M_ gxy[_t] * M_ gyz[_t] * M_ gxz[_t] + M_ gxz[_t] * M_ gxy[_t] * M_ gyz[_t] - + M_ gxz[_t] * M_ gyy[_t] * M_ gxz[_t] - M_ gxy[_t] * M_ gxy[_t] * M_ gzz[_t] - M_ gxx[_t] * M_ gyz[_t] * M_ gyz[_t]; + + M_ gupzz[_t] = 1.0 / pow( M_ gupzz[_t] , F1o3 ) ; + + M_ gxx[_t] = M_ gxx[_t] * M_ gupzz[_t]; + M_ gxy[_t] = M_ gxy[_t] * M_ gupzz[_t]; + M_ gxz[_t] = M_ gxz[_t] * M_ gupzz[_t]; + M_ gyy[_t] = M_ gyy[_t] * M_ gupzz[_t]; + M_ gyz[_t] = M_ gyz[_t] * M_ gupzz[_t]; + M_ gzz[_t] = M_ gzz[_t] * M_ gupzz[_t]; + + M_ dxx[_t] = M_ gxx[_t] - 1; + M_ dyy[_t] = M_ gyy[_t] - 1; + M_ dzz[_t] = M_ gzz[_t] - 1; + // for A ; + + M_ gupxx[_t] = ( M_ gyy[_t] * M_ gzz[_t] - M_ gyz[_t] * M_ gyz[_t] ); + M_ gupxy[_t] = - ( M_ gxy[_t] * M_ gzz[_t] - M_ gyz[_t] * M_ gxz[_t] ); + M_ gupxz[_t] = ( M_ gxy[_t] * M_ gyz[_t] - M_ gyy[_t] * M_ gxz[_t] ); + M_ gupyy[_t] = ( M_ gxx[_t] * M_ gzz[_t] - M_ gxz[_t] * M_ gxz[_t] ); + M_ gupyz[_t] = - ( M_ gxx[_t] * M_ gyz[_t] - M_ gxy[_t] * M_ gxz[_t] ); + M_ gupzz[_t] = ( M_ gxx[_t] * M_ gyy[_t] - M_ gxy[_t] * M_ gxy[_t] ); + + trA[_t] = M_ gupxx[_t] *M_ Axx[_t] + M_ gupyy[_t] * M_ Ayy[_t] + M_ gupzz[_t] * M_ Azz[_t] + + 2 * (M_ gupxy[_t] *M_ Axy[_t] + M_ gupxz[_t] *M_ Axz[_t] + M_ gupyz[_t] * M_ Ayz[_t]); + + M_ Axx[_t] = M_ Axx[_t] - F1o3 * M_ gxx[_t] * trA[_t]; + M_ Axy[_t] = M_ Axy[_t] - F1o3 * M_ gxy[_t] * trA[_t]; + M_ Axz[_t] = M_ Axz[_t] - F1o3 * M_ gxz[_t] * trA[_t]; + M_ Ayy[_t] = M_ Ayy[_t] - F1o3 * M_ gyy[_t] * trA[_t]; + M_ Ayz[_t] = M_ Ayz[_t] - F1o3 * M_ gyz[_t] * trA[_t]; + M_ Azz[_t] = M_ Azz[_t] - F1o3 * M_ gzz[_t] * trA[_t]; + //------------------- + _t += STEP_SIZE; + } +} + +inline void sub_enforce_ga(int matrix_size){ + double * trA = M_ chin1; + enforce_ga<<>>(trA); + cudaMemset(trA,0,matrix_size * sizeof(double)); + cudaThreadSynchronize(); + + //cudaMemset(Mh_ gupxx,0,matrix_size * sizeof(double)); + //trA gxx,gyy,gzz gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + +} +__device__ volatile unsigned int global_count = 0; +__global__ void test_init_matrix(){ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int curr = tid; + while(curr < _3D_SIZE[2]) + { + metac.fh[curr] = 0; + curr += STEP_SIZE; + } + curr = tid; + while(curr < _3D_SIZE[0]) + { + metac.betaxx[curr] = 0; + metac.betaxy[curr] = 0; + metac.betaxz[curr] = 0; + curr += STEP_SIZE; + } +} +__global__ void init_matrix(double * mat){ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int curr = tid; + while(curr < _3D_SIZE[0]) + { + mat[curr] = 0; + curr += STEP_SIZE; + } +} +__global__ void init_3_matrixs(double * mat1,double* mat2,double *mat3){ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int curr = tid; + while(curr < _3D_SIZE[0]) + { + mat1[curr] = 0; + mat2[curr] = 0; + mat3[curr] = 0; + curr += STEP_SIZE; + } +} +__global__ void init_matrix_fh(double * mat){ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int curr = tid; + while(curr < _3D_SIZE[2]) + { + mat[curr] = 0; + curr += STEP_SIZE; + } +} + + +__global__ void sub_symmetry_bd_partF(int ord, double * func, double *funcc) +{ + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); //= ps % ex_c[0]; + + funcc[i+ ord + (ord +j)* _1D_SIZE[ord] + (k + ord) * _2D_SIZE[ord]] = func[curr]; + + curr += STEP_SIZE; + } + +} + +#ifdef Vertex +__global__ void sub_symmetry_bd_partI(int ord, double * func, double * funcc,double S1){ + //for i + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; + int m; + while(curr < (ex_c[1]+ord)*(ex_c[2]+ord) ){ + m = ord * 2; + ps = curr * _1D_SIZE[ord]; + for(int i = 0;i < ord; ++i){ + funcc[ps] = funcc [ps + m] * S1; + ps ++; + m -= 2; + } + curr+= STEP_SIZE; + } + __syncthreads(); +} +__global__ void sub_symmetry_bd_partJ(int ord,double * func, double * funcc,double S2){ + //for j + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; + int m; + + while(curr < (ex_c[0]+ord)*(ex_c[2]+ord)) + { + m = 2 * ord; + ps = (curr/_1D_SIZE[ord])*_2D_SIZE[ord] + (curr % _1D_SIZE[ord]); + for(int i = 0;i>>(ord,func,funcc); + cudaThreadSynchronize(); + sub_symmetry_bd_partI<<>>(ord,func,funcc,SoA[0]); + cudaThreadSynchronize(); + sub_symmetry_bd_partJ<<>>(ord,func,funcc,SoA[1]); + cudaThreadSynchronize(); + sub_symmetry_bd_partK<<>>(ord,func,funcc,SoA[2]); + cudaThreadSynchronize(); +} + + +__global__ void sub_fdderivs_part1(double * f,double *fh,double *fxx,double *fxy,double *fxz,double *fyy,double *fyz,double *fzz) + { + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2]-1 || i == ex_c[0]-1 || j == ex_c[1]-1){ + curr += STEP_SIZE; + continue; + } + else + { + //xx + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0]){ + fxx[curr] = Fdxdx*(-_FH2_(i,(j+2),(k+2))+16*_FH2_((i+1),(j+2),(k+2))-30*_FH2_((i+2),(j+2),(k+2)) + -_FH2_((i+4),(j+2),(k+2))+16*_FH2_((i+3),(j+2),(k+2)) ); + + } + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0]){ + fxx[curr] = Sdxdx*(_FH2_((i+1),(j+2),(k+2))-2*_FH2_((i+2),(j+2),(k+2)) + +_FH2_(i+3,(j+2),(k+2)) ); + } + //zz-- + if(k+2 <= ijk_max[2] && k-2 >= ijk_min[2]){ + fzz[curr] = Fdzdz * (-_FH2_((i+2),(j+2),k) + 16 *_FH2_((i+2),(j+2),(k+1))- 30*_FH2_((i+2),(j+2),(k+2)) + -_FH2_((i+2),(j+2),(k+4))+ 16*_FH2_((i+2),(j+2),(k+3)) ); + } + else if(k+1 <= ijk_max[2] && k-1 >= ijk_min[2]){ + fzz[curr] = Sdzdz*(_FH2_((i+2),(j+2),(k+1))- 2 * _FH2_((i+2),(j+2),(k+2)) + + _FH2_((i+2),(j+2),(k+3)) ); + } + + //yy-- + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1]){ + fyy[curr] = Fdydy*(-_FH2_((i+2),j,(k+2))+16*_FH2_((i+2),(j+1),(k+2))-30*_FH2_((i+2),(j+2),(k+2)) + -_FH2_((i+2),(j+4),(k+2))+16*_FH2_((i+2),(j+3),(k+2)) ); + } + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1]){ + fyy[curr] = Sdydy*(_FH2_((i+2),(j+1),(k+2))-2*_FH2_((i+2),(j+2),(k+2)) + +_FH2_((i+2),(j+3),(k+2)) ); + } + + + + //xy + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0] && j+2 <= ijk_max[1] && j-2 >= ijk_min[1]) + fxy[curr] = Fdxdy*((_FH2_(i,j,(k+2))-8*_FH2_((i+1),j,(k+2))+8*_FH2_((i+3),j,(k+2))-_FH2_((i+4),j,(k+2))) + -8 *(_FH2_(i,(j+1),(k+2))-8*_FH2_((i+1),(j+1),(k+2))+8*_FH2_((i+3),(j+1),(k+2))-_FH2_((i+4),(j+1),(k+2))) + +8 *(_FH2_(i,(j+3),(k+2))-8*_FH2_((i+1),(j+3),(k+2))+8*_FH2_((i+3),(j+3),(k+2))-_FH2_((i+4),(j+3),(k+2))) + - (_FH2_(i,(j+4),(k+2))-8*_FH2_((i+1),(j+4),(k+2))+8*_FH2_((i+3),(j+4),(k+2))-_FH2_((i+4),(j+4),(k+2)))); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0] && j+1 <= ijk_max[1] && j-1 >= ijk_min[1]) + + fxy[curr] = Sdxdy*(_FH2_((i+1),(j+1),(k+2))-_FH2_((i+3),(j+1),(k+2))-_FH2_((i+1),(j+3),(k+2))+_FH2_((i+3),(j+3),(k+2))); + //xz + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0] && k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fxz[curr] = Fdxdz*( (_FH2_(i,(j+2),k)-8*_FH2_((i+1),(j+2),k)+8*_FH2_((i+3),(j+2),k)-_FH2_((i+4),(j+2),k)) + -8 *(_FH2_(i,(j+2),(k+1))-8*_FH2_((i+1),(j+2),(k+1))+8*_FH2_((i+3),(j+2),(k+1))-_FH2_((i+4),(j+2),(k+1))) + +8 *(_FH2_(i,(j+2),(k+3))-8*_FH2_((i+1),(j+2),(k+3))+8*_FH2_((i+3),(j+2),(k+3))-_FH2_((i+4),(j+2),(k+3))) + - (_FH2_(i,(j+2),(k+4))-8*_FH2_((i+1),(j+2),(k+4))+8*_FH2_((i+3),(j+2),(k+4))-_FH2_((i+4),(j+2),(k+4)))); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0] && k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fxz[curr] = Sdxdz*(_FH2_((i+1),(j+2),(k+1))-_FH2_((i+3),(j+2),(k+1))-_FH2_((i+1),(j+2),(k+3))+_FH2_((i+3),(j+2),(k+3))); + //yz + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1] && k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fyz[curr] = Fdydz*( (_FH2_((i+2),j,k)-8*_FH2_((i+2),(j+1),k)+8*_FH2_((i+2),(j+3),k)-_FH2_((i+2),(j+4),k)) + -8 *(_FH2_((i+2),j,(k+1))-8*_FH2_((i+2),(j+1),(k+1))+8*_FH2_((i+2),(j+3),(k+1))-_FH2_((i+2),(j+4),(k+1))) + +8 *(_FH2_((i+2),j,(k+3))-8*_FH2_((i+2),(j+1),(k+3))+8*_FH2_((i+2),(j+3),(k+3))-_FH2_((i+2),(j+4),(k+3))) + - (_FH2_((i+2),j,(k+4))-8*_FH2_((i+2),(j+1),(k+4))+8*_FH2_((i+2),(j+3),(k+4))-_FH2_((i+2),(j+4),(k+4)))); + + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1] && k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fyz[curr] = Sdydz*(_FH2_((i+2),(j+1),(k+1))-_FH2_((i+2),(j+3),(k+1))-_FH2_((i+2),(j+1),(k+3))+_FH2_((i+2),(j+3),(k+3))); + + curr += STEP_SIZE; + } + } + + __syncthreads(); + } + +inline void sub_fdderivs(double * f,double *fh,double *fxx,double *fxy,double *fxz,double *fyy,double *fyz,double *fzz,double* SoA) +{ + sub_symmetry_bd(2,f,fh,SoA); + cudaMemset(fxx,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fxy,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fxz,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fyy,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fyz,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fzz,0,_3D_SIZE[0] * sizeof(double)); + cudaThreadSynchronize(); + sub_fdderivs_part1<<>>(f,fh,fxx,fxy,fxz,fyy,fyz,fzz); + cudaThreadSynchronize(); +} + +__global__ void sub_fderivs_part1(double * f,double * fh,double *fx,double *fy,double *fz ) + { + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2]-1 || i == ex_c[0]-1 || j == ex_c[1]-1){ + curr += STEP_SIZE; + continue; + } + + //X-- + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0]) + fx[curr] = d12dxyz[0]*(fh[i+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] - + 8*fh[i+1+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] + + 8*fh[i+3+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] - + fh[i+4+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] ); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0]) + fx[curr] = d2dxyz[0]*(-fh[i+1+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] + + fh[i+3+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] ); + //Y-- + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1]) + fy[curr]=d12dxyz[1]*(fh[i+2+j*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]]- + 8*fh[i+2+(j+1)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] + + 8*fh[i+2+(j+3)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] - + fh[i+2+(j+4)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]]); + + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1]) + fy[curr]=d2dxyz[1]*(-fh[i+2+(j+1)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]] + + fh[i+2+(j+3)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]]); + //Z-- + + if(k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fz[curr]=d12dxyz[2]*( fh[i+2+(j+2)*_1D_SIZE[2]+k *_2D_SIZE[2]] - + 8* fh[i+2+(j+2)*_1D_SIZE[2]+(k+1)*_2D_SIZE[2]] + + 8* fh[i+2+(j+2)*_1D_SIZE[2]+(k+3)*_2D_SIZE[2]] - + fh[i+2+(j+2)*_1D_SIZE[2]+(k+4)*_2D_SIZE[2]]); + + else if(k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fz[curr]=d2dxyz[2]*(-fh[i+2+(j+2)*_1D_SIZE[2]+(k+1)*_2D_SIZE[2]]+ + fh[i+2+(j+2)*_1D_SIZE[2]+(k+3)*_2D_SIZE[2]]); + + curr += STEP_SIZE; + + } + } + +inline void sub_fderivs(double * f,double * fh,double *fx,double *fy,double *fz,double * SoA) +{ + sub_symmetry_bd(2,f,fh,SoA); + + cudaMemset(fx,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fy,0,_3D_SIZE[0] * sizeof(double)); + cudaMemset(fz,0,_3D_SIZE[0] * sizeof(double)); + + cudaThreadSynchronize(); + sub_fderivs_part1<<>>(f,fh,fx,fy,fz); + cudaThreadSynchronize(); +} + +__global__ void computeRicci_part1(double * dst) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + dst[_t] = M_ gupxx [_t]* M_ fxx [_t]+ M_ gupyy[_t]* M_ fyy[_t]+ M_ gupzz[_t]* M_ fzz[_t]+ + ( M_ gupxy[_t]* M_ fxy[_t]+ M_ gupxz[_t]* M_ fxz[_t]+ M_ gupyz[_t]* M_ fyz[_t]) * 2; + + _t += STEP_SIZE; + } +} + + inline void computeRicci(double * src,double* dst,double * SoA, Meta* meta) +{ + sub_fdderivs(src,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,SoA); + cudaThreadSynchronize(); + computeRicci_part1<<>>(dst); + cudaThreadSynchronize(); + +}/*Exception*/ + +__global__ void sub_kodis_part1(double *f,double *fh,double *f_rhs) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + double inc_f_rhs; + while(_t < _3D_SIZE[0]) + { + int k = _t / _2D_SIZE[0]; + ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2]-1 && i == ex_c[0]-1 && j == ex_c[1]-1){ + _t += STEP_SIZE; + continue; + } + + if(i-3 >= ijk_min3[0] && i+3 <= ijk_max[0] && + j-3 >= ijk_min3[1] && j+3 <= ijk_max[1] && + k-3 >= ijk_min3[2] && k+3 <= ijk_max[2]) + { + // x direction + inc_f_rhs = ( (_FH3_(i,(j+3),(k+3))+_FH3_((i+6),(j+3),(k+3))) - + 6*(_FH3_((i+1),(j+3),(k+3))+_FH3_((i+5),(j+3),(k+3))) + + 15*(_FH3_((i+2),(j+3),(k+3))+_FH3_((i+4),(j+3),(k+3))) - + 20* _FH3_((i+3),(j+3),(k+3)) ) /dX; + + + // y direction + + inc_f_rhs += ( (_FH3_((i+3),j,(k+3))+_FH3_((i+3),(j+6),(k+3))) - + 6*(_FH3_((i+3),(j+1),(k+3))+_FH3_((i+3),(j+5),(k+3))) + + 15*(_FH3_((i+3),(j+2),(k+3))+_FH3_((i+3),(j+4),(k+3))) - + 20* _FH3_((i+3),(j+3),(k+3)) )/dY; + + // z direction + + inc_f_rhs += ( (_FH3_((i+3),(j+3),k)+_FH3_((i+3),(j+3),(k+6))) - + 6*(_FH3_((i+3),(j+3),(k+1))+_FH3_((i+3),(j+3),(k+5))) + + 15*(_FH3_((i+3),(j+3),(k+2))+_FH3_((i+3),(j+3),(k+4))) - + 20* _FH3_((i+3),(j+3),(k+3)) )/dZ; + inc_f_rhs *= eps_c; + inc_f_rhs /= 64; + f_rhs[_t] += inc_f_rhs; //be careful the mark is "+=" not "==" ! + } + + _t += STEP_SIZE; + } +} + +inline void sub_kodis(double *f,double *fh,double *f_rhs,double *SoA) +{ + sub_symmetry_bd(3,f,fh,SoA); + cudaThreadSynchronize(); + sub_kodis_part1<<>>(f,fh,f_rhs); + cudaThreadSynchronize(); +} + +__global__ void sub_lopsided_part1(double *f,double* fh,double *f_rhs,double *Sfx,double *Sfy,double *Sfz) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(_t < _3D_SIZE[0]) + { + int k = _t / _2D_SIZE[0]; + ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k < ex_c[2]-1 && i < ex_c[0]-1 && j < ex_c[1]-1){ + // x direction + if(Sfx[_t] >= 0 && i+3 <= ijk_max[0] && i-1 >= ijk_min2[0]) + f_rhs[_t]=f_rhs[_t]+ + Sfx[_t]*d12dxyz[0]*(-3*_FH3_((i+2),(j+3),(k+3))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+4),(j+3),(k+3)) + -6*_FH3_((i+5),(j+3),(k+3))+ _FH3_((i+6),(j+3),(k+3))); + + else if(Sfx[_t] <= 0 && i-3 >= ijk_min2[0] && i+1 <= ijk_max[0]) + f_rhs[_t]=f_rhs[_t]- + Sfx[_t]*d12dxyz[0]*(-3*_FH3_((i+4),(j+3),(k+3))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+2),(j+3),(k+3)) + -6*_FH3_((i+1),(j+3),(k+3))+ _FH3_(i,(j+3),(k+3))); + + else if(i+2 <= ijk_max[0] && i-2 >= ijk_min2[0]) + + + f_rhs[_t]=f_rhs[_t]+ + Sfx[_t]*d12dxyz[0]*(_FH3_((i+1),(j+3),(k+3))-8*_FH3_((i+2),(j+3),(k+3))+8*_FH3_((i+4),(j+3),(k+3))-_FH3_((i+5),(j+3),(k+3))); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min2[0]) + + f_rhs[_t]=f_rhs[_t] + Sfx[_t]*d2dxyz[0]*(-_FH3_((i+2),(j+3),(k+3))+_FH3_((i+4),(j+3),(k+3))); + + + // y direction + if(Sfy[_t] >= 0 && j+3 <= ijk_max[1] && j-1 >= ijk_min2[1]) + + f_rhs[_t]=f_rhs[_t]+ + Sfy[_t]*d12dxyz[1]*(-3*_FH3_((i+3),(j+2),(k+3))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+3),(j+4),(k+3)) + -6*_FH3_((i+3),(j+5),(k+3))+ _FH3_((i+3),(j+6),(k+3))); + + else if(Sfy[_t] <= 0 && j-3 >= ijk_min2[1] && j+1 <= ijk_max[1]) + f_rhs[_t]=f_rhs[_t]- + Sfy[_t]*d12dxyz[1]*(-3*_FH3_((i+3),(j+4),(k+3))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+3),(j+2),(k+3)) + -6*_FH3_((i+3),(j+1),(k+3))+ _FH3_((i+3),j,(k+3))); + + else if(j+2 <= ijk_max[1] && j-2 >= ijk_min2[1]) + + f_rhs[_t]=f_rhs[_t]+ + Sfy[_t]*d12dxyz[1]*(_FH3_((i+3),(j+1),(k+3))-8*_FH3_((i+3),(j+2),(k+3))+8*_FH3_((i+3),(j+4),(k+3))-_FH3_((i+3),(j+5),(k+3))); + + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min2[1]) + + f_rhs[_t]=f_rhs[_t] + Sfy[_t]*d2dxyz[1]*(-_FH3_((i+3),(j+2),(k+3))+_FH3_((i+3),(j+4),(k+3))); + + + // z direction + if(Sfz[_t] >= 0 && k+3 <= ijk_max[2] && k-1 >= ijk_min2[2]) + // v + // D f = ------[ - 3f - 10f + 18f - 6f + f ] + // i 12dx i-v i i+v i+2v i+3v + f_rhs[_t]=f_rhs[_t]+ + Sfz[_t]*d12dxyz[2]*(-3*_FH3_((i+3),(j+3),(k+2))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+3),(j+3),(k+4)) + -6*_FH3_((i+3),(j+3),(k+5))+ _FH3_((i+3),(j+3),(k+6))); + + else if(Sfz[_t] <= 0 && k-3 >= ijk_min2[2] && k+1 <= ijk_max[2]) + f_rhs[_t]=f_rhs[_t]- + Sfz[_t]*d12dxyz[2]*(-3*_FH3_((i+3),(j+3),(k+4))-10*_FH3_((i+3),(j+3),(k+3))+18*_FH3_((i+3),(j+3),(k+2)) + -6*_FH3_((i+3),(j+3),(k+1))+ _FH3_((i+3),(j+3),k)); + + else if(k+2 <= ijk_max[2] && k-2 >= ijk_min2[2]) + + f_rhs[_t]=f_rhs[_t]+ + Sfz[_t]*d12dxyz[2]*(_FH3_((i+3),(j+3),(k+1))-8*_FH3_((i+3),(j+3),(k+2))+8*_FH3_((i+3),(j+3),(k+4))-_FH3_((i+3),(j+3),(k+5))); + + else if(k+1 <= ijk_max[2] && k-1 >= ijk_min2[2]) + + f_rhs[_t]=f_rhs[_t]+Sfz[_t]*d2dxyz[2]*(-_FH3_((i+3),(j+3),(k+2))+_FH3_((i+3),(j+3),(k+4))); + } + //------------------- + _t += STEP_SIZE; + } +} + + +inline void sub_lopsided(double *f,double*fh,double *f_rhs,double *Sfx,double *Sfy,double *Sfz,double *SoA){ + sub_symmetry_bd(3,f,fh,SoA); + cudaThreadSynchronize(); + sub_lopsided_part1<<>>(f,fh,f_rhs,Sfx,Sfy,Sfz); + cudaThreadSynchronize(); +} + +__global__ void compute_rhs_bssn_part1() +{ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int curr = tid; + while(curr < _3D_SIZE[0]) + { + metac.alpn1[curr] = metac.Lap[curr] + 1; + metac.chin1[curr] = metac.chi[curr] + 1; + metac.gxx[curr] = metac.dxx[curr] + 1; + metac.gyy[curr] = metac.dyy[curr] + 1; + metac.gzz[curr] = metac.dzz[curr] + 1; + + curr += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_part2() +{ + //__shared__ int judge = 1; + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + + M_ div_beta[_t] = M_ betaxx[_t] + M_ betayy[_t] + M_ betazz[_t]; + M_ chi_rhs[_t] = F2o3 *M_ chin1[_t]*( M_ alpn1[_t] * M_ trK[_t] - M_ div_beta[_t] ); //rhs[_t] for M_ chi + + M_ gxx_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axx[_t] - F2o3 * M_ gxx[_t]* M_ div_beta[_t] + + 2 *( M_ gxx[_t]* M_ betaxx[_t]+ M_ gxy[_t]* M_ betayx[_t]+ M_ gxz[_t]* M_ betazx[_t]); + M_ gyy_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Ayy[_t] - F2o3 * M_ gyy[_t]* M_ div_beta[_t] + + 2 *( M_ gxy[_t]* M_ betaxy[_t]+ M_ gyy[_t]* M_ betayy[_t]+ M_ gyz[_t]* M_ betazy[_t]); + + M_ gzz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Azz[_t] - F2o3 * M_ gzz[_t]* M_ div_beta[_t] + + 2 *( M_ gxz[_t]* M_ betaxz[_t]+ M_ gyz[_t]* M_ betayz[_t]+ M_ gzz[_t]* M_ betazz[_t]); + + M_ gxy_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axy[_t] + F1o3 * M_ gxy[_t] * M_ div_beta[_t] + + M_ gxx[_t]* M_ betaxy[_t] + M_ gxz[_t]* M_ betazy[_t]+ + M_ gyy[_t]* M_ betayx[_t]+ M_ gyz[_t]* M_ betazx[_t] + - M_ gxy[_t]* M_ betazz[_t]; + + M_ gyz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Ayz[_t] + F1o3 * M_ gyz[_t] * M_ div_beta[_t] + + M_ gxy[_t]* M_ betaxz[_t]+ M_ gyy[_t]* M_ betayz[_t] + + M_ gxz[_t]* M_ betaxy[_t] + M_ gzz[_t]* M_ betazy[_t] + - M_ gyz[_t]* M_ betaxx[_t]; + + M_ gxz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axz[_t] + F1o3 * M_ gxz[_t] * M_ div_beta[_t] + + M_ gxx[_t]* M_ betaxz[_t]+ M_ gxy[_t]* M_ betayz[_t] + + M_ gyz[_t]* M_ betayx[_t]+ M_ gzz[_t]* M_ betazx[_t] + - M_ gxz[_t]* M_ betayy[_t]; //rhs[_t] for gij + + // invert tilted metric + M_ gupzz[_t]= M_ gxx[_t]* M_ gyy[_t]* M_ gzz[_t]+ M_ gxy[_t]* M_ gyz[_t]* M_ gxz[_t]+ M_ gxz[_t]* M_ gxy[_t]* M_ gyz[_t]- + M_ gxz[_t]* M_ gyy[_t]* M_ gxz[_t]- M_ gxy[_t]* M_ gxy[_t]* M_ gzz[_t]- M_ gxx[_t]* M_ gyz[_t]* M_ gyz[_t]; + M_ gupxx[_t]= ( M_ gyy[_t]* M_ gzz[_t]- M_ gyz[_t]* M_ gyz[_t]) / M_ gupzz[_t]; + M_ gupxy[_t]= - ( M_ gxy[_t]* M_ gzz[_t]- M_ gyz[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupxz[_t]= ( M_ gxy[_t]* M_ gyz[_t]- M_ gyy[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupyy[_t]= ( M_ gxx[_t]* M_ gzz[_t]- M_ gxz[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupyz[_t]= - ( M_ gxx[_t]* M_ gyz[_t]- M_ gxy[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupzz[_t]= ( M_ gxx[_t]* M_ gyy[_t]- M_ gxy[_t]* M_ gxy[_t]) / M_ gupzz[_t]; + //if(threadIdx.x == 0){ + // judge = co_c; + //} + //__syncthreads(); + + if(co_c == 0) + { + // M_ Gam^i_Res = M_ Gam^i + M_ gup^ij_,j + M_ Gmx_Res[_t] = M_ Gamx[_t] - (M_ gupxx[_t]*(M_ gupxx[_t]*M_ gxxx[_t]+M_ gupxy[_t]*M_ gxyx[_t]+M_ gupxz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxx[_t]*M_ gxyx[_t]+M_ gupxy[_t]*M_ gyyx[_t]+M_ gupxz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxx[_t]*M_ gxzx[_t]+M_ gupxy[_t]*M_ gyzx[_t]+M_ gupxz[_t]*M_ gzzx[_t]) + +M_ gupxx[_t]*(M_ gupxy[_t]*M_ gxxy[_t]+M_ gupyy[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gxzy[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxyy[_t]+M_ gupyy[_t]*M_ gyyy[_t]+M_ gupyz[_t]*M_ gyzy[_t]) + +M_ gupxz[_t]*(M_ gupxy[_t]*M_ gxzy[_t]+M_ gupyy[_t]*M_ gyzy[_t]+M_ gupyz[_t]*M_ gzzy[_t]) + +M_ gupxx[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + M_ Gmy_Res[_t] = M_ Gamy[_t] - (M_ gupxx[_t]*(M_ gupxy[_t]*M_ gxxx[_t]+M_ gupyy[_t]*M_ gxyx[_t]+M_ gupyz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxyx[_t]+M_ gupyy[_t]*M_ gyyx[_t]+M_ gupyz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxy[_t]*M_ gxzx[_t]+M_ gupyy[_t]*M_ gyzx[_t]+M_ gupyz[_t]*M_ gzzx[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxxy[_t]+M_ gupyy[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gxzy[_t]) + +M_ gupyy[_t]*(M_ gupxy[_t]*M_ gxyy[_t]+M_ gupyy[_t]*M_ gyyy[_t]+M_ gupyz[_t]*M_ gyzy[_t]) + +M_ gupyz[_t]*(M_ gupxy[_t]*M_ gxzy[_t]+M_ gupyy[_t]*M_ gyzy[_t]+M_ gupyz[_t]*M_ gzzy[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupyy[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + M_ Gmz_Res[_t] = M_ Gamz[_t] - (M_ gupxx[_t]*(M_ gupxz[_t]*M_ gxxx[_t]+M_ gupyz[_t]*M_ gxyx[_t]+M_ gupzz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxyx[_t]+M_ gupyz[_t]*M_ gyyx[_t]+M_ gupzz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxzx[_t]+M_ gupyz[_t]*M_ gyzx[_t]+M_ gupzz[_t]*M_ gzzx[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxxy[_t]+M_ gupyz[_t]*M_ gxyy[_t]+M_ gupzz[_t]*M_ gxzy[_t]) + +M_ gupyy[_t]*(M_ gupxz[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gyyy[_t]+M_ gupzz[_t]*M_ gyzy[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxzy[_t]+M_ gupyz[_t]*M_ gyzy[_t]+M_ gupzz[_t]*M_ gzzy[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupzz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + }//if(co == 0) + + // second kind of connection + M_ Gamxxx[_t]=HALF*( M_ gupxx[_t]*M_ gxxx[_t]+ M_ gupxy[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupxz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + M_ Gamyxx[_t]=HALF*( M_ gupxy[_t]*M_ gxxx[_t]+ M_ gupyy[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupyz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + M_ Gamzxx[_t]=HALF*( M_ gupxz[_t]*M_ gxxx[_t]+ M_ gupyz[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupzz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + + M_ Gamxyy[_t]=HALF*( M_ gupxx[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupxy[_t]*M_ gyyy[_t]+ M_ gupxz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + M_ Gamyyy[_t]=HALF*( M_ gupxy[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupyy[_t]*M_ gyyy[_t]+ M_ gupyz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + M_ Gamzyy[_t]=HALF*( M_ gupxz[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupyz[_t]*M_ gyyy[_t]+ M_ gupzz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + + M_ Gamxzz[_t]=HALF*( M_ gupxx[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupxy[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupxz[_t]*M_ gzzz[_t]); + M_ Gamyzz[_t]=HALF*( M_ gupxy[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupyy[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupyz[_t]*M_ gzzz[_t]); + M_ Gamzzz[_t]=HALF*( M_ gupxz[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupyz[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupzz[_t]*M_ gzzz[_t]); + + M_ Gamxxy[_t]=HALF*( M_ gupxx[_t]*M_ gxxy[_t]+ M_ gupxy[_t]*M_ gyyx[_t]+ M_ gupxz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + M_ Gamyxy[_t]=HALF*( M_ gupxy[_t]*M_ gxxy[_t]+ M_ gupyy[_t]*M_ gyyx[_t]+ M_ gupyz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + M_ Gamzxy[_t]=HALF*( M_ gupxz[_t]*M_ gxxy[_t]+ M_ gupyz[_t]*M_ gyyx[_t]+ M_ gupzz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + + M_ Gamxxz[_t]=HALF*( M_ gupxx[_t]*M_ gxxz[_t]+ M_ gupxy[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupxz[_t]*M_ gzzx[_t]); + M_ Gamyxz[_t]=HALF*( M_ gupxy[_t]*M_ gxxz[_t]+ M_ gupyy[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupyz[_t]*M_ gzzx[_t]); + M_ Gamzxz[_t]=HALF*( M_ gupxz[_t]*M_ gxxz[_t]+ M_ gupyz[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupzz[_t]*M_ gzzx[_t]); + + M_ Gamxyz[_t]=HALF*( M_ gupxx[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupxy[_t]*M_ gyyz[_t]+ M_ gupxz[_t]*M_ gzzy[_t]); + M_ Gamyyz[_t]=HALF*( M_ gupxy[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupyy[_t]*M_ gyyz[_t]+ M_ gupyz[_t]*M_ gzzy[_t]); + M_ Gamzyz[_t]=HALF*( M_ gupxz[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupyz[_t]*M_ gyyz[_t]+ M_ gupzz[_t]*M_ gzzy[_t]); + // Raise indices of \tilde A_{ij} and store in R_ij + + M_ Rxx[_t]= M_ gupxx[_t]* M_ gupxx[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupxy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupxz[_t]* M_ Azz[_t]+ + 2*(M_ gupxx[_t]* M_ gupxy[_t]* M_ Axy[_t]+ M_ gupxx[_t]* M_ gupxz[_t]* M_ Axz[_t]+ M_ gupxy[_t]* M_ gupxz[_t]* M_ Ayz[_t]); + + M_ Ryy[_t]= M_ gupxy[_t]* M_ gupxy[_t]* M_ Axx[_t]+ M_ gupyy[_t]* M_ gupyy[_t]* M_ Ayy[_t]+ M_ gupyz[_t]* M_ gupyz[_t]* M_ Azz[_t]+ + 2*(M_ gupxy[_t]* M_ gupyy[_t]* M_ Axy[_t]+ M_ gupxy[_t]* M_ gupyz[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ gupyz[_t]* M_ Ayz[_t]); + + M_ Rzz[_t]= M_ gupxz[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupyz[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + 2*(M_ gupxz[_t]* M_ gupyz[_t]* M_ Axy[_t]+ M_ gupxz[_t]* M_ gupzz[_t]* M_ Axz[_t]+ M_ gupyz[_t]* M_ gupzz[_t]* M_ Ayz[_t]); + + M_ Rxy[_t]= M_ gupxx[_t]* M_ gupxy[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupyy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupyz[_t]* M_ Azz[_t]+ + (M_ gupxx[_t]* M_ gupyy[_t] + M_ gupxy[_t]* M_ gupxy[_t])* M_ Axy[_t] + + (M_ gupxx[_t]* M_ gupyz[_t] + M_ gupxz[_t]* M_ gupxy[_t])* M_ Axz[_t] + + (M_ gupxy[_t]* M_ gupyz[_t] + M_ gupxz[_t]* M_ gupyy[_t])* M_ Ayz[_t]; + + M_ Rxz[_t]= M_ gupxx[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + (M_ gupxx[_t]* M_ gupyz[_t] + M_ gupxy[_t]* M_ gupxz[_t])* M_ Axy[_t] + + (M_ gupxx[_t]* M_ gupzz[_t] + M_ gupxz[_t]* M_ gupxz[_t])* M_ Axz[_t] + + (M_ gupxy[_t]* M_ gupzz[_t] + M_ gupxz[_t]* M_ gupyz[_t])* M_ Ayz[_t]; + + M_ Ryz[_t]= M_ gupxy[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupyy[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupyz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + (M_ gupxy[_t]* M_ gupyz[_t] + M_ gupyy[_t]* M_ gupxz[_t])* M_ Axy[_t] + + (M_ gupxy[_t]* M_ gupzz[_t] + M_ gupyz[_t]* M_ gupxz[_t])* M_ Axz[_t] + + (M_ gupyy[_t]* M_ gupzz[_t] + M_ gupyz[_t]* M_ gupyz[_t])* M_ Ayz[_t]; + + // Right hand side for M_ Gam^i without shift terms... + + M_ Gamx_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxx[_t]+ M_ Lapy[_t] * M_ Rxy[_t]+ M_ Lapz[_t] * M_ Rxz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxx[_t]+ M_ chiy[_t] * M_ Rxy[_t]+ M_ chiz[_t] * M_ Rxz[_t]) - + M_ gupxx[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupxy[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupxz[_t]* ( F2o3 * M_ Kz[_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamxxx[_t]* M_ Rxx[_t]+ M_ Gamxyy[_t]* M_ Ryy[_t]+ M_ Gamxzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamxxy[_t]* M_ Rxy[_t]+ M_ Gamxxz[_t]* M_ Rxz[_t]+ M_ Gamxyz[_t]* M_ Ryz[_t]) ); + + M_ Gamy_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxy[_t]+ M_ Lapy[_t] * M_ Ryy[_t]+ M_ Lapz[_t] * M_ Ryz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxy[_t]+ M_ chiy[_t] * M_ Ryy[_t]+ M_ chiz[_t] * M_ Ryz[_t]) - + M_ gupxy[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupyy[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupyz[_t]* ( F2o3 * M_ Kz [_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamyxx[_t]* M_ Rxx[_t]+ M_ Gamyyy[_t]* M_ Ryy[_t]+ M_ Gamyzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamyxy[_t]* M_ Rxy[_t]+ M_ Gamyxz[_t]* M_ Rxz[_t]+ M_ Gamyyz[_t]* M_ Ryz[_t]) ); + + M_ Gamz_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxz[_t]+ M_ Lapy[_t] * M_ Ryz[_t]+ M_ Lapz[_t] * M_ Rzz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxz[_t]+ M_ chiy[_t] * M_ Ryz[_t]+ M_ chiz[_t] * M_ Rzz[_t]) - + M_ gupxz[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupyz[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupzz[_t]* ( F2o3 * M_ Kz[_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamzxx[_t]* M_ Rxx[_t]+ M_ Gamzyy[_t]* M_ Ryy[_t]+ M_ Gamzzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamzxy[_t]* M_ Rxy[_t]+ M_ Gamzxz[_t]* M_ Rxz[_t]+ M_ Gamzyz[_t]* M_ Ryz[_t]) ); + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_part3() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ fxx [_t]= M_ gxxx[_t]+ M_ gxyy[_t]+ M_ gxzz[_t]; + M_ fxy[_t]= M_ gxyx[_t]+ M_ gyyy[_t]+ M_ gyzz[_t]; + M_ fxz[_t]= M_ gxzx[_t]+ M_ gyzy[_t]+ M_ gzzz[_t]; + + M_ Gamxa[_t]= M_ gupxx [_t]* M_ Gamxxx [_t]+ M_ gupyy[_t]* M_ Gamxyy[_t]+ M_ gupzz[_t]* M_ Gamxzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamxxy[_t]+ M_ gupxz[_t]* M_ Gamxxz[_t]+ M_ gupyz[_t]* M_ Gamxyz[_t]); + M_ Gamya[_t]= M_ gupxx [_t]* M_ Gamyxx [_t]+ M_ gupyy[_t]* M_ Gamyyy[_t]+ M_ gupzz[_t]* M_ Gamyzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamyxy[_t]+ M_ gupxz[_t]* M_ Gamyxz[_t]+ M_ gupyz[_t]* M_ Gamyyz[_t]); + M_ Gamza[_t]= M_ gupxx [_t]* M_ Gamzxx [_t]+ M_ gupyy[_t]* M_ Gamzyy[_t]+ M_ gupzz[_t]* M_ Gamzzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamzxy[_t]+ M_ gupxz[_t]* M_ Gamzxz[_t]+ M_ gupyz[_t]* M_ Gamzyz[_t]); + + + + M_ Gamx_rhs[_t] = M_ Gamx_rhs[_t] + F2o3 * M_ Gamxa[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betaxx [_t]- M_ Gamya[_t]* M_ betaxy[_t]- M_ Gamza[_t]* M_ betaxz[_t] + + F1o3 * (M_ gupxx [_t]* M_ fxx [_t] + M_ gupxy[_t]* M_ fxy[_t] + M_ gupxz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxx [_t] + M_ gupyy[_t]* M_ gyyx [_t] + M_ gupzz[_t]* M_ gzzx [_t] + + 2 * (M_ gupxy[_t]* M_ gxyx [_t] + M_ gupxz[_t]* M_ gxzx [_t] + M_ gupyz[_t]* M_ gyzx [_t] ); + + M_ Gamy_rhs[_t] = M_ Gamy_rhs[_t] + F2o3 * M_ Gamya[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betayx [_t]- M_ Gamya[_t]* M_ betayy[_t]- M_ Gamza[_t]* M_ betayz[_t] + + F1o3 * (M_ gupxy[_t]* M_ fxx [_t] + M_ gupyy[_t]* M_ fxy[_t] + M_ gupyz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxy[_t] + M_ gupyy[_t]* M_ gyyy[_t] + M_ gupzz[_t]* M_ gzzy[_t] + + 2 * (M_ gupxy[_t]* M_ gxyy[_t] + M_ gupxz[_t]* M_ gxzy[_t] + M_ gupyz[_t]* M_ gyzy[_t] ); + + M_ Gamz_rhs[_t] = M_ Gamz_rhs[_t] + F2o3 * M_ Gamza[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betazx [_t]- M_ Gamya[_t]* M_ betazy[_t]- M_ Gamza[_t]* M_ betazz[_t] + + F1o3 * (M_ gupxz[_t]* M_ fxx [_t] + M_ gupyz[_t]* M_ fxy[_t] + M_ gupzz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxz[_t] + M_ gupyy[_t]* M_ gyyz[_t] + M_ gupzz[_t]* M_ gzzz[_t] + + 2 * (M_ gupxy[_t]* M_ gxyz[_t] + M_ gupxz[_t]* M_ gxzz[_t] + M_ gupyz[_t]* M_ gyzz[_t] ) ; //rhs M_ for M_ Gam^i + + //first kind of connection stored in M_ gij,k + M_ gxxx [_t]= M_ gxx [_t]* M_ Gamxxx [_t]+ M_ gxy[_t]* M_ Gamyxx [_t]+ M_ gxz[_t]* M_ Gamzxx[_t]; + M_ gxyx [_t]= M_ gxx [_t]* M_ Gamxxy[_t]+ M_ gxy[_t]* M_ Gamyxy[_t]+ M_ gxz[_t]* M_ Gamzxy[_t]; + M_ gxzx [_t]= M_ gxx [_t]* M_ Gamxxz[_t]+ M_ gxy[_t]* M_ Gamyxz[_t]+ M_ gxz[_t]* M_ Gamzxz[_t]; + M_ gyyx [_t]= M_ gxx [_t]* M_ Gamxyy[_t]+ M_ gxy[_t]* M_ Gamyyy[_t]+ M_ gxz[_t]* M_ Gamzyy[_t]; + M_ gyzx [_t]= M_ gxx [_t]* M_ Gamxyz[_t]+ M_ gxy[_t]* M_ Gamyyz[_t]+ M_ gxz[_t]* M_ Gamzyz[_t]; + M_ gzzx [_t]= M_ gxx [_t]* M_ Gamxzz[_t]+ M_ gxy[_t]* M_ Gamyzz[_t]+ M_ gxz[_t]* M_ Gamzzz[_t]; + M_ gxxy[_t]= M_ gxy[_t]* M_ Gamxxx [_t]+ M_ gyy[_t]* M_ Gamyxx [_t]+ M_ gyz[_t]* M_ Gamzxx[_t]; + M_ gxyy[_t]= M_ gxy[_t]* M_ Gamxxy[_t]+ M_ gyy[_t]* M_ Gamyxy[_t]+ M_ gyz[_t]* M_ Gamzxy[_t]; + M_ gxzy[_t]= M_ gxy[_t]* M_ Gamxxz[_t]+ M_ gyy[_t]* M_ Gamyxz[_t]+ M_ gyz[_t]* M_ Gamzxz[_t]; + M_ gyyy[_t]= M_ gxy[_t]* M_ Gamxyy[_t]+ M_ gyy[_t]* M_ Gamyyy[_t]+ M_ gyz[_t]* M_ Gamzyy[_t]; + M_ gyzy[_t]= M_ gxy[_t]* M_ Gamxyz[_t]+ M_ gyy[_t]* M_ Gamyyz[_t]+ M_ gyz[_t]* M_ Gamzyz[_t]; + M_ gzzy[_t]= M_ gxy[_t]* M_ Gamxzz[_t]+ M_ gyy[_t]* M_ Gamyzz[_t]+ M_ gyz[_t]* M_ Gamzzz[_t]; + M_ gxxz[_t]= M_ gxz[_t]* M_ Gamxxx [_t]+ M_ gyz[_t]* M_ Gamyxx [_t]+ M_ gzz[_t]* M_ Gamzxx[_t]; + M_ gxyz[_t]= M_ gxz[_t]* M_ Gamxxy[_t]+ M_ gyz[_t]* M_ Gamyxy[_t]+ M_ gzz[_t]* M_ Gamzxy[_t]; + M_ gxzz[_t]= M_ gxz[_t]* M_ Gamxxz[_t]+ M_ gyz[_t]* M_ Gamyxz[_t]+ M_ gzz[_t]* M_ Gamzxz[_t]; + M_ gyyz[_t]= M_ gxz[_t]* M_ Gamxyy[_t]+ M_ gyz[_t]* M_ Gamyyy[_t]+ M_ gzz[_t]* M_ Gamzyy[_t]; + M_ gyzz[_t]= M_ gxz[_t]* M_ Gamxyz[_t]+ M_ gyz[_t]* M_ Gamyyz[_t]+ M_ gzz[_t]* M_ Gamzyz[_t]; + M_ gzzz[_t]= M_ gxz[_t]* M_ Gamxzz[_t]+ M_ gyz[_t]* M_ Gamyzz[_t]+ M_ gzz[_t]* M_ Gamzzz[_t]; + + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_part4() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ Rxx [_t]= - HALF *M_ Rxx [_t] + + M_ gxx [_t]* M_ Gamxx[_t] +M_ gxy[_t]* M_ Gamyx [_t] + M_ gxz[_t]* M_ Gamzx [_t]+ + M_ Gamxa[_t]*M_ gxxx [_t]+ M_ Gamya[_t]*M_ gxyx [_t]+ M_ Gamza[_t]*M_ gxzx [_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxx [_t]*M_ gxxx [_t]+ M_ Gamyxx [_t]*M_ gxyx [_t]+ M_ Gamzxx [_t]*M_ gxzx[_t]) + + M_ Gamxxx [_t]*M_ gxxx [_t]+ M_ Gamyxx [_t]*M_ gxxy[_t]+ M_ Gamzxx [_t]*M_ gxxz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gyyx [_t]+ M_ Gamzxx [_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxyx [_t]+ M_ Gamzxy[_t]*M_ gxzx[_t]) + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxxy[_t]+ M_ Gamzxy[_t]*M_ gxxz[_t] + + M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxyz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gyzx [_t]+ M_ Gamzxx [_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxyx [_t]+ M_ Gamzxz[_t]*M_ gxzx[_t]) + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxxy[_t]+ M_ Gamzxz[_t]*M_ gxxz[_t] + + M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gxzy[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gyyx [_t]+ M_ Gamzxy[_t]*M_ gyzx[_t]) + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gyzx [_t]+ M_ Gamzxy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gyyx [_t]+ M_ Gamzxz[_t]*M_ gyzx[_t]) + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gyzx [_t]+ M_ Gamzxz[_t]*M_ gzzx[_t]) + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t]); + + M_ Ryy[_t]= - HALF *M_ Ryy[_t] + + M_ gxy[_t]* M_ Gamxy[_t]+ M_ gyy[_t]* M_ Gamyy[_t] + M_ gyz[_t]* M_ Gamzy[_t] + + M_ Gamxa[_t]*M_ gxyy[_t]+ M_ Gamya[_t]*M_ gyyy[_t]+ M_ Gamza[_t]*M_ gyzy[_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxy[_t]*M_ gxxy[_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxzy[_t]) + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxyy[_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxxy[_t]+ M_ Gamyyy[_t]*M_ gxyy[_t]+ M_ Gamzyy[_t]*M_ gxzy[_t]) + + M_ Gamxyy[_t]*M_ gxyx [_t]+ M_ Gamyyy[_t]*M_ gxyy[_t]+ M_ Gamzyy[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gyyx [_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyyz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxzy[_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxxy[_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxzy[_t]) + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxyy[_t]*M_ gxyy[_t]+ M_ Gamyyy[_t]*M_ gyyy[_t]+ M_ Gamzyy[_t]*M_ gyzy[_t]) + + M_ Gamxyy[_t]*M_ gyyx [_t]+ M_ Gamyyy[_t]*M_ gyyy[_t]+ M_ Gamzyy[_t]*M_ gyyz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxyy[_t]*M_ gxzy[_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxyy[_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyzy[_t]) + + M_ Gamxyz[_t]*M_ gyyx [_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyyz[_t] + + M_ Gamxyy[_t]*M_ gyzx [_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxzy[_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gzzy[_t]) + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t]); + + M_ Rzz[_t]= - HALF *M_ Rzz[_t] + + M_ gxz[_t]* M_ Gamxz[_t] +M_ gyz[_t]* M_ Gamyz[_t] + M_ gzz[_t]* M_ Gamzz[_t] + + M_ Gamxa[_t]*M_ gxzz[_t]+ M_ Gamya[_t]*M_ gyzz[_t]+ M_ Gamza[_t]*M_ gzzz[_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxz[_t]*M_ gxxz[_t]+ M_ Gamyxz[_t]*M_ gxyz[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t]) + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxyz[_t]+ M_ Gamyxz[_t]*M_ gyyz[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxxz[_t]+ M_ Gamyyz[_t]*M_ gxyz[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t]) + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gxzy[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxzz[_t]+ M_ Gamyxz[_t]*M_ gyzz[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxxz[_t]+ M_ Gamyzz[_t]*M_ gxyz[_t]+ M_ Gamzzz[_t]*M_ gxzz[_t]) + + M_ Gamxzz[_t]*M_ gxzx [_t]+ M_ Gamyzz[_t]*M_ gxzy[_t]+ M_ Gamzzz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gzzx [_t]+ M_ Gamyxz[_t]*M_ gzzy[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxyz[_t]+ M_ Gamyyz[_t]*M_ gyyz[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t]) + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxzz[_t]+ M_ Gamyyz[_t]*M_ gyzz[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxyz[_t]+ M_ Gamyzz[_t]*M_ gyyz[_t]+ M_ Gamzzz[_t]*M_ gyzz[_t]) + + M_ Gamxzz[_t]*M_ gyzx [_t]+ M_ Gamyzz[_t]*M_ gyzy[_t]+ M_ Gamzzz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gzzx [_t]+ M_ Gamyyz[_t]*M_ gzzy[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxzz[_t]*M_ gxzz[_t]+ M_ Gamyzz[_t]*M_ gyzz[_t]+ M_ Gamzzz[_t]*M_ gzzz[_t]) + + M_ Gamxzz[_t]*M_ gzzx [_t]+ M_ Gamyzz[_t]*M_ gzzy[_t]+ M_ Gamzzz[_t]*M_ gzzz[_t]); + + M_ Rxy[_t]= HALF*( -M_ Rxy[_t] + + M_ gxx [_t]* M_ Gamxy[_t]+ M_ gxy[_t]* M_ Gamyy[_t]+M_ gxz[_t]* M_ Gamzy[_t] + + M_ gxy[_t]* M_ Gamxx [_t]+ M_ gyy[_t]* M_ Gamyx [_t]+M_ gyz[_t]* M_ Gamzx [_t] + + M_ Gamxa[_t]*M_ gxyx [_t]+ M_ Gamya[_t]*M_ gyyx [_t]+ M_ Gamza[_t]*M_ gyzx [_t] + + M_ Gamxa[_t]*M_ gxxy[_t]+ M_ Gamya[_t]*M_ gxyy[_t]+ M_ Gamza[_t]*M_ gxzy[_t])+ + M_ gupxx [_t]*( + M_ Gamxxx [_t]*M_ gxxy[_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxyx [_t]+ M_ Gamzxy[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxyz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxx [_t]*M_ gxyy[_t]+ M_ Gamyxx [_t]*M_ gyyy[_t]+ M_ Gamzxx [_t]*M_ gyzy[_t] + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gyyx [_t]+ M_ Gamzxy[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gxxy[_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxzy[_t] + + M_ Gamxyy[_t]*M_ gxxx [_t]+ M_ Gamyyy[_t]*M_ gxyx [_t]+ M_ Gamzyy[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyyx [_t]+ M_ Gamyxx [_t]*M_ gyyy[_t]+ M_ Gamzxx [_t]*M_ gyyz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxx [_t]*M_ gxzy[_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gzzy[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gyzx [_t]+ M_ Gamzxy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxyz[_t] + + M_ Gamxxz[_t]*M_ gxxy[_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxzy[_t] + + M_ Gamxyz[_t]*M_ gxxx [_t]+ M_ Gamyyz[_t]*M_ gxyx [_t]+ M_ Gamzyz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyzx [_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxxy[_t]*M_ gxyy[_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxyx [_t]+ M_ Gamyyy[_t]*M_ gyyx [_t]+ M_ Gamzyy[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyyx [_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyyz[_t])+ + M_ gupyz[_t]*( + M_ Gamxxy[_t]*M_ gxzy[_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gzzy[_t] + + M_ Gamxyy[_t]*M_ gxzx [_t]+ M_ Gamyyy[_t]*M_ gyzx [_t]+ M_ Gamzyy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyyx [_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyyz[_t] + + M_ Gamxxz[_t]*M_ gxyy[_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyzy[_t] + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gyyx [_t]+ M_ Gamzyz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxxz[_t]*M_ gxzy[_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gyzx [_t]+ M_ Gamzyz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t]); + + M_ Rxz[_t]= HALF*( -M_ Rxz[_t] + + M_ gxx [_t]* M_ Gamxz[_t]+ M_ gxy[_t]* M_ Gamyz[_t]+M_ gxz[_t]* M_ Gamzz[_t] + + M_ gxz[_t]* M_ Gamxx [_t]+ M_ gyz[_t]* M_ Gamyx [_t]+M_ gzz[_t]* M_ Gamzx [_t] + + M_ Gamxa[_t]*M_ gxzx [_t]+ M_ Gamya[_t]*M_ gyzx [_t]+ M_ Gamza[_t]*M_ gzzx [_t] + + M_ Gamxa[_t]*M_ gxxz[_t]+ M_ Gamya[_t]*M_ gxyz[_t]+ M_ Gamza[_t]*M_ gxzz[_t])+ + M_ gupxx [_t]*( + M_ Gamxxx [_t]*M_ gxxz[_t]+ M_ Gamyxx [_t]*M_ gxyz[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxyx [_t]+ M_ Gamzxz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gxzy[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxx [_t]*M_ gxyz[_t]+ M_ Gamyxx [_t]*M_ gyyz[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gyyx [_t]+ M_ Gamzxz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxxy[_t]*M_ gxxz[_t]+ M_ Gamyxy[_t]*M_ gxyz[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxx [_t]+ M_ Gamyyz[_t]*M_ gxyx [_t]+ M_ Gamzyz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyzx [_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxx [_t]*M_ gxzz[_t]+ M_ Gamyxx [_t]*M_ gyzz[_t]+ M_ Gamzxx [_t]*M_ gzzz[_t] + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gyzx [_t]+ M_ Gamzxz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxz[_t]+ M_ Gamyxz[_t]*M_ gxyz[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t] + + M_ Gamxzz[_t]*M_ gxxx [_t]+ M_ Gamyzz[_t]*M_ gxyx [_t]+ M_ Gamzzz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gzzx [_t]+ M_ Gamyxx [_t]*M_ gzzy[_t]+ M_ Gamzxx [_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxxy[_t]*M_ gxyz[_t]+ M_ Gamyxy[_t]*M_ gyyz[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gyyx [_t]+ M_ Gamzyz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + M_ Gamxxy[_t]*M_ gxzz[_t]+ M_ Gamyxy[_t]*M_ gyzz[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gyzx [_t]+ M_ Gamzyz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyz[_t]+ M_ Gamyxz[_t]*M_ gyyz[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxzz[_t]*M_ gxyx [_t]+ M_ Gamyzz[_t]*M_ gyyx [_t]+ M_ Gamzzz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gzzx [_t]+ M_ Gamyxy[_t]*M_ gzzy[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxxz[_t]*M_ gxzz[_t]+ M_ Gamyxz[_t]*M_ gyzz[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxzx [_t]+ M_ Gamyzz[_t]*M_ gyzx [_t]+ M_ Gamzzz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gzzx [_t]+ M_ Gamyxz[_t]*M_ gzzy[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t]); + + M_ Ryz[_t]= HALF*( -M_ Ryz[_t] + + M_ gxy[_t]* M_ Gamxz[_t]+M_ gyy[_t]* M_ Gamyz[_t]+M_ gyz[_t]* M_ Gamzz[_t] + + M_ gxz[_t]* M_ Gamxy[_t]+M_ gyz[_t]* M_ Gamyy[_t]+M_ gzz[_t]* M_ Gamzy[_t] + + M_ Gamxa[_t]*M_ gxzy[_t]+ M_ Gamya[_t]*M_ gyzy[_t]+ M_ Gamza[_t]*M_ gzzy[_t] + + M_ Gamxa[_t]*M_ gxyz[_t]+ M_ Gamya[_t]*M_ gyyz[_t]+ M_ Gamza[_t]*M_ gyzz[_t])+ + M_ gupxx [_t]*( + M_ Gamxxy[_t]*M_ gxxz[_t]+ M_ Gamyxy[_t]*M_ gxyz[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxy[_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxy[_t]*M_ gxyz[_t]+ M_ Gamyxy[_t]*M_ gyyz[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyy[_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxzx [_t]+ M_ Gamyyy[_t]*M_ gxzy[_t]+ M_ Gamzyy[_t]*M_ gxzz[_t] + + M_ Gamxyy[_t]*M_ gxxz[_t]+ M_ Gamyyy[_t]*M_ gxyz[_t]+ M_ Gamzyy[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxy[_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxy[_t]*M_ gxzz[_t]+ M_ Gamyxy[_t]*M_ gyzz[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t] + + M_ Gamxxz[_t]*M_ gxzy[_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gxzy[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxz[_t]+ M_ Gamyyz[_t]*M_ gxyz[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxzz[_t]*M_ gxxy[_t]+ M_ Gamyzz[_t]*M_ gxyy[_t]+ M_ Gamzzz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gzzx [_t]+ M_ Gamyxy[_t]*M_ gzzy[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxyy[_t]*M_ gxyz[_t]+ M_ Gamyyy[_t]*M_ gyyz[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyy[_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gyzx [_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + M_ Gamxyy[_t]*M_ gxzz[_t]+ M_ Gamyyy[_t]*M_ gyzz[_t]+ M_ Gamzyy[_t]*M_ gzzz[_t] + + M_ Gamxyz[_t]*M_ gxzy[_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyz[_t]+ M_ Gamyyz[_t]*M_ gyyz[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t] + + M_ Gamxzz[_t]*M_ gxyy[_t]+ M_ Gamyzz[_t]*M_ gyyy[_t]+ M_ Gamzzz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gzzx [_t]+ M_ Gamyyy[_t]*M_ gzzy[_t]+ M_ Gamzyy[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxyz[_t]*M_ gxzz[_t]+ M_ Gamyyz[_t]*M_ gyzz[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxzy[_t]+ M_ Gamyzz[_t]*M_ gyzy[_t]+ M_ Gamzzz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gzzx [_t]+ M_ Gamyyz[_t]*M_ gzzy[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t]); + + _t += STEP_SIZE; + } +} +__global__ void compute_rhs_bssn_part5() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ fxx [_t]=M_ fxx [_t]- M_ Gamxxx [_t]* M_ chix [_t]- M_ Gamyxx [_t]* M_ chiy[_t]- M_ Gamzxx [_t]* M_ chiz[_t]; + M_ fxy[_t]=M_ fxy[_t]- M_ Gamxxy[_t]* M_ chix [_t]- M_ Gamyxy[_t]* M_ chiy[_t]- M_ Gamzxy[_t]* M_ chiz[_t]; + M_ fxz[_t]=M_ fxz[_t]- M_ Gamxxz[_t]* M_ chix [_t]- M_ Gamyxz[_t]* M_ chiy[_t]- M_ Gamzxz[_t]* M_ chiz[_t]; + M_ fyy[_t]=M_ fyy[_t]- M_ Gamxyy[_t]* M_ chix [_t]- M_ Gamyyy[_t]* M_ chiy[_t]- M_ Gamzyy[_t]* M_ chiz[_t]; + M_ fyz[_t]=M_ fyz[_t]- M_ Gamxyz[_t]* M_ chix [_t]- M_ Gamyyz[_t]* M_ chiy[_t]- M_ Gamzyz[_t]* M_ chiz[_t]; + M_ fzz[_t]=M_ fzz[_t]- M_ Gamxzz[_t]* M_ chix [_t]- M_ Gamyzz[_t]* M_ chiy[_t]- M_ Gamzzz[_t]* M_ chiz[_t]; + // M_ Store D^l D_l M_ chi - 3/(2*M_ chi) D^l M_ chi D_l M_ chi inM_ f[_t] + + M_ f[_t] = M_ gupxx [_t]* (M_ fxx [_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chix [_t]) + + M_ gupyy[_t]* (M_ fyy[_t]- F3o2/M_ chin1[_t] * M_ chiy[_t]* M_ chiy[_t]) + + M_ gupzz[_t]* (M_ fzz[_t]- F3o2/M_ chin1[_t] * M_ chiz[_t]* M_ chiz[_t]) + + 2 *M_ gupxy[_t]* (M_ fxy[_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chiy[_t]) + + 2 *M_ gupxz[_t]* (M_ fxz[_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chiz[_t]) + + 2 *M_ gupyz[_t]* (M_ fyz[_t]- F3o2/M_ chin1[_t] * M_ chiy[_t]* M_ chiz[_t]); + // M_ Add M_ chi part toM_ Ricci tensor: + + M_ Rxx [_t]=M_ Rxx [_t]+ (M_ fxx [_t]- M_ chix[_t]*M_ chix[_t]/M_ chin1[_t]/2 +M_ gxx [_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Ryy[_t]=M_ Ryy[_t]+ (M_ fyy[_t]- M_ chiy[_t]*M_ chiy[_t]/M_ chin1[_t]/2 +M_ gyy[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rzz[_t]=M_ Rzz[_t]+ (M_ fzz[_t]- M_ chiz[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gzz[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rxy[_t]=M_ Rxy[_t]+ (M_ fxy[_t]- M_ chix[_t]*M_ chiy[_t]/M_ chin1[_t]/2 +M_ gxy[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rxz[_t]=M_ Rxz[_t]+ (M_ fxz[_t]- M_ chix[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gxz[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Ryz[_t]=M_ Ryz[_t]+ (M_ fyz[_t]- M_ chiy[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gyz[_t]*M_ f[_t])/M_ chin1[_t]/2; + + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_part6() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ gxxx [_t]= (M_ gupxx [_t]* M_ chix [_t]+M_ gupxy[_t]* M_ chiy[_t]+M_ gupxz[_t]* M_ chiz[_t])/M_ chin1[_t]; + M_ gxxy[_t]= (M_ gupxy[_t]* M_ chix [_t]+M_ gupyy[_t]* M_ chiy[_t]+M_ gupyz[_t]* M_ chiz[_t])/M_ chin1[_t]; + M_ gxxz[_t]= (M_ gupxz[_t]* M_ chix [_t]+M_ gupyz[_t]* M_ chiy[_t]+M_ gupzz[_t]* M_ chiz[_t])/M_ chin1[_t]; + // nowM_ get physical second kind of connection + M_ Gamxxx [_t]= M_ Gamxxx [_t]- ( (M_ chix [_t]+ M_ chix[_t])/M_ chin1[_t] -M_ gxx [_t]*M_ gxxx [_t])*HALF; + M_ Gamyxx [_t]= M_ Gamyxx [_t]- ( -M_ gxx [_t]*M_ gxxy[_t])*HALF; + M_ Gamzxx [_t]= M_ Gamzxx [_t]- ( -M_ gxx [_t]*M_ gxxz[_t])*HALF; + M_ Gamxyy[_t]= M_ Gamxyy[_t]- ( -M_ gyy[_t]*M_ gxxx [_t])*HALF; + M_ Gamyyy[_t]= M_ Gamyyy[_t]- ( (M_ chiy[_t]+ M_ chiy[_t])/M_ chin1[_t] -M_ gyy[_t]*M_ gxxy[_t])*HALF; + M_ Gamzyy[_t]= M_ Gamzyy[_t]- ( -M_ gyy[_t]*M_ gxxz[_t])*HALF; + M_ Gamxzz[_t]= M_ Gamxzz[_t]- ( -M_ gzz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyzz[_t]= M_ Gamyzz[_t]- ( -M_ gzz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzzz[_t]= M_ Gamzzz[_t]- ( (M_ chiz[_t]+ M_ chiz[_t])/M_ chin1[_t] -M_ gzz[_t]*M_ gxxz[_t])*HALF; + M_ Gamxxy[_t]= M_ Gamxxy[_t]- ( M_ chiy[_t] /M_ chin1[_t] -M_ gxy[_t]*M_ gxxx [_t])*HALF; + M_ Gamyxy[_t]= M_ Gamyxy[_t]- ( M_ chix [_t]/M_ chin1[_t] -M_ gxy[_t]*M_ gxxy[_t])*HALF; + M_ Gamzxy[_t]= M_ Gamzxy[_t]- ( -M_ gxy[_t]*M_ gxxz[_t])*HALF; + M_ Gamxxz[_t]= M_ Gamxxz[_t]- ( M_ chiz[_t] /M_ chin1[_t] -M_ gxz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyxz[_t]= M_ Gamyxz[_t]- ( -M_ gxz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzxz[_t]= M_ Gamzxz[_t]- ( M_ chix [_t]/M_ chin1[_t] -M_ gxz[_t]*M_ gxxz[_t])*HALF; + M_ Gamxyz[_t]= M_ Gamxyz[_t]- ( -M_ gyz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyyz[_t]= M_ Gamyyz[_t]- ( M_ chiz[_t] /M_ chin1[_t] -M_ gyz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzyz[_t]= M_ Gamzyz[_t]- ( M_ chiy[_t]/M_ chin1[_t] -M_ gyz[_t]*M_ gxxz[_t])*HALF; + + M_ fxx [_t]=M_ fxx [_t]- M_ Gamxxx[_t]*M_ Lapx [_t]- M_ Gamyxx[_t]*M_ Lapy[_t]- M_ Gamzxx[_t]*M_ Lapz[_t]; + M_ fyy[_t]=M_ fyy[_t]- M_ Gamxyy[_t]*M_ Lapx [_t]- M_ Gamyyy[_t]*M_ Lapy[_t]- M_ Gamzyy[_t]*M_ Lapz[_t]; + M_ fzz[_t]=M_ fzz[_t]- M_ Gamxzz[_t]*M_ Lapx [_t]- M_ Gamyzz[_t]*M_ Lapy[_t]- M_ Gamzzz[_t]*M_ Lapz[_t]; + M_ fxy[_t]=M_ fxy[_t]- M_ Gamxxy[_t]*M_ Lapx [_t]- M_ Gamyxy[_t]*M_ Lapy[_t]- M_ Gamzxy[_t]*M_ Lapz[_t]; + M_ fxz[_t]=M_ fxz[_t]- M_ Gamxxz[_t]*M_ Lapx [_t]- M_ Gamyxz[_t]*M_ Lapy[_t]- M_ Gamzxz[_t]*M_ Lapz[_t]; + M_ fyz[_t]=M_ fyz[_t]- M_ Gamxyz[_t]*M_ Lapx [_t]- M_ Gamyyz[_t]*M_ Lapy[_t]- M_ Gamzyz[_t]*M_ Lapz[_t]; + + // store D^i D_i Lap in M_ trK_rhs[_t] upto M_ chi + M_ trK_rhs[_t] = M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t]+ + 2* (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]); + // M_ Add lapse and M_ S_ij parts toM_ Ricci tensor: + + //follow bam code + M_ S[_t] = M_ chin1[_t] * ( M_ gupxx[_t] * M_ Sxx[_t] + M_ gupyy[_t] * M_ Syy[_t] + M_ gupzz[_t] * M_ Szz[_t] + + + 2 * ( M_ gupxy[_t] * M_ Sxy[_t] + M_ gupxz[_t] * M_ Sxz[_t] + M_ gupyz[_t] * M_ Syz[_t] ) ); + + +M_ f[_t] = F2o3 * M_ trK[_t] * M_ trK[_t] -( + + M_ gupxx[_t] * ( + + M_ gupxx[_t] * M_ Axx[_t] * M_ Axx[_t] + M_ gupyy[_t] * M_ Axy[_t] * M_ Axy[_t] + M_ gupzz[_t] * M_ Axz[_t] * M_ Axz[_t] + + + 2 * (M_ gupxy[_t] * M_ Axx[_t] * M_ Axy[_t] + M_ gupxz[_t] * M_ Axx[_t] * M_ Axz[_t] + M_ gupyz[_t] * M_ Axy[_t] * M_ Axz[_t]) ) + + + M_ gupyy[_t] * ( + + M_ gupxx[_t] * M_ Axy[_t] * M_ Axy[_t] + M_ gupyy[_t] * M_ Ayy[_t] * M_ Ayy[_t] + M_ gupzz[_t] * M_ Ayz[_t] * M_ Ayz[_t] + + + 2 * (M_ gupxy[_t] * M_ Axy[_t] * M_ Ayy[_t] + M_ gupxz[_t] * M_ Axy[_t] * M_ Ayz[_t] + M_ gupyz[_t] * M_ Ayy[_t] * M_ Ayz[_t]) ) + + + M_ gupzz[_t] * ( + + M_ gupxx[_t] * M_ Axz[_t] * M_ Axz[_t] + M_ gupyy[_t] * M_ Ayz[_t] * M_ Ayz[_t] + M_ gupzz[_t] * M_ Azz[_t] * M_ Azz[_t] + + + 2 * (M_ gupxy[_t] * M_ Axz[_t] * M_ Ayz[_t] + M_ gupxz[_t] * M_ Axz[_t] * M_ Azz[_t] + M_ gupyz[_t] * M_ Ayz[_t] * M_ Azz[_t]) ) + + + 2 * ( + + M_ gupxy[_t] * ( + + M_ gupxx[_t] * M_ Axx[_t] * M_ Axy[_t] + M_ gupyy[_t] * M_ Axy[_t] * M_ Ayy[_t] + M_ gupzz[_t] * M_ Axz[_t] * M_ Ayz[_t] + + + M_ gupxy[_t] * (M_ Axx[_t] * M_ Ayy[_t] + M_ Axy[_t] * M_ Axy[_t]) + + + M_ gupxz[_t] * (M_ Axx[_t] * M_ Ayz[_t] + M_ Axz[_t] * M_ Axy[_t]) + + + M_ gupyz[_t] * (M_ Axy[_t] * M_ Ayz[_t] + M_ Axz[_t] * M_ Ayy[_t]) ) + + + M_ gupxz[_t] * ( + + M_ gupxx[_t] * M_ Axx[_t] * M_ Axz[_t] + M_ gupyy[_t] * M_ Axy[_t] * M_ Ayz[_t] + M_ gupzz[_t] * M_ Axz[_t] * M_ Azz[_t] + + + M_ gupxy[_t] * (M_ Axx[_t] * M_ Ayz[_t] + M_ Axy[_t] * M_ Axz[_t]) + + + M_ gupxz[_t] * (M_ Axx[_t] * M_ Azz[_t] + M_ Axz[_t] * M_ Axz[_t]) + + + M_ gupyz[_t] * (M_ Axy[_t] * M_ Azz[_t] + M_ Axz[_t] * M_ Ayz[_t]) ) + + + M_ gupyz[_t] * ( + + M_ gupxx[_t] * M_ Axy[_t] * M_ Axz[_t] + M_ gupyy[_t] * M_ Ayy[_t] * M_ Ayz[_t] + M_ gupzz[_t] * M_ Ayz[_t] * M_ Azz[_t] + + + M_ gupxy[_t] * (M_ Axy[_t] * M_ Ayz[_t] + M_ Ayy[_t] * M_ Axz[_t]) + + + M_ gupxz[_t] * (M_ Axy[_t] * M_ Azz[_t] + M_ Ayz[_t] * M_ Axz[_t]) + + + M_ gupyz[_t] * (M_ Ayy[_t] * M_ Azz[_t] + M_ Ayz[_t] * M_ Ayz[_t]) ) )) -16 * PI * M_ rho[_t] + 8 * PI * M_ S[_t]; + + + M_ f[_t] = - F1o3 *( M_ gupxx[_t] * M_ fxx[_t] + M_ gupyy[_t] * M_ fyy[_t] + M_ gupzz[_t] * M_ fzz[_t] + + + 2* ( M_ gupxy[_t] * M_ fxy[_t] + M_ gupxz[_t] * M_ fxz[_t] + M_ gupyz[_t] * M_ fyz[_t] ) + M_ alpn1[_t] / M_ chin1[_t] * M_ f[_t]); + + + + M_ fxx[_t] = M_ alpn1[_t] * (M_ Rxx[_t] - 8 * PI * M_ Sxx[_t]) - M_ fxx[_t]; + + M_ fxy[_t] = M_ alpn1[_t] * (M_ Rxy[_t] - 8 * PI * M_ Sxy[_t]) - M_ fxy[_t]; + + M_ fxz[_t] = M_ alpn1[_t] * (M_ Rxz[_t] - 8 * PI * M_ Sxz[_t]) - M_ fxz[_t]; + + M_ fyy[_t] = M_ alpn1[_t] * (M_ Ryy[_t] - 8 * PI * M_ Syy[_t]) - M_ fyy[_t]; + + M_ fyz[_t] = M_ alpn1[_t] * (M_ Ryz[_t] - 8 * PI * M_ Syz[_t]) - M_ fyz[_t]; + + M_ fzz[_t] = M_ alpn1[_t] * (M_ Rzz[_t] - 8 * PI * M_ Szz[_t]) - M_ fzz[_t]; + /* + M_ fxx [_t]= M_ alpn1[_t]* (M_ Rxx [_t]- 8 * PI * M_ Sxx[_t]) -M_ fxx[_t]; + M_ fxy[_t]= M_ alpn1[_t]* (M_ Rxy[_t]- 8 * PI * M_ Sxy[_t]) -M_ fxy[_t]; + M_ fxz[_t]= M_ alpn1[_t]* (M_ Rxz[_t]- 8 * PI * M_ Sxz[_t]) -M_ fxz[_t]; + M_ fyy[_t]= M_ alpn1[_t]* (M_ Ryy[_t]- 8 * PI * M_ Syy[_t]) -M_ fyy[_t]; + M_ fyz[_t]= M_ alpn1[_t]* (M_ Ryz[_t]- 8 * PI * M_ Syz[_t]) -M_ fyz[_t]; + M_ fzz[_t]= M_ alpn1[_t]* (M_ Rzz[_t]- 8 * PI * M_ Szz[_t]) -M_ fzz[_t]; + + // Compute trace-free part (note: M_ chi^-1 and M_ chi cancel//): + + M_ f[_t] = F1o3 *( M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t]+ + 2* (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]) ); + */ + M_ Axx_rhs[_t] =M_ fxx [_t]-M_ gxx [_t]*M_ f[_t]; + M_ Ayy_rhs[_t] =M_ fyy[_t]-M_ gyy[_t]*M_ f[_t]; + M_ Azz_rhs[_t] =M_ fzz[_t]-M_ gzz[_t]*M_ f[_t]; + M_ Axy_rhs[_t] =M_ fxy[_t]-M_ gxy[_t]*M_ f[_t]; + M_ Axz_rhs[_t] =M_ fxz[_t]-M_ gxz[_t]*M_ f[_t]; + M_ Ayz_rhs[_t] =M_ fyz[_t]-M_ gyz[_t]*M_ f[_t]; + + // Now: store M_ A_il M_ A^l_j intoM_ fij: + + M_ fxx [_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axx [_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Axy[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Axz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axx [_t]* M_ Axy[_t]+M_ gupxz[_t]* M_ Axx [_t]* M_ Axz[_t]+M_ gupyz[_t]* M_ Axy[_t]* M_ Axz[_t]); + + M_ fyy[_t]= M_ gupxx [_t]* M_ Axy[_t]* M_ Axy[_t]+M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayy[_t]+M_ gupzz[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axy[_t]* M_ Ayy[_t]+M_ gupxz[_t]* M_ Axy[_t]* M_ Ayz[_t]+M_ gupyz[_t]* M_ Ayy[_t]* M_ Ayz[_t]); + + M_ fzz[_t]= M_ gupxx [_t]* M_ Axz[_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Ayz[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Azz[_t]* M_ Azz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axz[_t]* M_ Ayz[_t]+M_ gupxz[_t]* M_ Axz[_t]* M_ Azz[_t]+M_ gupyz[_t]* M_ Ayz[_t]* M_ Azz[_t]); + + M_ fxy[_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axy[_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Ayy[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Ayz[_t]+ + M_ gupxy[_t]*(M_ Axx [_t]* M_ Ayy[_t]+ M_ Axy[_t]* M_ Axy[_t]) + + M_ gupxz[_t]*(M_ Axx [_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Axy[_t]) + + M_ gupyz[_t]*(M_ Axy[_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Ayy[_t]); + M_ fxz[_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]*(M_ Axx [_t]* M_ Ayz[_t]+ M_ Axy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]*(M_ Axx [_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]*(M_ Axy[_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Ayz[_t]); + M_ fyz[_t]= M_ gupxx [_t]* M_ Axy[_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Ayz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]*(M_ Axy[_t]* M_ Ayz[_t]+ M_ Ayy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]*(M_ Axy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]*(M_ Ayy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Ayz[_t]); + + M_ f[_t] = M_ chin1[_t]; + // store D^i D_i Lap in M_ trK_rhs[_t] + M_ trK_rhs[_t] =M_ f[_t]*M_ trK_rhs[_t]; + + M_ Axx_rhs[_t] = M_ f[_t] * M_ Axx_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Axx [_t]- 2 *M_ fxx[_t]) + + 2 * ( M_ Axx [_t]* M_ betaxx [_t]+ M_ Axy[_t]* M_ betayx [_t]+ M_ Axz[_t]* M_ betazx [_t])- + F2o3 * M_ Axx [_t]* M_ div_beta[_t]; + + M_ Ayy_rhs[_t] = M_ f[_t] * M_ Ayy_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Ayy[_t]- 2 *M_ fyy[_t]) + + 2 * ( M_ Axy[_t]* M_ betaxy[_t]+ M_ Ayy[_t]* M_ betayy[_t]+ M_ Ayz[_t]* M_ betazy[_t])- + F2o3 * M_ Ayy[_t]* M_ div_beta[_t]; + + M_ Azz_rhs[_t] = M_ f[_t] * M_ Azz_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Azz[_t]- 2 *M_ fzz[_t]) + + 2 * ( M_ Axz[_t]* M_ betaxz[_t]+ M_ Ayz[_t]* M_ betayz[_t]+ M_ Azz[_t]* M_ betazz[_t])- + F2o3 * M_ Azz[_t]* M_ div_beta[_t]; + + M_ Axy_rhs[_t] = M_ f[_t] * M_ Axy_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Axy[_t] - 2 *M_ fxy[_t])+ + M_ Axx [_t]* M_ betaxy[_t] + M_ Axz[_t]* M_ betazy[_t] + + M_ Ayy[_t]* M_ betayx [_t]+ M_ Ayz[_t]* M_ betazx [_t] + + F1o3 * M_ Axy[_t]* M_ div_beta[_t] - M_ Axy[_t]* M_ betazz[_t]; + + M_ Ayz_rhs[_t] = M_ f[_t] * M_ Ayz_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Ayz[_t] - 2 *M_ fyz[_t])+ + M_ Axy[_t]* M_ betaxz[_t]+ M_ Ayy[_t]* M_ betayz[_t] + + M_ Axz[_t]* M_ betaxy[_t] + M_ Azz[_t]* M_ betazy[_t] + + F1o3 * M_ Ayz[_t]* M_ div_beta[_t] - M_ Ayz[_t]* M_ betaxx[_t]; + + M_ Axz_rhs[_t] = M_ f[_t] * M_ Axz_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Axz[_t] - 2 *M_ fxz[_t])+ + M_ Axx [_t]* M_ betaxz[_t]+ M_ Axy[_t]* M_ betayz[_t] + + M_ Ayz[_t]* M_ betayx [_t]+ M_ Azz[_t]* M_ betazx [_t] + + F1o3 * M_ Axz[_t]* M_ div_beta[_t] - M_ Axz[_t]* M_ betayy[_t] ; //rhsM_ for M_ Aij + + // Compute trace of M_ S_ij + + M_ S[_t] = M_ f[_t] * (M_ gupxx [_t]* M_ Sxx [_t]+M_ gupyy[_t]* M_ Syy[_t]+M_ gupzz[_t]* M_ Szz[_t]+ + 2 * (M_ gupxy[_t]* M_ Sxy[_t]+M_ gupxz[_t]* M_ Sxz[_t]+M_ gupyz[_t]* M_ Syz[_t]) ); + + M_ trK_rhs[_t] = - M_ trK_rhs[_t] + M_ alpn1[_t]*( F1o3 * M_ trK[_t]* M_ trK[_t] + + M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t] + + 2 * (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]) + + 4 * PI * ( M_ rho[_t] + M_ S[_t] )) ; //rhsM_ for M_ trK[_t] + + ////////M_ gauge variable part + + M_ Lap_rhs[_t] = -2*M_ alpn1[_t] * M_ trK[_t]; + +#if (GAUGE == 0) + M_ betax_rhs[_t] =0.75*M_ dtSfx[_t]; + M_ betay_rhs[_t] =0.75*M_ dtSfy[_t]; + M_ betaz_rhs[_t] =0.75*M_ dtSfz[_t]; + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] -2*M_ dtSfx[_t]; + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] -2*M_ dtSfy[_t]; + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] -2*M_ dtSfz[_t]; + +#elif (GAUGE == 1) + M_ betax_rhs[_t] =M_ Gamx[_t] - 2 * M_ betax[_t] ; + + M_ betay_rhs[_t] =M_ Gamy[_t] - 2 * M_ betay[_t] ; + + M_ betaz_rhs[_t] =M_ Gamz[_t] - 2 * M_ betaz[_t] ; + + M_ dtSfx_rhs[_t] = 0; + M_ dtSfy_rhs[_t] = 0; + M_ dtSfz_rhs[_t] = 0; + +#elif (GAUGE == 2 || GAUGE == 3) + + M_ betax_rhs[_t] = 0.75* M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75* M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ dtSfz[_t]; + +#elif (GAUGE == 6) + if(BHN==2) + { + int k = _t / _2D_SIZE[0]; + int ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + r1 = ( pow2((Porg[0]-X[i]))+ pow2((Porg[1]-Y[j]))+ pow2((Porg[2]-Z[k])) ) / + + ( pow2((Porg[0]-Porg[3]))+ pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + r2 = ( pow2((Porg[3]-X[i])) + pow2((Porg[4]-Y[j])) + pow2((Porg[5]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + reta[i+ j*_1D_SIZE[0]+ k*_2D_SIZE[0] ] = A + C1/(1 + 12 * r1) + C2/(1 + 12 *r2); + }//BHN == 2 + + M_ betax_rhs[_t] = 0.75*M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75*M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75*M_ dtSfz[_t]; + + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t] * M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t] * M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t] * M_ dtSfz[_t]; + +#elif (GAUGE == 7) + if(BHN==2){ + int k = _t / _2D_SIZE[0]; + int ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + r1 = ( pow2((Porg[0]-X[i])) + pow2((Porg[1]-Y[j])) + pow2((Porg[2]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + r2 = ( pow2((Porg[3]-X[i])) + pow2((Porg[4]-Y[j])) + pow2((Porg[5]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + M_ reta[_t][i+ j*_1D_SIZE[0]+ k*_2D_SIZE[0] ] = A + C1* exp(-12 *r1) + C2*exp(- 12*r2); + }//BHN ==2 + + M_ betax_rhs[_t] = 0.75*M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75*M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75*M_ dtSfz[_t]; + + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]*M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]*M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]*M_ dtSfz[_t]; + +#endif //if (GAUGE == ?) + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_part6_gauge() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { +#if (GAUGE == 2) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1[_t])/ pow2( ( 1-sqrt(M_ chin1[_t]) ) ); + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]* M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]* M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]* M_ dtSfz[_t]; + +#elif (GAUGE == 3) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13/2 * sqrt( M_ reta[_t]/ M_ chin1[_t])/ pow2((1-M_ chin1[_t])); + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]* M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]* M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]* M_ dtSfz[_t]; + +#elif (GAUGE == 4) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * + M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * + M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1[_t])/ pow( (1-sqrt(M_ chin1[_t]))); + + + M_ betax_rhs[_t] = 0.75* M_ Gamx[_t] - M_ reta[_t]*M_ betax[_t]; + + M_ betay_rhs[_t] = 0.75* M_ Gamy[_t] - M_ reta[_t]*M_ betay[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ Gamz[_t] - M_ reta[_t]*M_ betaz[_t]; + +#elif (GAUGE == 5) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1)/ pow( (1-M_ chin1[_t]) ); + + M_ betax_rhs[_t] = 0.75* M_ Gamx[_t] - M_ reta[_t]*M_ betax[_t]; + + M_ betay_rhs[_t] = 0.75* M_ Gamy[_t] - M_ reta[_t]*M_ betay[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ Gamz[_t] - M_ reta[_t]*M_ betaz[_t]; + + + + M_ dtSfx_rhs[_t] = 0; + + M_ dtSfy_rhs[_t] = 0; + + M_ dtSfz_rhs[_t] = 0; +#endif + _t += STEP_SIZE; + } +} +__global__ void compute_rhs_bssn_part7() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ ham_Res[_t] = M_ gupxx [_t]* M_ Rxx [_t]+ M_ gupyy[_t]* M_ Ryy[_t]+ M_ gupzz[_t]* M_ Rzz[_t]+ + 2* ( M_ gupxy[_t]* M_ Rxy[_t]+ M_ gupxz[_t]* M_ Rxz[_t]+ M_ gupyz[_t]* M_ Ryz[_t]); + + M_ ham_Res[_t] = M_ chin1[_t]*M_ ham_Res[_t] + F2o3 * M_ trK[_t] * M_ trK[_t] -( + M_ gupxx [_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axx [_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Axy[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Axz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axx [_t]* M_ Axy[_t]+ M_ gupxz[_t]* M_ Axx [_t]* M_ Axz[_t]+ M_ gupyz[_t]* M_ Axy[_t]* M_ Axz[_t]) ) + + M_ gupyy[_t]* ( + M_ gupxx [_t]* M_ Axy[_t]* M_ Axy[_t]+ M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ Axy[_t]* M_ Ayz[_t]+ M_ gupyz[_t]* M_ Ayy[_t]* M_ Ayz[_t]) ) + + M_ gupzz[_t]* ( + M_ gupxx [_t]* M_ Axz[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Azz[_t]* M_ Azz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axz[_t]* M_ Ayz[_t]+ M_ gupxz[_t]* M_ Axz[_t]* M_ Azz[_t]+ M_ gupyz[_t]* M_ Ayz[_t]* M_ Azz[_t]) ) + + 2 * ( + M_ gupxy[_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axy[_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Ayz[_t]+ + M_ gupxy[_t]* (M_ Axx [_t]* M_ Ayy[_t]+ M_ Axy[_t]* M_ Axy[_t]) + + M_ gupxz[_t]* (M_ Axx [_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Axy[_t]) + + M_ gupyz[_t]* (M_ Axy[_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Ayy[_t]) ) + + M_ gupxz[_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]* (M_ Axx [_t]* M_ Ayz[_t]+ M_ Axy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]* (M_ Axx [_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]* (M_ Axy[_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Ayz[_t]) ) + + M_ gupyz[_t]* ( + M_ gupxx [_t]* M_ Axy[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Ayz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]* (M_ Axy[_t]* M_ Ayz[_t]+ M_ Ayy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]* (M_ Axy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]* (M_ Ayy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Ayz[_t]) ) ))- 16 * PI * M_ rho[_t]; + + _t += STEP_SIZE; + } +} +__global__ void compute_rhs_bssn_part8() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ gxxx [_t]= M_ gxxx [_t]- ( M_ Gamxxx [_t]* M_ Axx [_t]+ M_ Gamyxx [_t]* M_ Axy[_t]+ M_ Gamzxx [_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axx [_t]+ M_ Gamyxx [_t]* M_ Axy[_t]+ M_ Gamzxx [_t]* M_ Axz[_t]) - M_ chix[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyx [_t]= M_ gxyx [_t]- ( M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axy[_t]+ M_ Gamyxx [_t]* M_ Ayy[_t]+ M_ Gamzxx [_t]* M_ Ayz[_t]) - M_ chix[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzx [_t]= M_ gxzx [_t]- ( M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axz[_t]+ M_ Gamyxx [_t]* M_ Ayz[_t]+ M_ Gamzxx [_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyx [_t]= M_ gyyx [_t]- ( M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t] + + M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t]) - M_ chix[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzx [_t]= M_ gyzx [_t]- ( M_ Gamxxz[_t]* M_ Axy[_t]+ M_ Gamyxz[_t]* M_ Ayy[_t]+ M_ Gamzxz[_t]* M_ Ayz[_t] + + M_ Gamxxy[_t]* M_ Axz[_t]+ M_ Gamyxy[_t]* M_ Ayz[_t]+ M_ Gamzxy[_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzx [_t]= M_ gzzx [_t]- ( M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t] + + M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ gxxy[_t]= M_ gxxy[_t]- ( M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t]) - M_ chiy[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyy[_t]= M_ gxyy[_t]- ( M_ Gamxyy[_t]* M_ Axx [_t]+ M_ Gamyyy[_t]* M_ Axy[_t]+ M_ Gamzyy[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t]) - M_ chiy[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzy[_t]= M_ gxzy[_t]- ( M_ Gamxyz[_t]* M_ Axx [_t]+ M_ Gamyyz[_t]* M_ Axy[_t]+ M_ Gamzyz[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axz[_t]+ M_ Gamyxy[_t]* M_ Ayz[_t]+ M_ Gamzxy[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyy[_t]= M_ gyyy[_t]- ( M_ Gamxyy[_t]* M_ Axy[_t]+ M_ Gamyyy[_t]* M_ Ayy[_t]+ M_ Gamzyy[_t]* M_ Ayz[_t] + + M_ Gamxyy[_t]* M_ Axy[_t]+ M_ Gamyyy[_t]* M_ Ayy[_t]+ M_ Gamzyy[_t]* M_ Ayz[_t]) - M_ chiy[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzy[_t]= M_ gyzy[_t]- ( M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t] + + M_ Gamxyy[_t]* M_ Axz[_t]+ M_ Gamyyy[_t]* M_ Ayz[_t]+ M_ Gamzyy[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzy[_t]= M_ gzzy[_t]- ( M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t] + + M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ gxxz[_t]= M_ gxxz[_t]- ( M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t]) - M_ chiz[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyz[_t]= M_ gxyz[_t]- ( M_ Gamxyz[_t]* M_ Axx [_t]+ M_ Gamyyz[_t]* M_ Axy[_t]+ M_ Gamzyz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axy[_t]+ M_ Gamyxz[_t]* M_ Ayy[_t]+ M_ Gamzxz[_t]* M_ Ayz[_t]) - M_ chiz[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzz[_t]= M_ gxzz[_t]- ( M_ Gamxzz[_t]* M_ Axx [_t]+ M_ Gamyzz[_t]* M_ Axy[_t]+ M_ Gamzzz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyz[_t]= M_ gyyz[_t]- ( M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t] + + M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t]) - M_ chiz[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzz[_t]= M_ gyzz[_t]- ( M_ Gamxzz[_t]* M_ Axy[_t]+ M_ Gamyzz[_t]* M_ Ayy[_t]+ M_ Gamzzz[_t]* M_ Ayz[_t] + + M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzz[_t]= M_ gzzz[_t]- ( M_ Gamxzz[_t]* M_ Axz[_t]+ M_ Gamyzz[_t]* M_ Ayz[_t]+ M_ Gamzzz[_t]* M_ Azz[_t] + + M_ Gamxzz[_t]* M_ Axz[_t]+ M_ Gamyzz[_t]* M_ Ayz[_t]+ M_ Gamzzz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ movx_Res[_t] = M_ gupxx[_t]*M_ gxxx [_t]+ M_ gupyy[_t]*M_ gxyy[_t]+ M_ gupzz[_t]*M_ gxzz[_t] + +M_ gupxy[_t]*M_ gxyx [_t]+ M_ gupxz[_t]*M_ gxzx [_t]+ M_ gupyz[_t]*M_ gxzy[_t] + +M_ gupxy[_t]*M_ gxxy[_t]+ M_ gupxz[_t]*M_ gxxz[_t]+ M_ gupyz[_t]*M_ gxyz[_t]; + M_ movy_Res[_t] = M_ gupxx[_t]*M_ gxyx [_t]+ M_ gupyy[_t]*M_ gyyy[_t]+ M_ gupzz[_t]*M_ gyzz[_t] + +M_ gupxy[_t]*M_ gyyx [_t]+ M_ gupxz[_t]*M_ gyzx [_t]+ M_ gupyz[_t]*M_ gyzy[_t] + +M_ gupxy[_t]*M_ gxyy[_t]+ M_ gupxz[_t]*M_ gxyz[_t]+ M_ gupyz[_t]*M_ gyyz[_t]; + + M_ movz_Res[_t] = M_ gupxx[_t]*M_ gxzx [_t]+ M_ gupyy[_t]*M_ gyzy[_t]+ M_ gupzz[_t]*M_ gzzz[_t] + +M_ gupxy[_t]*M_ gyzx [_t]+ M_ gupxz[_t]*M_ gzzx [_t]+ M_ gupyz[_t]*M_ gzzy[_t] + +M_ gupxy[_t]*M_ gxzy[_t]+ M_ gupxz[_t]*M_ gxzz[_t]+ M_ gupyz[_t]*M_ gyzz[_t]; + + M_ movx_Res[_t] = M_ movx_Res[_t] - F2o3*M_ Kx [_t]- 8*PI*M_ Sx[_t]; + M_ movy_Res[_t] = M_ movy_Res[_t] - F2o3*M_ Ky[_t]- 8*PI*M_ Sy[_t]; + M_ movz_Res[_t] = M_ movz_Res[_t] - F2o3*M_ Kz[_t]- 8*PI*M_ Sz[_t]; + + _t += STEP_SIZE; + } +} + + + +__global__ void device_test(double * result, double * Xt){ + /*result[0] = MAXSIZE; + result[1] = STEP; + result[2] = ex_c[0]; + result[3] = ex_c[1]; + result[4] = ex_c[2]; + result[5] = Xt[0]; + result[6] = Xt[1]; + result[7] = metac.X[0]; + result[8] = metac.X[1]; */ + + result[0] = metac.gzz[0]; + result[1] = metac.gzz[1]; + result[2] = metac.gzz[2]; + result[3] = metac.gyy[0]; + result[4] = metac.gyy[1]; + result[5] = metac.gyy[2]; + result[6] = _3D_SIZE[0]; + result[7] = STEP_SIZE; + result[8] = blockDim.x * gridDim.x; +} + +void destroy_meta(Meta *meta) +{ + /* + if(Mh_ X) CUDA_SAFE_CALL(cudaFree(Mh_ X)); + if(Mh_ Y) CUDA_SAFE_CALL(cudaFree(Mh_ Y)); + if(Mh_ Z) CUDA_SAFE_CALL(cudaFree(Mh_ Z)); + if(Mh_ chi) CUDA_SAFE_CALL(cudaFree(Mh_ chi)); + if(Mh_ dxx) CUDA_SAFE_CALL(cudaFree(Mh_ dxx)); + if(Mh_ dyy) CUDA_SAFE_CALL(cudaFree(Mh_ dyy)); + if(Mh_ dzz) CUDA_SAFE_CALL(cudaFree(Mh_ dzz)); + if(Mh_ trK) CUDA_SAFE_CALL(cudaFree(Mh_ trK)); + if(Mh_ gxy) CUDA_SAFE_CALL(cudaFree(Mh_ gxy)); + if(Mh_ gxz) CUDA_SAFE_CALL(cudaFree(Mh_ gxz)); + if(Mh_ gyz) CUDA_SAFE_CALL(cudaFree(Mh_ gyz)); + if(Mh_ Axx) CUDA_SAFE_CALL(cudaFree(Mh_ Axx)); + if(Mh_ Axy) CUDA_SAFE_CALL(cudaFree(Mh_ Axy)); + if(Mh_ Axz) CUDA_SAFE_CALL(cudaFree(Mh_ Axz)); + if(Mh_ Ayz) CUDA_SAFE_CALL(cudaFree(Mh_ Ayz)); + if(Mh_ Ayy) CUDA_SAFE_CALL(cudaFree(Mh_ Ayy)); + if(Mh_ Azz) CUDA_SAFE_CALL(cudaFree(Mh_ Azz)); + if(Mh_ Gamx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamx)); + if(Mh_ Gamy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamy)); + if(Mh_ Gamz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamz)); + if(Mh_ Lap) CUDA_SAFE_CALL(cudaFree(Mh_ Lap)); + if(Mh_ betax) CUDA_SAFE_CALL(cudaFree(Mh_ betax)); + if(Mh_ betay) CUDA_SAFE_CALL(cudaFree(Mh_ betay)); + if(Mh_ betaz) CUDA_SAFE_CALL(cudaFree(Mh_ betaz)); + if(Mh_ dtSfx) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfx)); + if(Mh_ dtSfy) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfy)); + if(Mh_ dtSfz) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfz)); + if(Mh_ chi_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ chi_rhs)); + if(Mh_ trK_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ trK_rhs)); + if(Mh_ gxy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gxy_rhs)); + if(Mh_ gxz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gxz_rhs)); + if(Mh_ gyz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gyz_rhs)); + if(Mh_ Axx_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Axx_rhs)); + if(Mh_ Axy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Axy_rhs)); + if(Mh_ Axz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Axz_rhs)); + if(Mh_ Ayz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Ayz_rhs)); + if(Mh_ Ayy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Ayy_rhs)); + if(Mh_ Azz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Azz_rhs)); + if(Mh_ Gamx_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Gamx_rhs)); + if(Mh_ Gamy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Gamy_rhs)); + if(Mh_ Gamz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Gamz_rhs)); + if(Mh_ Lap_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ Lap_rhs)); + if(Mh_ betax_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ betax_rhs)); + if(Mh_ betay_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ betay_rhs)); + if(Mh_ betaz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ betaz_rhs)); + if(Mh_ dtSfx_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfx_rhs)); + if(Mh_ dtSfy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfy_rhs)); + if(Mh_ dtSfz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ dtSfz_rhs)); + if(Mh_ rho) CUDA_SAFE_CALL(cudaFree(Mh_ rho)); + if(Mh_ Sx) CUDA_SAFE_CALL(cudaFree(Mh_ Sx)); + if(Mh_ Sy) CUDA_SAFE_CALL(cudaFree(Mh_ Sy)); + if(Mh_ Sz) CUDA_SAFE_CALL(cudaFree(Mh_ Sz)); + if(Mh_ Sxx) CUDA_SAFE_CALL(cudaFree(Mh_ Sxx)); + if(Mh_ Sxy) CUDA_SAFE_CALL(cudaFree(Mh_ Sxy)); + if(Mh_ Sxz) CUDA_SAFE_CALL(cudaFree(Mh_ Sxz)); + if(Mh_ Syz) CUDA_SAFE_CALL(cudaFree(Mh_ Syz)); + if(Mh_ Syy) CUDA_SAFE_CALL(cudaFree(Mh_ Syy)); + if(Mh_ Szz) CUDA_SAFE_CALL(cudaFree(Mh_ Szz)); + if(Mh_ Gamxxx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxxx)); + if(Mh_ Gamxxy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxxy)); + if(Mh_ Gamxxz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxxz)); + if(Mh_ Gamxyy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxyy)); + if(Mh_ Gamxyz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxyz)); + if(Mh_ Gamxzz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxzz)); + if(Mh_ Gamyxx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyxx)); + if(Mh_ Gamyxy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyxy)); + if(Mh_ Gamyxz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyxz)); + if(Mh_ Gamyyy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyyy)); + if(Mh_ Gamyyz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyyz)); + if(Mh_ Gamyzz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyzz)); + if(Mh_ Gamzxx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzxx)); + if(Mh_ Gamzxy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzxy)); + if(Mh_ Gamzxz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzxz)); + if(Mh_ Gamzyz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzyz)); + if(Mh_ Gamzyy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzyy)); + if(Mh_ Gamzzz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzzz)); + if(Mh_ Rxx) CUDA_SAFE_CALL(cudaFree(Mh_ Rxx)); + if(Mh_ Rxy) CUDA_SAFE_CALL(cudaFree(Mh_ Rxy)); + if(Mh_ Rxz) CUDA_SAFE_CALL(cudaFree(Mh_ Rxz)); + if(Mh_ Ryy) CUDA_SAFE_CALL(cudaFree(Mh_ Ryy)); + if(Mh_ Ryz) CUDA_SAFE_CALL(cudaFree(Mh_ Ryz)); + if(Mh_ Rzz) CUDA_SAFE_CALL(cudaFree(Mh_ Rzz)); + if(Mh_ ham_Res) CUDA_SAFE_CALL(cudaFree(Mh_ ham_Res)); + if(Mh_ movx_Res) CUDA_SAFE_CALL(cudaFree(Mh_ movx_Res)); + if(Mh_ movy_Res) CUDA_SAFE_CALL(cudaFree(Mh_ movy_Res)); + if(Mh_ movz_Res) CUDA_SAFE_CALL(cudaFree(Mh_ movz_Res)); + if(Mh_ Gmx_Res) CUDA_SAFE_CALL(cudaFree(Mh_ Gmx_Res)); + if(Mh_ Gmy_Res) CUDA_SAFE_CALL(cudaFree(Mh_ Gmy_Res)); + if(Mh_ Gmz_Res) CUDA_SAFE_CALL(cudaFree(Mh_ Gmz_Res)); + if(Mh_ gxx) CUDA_SAFE_CALL(cudaFree(Mh_ gxx)); + if(Mh_ gyy) CUDA_SAFE_CALL(cudaFree(Mh_ gyy)); + if(Mh_ gzz) CUDA_SAFE_CALL(cudaFree(Mh_ gzz)); + if(Mh_ chix) CUDA_SAFE_CALL(cudaFree(Mh_ chix)); + if(Mh_ chiy) CUDA_SAFE_CALL(cudaFree(Mh_ chiy)); + if(Mh_ chiz) CUDA_SAFE_CALL(cudaFree(Mh_ chiz)); + if(Mh_ gxxx) CUDA_SAFE_CALL(cudaFree(Mh_ gxxx)); + if(Mh_ gxyx) CUDA_SAFE_CALL(cudaFree(Mh_ gxyx)); + if(Mh_ gxzx) CUDA_SAFE_CALL(cudaFree(Mh_ gxzx)); + if(Mh_ gyyx) CUDA_SAFE_CALL(cudaFree(Mh_ gyyx)); + if(Mh_ gyzx) CUDA_SAFE_CALL(cudaFree(Mh_ gyzx)); + if(Mh_ gzzx) CUDA_SAFE_CALL(cudaFree(Mh_ gzzx)); + if(Mh_ gxxy) CUDA_SAFE_CALL(cudaFree(Mh_ gxxy)); + if(Mh_ gxyy) CUDA_SAFE_CALL(cudaFree(Mh_ gxyy)); + if(Mh_ gxzy) CUDA_SAFE_CALL(cudaFree(Mh_ gxzy)); + if(Mh_ gyyy) CUDA_SAFE_CALL(cudaFree(Mh_ gyyy)); + if(Mh_ gyzy) CUDA_SAFE_CALL(cudaFree(Mh_ gyzy)); + if(Mh_ gzzy) CUDA_SAFE_CALL(cudaFree(Mh_ gzzy)); + if(Mh_ gxxz) CUDA_SAFE_CALL(cudaFree(Mh_ gxxz)); + if(Mh_ gxyz) CUDA_SAFE_CALL(cudaFree(Mh_ gxyz)); + if(Mh_ gxzz) CUDA_SAFE_CALL(cudaFree(Mh_ gxzz)); + if(Mh_ gyyz) CUDA_SAFE_CALL(cudaFree(Mh_ gyyz)); + if(Mh_ gyzz) CUDA_SAFE_CALL(cudaFree(Mh_ gyzz)); + if(Mh_ gzzz) CUDA_SAFE_CALL(cudaFree(Mh_ gzzz)); + if(Mh_ Lapx) CUDA_SAFE_CALL(cudaFree(Mh_ Lapx)); + if(Mh_ Lapy) CUDA_SAFE_CALL(cudaFree(Mh_ Lapy)); + if(Mh_ Lapz) CUDA_SAFE_CALL(cudaFree(Mh_ Lapz)); + if(Mh_ betaxx) CUDA_SAFE_CALL(cudaFree(Mh_ betaxx)); + if(Mh_ betaxy) CUDA_SAFE_CALL(cudaFree(Mh_ betaxy)); + if(Mh_ betaxz) CUDA_SAFE_CALL(cudaFree(Mh_ betaxz)); + if(Mh_ betayy) CUDA_SAFE_CALL(cudaFree(Mh_ betayy)); + if(Mh_ betayz) CUDA_SAFE_CALL(cudaFree(Mh_ betayz)); + if(Mh_ betazz) CUDA_SAFE_CALL(cudaFree(Mh_ betazz)); + if(Mh_ betayx) CUDA_SAFE_CALL(cudaFree(Mh_ betayx)); + if(Mh_ betazy) CUDA_SAFE_CALL(cudaFree(Mh_ betazy)); + if(Mh_ betazx) CUDA_SAFE_CALL(cudaFree(Mh_ betazx)); + if(Mh_ Kx) CUDA_SAFE_CALL(cudaFree(Mh_ Kx)); + if(Mh_ Ky) CUDA_SAFE_CALL(cudaFree(Mh_ Ky)); + if(Mh_ Kz) CUDA_SAFE_CALL(cudaFree(Mh_ Kz)); + if(Mh_ Gamxx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxx)); + if(Mh_ Gamxy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxy)); + if(Mh_ Gamxz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxz)); + if(Mh_ Gamyy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyy)); + if(Mh_ Gamyz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyz)); + if(Mh_ Gamzz) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzz)); + if(Mh_ Gamyx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamyx)); + if(Mh_ Gamzy) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzy)); + if(Mh_ Gamzx) CUDA_SAFE_CALL(cudaFree(Mh_ Gamzx)); + if(Mh_ div_beta) CUDA_SAFE_CALL(cudaFree(Mh_ div_beta)); + if(Mh_ S) CUDA_SAFE_CALL(cudaFree(Mh_ S)); + if(Mh_ f) CUDA_SAFE_CALL(cudaFree(Mh_ f)); + if(Mh_ fxx) CUDA_SAFE_CALL(cudaFree(Mh_ fxx)); + if(Mh_ fxy) CUDA_SAFE_CALL(cudaFree(Mh_ fxy)); + if(Mh_ fxz) CUDA_SAFE_CALL(cudaFree(Mh_ fxz)); + if(Mh_ fyy) CUDA_SAFE_CALL(cudaFree(Mh_ fyy)); + if(Mh_ fyz) CUDA_SAFE_CALL(cudaFree(Mh_ fyz)); + if(Mh_ fzz) CUDA_SAFE_CALL(cudaFree(Mh_ fzz)); + if(Mh_ gupxx) CUDA_SAFE_CALL(cudaFree(Mh_ gupxx)); + if(Mh_ gupxy) CUDA_SAFE_CALL(cudaFree(Mh_ gupxy)); + if(Mh_ gupxz) CUDA_SAFE_CALL(cudaFree(Mh_ gupxz)); + if(Mh_ gupyy) CUDA_SAFE_CALL(cudaFree(Mh_ gupyy)); + if(Mh_ gupyz) CUDA_SAFE_CALL(cudaFree(Mh_ gupyz)); + if(Mh_ gupzz) CUDA_SAFE_CALL(cudaFree(Mh_ gupzz)); + if(Mh_ Gamxa) CUDA_SAFE_CALL(cudaFree(Mh_ Gamxa)); + if(Mh_ Gamya) CUDA_SAFE_CALL(cudaFree(Mh_ Gamya)); + if(Mh_ Gamza) CUDA_SAFE_CALL(cudaFree(Mh_ Gamza)); + if(Mh_ alpn1) CUDA_SAFE_CALL(cudaFree(Mh_ alpn1)); + if(Mh_ chin1) CUDA_SAFE_CALL(cudaFree(Mh_ chin1)); + if(Mh_ fh) CUDA_SAFE_CALL(cudaFree(Mh_ fh)); + if(Mh_ fh2) CUDA_SAFE_CALL(cudaFree(Mh_ fh2)); + if(Mh_ gxx_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gxx_rhs)); + if(Mh_ gyy_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gyy_rhs)); + if(Mh_ gzz_rhs) CUDA_SAFE_CALL(cudaFree(Mh_ gzz_rhs)); + */ + + if(Mh_ X) cudaFree(Mh_ X); + if(Mh_ Y) cudaFree(Mh_ Y); + if(Mh_ Z) cudaFree(Mh_ Z); + if(Mh_ chi) cudaFree(Mh_ chi); + if(Mh_ dxx) cudaFree(Mh_ dxx); + if(Mh_ dyy) cudaFree(Mh_ dyy); + if(Mh_ dzz) cudaFree(Mh_ dzz); + if(Mh_ trK) cudaFree(Mh_ trK); + if(Mh_ gxy) cudaFree(Mh_ gxy); + if(Mh_ gxz) cudaFree(Mh_ gxz); + if(Mh_ gyz) cudaFree(Mh_ gyz); + if(Mh_ Axx) cudaFree(Mh_ Axx); + if(Mh_ Axy) cudaFree(Mh_ Axy); + if(Mh_ Axz) cudaFree(Mh_ Axz); + if(Mh_ Ayz) cudaFree(Mh_ Ayz); + if(Mh_ Ayy) cudaFree(Mh_ Ayy); + if(Mh_ Azz) cudaFree(Mh_ Azz); + if(Mh_ Gamx) cudaFree(Mh_ Gamx); + if(Mh_ Gamy) cudaFree(Mh_ Gamy); + if(Mh_ Gamz) cudaFree(Mh_ Gamz); + if(Mh_ Lap) cudaFree(Mh_ Lap); + if(Mh_ betax) cudaFree(Mh_ betax); + if(Mh_ betay) cudaFree(Mh_ betay); + if(Mh_ betaz) cudaFree(Mh_ betaz); + if(Mh_ dtSfx) cudaFree(Mh_ dtSfx); + if(Mh_ dtSfy) cudaFree(Mh_ dtSfy); + if(Mh_ dtSfz) cudaFree(Mh_ dtSfz); + if(Mh_ chi_rhs) cudaFree(Mh_ chi_rhs); + if(Mh_ trK_rhs) cudaFree(Mh_ trK_rhs); + if(Mh_ gxy_rhs) cudaFree(Mh_ gxy_rhs); + if(Mh_ gxz_rhs) cudaFree(Mh_ gxz_rhs); + if(Mh_ gyz_rhs) cudaFree(Mh_ gyz_rhs); + if(Mh_ Axx_rhs) cudaFree(Mh_ Axx_rhs); + if(Mh_ Axy_rhs) cudaFree(Mh_ Axy_rhs); + if(Mh_ Axz_rhs) cudaFree(Mh_ Axz_rhs); + if(Mh_ Ayz_rhs) cudaFree(Mh_ Ayz_rhs); + if(Mh_ Ayy_rhs) cudaFree(Mh_ Ayy_rhs); + if(Mh_ Azz_rhs) cudaFree(Mh_ Azz_rhs); + if(Mh_ Gamx_rhs) cudaFree(Mh_ Gamx_rhs); + if(Mh_ Gamy_rhs) cudaFree(Mh_ Gamy_rhs); + if(Mh_ Gamz_rhs) cudaFree(Mh_ Gamz_rhs); + if(Mh_ Lap_rhs) cudaFree(Mh_ Lap_rhs); + if(Mh_ betax_rhs) cudaFree(Mh_ betax_rhs); + if(Mh_ betay_rhs) cudaFree(Mh_ betay_rhs); + if(Mh_ betaz_rhs) cudaFree(Mh_ betaz_rhs); + if(Mh_ dtSfx_rhs) cudaFree(Mh_ dtSfx_rhs); + if(Mh_ dtSfy_rhs) cudaFree(Mh_ dtSfy_rhs); + if(Mh_ dtSfz_rhs) cudaFree(Mh_ dtSfz_rhs); + if(Mh_ rho) cudaFree(Mh_ rho); + if(Mh_ Sx) cudaFree(Mh_ Sx); + if(Mh_ Sy) cudaFree(Mh_ Sy); + if(Mh_ Sz) cudaFree(Mh_ Sz); + if(Mh_ Sxx) cudaFree(Mh_ Sxx); + if(Mh_ Sxy) cudaFree(Mh_ Sxy); + if(Mh_ Sxz) cudaFree(Mh_ Sxz); + if(Mh_ Syz) cudaFree(Mh_ Syz); + if(Mh_ Syy) cudaFree(Mh_ Syy); + if(Mh_ Szz) cudaFree(Mh_ Szz); + if(Mh_ Gamxxx) cudaFree(Mh_ Gamxxx); + if(Mh_ Gamxxy) cudaFree(Mh_ Gamxxy); + if(Mh_ Gamxxz) cudaFree(Mh_ Gamxxz); + if(Mh_ Gamxyy) cudaFree(Mh_ Gamxyy); + if(Mh_ Gamxyz) cudaFree(Mh_ Gamxyz); + if(Mh_ Gamxzz) cudaFree(Mh_ Gamxzz); + if(Mh_ Gamyxx) cudaFree(Mh_ Gamyxx); + if(Mh_ Gamyxy) cudaFree(Mh_ Gamyxy); + if(Mh_ Gamyxz) cudaFree(Mh_ Gamyxz); + if(Mh_ Gamyyy) cudaFree(Mh_ Gamyyy); + if(Mh_ Gamyyz) cudaFree(Mh_ Gamyyz); + if(Mh_ Gamyzz) cudaFree(Mh_ Gamyzz); + if(Mh_ Gamzxx) cudaFree(Mh_ Gamzxx); + if(Mh_ Gamzxy) cudaFree(Mh_ Gamzxy); + if(Mh_ Gamzxz) cudaFree(Mh_ Gamzxz); + if(Mh_ Gamzyz) cudaFree(Mh_ Gamzyz); + if(Mh_ Gamzyy) cudaFree(Mh_ Gamzyy); + if(Mh_ Gamzzz) cudaFree(Mh_ Gamzzz); + if(Mh_ Rxx) cudaFree(Mh_ Rxx); + if(Mh_ Rxy) cudaFree(Mh_ Rxy); + if(Mh_ Rxz) cudaFree(Mh_ Rxz); + if(Mh_ Ryy) cudaFree(Mh_ Ryy); + if(Mh_ Ryz) cudaFree(Mh_ Ryz); + if(Mh_ Rzz) cudaFree(Mh_ Rzz); + if(Mh_ ham_Res) cudaFree(Mh_ ham_Res); + if(Mh_ movx_Res) cudaFree(Mh_ movx_Res); + if(Mh_ movy_Res) cudaFree(Mh_ movy_Res); + if(Mh_ movz_Res) cudaFree(Mh_ movz_Res); + if(Mh_ Gmx_Res) cudaFree(Mh_ Gmx_Res); + if(Mh_ Gmy_Res) cudaFree(Mh_ Gmy_Res); + if(Mh_ Gmz_Res) cudaFree(Mh_ Gmz_Res); + if(Mh_ gxx) cudaFree(Mh_ gxx); + if(Mh_ gyy) cudaFree(Mh_ gyy); + if(Mh_ gzz) cudaFree(Mh_ gzz); + if(Mh_ chix) cudaFree(Mh_ chix); + if(Mh_ chiy) cudaFree(Mh_ chiy); + if(Mh_ chiz) cudaFree(Mh_ chiz); + if(Mh_ gxxx) cudaFree(Mh_ gxxx); + if(Mh_ gxyx) cudaFree(Mh_ gxyx); + if(Mh_ gxzx) cudaFree(Mh_ gxzx); + if(Mh_ gyyx) cudaFree(Mh_ gyyx); + if(Mh_ gyzx) cudaFree(Mh_ gyzx); + if(Mh_ gzzx) cudaFree(Mh_ gzzx); + if(Mh_ gxxy) cudaFree(Mh_ gxxy); + if(Mh_ gxyy) cudaFree(Mh_ gxyy); + if(Mh_ gxzy) cudaFree(Mh_ gxzy); + if(Mh_ gyyy) cudaFree(Mh_ gyyy); + if(Mh_ gyzy) cudaFree(Mh_ gyzy); + if(Mh_ gzzy) cudaFree(Mh_ gzzy); + if(Mh_ gxxz) cudaFree(Mh_ gxxz); + if(Mh_ gxyz) cudaFree(Mh_ gxyz); + if(Mh_ gxzz) cudaFree(Mh_ gxzz); + if(Mh_ gyyz) cudaFree(Mh_ gyyz); + if(Mh_ gyzz) cudaFree(Mh_ gyzz); + if(Mh_ gzzz) cudaFree(Mh_ gzzz); + if(Mh_ Lapx) cudaFree(Mh_ Lapx); + if(Mh_ Lapy) cudaFree(Mh_ Lapy); + if(Mh_ Lapz) cudaFree(Mh_ Lapz); + if(Mh_ betaxx) cudaFree(Mh_ betaxx); + if(Mh_ betaxy) cudaFree(Mh_ betaxy); + if(Mh_ betaxz) cudaFree(Mh_ betaxz); + if(Mh_ betayy) cudaFree(Mh_ betayy); + if(Mh_ betayz) cudaFree(Mh_ betayz); + if(Mh_ betazz) cudaFree(Mh_ betazz); + if(Mh_ betayx) cudaFree(Mh_ betayx); + if(Mh_ betazy) cudaFree(Mh_ betazy); + if(Mh_ betazx) cudaFree(Mh_ betazx); + if(Mh_ Kx) cudaFree(Mh_ Kx); + if(Mh_ Ky) cudaFree(Mh_ Ky); + if(Mh_ Kz) cudaFree(Mh_ Kz); + if(Mh_ Gamxx) cudaFree(Mh_ Gamxx); + if(Mh_ Gamxy) cudaFree(Mh_ Gamxy); + if(Mh_ Gamxz) cudaFree(Mh_ Gamxz); + if(Mh_ Gamyy) cudaFree(Mh_ Gamyy); + if(Mh_ Gamyz) cudaFree(Mh_ Gamyz); + if(Mh_ Gamzz) cudaFree(Mh_ Gamzz); + if(Mh_ Gamyx) cudaFree(Mh_ Gamyx); + if(Mh_ Gamzy) cudaFree(Mh_ Gamzy); + if(Mh_ Gamzx) cudaFree(Mh_ Gamzx); + if(Mh_ div_beta) cudaFree(Mh_ div_beta); + if(Mh_ S) cudaFree(Mh_ S); + if(Mh_ f) cudaFree(Mh_ f); + if(Mh_ fxx) cudaFree(Mh_ fxx); + if(Mh_ fxy) cudaFree(Mh_ fxy); + if(Mh_ fxz) cudaFree(Mh_ fxz); + if(Mh_ fyy) cudaFree(Mh_ fyy); + if(Mh_ fyz) cudaFree(Mh_ fyz); + if(Mh_ fzz) cudaFree(Mh_ fzz); + if(Mh_ gupxx) cudaFree(Mh_ gupxx); + if(Mh_ gupxy) cudaFree(Mh_ gupxy); + if(Mh_ gupxz) cudaFree(Mh_ gupxz); + if(Mh_ gupyy) cudaFree(Mh_ gupyy); + if(Mh_ gupyz) cudaFree(Mh_ gupyz); + if(Mh_ gupzz) cudaFree(Mh_ gupzz); + if(Mh_ Gamxa) cudaFree(Mh_ Gamxa); + if(Mh_ Gamya) cudaFree(Mh_ Gamya); + if(Mh_ Gamza) cudaFree(Mh_ Gamza); + if(Mh_ alpn1) cudaFree(Mh_ alpn1); + if(Mh_ chin1) cudaFree(Mh_ chin1); + if(Mh_ fh) cudaFree(Mh_ fh); + if(Mh_ fh2) cudaFree(Mh_ fh2); + if(Mh_ gxx_rhs) cudaFree(Mh_ gxx_rhs); + if(Mh_ gyy_rhs) cudaFree(Mh_ gyy_rhs); + if(Mh_ gzz_rhs) cudaFree(Mh_ gzz_rhs); + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + // if(Mh_ reta) CUDA_SAFE_CALL(cudaFree(Mh_ reta)); + if(Mh_ reta) cudaFree(Mh_ reta); + +#endif + + //if(Mh_ other_int) cudaFree(Mh_ other_int); + //if(Mh_ other_double) cudaFree(Mh_ other_double); + //cout<<"Address of meta:"<<&meta< 1 && abs[0] < dXh) {ijkmin_h[0] = -2; ijkmin2_h[0] = -3;} + if(Symmetry > 1 && abs[1] < dYh) {ijkmin_h[1] = -2; ijkmin2_h[1] = -3;} + if(Symmetry > 0 && abs[2] < dZh) {ijkmin_h[2] = -2; ijkmin2_h[2] = -3;} + + if(Symmetry > 2 && abs[0] < dXh) {ijkmin3_h[0] = -3;} + if(Symmetry > 2 && abs[1] < dYh) {ijkmin3_h[1] = -3;} + if(Symmetry > 0 && abs[2] < dZh) {ijkmin3_h[2] = -3;} + + cudaMemcpyToSymbol(ijk_max,ijkmax_h,3*sizeof(int)); + cudaMemcpyToSymbol(ijk_min,ijkmin_h,3*sizeof(int)); + cudaMemcpyToSymbol(ijk_min2,ijkmin2_h,3*sizeof(int)); + cudaMemcpyToSymbol(ijk_min3,ijkmin3_h,3*sizeof(int)); + + double d12dxyz_h[3] = {1.0,1.0,1.0}; + double d2dxyz_h[3] = {1.0,1.0,1.0}; + d12dxyz_h[0] /= 12; d12dxyz_h[1] /= 12; d12dxyz_h[2] /= 12; + d12dxyz_h[0] /= dXh; d12dxyz_h[1] /= dYh; d12dxyz_h[2] /= dZh; + d2dxyz_h[0] /= 2; d2dxyz_h[1] /= 2; d2dxyz_h[2] /= 2; + d2dxyz_h[0] /= dXh; d2dxyz_h[1] /= dYh; d2dxyz_h[2] /= dZh; + + cudaMemcpyToSymbol(d12dxyz,d12dxyz_h,3*sizeof(double)); + cudaMemcpyToSymbol(d2dxyz,d2dxyz_h,3*sizeof(double)); + +//3.3--------for fdderivs------------ + double Sdxdxh = 1.0 /( dXh * dXh ); + double Sdydyh = 1.0 /( dYh * dYh ); + double Sdzdzh = 1.0 /( dZh * dZh ); + double Fdxdxh = 1.0 / 12.0 /( dXh * dXh ); + double Fdydyh = 1.0 / 12.0 /( dYh * dYh ); + double Fdzdzh = 1.0 / 12.0 /( dZh * dZh ); + double Sdxdyh = 1.0/4.0 /( dXh * dYh ); + double Sdxdzh = 1.0/4.0 /( dXh * dZh ); + double Sdydzh = 1.0/4.0 /( dYh * dZh ); + double Fdxdyh = 1.0/144.0 /( dXh * dYh ); + double Fdxdzh = 1.0/144.0 /( dXh * dZh ); + double Fdydzh = 1.0/144.0 /( dYh * dZh ); + cudaMemcpyToSymbol(Sdxdx,&Sdxdxh,sizeof(double)); + cudaMemcpyToSymbol(Sdydy,&Sdydyh,sizeof(double)); + cudaMemcpyToSymbol(Sdzdz,&Sdzdzh,sizeof(double)); + cudaMemcpyToSymbol(Sdxdy,&Sdxdyh,sizeof(double)); + cudaMemcpyToSymbol(Sdxdz,&Sdxdzh,sizeof(double)); + cudaMemcpyToSymbol(Sdydz,&Sdydzh,sizeof(double)); + cudaMemcpyToSymbol(Fdxdx,&Fdxdxh,sizeof(double)); + cudaMemcpyToSymbol(Fdydy,&Fdydyh,sizeof(double)); + cudaMemcpyToSymbol(Fdzdz,&Fdzdzh,sizeof(double)); + cudaMemcpyToSymbol(Fdxdy,&Fdxdyh,sizeof(double)); + cudaMemcpyToSymbol(Fdxdz,&Fdxdzh,sizeof(double)); + cudaMemcpyToSymbol(Fdydz,&Fdydzh,sizeof(double)); + +//3.4---------for lopsided--------------------------- + + +#ifdef TIMING1 + cudaThreadSynchronize(); + gettimeofday(&tv2, NULL); + cout<<"TIME USED"<>>(ctest_d); + cudaMemcpy(ctest, ctest_d, sizeof(double), cudaMemcpyDeviceToHost); + cout<<"My rank is: "<>>(); + cudaThreadSynchronize(); + + sub_fderivs(Mh_ betax,Mh_ fh,Mh_ betaxx,Mh_ betaxy,Mh_ betaxz,ass); + sub_fderivs(Mh_ betay,Mh_ fh,Mh_ betayx,Mh_ betayy,Mh_ betayz,sas); + sub_fderivs(Mh_ betaz,Mh_ fh,Mh_ betazx,Mh_ betazy,Mh_ betazz,ssa); + sub_fderivs(Mh_ chi,Mh_ fh,Mh_ chix,Mh_ chiy,Mh_ chiz, sss); + sub_fderivs(Mh_ Lap,Mh_ fh,Mh_ Lapx,Mh_ Lapy,Mh_ Lapz, sss); + sub_fderivs(Mh_ trK,Mh_ fh,Mh_ Kx,Mh_ Ky,Mh_ Kz, sss); + sub_fderivs(Mh_ dxx,Mh_ fh,Mh_ gxxx,Mh_ gxxy,Mh_ gxxz, sss); + sub_fderivs(Mh_ dyy,Mh_ fh,Mh_ gyyx,Mh_ gyyy,Mh_ gyyz, sss); + sub_fderivs(Mh_ dzz,Mh_ fh,Mh_ gzzx,Mh_ gzzy,Mh_ gzzz, sss); + sub_fderivs(Mh_ gxy,Mh_ fh,Mh_ gxyx,Mh_ gxyy,Mh_ gxyz, aas); + sub_fderivs(Mh_ gxz,Mh_ fh,Mh_ gxzx,Mh_ gxzy,Mh_ gxzz, asa); + sub_fderivs(Mh_ gyz,Mh_ fh,Mh_ gyzx,Mh_ gyzy,Mh_ gyzz, saa); + + compute_rhs_bssn_part2<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs(Mh_ betax,Mh_ fh,Mh_ gxxx,Mh_ gxyx,Mh_ gxzx,Mh_ gyyx,Mh_ gyzx,Mh_ gzzx,ass); + sub_fdderivs(Mh_ betay,Mh_ fh,Mh_ gxxy,Mh_ gxyy,Mh_ gxzy,Mh_ gyyy,Mh_ gyzy,Mh_ gzzy,sas); + sub_fdderivs(Mh_ betaz,Mh_ fh,Mh_ gxxz,Mh_ gxyz,Mh_ gxzz,Mh_ gyyz,Mh_ gyzz,Mh_ gzzz,ssa); + sub_fderivs( Mh_ Gamx, Mh_ fh,Mh_ Gamxx, Mh_ Gamxy, Mh_ Gamxz,ass); + sub_fderivs( Mh_ Gamy, Mh_ fh,Mh_ Gamyx, Mh_ Gamyy, Mh_ Gamyz,sas); + sub_fderivs( Mh_ Gamz, Mh_ fh,Mh_ Gamzx, Mh_ Gamzy, Mh_ Gamzz,ssa); + + compute_rhs_bssn_part3<<>>(); + cudaThreadSynchronize(); + + computeRicci(Mh_ dxx,Mh_ Rxx,sss, meta); + computeRicci(Mh_ dyy,Mh_ Ryy,sss, meta); + computeRicci(Mh_ dzz,Mh_ Rzz,sss, meta); + computeRicci(Mh_ gxy,Mh_ Rxy,aas, meta); + computeRicci(Mh_ gxz,Mh_ Rxz,asa, meta); + computeRicci(Mh_ gyz,Mh_ Ryz,saa, meta); + + cudaThreadSynchronize(); + + compute_rhs_bssn_part4<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs(Mh_ chi,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,sss); + + compute_rhs_bssn_part5<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs(Mh_ Lap,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,sss); + + compute_rhs_bssn_part6<<>>(); + cudaThreadSynchronize(); + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5) + sub_fderivs(Mh_ chi,Mh_ fh, Mh_ dtSfx_rhs, Mh_ dtSfy_rhs, Mh_ dtSfz_rhs,sss); + compute_rhs_bssn_part6_gauge<<>>(); +#endif + + sub_lopsided(Mh_ gxx,Mh_ fh2,Mh_ gxx_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ gxy,Mh_ fh2,Mh_ gxy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,aas); + sub_lopsided(Mh_ gxz,Mh_ fh2,Mh_ gxz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,asa); + sub_lopsided(Mh_ gyy,Mh_ fh2,Mh_ gyy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ gyz,Mh_ fh2,Mh_ gyz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,saa); + sub_lopsided(Mh_ gzz,Mh_ fh2,Mh_ gzz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ Axx,Mh_ fh2,Mh_ Axx_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ Axy,Mh_ fh2,Mh_ Axy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,aas); + sub_lopsided(Mh_ Axz,Mh_ fh2,Mh_ Axz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,asa); + sub_lopsided(Mh_ Ayy,Mh_ fh2,Mh_ Ayy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ Ayz,Mh_ fh2,Mh_ Ayz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,saa); + sub_lopsided(Mh_ Azz,Mh_ fh2,Mh_ Azz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ chi,Mh_ fh2,Mh_ chi_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ trK,Mh_ fh2,Mh_ trK_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + sub_lopsided(Mh_ Gamx,Mh_ fh2,Mh_ Gamx_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ass); + sub_lopsided(Mh_ Gamy,Mh_ fh2,Mh_ Gamy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sas); + sub_lopsided(Mh_ Gamz,Mh_ fh2,Mh_ Gamz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ssa); + sub_lopsided(Mh_ Lap,Mh_ fh2,Mh_ Lap_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sss); + +#if (GAUGE == 0 || GAUGE == 1 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + + sub_lopsided(Mh_ betax,Mh_ fh2,Mh_ betax_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ass); + sub_lopsided(Mh_ betay,Mh_ fh2,Mh_ betay_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sas); + sub_lopsided(Mh_ betaz,Mh_ fh2,Mh_ betaz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ssa); + +#endif +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + sub_lopsided(Mh_ dtSfx,Mh_ fh2,Mh_ dtSfx_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ass); + sub_lopsided(Mh_ dtSfy,Mh_ fh2,Mh_ dtSfy_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,sas); + sub_lopsided(Mh_ dtSfz,Mh_ fh2,Mh_ dtSfz_rhs,Mh_ betax,Mh_ betay,Mh_ betaz,ssa); +#endif + if(eps > 0){ + sub_kodis(Mh_ chi,Mh_ fh2, Mh_ chi_rhs,sss); + sub_kodis(Mh_ trK,Mh_ fh2, Mh_ trK_rhs,sss); + sub_kodis(Mh_ dxx,Mh_ fh2, Mh_ gxx_rhs,sss); + sub_kodis(Mh_ gxy,Mh_ fh2, Mh_ gxy_rhs,aas); + sub_kodis(Mh_ gxz,Mh_ fh2, Mh_ gxz_rhs,asa); + sub_kodis(Mh_ dyy,Mh_ fh2, Mh_ gyy_rhs,sss); + sub_kodis(Mh_ gyz,Mh_ fh2, Mh_ gyz_rhs,saa); + sub_kodis(Mh_ dzz,Mh_ fh2, Mh_ gzz_rhs,sss); + sub_kodis(Mh_ Axx,Mh_ fh2, Mh_ Axx_rhs,sss); + sub_kodis(Mh_ Axy,Mh_ fh2, Mh_ Axy_rhs,aas); + sub_kodis(Mh_ Axz,Mh_ fh2, Mh_ Axz_rhs,asa); + sub_kodis(Mh_ Ayy,Mh_ fh2, Mh_ Ayy_rhs,sss); + sub_kodis(Mh_ Ayz,Mh_ fh2, Mh_ Ayz_rhs,saa); + sub_kodis(Mh_ Azz,Mh_ fh2, Mh_ Azz_rhs,sss); + sub_kodis(Mh_ Gamx,Mh_ fh2, Mh_ Gamx_rhs,ass); + sub_kodis(Mh_ Gamy,Mh_ fh2, Mh_ Gamy_rhs,sas); + sub_kodis(Mh_ Gamz,Mh_ fh2, Mh_ Gamz_rhs,ssa); + + sub_kodis(Mh_ Lap,Mh_ fh2, Mh_ Lap_rhs,sss); + sub_kodis(Mh_ betax,Mh_ fh2, Mh_ betax_rhs,ass); + sub_kodis(Mh_ betay,Mh_ fh2, Mh_ betay_rhs,sas); + sub_kodis(Mh_ betaz,Mh_ fh2, Mh_ betaz_rhs,ssa); + +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + sub_kodis(Mh_ dtSfx,Mh_ fh2, Mh_ dtSfx_rhs,ass); + sub_kodis(Mh_ dtSfy,Mh_ fh2, Mh_ dtSfy_rhs,sas); + sub_kodis(Mh_ dtSfz,Mh_ fh2, Mh_ dtSfz_rhs,ssa); +#endif + + } + + if(co == 0){ + compute_rhs_bssn_part7<<>>(); + cudaThreadSynchronize(); + + sub_fderivs(Mh_ Axx,Mh_ fh,Mh_ gxxx,Mh_ gxxy,Mh_ gxxz,sss); + sub_fderivs(Mh_ Axy,Mh_ fh,Mh_ gxyx,Mh_ gxyy,Mh_ gxyz,aas); + sub_fderivs(Mh_ Axz,Mh_ fh,Mh_ gxzx,Mh_ gxzy,Mh_ gxzz,asa); + sub_fderivs(Mh_ Ayy,Mh_ fh,Mh_ gyyx,Mh_ gyyy,Mh_ gyyz,sss); + sub_fderivs(Mh_ Ayz,Mh_ fh,Mh_ gyzx,Mh_ gyzy,Mh_ gyzz,saa); + sub_fderivs(Mh_ Azz,Mh_ fh,Mh_ gzzx,Mh_ gzzy,Mh_ gzzz,sss); + compute_rhs_bssn_part8<<>>(); + cudaThreadSynchronize(); + } + +#if (ABV == 1) + cout<<"TODO: bssn_gpu.cu::2373 (ABV == 1)"< +#define Ms_ metassc. +#define Msh_ metass-> + +// #define TIMING + +#define RHS_SS_PARA int calledby, int mpi_rank, int *ex, double &T, double *crho, double *sigma, double *R, double *X, double *Y, double *Z, double *drhodx, double *drhody, double *drhodz, double *dsigmadx, double *dsigmady, double *dsigmadz, double *dRdx, double *dRdy, double *dRdz, double *drhodxx, double *drhodxy, double *drhodxz, double *drhodyy, double *drhodyz, double *drhodzz, double *dsigmadxx, double *dsigmadxy, double *dsigmadxz, double *dsigmadyy, double *dsigmadyz, double *dsigmadzz, double *dRdxx, double *dRdxy, double *dRdxz, double *dRdyy, double *dRdyz, double *dRdzz, double *chi, double *trK, double *dxx, double *gxy, double *gxz, double *dyy, double *gyz, double *dzz, double *Axx, double *Axy, double *Axz, double *Ayy, double *Ayz, double *Azz, double *Gamx, double *Gamy, double *Gamz, double *Lap, double *betax, double *betay, double *betaz, double *dtSfx, double *dtSfy, double *dtSfz, double *chi_rhs, double *trK_rhs, double *gxx_rhs, double *gxy_rhs, double *gxz_rhs, double *gyy_rhs, double *gyz_rhs, double *gzz_rhs, double *Axx_rhs, double *Axy_rhs, double *Axz_rhs, double *Ayy_rhs, double *Ayz_rhs, double *Azz_rhs, double *Gamx_rhs, double *Gamy_rhs, double *Gamz_rhs, double *Lap_rhs, double *betax_rhs, double *betay_rhs, double *betaz_rhs, double *dtSfx_rhs, double *dtSfy_rhs, double *dtSfz_rhs, double *rho, double *Sx, double *Sy, double *Sz, double *Sxx, double *Sxy, double *Sxz, double *Syy, double *Syz, double *Szz, double *Gamxxx, double *Gamxxy, double *Gamxxz, double *Gamxyy, double *Gamxyz, double *Gamxzz, double *Gamyxx, double *Gamyxy, double *Gamyxz, double *Gamyyy, double *Gamyyz, double *Gamyzz, double *Gamzxx, double *Gamzxy, double *Gamzxz, double *Gamzyy, double *Gamzyz, double *Gamzzz, double *Rxx, double *Rxy, double *Rxz, double *Ryy, double *Ryz, double *Rzz, double *ham_Res, double *movx_Res, double *movy_Res, double *movz_Res, double *Gmx_Res, double *Gmy_Res, double *Gmz_Res, int &Symmetry, int &Lev, double &eps, int &sst, int &co + +/** main function */ +int gpu_rhs(int calledby, int mpi_rank, int *ex, double &T, + double *X, double *Y, double *Z, + + double *chi, double *trK, + + double *dxx, double *gxy, double *gxz, double *dyy, double *gyz, double *dzz, + + double *Axx, double *Axy, double *Axz, double *Ayy, double *Ayz, double *Azz, + + double *Gamx, double *Gamy, double *Gamz, + + double *Lap, double *betax, double *betay, double *betaz, + + double *dtSfx, double *dtSfy, double *dtSfz, + + double *chi_rhs, double *trK_rhs, + + double *gxx_rhs, double *gxy_rhs, double *gxz_rhs, double *gyy_rhs, double *gyz_rhs, double *gzz_rhs, + + double *Axx_rhs, double *Axy_rhs, double *Axz_rhs, double *Ayy_rhs, double *Ayz_rhs, double *Azz_rhs, + + double *Gamx_rhs, double *Gamy_rhs, double *Gamz_rhs, + + double *Lap_rhs, double *betax_rhs, double *betay_rhs, double *betaz_rhs, + + double *dtSfx_rhs, double *dtSfy_rhs, double *dtSfz_rhs, + + double *rho, double *Sx, double *Sy, double *Sz, double *Sxx, + double *Sxy, double *Sxz, double *Syy, double *Syz, double *Szz, + + double *Gamxxx, double *Gamxxy, double *Gamxxz, double *Gamxyy, double *Gamxyz, double *Gamxzz, + + double *Gamyxx, double *Gamyxy, double *Gamyxz, double *Gamyyy, double *Gamyyz, double *Gamyzz, + + double *Gamzxx, double *Gamzxy, double *Gamzxz, double *Gamzyy, double *Gamzyz, double *Gamzzz, + + double *Rxx, double *Rxy, double *Rxz, double *Ryy, double *Ryz, double *Rzz, + + double *ham_Res, double *movx_Res, double *movy_Res, double *movz_Res, + double *Gmx_Res, double *Gmy_Res, double *Gmz_Res, + int &Symmetry, int &Lev, double &eps, int &co); + +int gpu_rhs_ss(RHS_SS_PARA); + +/** Init GPU side data in GPUMeta. */ +// void init_fluid_meta_gpu(GPUMeta *gpu_meta); + +#endif diff --git a/AMSS_NCKU_source/bssn_gpu_class.C b/AMSS_NCKU_source/bssn_gpu_class.C new file mode 100644 index 0000000..f6d5170 --- /dev/null +++ b/AMSS_NCKU_source/bssn_gpu_class.C @@ -0,0 +1,7790 @@ + +#ifdef newc +#include +#include +using namespace std; +#else +#include +#endif + +#include "macrodef.h" +#include "misc.h" +#include +#include "Ansorg.h" +#include "fmisc.h" +#include "Parallel.h" +#include "bssn_gpu_class.h" +#include "bssn_rhs.h" +#include "initial_puncture.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "getnp4.h" +#include "shellfunctions.h" + +#ifdef With_AHF +#include "derivatives.h" +#include "myglobal.h" +#endif + +#include "perf.h" +#include "derivatives.h" +#include "ricci_gamma.h" + +// include GPU files +#include "bssn_gpu.h" + +//================================================================================================ + +// Define bssn_gpu_class + +//================================================================================================ + +bssn_class::bssn_class(double Couranti, double StartTimei, double TotalTimei, + double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, + double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi) + : Courant(Couranti), StartTime(StartTimei), TotalTime(TotalTimei), + DumpTime(DumpTimei), d2DumpTime(d2DumpTimei), CheckTime(CheckTimei), AnasTime(AnasTimei), + Symmetry(Symmetryi), checkrun(checkruni), numepss(numepssi), numepsb(numepsbi), numepsh(numepshi), +#ifdef With_AHF + xc(0), yc(0), zc(0), xr(0), yr(0), zr(0), trigger(0), dTT(0), dumpid(0), +#endif + a_lev(a_levi), maxl(maxli), decn(decni), maxrex(maxrexi), drex(drexi), + CheckPoint(0) +{ + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + // setup Monitors + { + stringstream a_stream; + a_stream.setf(ios::left); + a_stream << "# Error log information"; + ErrorMonitor = new monitor("Error.log", myrank, a_stream.str()); + ErrorMonitor->print_message("Warning: we always assume intput parameter in cell center style."); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + char str[50]; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + Psi4Monitor = new monitor("bssn_psi4.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + BHMonitor = new monitor("bssn_BH.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time ADMmass ADMPx ADMPy ADMPz ADMSx ADMSy ADMSz"; + MAPMonitor = new monitor("bssn_ADMQs.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time Ham Px Py Pz Gx Gy Gz"; + ConVMonitor = new monitor("bssn_constraint.dat", myrank, a_stream.str()); + } + // setup sphere integration engine + Waveshell = new surface_integral(Symmetry); + + trfls = 0; + chitiny = 0; + // read parameter from file + { + char filename[50]; + strcpy(filename, "input.par"); + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "chitiny") + chitiny = atof(sval.c_str()); + else if (sgrp == "BSSN" && skey == "time refinement start from level") + trfls = atoi(sval.c_str()); +#ifdef With_AHF + else if (sgrp == "AHF" && skey == "AHfindevery") + AHfindevery = atoi(sval.c_str()); + else if (sgrp == "AHF" && skey == "AHdumptime") + AHdumptime = atof(sval.c_str()); +#endif + } + inf.close(); + } + if (myrank == 0) + { + // echo information of lower bound of chi + cout << "chitiny = " << chitiny << endl; + cout << "time refinement start from level #" << trfls << endl; +#ifdef With_AHF + cout << "parameters for AHF:" << endl; + cout << "AHfindevery = " << AHfindevery << endl; + cout << "AHdumptime = " << AHdumptime << endl; +#endif + } + + chitiny = chitiny - 1; // because we have subtracted one from chi + + strcpy(checkfilename, checkfilenamei); + + ngfs = 0; + phio = new var("phio", ngfs++, 1, 1, 1); + trKo = new var("trKo", ngfs++, 1, 1, 1); + gxxo = new var("gxxo", ngfs++, 1, 1, 1); + gxyo = new var("gxyo", ngfs++, -1, -1, 1); + gxzo = new var("gxzo", ngfs++, -1, 1, -1); + gyyo = new var("gyyo", ngfs++, 1, 1, 1); + gyzo = new var("gyzo", ngfs++, 1, -1, -1); + gzzo = new var("gzzo", ngfs++, 1, 1, 1); + Axxo = new var("Axxo", ngfs++, 1, 1, 1); + Axyo = new var("Axyo", ngfs++, -1, -1, 1); + Axzo = new var("Axzo", ngfs++, -1, 1, -1); + Ayyo = new var("Ayyo", ngfs++, 1, 1, 1); + Ayzo = new var("Ayzo", ngfs++, 1, -1, -1); + Azzo = new var("Azzo", ngfs++, 1, 1, 1); + Gmxo = new var("Gmxo", ngfs++, -1, 1, 1); + Gmyo = new var("Gmyo", ngfs++, 1, -1, 1); + Gmzo = new var("Gmzo", ngfs++, 1, 1, -1); + Lapo = new var("Lapo", ngfs++, 1, 1, 1); + Sfxo = new var("Sfxo", ngfs++, -1, 1, 1); + Sfyo = new var("Sfyo", ngfs++, 1, -1, 1); + Sfzo = new var("Sfzo", ngfs++, 1, 1, -1); + dtSfxo = new var("dtSfxo", ngfs++, -1, 1, 1); + dtSfyo = new var("dtSfyo", ngfs++, 1, -1, 1); + dtSfzo = new var("dtSfzo", ngfs++, 1, 1, -1); + + phi0 = new var("phi0", ngfs++, 1, 1, 1); + trK0 = new var("trK0", ngfs++, 1, 1, 1); + gxx0 = new var("gxx0", ngfs++, 1, 1, 1); + gxy0 = new var("gxy0", ngfs++, -1, -1, 1); + gxz0 = new var("gxz0", ngfs++, -1, 1, -1); + gyy0 = new var("gyy0", ngfs++, 1, 1, 1); + gyz0 = new var("gyz0", ngfs++, 1, -1, -1); + gzz0 = new var("gzz0", ngfs++, 1, 1, 1); + Axx0 = new var("Axx0", ngfs++, 1, 1, 1); + Axy0 = new var("Axy0", ngfs++, -1, -1, 1); + Axz0 = new var("Axz0", ngfs++, -1, 1, -1); + Ayy0 = new var("Ayy0", ngfs++, 1, 1, 1); + Ayz0 = new var("Ayz0", ngfs++, 1, -1, -1); + Azz0 = new var("Azz0", ngfs++, 1, 1, 1); + Gmx0 = new var("Gmx0", ngfs++, -1, 1, 1); + Gmy0 = new var("Gmy0", ngfs++, 1, -1, 1); + Gmz0 = new var("Gmz0", ngfs++, 1, 1, -1); + Lap0 = new var("Lap0", ngfs++, 1, 1, 1); + Sfx0 = new var("Sfx0", ngfs++, -1, 1, 1); + Sfy0 = new var("Sfy0", ngfs++, 1, -1, 1); + Sfz0 = new var("Sfz0", ngfs++, 1, 1, -1); + dtSfx0 = new var("dtSfx0", ngfs++, -1, 1, 1); + dtSfy0 = new var("dtSfy0", ngfs++, 1, -1, 1); + dtSfz0 = new var("dtSfz0", ngfs++, 1, 1, -1); + + phi = new var("phi", ngfs++, 1, 1, 1); + trK = new var("trK", ngfs++, 1, 1, 1); + gxx = new var("gxx", ngfs++, 1, 1, 1); + gxy = new var("gxy", ngfs++, -1, -1, 1); + gxz = new var("gxz", ngfs++, -1, 1, -1); + gyy = new var("gyy", ngfs++, 1, 1, 1); + gyz = new var("gyz", ngfs++, 1, -1, -1); + gzz = new var("gzz", ngfs++, 1, 1, 1); + Axx = new var("Axx", ngfs++, 1, 1, 1); + Axy = new var("Axy", ngfs++, -1, -1, 1); + Axz = new var("Axz", ngfs++, -1, 1, -1); + Ayy = new var("Ayy", ngfs++, 1, 1, 1); + Ayz = new var("Ayz", ngfs++, 1, -1, -1); + Azz = new var("Azz", ngfs++, 1, 1, 1); + Gmx = new var("Gmx", ngfs++, -1, 1, 1); + Gmy = new var("Gmy", ngfs++, 1, -1, 1); + Gmz = new var("Gmz", ngfs++, 1, 1, -1); + Lap = new var("Lap", ngfs++, 1, 1, 1); + Sfx = new var("Sfx", ngfs++, -1, 1, 1); + Sfy = new var("Sfy", ngfs++, 1, -1, 1); + Sfz = new var("Sfz", ngfs++, 1, 1, -1); + dtSfx = new var("dtSfx", ngfs++, -1, 1, 1); + dtSfy = new var("dtSfy", ngfs++, 1, -1, 1); + dtSfz = new var("dtSfz", ngfs++, 1, 1, -1); + + phi1 = new var("phi1", ngfs++, 1, 1, 1); + trK1 = new var("trK1", ngfs++, 1, 1, 1); + gxx1 = new var("gxx1", ngfs++, 1, 1, 1); + gxy1 = new var("gxy1", ngfs++, -1, -1, 1); + gxz1 = new var("gxz1", ngfs++, -1, 1, -1); + gyy1 = new var("gyy1", ngfs++, 1, 1, 1); + gyz1 = new var("gyz1", ngfs++, 1, -1, -1); + gzz1 = new var("gzz1", ngfs++, 1, 1, 1); + Axx1 = new var("Axx1", ngfs++, 1, 1, 1); + Axy1 = new var("Axy1", ngfs++, -1, -1, 1); + Axz1 = new var("Axz1", ngfs++, -1, 1, -1); + Ayy1 = new var("Ayy1", ngfs++, 1, 1, 1); + Ayz1 = new var("Ayz1", ngfs++, 1, -1, -1); + Azz1 = new var("Azz1", ngfs++, 1, 1, 1); + Gmx1 = new var("Gmx1", ngfs++, -1, 1, 1); + Gmy1 = new var("Gmy1", ngfs++, 1, -1, 1); + Gmz1 = new var("Gmz1", ngfs++, 1, 1, -1); + Lap1 = new var("Lap1", ngfs++, 1, 1, 1); + Sfx1 = new var("Sfx1", ngfs++, -1, 1, 1); + Sfy1 = new var("Sfy1", ngfs++, 1, -1, 1); + Sfz1 = new var("Sfz1", ngfs++, 1, 1, -1); + dtSfx1 = new var("dtSfx1", ngfs++, -1, 1, 1); + dtSfy1 = new var("dtSfy1", ngfs++, 1, -1, 1); + dtSfz1 = new var("dtSfz1", ngfs++, 1, 1, -1); + + phi_rhs = new var("phi_rhs", ngfs++, 1, 1, 1); + trK_rhs = new var("trK_rhs", ngfs++, 1, 1, 1); + gxx_rhs = new var("gxx_rhs", ngfs++, 1, 1, 1); + gxy_rhs = new var("gxy_rhs", ngfs++, -1, -1, 1); + gxz_rhs = new var("gxz_rhs", ngfs++, -1, 1, -1); + gyy_rhs = new var("gyy_rhs", ngfs++, 1, 1, 1); + gyz_rhs = new var("gyz_rhs", ngfs++, 1, -1, -1); + gzz_rhs = new var("gzz_rhs", ngfs++, 1, 1, 1); + Axx_rhs = new var("Axx_rhs", ngfs++, 1, 1, 1); + Axy_rhs = new var("Axy_rhs", ngfs++, -1, -1, 1); + Axz_rhs = new var("Axz_rhs", ngfs++, -1, 1, -1); + Ayy_rhs = new var("Ayy_rhs", ngfs++, 1, 1, 1); + Ayz_rhs = new var("Ayz_rhs", ngfs++, 1, -1, -1); + Azz_rhs = new var("Azz_rhs", ngfs++, 1, 1, 1); + Gmx_rhs = new var("Gmx_rhs", ngfs++, -1, 1, 1); + Gmy_rhs = new var("Gmy_rhs", ngfs++, 1, -1, 1); + Gmz_rhs = new var("Gmz_rhs", ngfs++, 1, 1, -1); + Lap_rhs = new var("Lap_rhs", ngfs++, 1, 1, 1); + Sfx_rhs = new var("Sfx_rhs", ngfs++, -1, 1, 1); + Sfy_rhs = new var("Sfy_rhs", ngfs++, 1, -1, 1); + Sfz_rhs = new var("Sfz_rhs", ngfs++, 1, 1, -1); + dtSfx_rhs = new var("dtSfx_rhs", ngfs++, -1, 1, 1); + dtSfy_rhs = new var("dtSfy_rhs", ngfs++, 1, -1, 1); + dtSfz_rhs = new var("dtSfz_rhs", ngfs++, 1, 1, -1); + + rho = new var("rho", ngfs++, 1, 1, 1); + Sx = new var("Sx", ngfs++, -1, 1, 1); + Sy = new var("Sy", ngfs++, 1, -1, 1); + Sz = new var("Sz", ngfs++, 1, 1, -1); + Sxx = new var("Sxx", ngfs++, 1, 1, 1); + Sxy = new var("Sxy", ngfs++, -1, -1, 1); + Sxz = new var("Sxz", ngfs++, -1, 1, -1); + Syy = new var("Syy", ngfs++, 1, 1, 1); + Syz = new var("Syz", ngfs++, 1, -1, -1); + Szz = new var("Szz", ngfs++, 1, 1, 1); + + Gamxxx = new var("Gamxxx", ngfs++, -1, 1, 1); + Gamxxy = new var("Gamxxy", ngfs++, 1, -1, 1); + Gamxxz = new var("Gamxxz", ngfs++, 1, 1, -1); + Gamxyy = new var("Gamxyy", ngfs++, -1, 1, 1); + Gamxyz = new var("Gamxyz", ngfs++, -1, -1, -1); + Gamxzz = new var("Gamxzz", ngfs++, -1, 1, 1); + Gamyxx = new var("Gamyxx", ngfs++, 1, -1, 1); + Gamyxy = new var("Gamyxy", ngfs++, -1, 1, 1); + Gamyxz = new var("Gamyxz", ngfs++, -1, -1, -1); + Gamyyy = new var("Gamyyy", ngfs++, 1, -1, 1); + Gamyyz = new var("Gamyyz", ngfs++, 1, 1, -1); + Gamyzz = new var("Gamyzz", ngfs++, 1, -1, 1); + Gamzxx = new var("Gamzxx", ngfs++, 1, 1, -1); + Gamzxy = new var("Gamzxy", ngfs++, -1, -1, -1); + Gamzxz = new var("Gamzxz", ngfs++, -1, 1, 1); + Gamzyy = new var("Gamzyy", ngfs++, 1, 1, -1); + Gamzyz = new var("Gamzyz", ngfs++, 1, -1, 1); + Gamzzz = new var("Gamzzz", ngfs++, 1, 1, -1); + + Rxx = new var("Rxx", ngfs++, 1, 1, 1); + Rxy = new var("Rxy", ngfs++, -1, -1, 1); + Rxz = new var("Rxz", ngfs++, -1, 1, -1); + Ryy = new var("Ryy", ngfs++, 1, 1, 1); + Ryz = new var("Ryz", ngfs++, 1, -1, -1); + Rzz = new var("Rzz", ngfs++, 1, 1, 1); + + // refer to PRD, 77, 024027 (2008) + Rpsi4 = new var("Rpsi4", ngfs++, 1, 1, 1); + Ipsi4 = new var("Ipsi4", ngfs++, -1, -1, -1); + t1Rpsi4 = new var("t1Rpsi4", ngfs++, 1, 1, 1); + t1Ipsi4 = new var("t1Ipsi4", ngfs++, -1, -1, -1); + t2Rpsi4 = new var("t2Rpsi4", ngfs++, 1, 1, 1); + t2Ipsi4 = new var("t2Ipsi4", ngfs++, -1, -1, -1); + + // constraint violation monitor variables + Cons_Ham = new var("Cons_Ham", ngfs++, 1, 1, 1); + Cons_Px = new var("Cons_Px", ngfs++, -1, 1, 1); + Cons_Py = new var("Cons_Py", ngfs++, 1, -1, 1); + Cons_Pz = new var("Cons_Pz", ngfs++, 1, 1, -1); + Cons_Gx = new var("Cons_Gx", ngfs++, -1, 1, 1); + Cons_Gy = new var("Cons_Gy", ngfs++, 1, -1, 1); + Cons_Gz = new var("Cons_Gz", ngfs++, 1, 1, -1); + +#ifdef Point_Psi4 + phix = new var("phix", ngfs++, -1, 1, 1); + phiy = new var("phiy", ngfs++, 1, -1, 1); + phiz = new var("phiz", ngfs++, 1, 1, -1); + trKx = new var("trKx", ngfs++, -1, 1, 1); + trKy = new var("trKy", ngfs++, 1, -1, 1); + trKz = new var("trKz", ngfs++, 1, 1, -1); + Axxx = new var("Axxx", ngfs++, -1, 1, 1); + Axxy = new var("Axxy", ngfs++, 1, -1, 1); + Axxz = new var("Axxz", ngfs++, 1, 1, -1); + Axyx = new var("Axyx", ngfs++, 1, -1, 1); + Axyy = new var("Axyy", ngfs++, -1, 1, 1); + Axyz = new var("Axyz", ngfs++, -1, -1, -1); + Axzx = new var("Axzx", ngfs++, 1, 1, -1); + Axzy = new var("Axzy", ngfs++, -1, -1, -1); + Axzz = new var("Axzz", ngfs++, -1, 1, 1); + Ayyx = new var("Ayyx", ngfs++, -1, 1, 1); + Ayyy = new var("Ayyy", ngfs++, 1, -1, 1); + Ayyz = new var("Ayyz", ngfs++, 1, 1, -1); + Ayzx = new var("Ayzx", ngfs++, -1, -1, -1); + Ayzy = new var("Ayzy", ngfs++, 1, 1, -1); + Ayzz = new var("Ayzz", ngfs++, 1, -1, 1); + Azzx = new var("Azzx", ngfs++, -1, 1, 1); + Azzy = new var("Azzy", ngfs++, 1, -1, 1); + Azzz = new var("Azzz", ngfs++, 1, 1, -1); +#endif + + // specific properspeed for 1+log slice + { + const double vl = sqrt(2); + trKo->setpropspeed(vl); + trK0->setpropspeed(vl); + trK->setpropspeed(vl); + trK1->setpropspeed(vl); + trK_rhs->setpropspeed(vl); + + phio->setpropspeed(vl); + phi0->setpropspeed(vl); + phi->setpropspeed(vl); + phi1->setpropspeed(vl); + phi_rhs->setpropspeed(vl); + + Lapo->setpropspeed(vl); + Lap0->setpropspeed(vl); + Lap->setpropspeed(vl); + Lap1->setpropspeed(vl); + Lap_rhs->setpropspeed(vl); + } + + OldStateList = new MyList(phio); + OldStateList->insert(trKo); + OldStateList->insert(gxxo); + OldStateList->insert(gxyo); + OldStateList->insert(gxzo); + OldStateList->insert(gyyo); + OldStateList->insert(gyzo); + OldStateList->insert(gzzo); + OldStateList->insert(Axxo); + OldStateList->insert(Axyo); + OldStateList->insert(Axzo); + OldStateList->insert(Ayyo); + OldStateList->insert(Ayzo); + OldStateList->insert(Azzo); + OldStateList->insert(Gmxo); + OldStateList->insert(Gmyo); + OldStateList->insert(Gmzo); + OldStateList->insert(Lapo); + OldStateList->insert(Sfxo); + OldStateList->insert(Sfyo); + OldStateList->insert(Sfzo); + OldStateList->insert(dtSfxo); + OldStateList->insert(dtSfyo); + OldStateList->insert(dtSfzo); + + StateList = new MyList(phi0); + StateList->insert(trK0); + StateList->insert(gxx0); + StateList->insert(gxy0); + StateList->insert(gxz0); + StateList->insert(gyy0); + StateList->insert(gyz0); + StateList->insert(gzz0); + StateList->insert(Axx0); + StateList->insert(Axy0); + StateList->insert(Axz0); + StateList->insert(Ayy0); + StateList->insert(Ayz0); + StateList->insert(Azz0); + StateList->insert(Gmx0); + StateList->insert(Gmy0); + StateList->insert(Gmz0); + StateList->insert(Lap0); + StateList->insert(Sfx0); + StateList->insert(Sfy0); + StateList->insert(Sfz0); + StateList->insert(dtSfx0); + StateList->insert(dtSfy0); + StateList->insert(dtSfz0); + + RHSList = new MyList(phi_rhs); + RHSList->insert(trK_rhs); + RHSList->insert(gxx_rhs); + RHSList->insert(gxy_rhs); + RHSList->insert(gxz_rhs); + RHSList->insert(gyy_rhs); + RHSList->insert(gyz_rhs); + RHSList->insert(gzz_rhs); + RHSList->insert(Axx_rhs); + RHSList->insert(Axy_rhs); + RHSList->insert(Axz_rhs); + RHSList->insert(Ayy_rhs); + RHSList->insert(Ayz_rhs); + RHSList->insert(Azz_rhs); + RHSList->insert(Gmx_rhs); + RHSList->insert(Gmy_rhs); + RHSList->insert(Gmz_rhs); + RHSList->insert(Lap_rhs); + RHSList->insert(Sfx_rhs); + RHSList->insert(Sfy_rhs); + RHSList->insert(Sfz_rhs); + RHSList->insert(dtSfx_rhs); + RHSList->insert(dtSfy_rhs); + RHSList->insert(dtSfz_rhs); + + SynchList_pre = new MyList(phi); + SynchList_pre->insert(trK); + SynchList_pre->insert(gxx); + SynchList_pre->insert(gxy); + SynchList_pre->insert(gxz); + SynchList_pre->insert(gyy); + SynchList_pre->insert(gyz); + SynchList_pre->insert(gzz); + SynchList_pre->insert(Axx); + SynchList_pre->insert(Axy); + SynchList_pre->insert(Axz); + SynchList_pre->insert(Ayy); + SynchList_pre->insert(Ayz); + SynchList_pre->insert(Azz); + SynchList_pre->insert(Gmx); + SynchList_pre->insert(Gmy); + SynchList_pre->insert(Gmz); + SynchList_pre->insert(Lap); + SynchList_pre->insert(Sfx); + SynchList_pre->insert(Sfy); + SynchList_pre->insert(Sfz); + SynchList_pre->insert(dtSfx); + SynchList_pre->insert(dtSfy); + SynchList_pre->insert(dtSfz); + + SynchList_cor = new MyList(phi1); + SynchList_cor->insert(trK1); + SynchList_cor->insert(gxx1); + SynchList_cor->insert(gxy1); + SynchList_cor->insert(gxz1); + SynchList_cor->insert(gyy1); + SynchList_cor->insert(gyz1); + SynchList_cor->insert(gzz1); + SynchList_cor->insert(Axx1); + SynchList_cor->insert(Axy1); + SynchList_cor->insert(Axz1); + SynchList_cor->insert(Ayy1); + SynchList_cor->insert(Ayz1); + SynchList_cor->insert(Azz1); + SynchList_cor->insert(Gmx1); + SynchList_cor->insert(Gmy1); + SynchList_cor->insert(Gmz1); + SynchList_cor->insert(Lap1); + SynchList_cor->insert(Sfx1); + SynchList_cor->insert(Sfy1); + SynchList_cor->insert(Sfz1); + SynchList_cor->insert(dtSfx1); + SynchList_cor->insert(dtSfy1); + SynchList_cor->insert(dtSfz1); + + DumpList = new MyList(phi0); + DumpList->insert(trK0); + DumpList->insert(gxx0); + DumpList->insert(gxy0); + DumpList->insert(gxz0); + DumpList->insert(gyy0); + DumpList->insert(gyz0); + DumpList->insert(gzz0); + // DumpList->insert(Axx0); + // DumpList->insert(Axy0); + // DumpList->insert(Axz0); + // DumpList->insert(Ayy0); + // DumpList->insert(Ayz0); + // DumpList->insert(Azz0); + // DumpList->insert(Gmx0); + // DumpList->insert(Gmy0); + // DumpList->insert(Gmz0); + DumpList->insert(Lap0); + // DumpList->insert(Sfx0); + // DumpList->insert(Sfy0); + // DumpList->insert(Sfz0); + // DumpList->insert(dtSfx0); + // DumpList->insert(dtSfy0); + // DumpList->insert(dtSfz0); + DumpList->insert(Rpsi4); + DumpList->insert(Ipsi4); + DumpList->insert(Cons_Ham); + DumpList->insert(Cons_Px); + DumpList->insert(Cons_Py); + DumpList->insert(Cons_Pz); + // DumpList->insert(Cons_Gx); + // DumpList->insert(Cons_Gy); + // DumpList->insert(Cons_Gz); + + ConstraintList = new MyList(Cons_Ham); + ConstraintList->insert(Cons_Px); + ConstraintList->insert(Cons_Py); + ConstraintList->insert(Cons_Pz); + ConstraintList->insert(Cons_Gx); + ConstraintList->insert(Cons_Gy); + ConstraintList->insert(Cons_Gz); +#ifdef With_AHF + // setup kinds of var list + // List for AparentHorizonFinderDirect + // special attension is payed to symmetry type + // gij gij,x gij,y gij,z + AHList = new MyList(gxx0); + AHList->insert(Gamxxx); + AHList->insert(Gamyxx); + AHList->insert(Gamzxx); + AHList->insert(gxy0); + AHList->insert(Gamxxy); + AHList->insert(Gamyxy); + AHList->insert(Gamzxy); + AHList->insert(gxz0); + AHList->insert(Gamxxz); + AHList->insert(Gamyxz); + AHList->insert(Gamzxz); + AHList->insert(gyy0); + AHList->insert(Gamxyy); + AHList->insert(Gamyyy); + AHList->insert(Gamzyy); + AHList->insert(gyz0); + AHList->insert(Gamxyz); + AHList->insert(Gamyyz); + AHList->insert(Gamzyz); + AHList->insert(gzz0); + AHList->insert(Gamxzz); + AHList->insert(Gamyzz); + AHList->insert(Gamzzz); + // phi phi,x phi,y phi,z + AHList->insert(phi0); + AHList->insert(dtSfx_rhs); + AHList->insert(dtSfy_rhs); + AHList->insert(dtSfz_rhs); + // Aij + AHList->insert(Axx0); + AHList->insert(Axy0); + AHList->insert(Axz0); + AHList->insert(Ayy0); + AHList->insert(Ayz0); + AHList->insert(Azz0); + // trK + AHList->insert(trK0); + // gij,x gij,y gij,z + AHDList = new MyList(Gamxxx); + AHDList->insert(Gamyxx); + AHDList->insert(Gamzxx); + AHDList->insert(Gamxxy); + AHDList->insert(Gamyxy); + AHDList->insert(Gamzxy); + AHDList->insert(Gamxxz); + AHDList->insert(Gamyxz); + AHDList->insert(Gamzxz); + AHDList->insert(Gamxyy); + AHDList->insert(Gamyyy); + AHDList->insert(Gamzyy); + AHDList->insert(Gamxyz); + AHDList->insert(Gamyyz); + AHDList->insert(Gamzyz); + AHDList->insert(Gamxzz); + AHDList->insert(Gamyzz); + AHDList->insert(Gamzzz); + // phi,x phi,y phi,z + AHDList->insert(dtSfx_rhs); + AHDList->insert(dtSfy_rhs); + AHDList->insert(dtSfz_rhs); + + GaugeList = new MyList(Lap0); + GaugeList->insert(Sfx0); + GaugeList->insert(Sfy0); + GaugeList->insert(Sfz0); +#endif + + CheckPoint = new checkpoint(checkrun, checkfilename, myrank); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function initializes the class + +//================================================================================================ + +void bssn_class::Initialize() +{ + if (myrank == 0) + cout << "you have setted " << ngfs << " grid functions." << endl; + + CheckPoint->addvariablelist(StateList); + CheckPoint->addvariablelist(OldStateList); + + GH = new cgh(0, ngfs, Symmetry, "input.par", checkrun, ErrorMonitor); + if (checkrun) + CheckPoint->readcheck_cgh(PhysTime, GH, myrank, nprocs, Symmetry); + else + GH->compose_cgh(nprocs); + +#ifdef WithShell + SH = new ShellPatch(0, ngfs, "input.par", Symmetry, myrank, ErrorMonitor); + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + // SH->compose_shr(nprocs); //sh is faster than shr + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); + + if (checkrun) + CheckPoint->readcheck_sh(SH, myrank); +#else + SH = 0; +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; + + if (checkrun) + { + CheckPoint->read_Black_Hole_position(BH_num_input, BH_num, Porg0, Pmom, Spin, Mass, Porgbr, Porg, Porg1, Porg_rhs); + } + else + { + PhysTime = StartTime; + Setup_Black_Hole_position(); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// Destructor: free allocated variables + +//================================================================================================ + +bssn_class::~bssn_class() +{ +#ifdef With_AHF + AHList->clearList(); + AHDList->clearList(); + GaugeList->clearList(); + if (lastahdumpid) + delete[] lastahdumpid; + if (findeveryl) + delete[] findeveryl; + + if (xc) + { + delete[] xc; + delete[] yc; + delete[] zc; + delete[] xr; + delete[] yr; + delete[] zr; + delete[] trigger; + delete[] dumpid; + delete[] dTT; + } + + AHFinderDirect::AHFinderDirect_cleanup(); +#endif + + StateList->clearList(); + RHSList->clearList(); + OldStateList->clearList(); + SynchList_pre->clearList(); + SynchList_cor->clearList(); + DumpList->clearList(); + ConstraintList->clearList(); + + delete phio; + delete trKo; + delete gxxo; + delete gxyo; + delete gxzo; + delete gyyo; + delete gyzo; + delete gzzo; + delete Axxo; + delete Axyo; + delete Axzo; + delete Ayyo; + delete Ayzo; + delete Azzo; + delete Gmxo; + delete Gmyo; + delete Gmzo; + delete Lapo; + delete Sfxo; + delete Sfyo; + delete Sfzo; + delete dtSfxo; + delete dtSfyo; + delete dtSfzo; + + delete phi0; + delete trK0; + delete gxx0; + delete gxy0; + delete gxz0; + delete gyy0; + delete gyz0; + delete gzz0; + delete Axx0; + delete Axy0; + delete Axz0; + delete Ayy0; + delete Ayz0; + delete Azz0; + delete Gmx0; + delete Gmy0; + delete Gmz0; + delete Lap0; + delete Sfx0; + delete Sfy0; + delete Sfz0; + delete dtSfx0; + delete dtSfy0; + delete dtSfz0; + + delete phi; + delete trK; + delete gxx; + delete gxy; + delete gxz; + delete gyy; + delete gyz; + delete gzz; + delete Axx; + delete Axy; + delete Axz; + delete Ayy; + delete Ayz; + delete Azz; + delete Gmx; + delete Gmy; + delete Gmz; + delete Lap; + delete Sfx; + delete Sfy; + delete Sfz; + delete dtSfx; + delete dtSfy; + delete dtSfz; + + delete phi1; + delete trK1; + delete gxx1; + delete gxy1; + delete gxz1; + delete gyy1; + delete gyz1; + delete gzz1; + delete Axx1; + delete Axy1; + delete Axz1; + delete Ayy1; + delete Ayz1; + delete Azz1; + delete Gmx1; + delete Gmy1; + delete Gmz1; + delete Lap1; + delete Sfx1; + delete Sfy1; + delete Sfz1; + delete dtSfx1; + delete dtSfy1; + delete dtSfz1; + + delete phi_rhs; + delete trK_rhs; + delete gxx_rhs; + delete gxy_rhs; + delete gxz_rhs; + delete gyy_rhs; + delete gyz_rhs; + delete gzz_rhs; + delete Axx_rhs; + delete Axy_rhs; + delete Axz_rhs; + delete Ayy_rhs; + delete Ayz_rhs; + delete Azz_rhs; + delete Gmx_rhs; + delete Gmy_rhs; + delete Gmz_rhs; + delete Lap_rhs; + delete Sfx_rhs; + delete Sfy_rhs; + delete Sfz_rhs; + delete dtSfx_rhs; + delete dtSfy_rhs; + delete dtSfz_rhs; + + delete rho; + delete Sx; + delete Sy; + delete Sz; + delete Sxx; + delete Sxy; + delete Sxz; + delete Syy; + delete Syz; + delete Szz; + + delete Gamxxx; + delete Gamxxy; + delete Gamxxz; + delete Gamxyy; + delete Gamxyz; + delete Gamxzz; + delete Gamyxx; + delete Gamyxy; + delete Gamyxz; + delete Gamyyy; + delete Gamyyz; + delete Gamyzz; + delete Gamzxx; + delete Gamzxy; + delete Gamzxz; + delete Gamzyy; + delete Gamzyz; + delete Gamzzz; + + delete Rxx; + delete Rxy; + delete Rxz; + delete Ryy; + delete Ryz; + delete Rzz; + + delete Rpsi4; + delete Ipsi4; + delete t1Rpsi4; + delete t1Ipsi4; + delete t2Rpsi4; + delete t2Ipsi4; + + delete Cons_Ham; + delete Cons_Px; + delete Cons_Py; + delete Cons_Pz; + delete Cons_Gx; + delete Cons_Gy; + delete Cons_Gz; + +#ifdef Point_Psi4 + delete phix; + delete phiy; + delete phiz; + delete trKx; + delete trKy; + delete trKz; + delete Axxx; + delete Axxy; + delete Axxz; + delete Axyx; + delete Axyy; + delete Axyz; + delete Axzx; + delete Axzy; + delete Axzz; + delete Ayyx; + delete Ayyy; + delete Ayyz; + delete Ayzx; + delete Ayzy; + delete Ayzz; + delete Azzx; + delete Azzy; + delete Azzz; +#endif + + delete GH; +#ifdef WithShell + delete SH; +#endif + + for (int i = 0; i < BH_num; i++) + { + delete[] Porg0[i]; + delete[] Porgbr[i]; + delete[] Porg[i]; + delete[] Porg1[i]; + delete[] Porg_rhs[i]; + } + + delete[] Porg0; + delete[] Porgbr; + delete[] Porg; + delete[] Porg1; + delete[] Porg_rhs; + + delete[] Mass; + delete[] Spin; + delete[] Pmom; + + delete ErrorMonitor; + delete Psi4Monitor; + delete BHMonitor; + delete MAPMonitor; + delete ConVMonitor; + delete Waveshell; + + delete CheckPoint; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes initial data using Lousto's analytic formulas + +//================================================================================================ + +void bssn_class::Setup_Initial_Data_Lousto() +{ + if (!checkrun) + { + if (myrank == 0) + cout << "Setup initial data with Lousto's analytical formula." << endl; + char filename[50]; + strcpy(filename, "input.par"); + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + // Use Lousto's analytic formulas to compute initial data + f_get_lousto_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT); +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhs_sh(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + // dump read_in initial data + SH->Dump_Data(StateList, 0, PhysTime, dT); +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // exit(0); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes initial data using analytic formulas by Prof. Cao + +//================================================================================================ + +void bssn_class::Setup_Initial_Data_Cao() +{ + if (!checkrun) + { + if (myrank == 0) + cout << "Setup initial data with Cao's analytical formula." << endl; + char filename[50]; + strcpy(filename, "input.par"); + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + // Use Prof. Cao's analytic formulas to compute initial data + f_get_initial_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT); +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_nbhs_sh(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + // dump read_in initial data + SH->Dump_Data(StateList, 0, PhysTime, dT); +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // exit(0); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes Kerr-Schild initial data analytically + +//================================================================================================ + +void bssn_class::Setup_KerrSchild() +{ + if (!checkrun) + { + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_kerrschild(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + int lev = 0, fngfs = Pp->data->fngfs; + + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_kerrschild_ss(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn]); + /* + f_fderivs_shc(cg->shape, + cg->fgfs[phi0->sgfn], + cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn], + cg->X[0],cg->X[1],cg->X[2], + phi0->SoA[0],phi0->SoA[1],phi0->SoA[2], + Symmetry,lev,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz]); + f_fdderivs_shc(cg->shape,cg->fgfs[phi0->sgfn], + cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn], + cg->X[0],cg->X[1],cg->X[2], + phi0->SoA[0],phi0->SoA[1],phi0->SoA[2], + Symmetry,lev,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz], + cg->fgfs[fngfs+ShellPatch::drhodxx], + cg->fgfs[fngfs+ShellPatch::drhodxy], + cg->fgfs[fngfs+ShellPatch::drhodxz], + cg->fgfs[fngfs+ShellPatch::drhodyy], + cg->fgfs[fngfs+ShellPatch::drhodyz], + cg->fgfs[fngfs+ShellPatch::drhodzz], + cg->fgfs[fngfs+ShellPatch::dsigmadxx], + cg->fgfs[fngfs+ShellPatch::dsigmadxy], + cg->fgfs[fngfs+ShellPatch::dsigmadxz], + cg->fgfs[fngfs+ShellPatch::dsigmadyy], + cg->fgfs[fngfs+ShellPatch::dsigmadyz], + cg->fgfs[fngfs+ShellPatch::dsigmadzz], + cg->fgfs[fngfs+ShellPatch::dRdxx], + cg->fgfs[fngfs+ShellPatch::dRdxy], + cg->fgfs[fngfs+ShellPatch::dRdxz], + cg->fgfs[fngfs+ShellPatch::dRdyy], + cg->fgfs[fngfs+ShellPatch::dRdyz], + cg->fgfs[fngfs+ShellPatch::dRdzz]); + */ + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + // dump read_in initial data + // SH->Synch(GH->PatL[0],StateList,Symmetry); + // for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); + // SH->Dump_Data(StateList,0,PhysTime,dT); + // exit(0); + + /* + { + MyList * DG_List=new MyList(Sfx_rhs); + DG_List->insert(Sfy_rhs); DG_List->insert(Sfz_rhs); + DG_List->insert(Axx_rhs); DG_List->insert(Axy_rhs); DG_List->insert(Axz_rhs); + DG_List->insert(Ayy_rhs); DG_List->insert(Ayz_rhs); DG_List->insert(Azz_rhs); + SH->Synch(DG_List,Symmetry); + SH->Dump_Data(DG_List,0,PhysTime,dT); + DG_List->clearList(); + exit(0); + } + */ + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function reads initial data produced by Pablo Galaviz's Olliptic program + +//================================================================================================ + +//|---------------------------------------------------------------------------- +// read ASCII file with the style of Pablo +//|---------------------------------------------------------------------------- +bool bssn_class::read_Pablo_file(int *ext, double *datain, char *filename) +{ + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + double x, y, z; + //|--->open in put file + ifstream infile; + infile.open(filename); + if (!infile) + { + cout << "bssn_class: read_Pablo_file can't open " << filename << " for input." << endl; + return false; + } + for (k = 0; k < nz; k++) + for (j = 0; j < ny; j++) + for (i = 0; i < nx; i++) + { + infile >> x >> y >> z >> datain[i + j * nx + k * nx * ny]; + } + + infile.close(); + + return true; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function writes initial data for Pablo Galaviz's Olliptic program + +//================================================================================================ + +//|---------------------------------------------------------------------------- +// write ASCII file with the style of Pablo +//|---------------------------------------------------------------------------- +void bssn_class::write_Pablo_file(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename) +{ + int nx = ext[0], ny = ext[1], nz = ext[2]; + int i, j, k; + double *X, *Y, *Z; + X = new double[nx]; + Y = new double[ny]; + Z = new double[nz]; + double dX, dY, dZ; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dX = (xmax - xmin) / (nx - 1); + for (i = 0; i < nx; i++) + X[i] = xmin + i * dX; + dY = (ymax - ymin) / (ny - 1); + for (j = 0; j < ny; j++) + Y[j] = ymin + j * dY; + dZ = (zmax - zmin) / (nz - 1); + for (k = 0; k < nz; k++) + Z[k] = zmin + k * dZ; +#else +#ifdef Cell + dX = (xmax - xmin) / nx; + for (i = 0; i < nx; i++) + X[i] = xmin + (i + 0.5) * dX; + dY = (ymax - ymin) / ny; + for (j = 0; j < ny; j++) + Y[j] = ymin + (j + 0.5) * dY; + dZ = (zmax - zmin) / nz; + for (k = 0; k < nz; k++) + Z[k] = zmin + (k + 0.5) * dZ; +#else +#error Not define Vertex nor Cell +#endif +#endif + //|--->open out put file + ofstream outfile; + outfile.open(filename); + if (!outfile) + { + cout << "bssn=_class: write_Pablo_file can't open " << filename << " for output." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + for (k = 0; k < nz; k++) + for (j = 0; j < ny; j++) + for (i = 0; i < nx; i++) + { + outfile << X[i] << " " << Y[j] << " " << Z[k] << " " + << 0 << endl; + } + outfile.close(); + + delete[] X; + delete[] Y; + delete[] Z; +} + +//================================================================================================ + + + + +//================================================================================================ + +// This member function reads TwoPuncture initial data produced by the Ansorg solver + +//================================================================================================ + +// Read initial data solved by Ansorg, PRD 70, 064011 (2004) + +void bssn_class::Read_Ansorg() +{ + if (!checkrun) + { + if (myrank == 0) + cout << "Read initial data from Ansorg's solver," + << " please be sure the input parameters for black holes are puncture parameters!!" << endl; + char filename[50]; + strcpy(filename, "input.par"); + int BH_NM; + double *Porg_here, *Pmom_here, *Spin_here, *Mass_here; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_NM = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + Porg_here = new double[3 * BH_NM]; + Pmom_here = new double[3 * BH_NM]; + Spin_here = new double[3 * BH_NM]; + Mass_here = new double[BH_NM]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_NM) + { + if (skey == "Mass") + Mass_here[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin_here[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom_here[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom_here[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom_here[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + + int order = 6; + Ansorg read_ansorg("Ansorg.psid", order); + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->X[0][i], cg->X[1][j], cg->X[2][k]); + + f_get_ansorg_nbhs(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + for (int k = 0; k < cg->shape[2]; k++) + for (int j = 0; j < cg->shape[1]; j++) + for (int i = 0; i < cg->shape[0]; i++) + cg->fgfs[phi0->sgfn][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]] = + read_ansorg.ps_u_at_xyz(cg->fgfs[Pp->data->fngfs + ShellPatch::gx][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz][i + j * cg->shape[0] + k * cg->shape[0] * cg->shape[1]]); + + f_get_ansorg_nbhs_ss(cg->shape, + cg->fgfs[Pp->data->fngfs + ShellPatch::gx], + cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + Mass_here, Porg_here, Pmom_here, Spin_here, BH_NM); +#if 0 +// for check fderivs_sh + f_fderivs_sh(cg->shape,cg->fgfs[Ayz0->sgfn], + cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn], + cg->X[0],cg->X[1],cg->X[2], + Ayz0->SoA[0],Ayz0->SoA[1],Ayz0->SoA[2], + Symmetry,Pp->data->sst,Pp->data->sst); +#endif +#if 0 +// for check fderivs_shc + int fngfs = Pp->data->fngfs; + f_fderivs_shc(cg->shape,cg->fgfs[Ayz0->sgfn], + cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn], + cg->X[0],cg->X[1],cg->X[2], + Ayz0->SoA[0],Ayz0->SoA[1],Ayz0->SoA[2], + Symmetry,Pp->data->sst,Pp->data->sst, + cg->fgfs[fngfs+ShellPatch::drhodx], + cg->fgfs[fngfs+ShellPatch::drhody], + cg->fgfs[fngfs+ShellPatch::drhodz], + cg->fgfs[fngfs+ShellPatch::dsigmadx], + cg->fgfs[fngfs+ShellPatch::dsigmady], + cg->fgfs[fngfs+ShellPatch::dsigmadz], + cg->fgfs[fngfs+ShellPatch::dRdx], + cg->fgfs[fngfs+ShellPatch::dRdy], + cg->fgfs[fngfs+ShellPatch::dRdz]); +#endif + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +#endif + + delete[] Porg_here; + delete[] Mass_here; + delete[] Pmom_here; + delete[] Spin_here; + + Compute_Constraint(); + // dump read_in initial data + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT); +#ifdef WithShell + SH->Dump_Data(DumpList, 0, PhysTime, dT); +#endif + // if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets up the time evolution for the entire process + +//================================================================================================ + +void bssn_class::Evolve(int Steps) +{ + + clock_t prev_clock, curr_clock; + double LastDump = 0.0, LastCheck = 0.0, Last2dDump = 0.0; + LastAnas = 0; +#if 0 +//initial checkpoint for special uasge + { + CheckPoint->write_Black_Hole_position(BH_num_input,BH_num,Porg0,Porgbr,Mass); + CheckPoint->writecheck_cgh(PhysTime,GH); +#ifdef WithShell + CheckPoint->writecheck_sh(PhysTime,SH); +#endif + CheckPoint->write_bssn(LastDump,Last2dDump,LastAnas); + misc::tillherecheck("complete initialization preparation"); // we need synchronization here + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } +#endif + + double beg_time; + beg_time = MPI_Wtime(); +// added by yangquan +#ifdef USE_GPU +#ifdef USE_GPU_DIVIDE + // new code considering different partition for cpu and gpu + { + MyList *Pp = GH->PatL[0]; + bool fg = true; + while (fg && Pp) + { + MyList *BP = Pp->data->blb; + while (fg && BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + use_gpu = cg->cgpu; + fg = false; + break; + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } +#else + // old yangquan code + use_gpu = 0; + if (myrank % 2 == 1) + use_gpu = 1; +#endif +#endif + + // for step 0 constraint interpolation + Interp_Constraint(true); + +#ifdef With_AHF + // setup apparent horizon finder direct of thornburg + { + HN_num = BH_num; + for (int ia = 0; ia < BH_num; ia++) + for (int ib = ia + 1; ib < BH_num; ib++) + HN_num++; + + AHFinderDirect::AHFinderDirect_setup(AHList, GaugeList, + this, + Symmetry, HN_num, &PhysTime); + + lastahdumpid = new int[HN_num]; + findeveryl = new int[HN_num]; + xc = new double[HN_num]; + yc = new double[HN_num]; + zc = new double[HN_num]; + xr = new double[HN_num]; + yr = new double[HN_num]; + zr = new double[HN_num]; + dTT = new double[HN_num]; + trigger = new bool[HN_num]; + dumpid = new int[HN_num]; + + for (int ihn = 0; ihn < HN_num; ihn++) + { + lastahdumpid[ihn] = 0; + findeveryl[ihn] = AHfindevery; + } + } +#endif + + if (checkrun) + CheckPoint->read_bssn(LastDump, Last2dDump, LastAnas); + + double dT_mon = dT * pow(0.5, Mymax(0, trfls)); + /* + #ifdef With_AHF + //initial apparent horizon finding + { + double gam; + double massmin=Mass[0]; + for(int ihn=1;ihnlevels; lev++) + GH->Lt[lev] = PhysTime; + + GH->settrfls(trfls); + + for (int ncount = 1; ncount < Steps + 1; ncount++) + { + cout << "Before Step: " << ncount << " My Rank: " << myrank + << " takes " << MPI_Wtime() - beg_time << " seconds!" << endl; + beg_time = MPI_Wtime(); +#if (PSTR == 0) + RecursiveStep(0); +#elif (PSTR == 1) + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + AnalysisStuff(a_lev, dT_mon); + ParallelStep(); +#endif + cout << "After Step: " << ncount << " My Rank: " << myrank + << " takes " << MPI_Wtime() - beg_time << " seconds!" << endl; + beg_time = MPI_Wtime(); + + // misc::tillherecheck("before Constraint_Out"); + + Constraint_Out(); // this will affect the Dump_List + + LastDump += dT_mon; + Last2dDump += dT_mon; + LastCheck += dT_mon; + + if (LastDump >= DumpTime) + { + // misc::tillherecheck("before Dump_Data"); + + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT_mon); +#ifdef WithShell + SH->Dump_Data(DumpList, 0, PhysTime, dT_mon); +#endif + + LastDump = 0; + + if (myrank == 0) + { + cout << "Dump done." << endl; + } + } + + if (Last2dDump >= d2DumpTime) + { + // misc::tillherecheck("before 2dDump_Data"); + + for (int lev = 0; lev < GH->levels; lev++) + Parallel::d2Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT_mon); + + Last2dDump = 0; + + if (myrank == 0) + { + cout << "2dDump done." << endl; + } + } + + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Timestep # " << ncount << ": integrating to time: " << PhysTime << endl; + cout << "used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + + if (PhysTime >= TotalTime) + break; + +#if (REGLEV == 1) + GH->Regrid(Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_mon, StartTime, dT_mon / 2), ErrorMonitor); +#endif + +#if (REGLEV == 0 && PSTR == 1) +// GH->Regrid_fake(Symmetry,BH_num,Porgbr,Porg0, +// SynchList_cor,OldStateList,StateList,SynchList_pre, +// fgt(PhysTime-dT_mon,StartTime,dT_mon/2),ErrorMonitor); +#endif + + bssn_perf.MemoryUsage(¤t_min, ¤t_avg, ¤t_max, + &peak_min, &peak_avg, &peak_max, nprocs); + if (myrank == 0) + printf("Memory usage: current %0.4lg/%0.4lg/%0.4lgMB, " + "peak %0.4lg/%0.4lg/%0.4lgMB\n", + (double)current_min / (1024.0 * 1024.0), + (double)current_avg / (1024.0 * 1024.0), + (double)current_max / (1024.0 * 1024.0), + (double)peak_min / (1024.0 * 1024.0), + (double)peak_avg / (1024.0 * 1024.0), + (double)peak_max / (1024.0 * 1024.0)); + + if (LastCheck >= CheckTime) + { + LastCheck = 0; + + CheckPoint->write_Black_Hole_position(BH_num_input, BH_num, Porg0, Porgbr, Mass); + CheckPoint->writecheck_cgh(PhysTime, GH); + CheckPoint->writecheck_sh(PhysTime, SH); + CheckPoint->write_bssn(LastDump, Last2dDump, LastAnas); + } + } + /* + #ifdef With_AHF + // final apparent horizon finding + { + double gam; + for(int ihn=0;ihnPatL[lev],StateList,0,PhysTime,dT_lev); + } + +#if 0 + if(lev>0) Parallel::Restrict_after(GH->PatL[lev-1],GH->PatL[lev],StateList,StateList,Symmetry); +#endif + +#if (REGLEV == 0) + GH->Regrid_Onelevel(lev, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), ErrorMonitor); +#endif +} + +//================================================================================================ + + + +//================================================================================================ + +// ParallelStep performs time evolution across multiple grid levels (includes parallel execution) +// This section applies only when PSTR == 1 + +//================================================================================================ + +#if (PSTR == 1) +void bssn_class::ParallelStep() +{ + // stringstream a_stream; + // a_stream.setf(ios::left); + + double *tporg, *tporgo; + tporg = new double[3 * BH_num]; + tporgo = new double[3 * BH_num]; + + int lev = GH->mylev; + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + double dT_levp1 = dT * pow(0.5, Mymax(lev + 1, trfls)); + double dT_levm1 = dT * pow(0.5, Mymax(lev - 1, trfls)); + + int NoIterations = 1, YN; + if (lev <= trfls) + NoIterations = 1; + else + NoIterations = int(pow(2.0, lev - trfls)); + + for (int i = 0; i < NoIterations; i++) + { + // if(myrank==GH->start_rank[lev]) cout<<"level now = "<Commlev[lev],GH->start_rank[lev],a_stream.str()); + + // Step(lev,YN); +#ifdef USE_GPU + if (use_gpu == 1) + Step_GPU(lev, YN); + else + Step(lev, YN); +#else + Step(lev, YN); +#endif + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + +#if (AGM == 2) + if (GH->levels == 1) + { + Enforce_algcon(lev, 0); + } +#endif + + GH->Lt[lev] += dT_lev; + + PhysTime += dT_lev; + +#if (AGM == 2) + if (lev > 0) + { + Enforce_algcon(lev, 0); + if (YN == 1) + Enforce_algcon(lev - 1, 0); + } +#endif + +#if (RPS == 1) + // mesh refinement boundary part + // + // till here the PhysTime has updated dT_lev + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + if (lev < GH->levels - 1) + { + if (lev + 1 <= trfls) + { + // RestrictProlong_aux(lev,1,fgt(PhysTime-dT_lev,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + RestrictProlong(lev + 1, 1, fgt(PhysTime - dT_lev, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + } + else + { + // if(myrank==GH->start_rank[lev]) cout<mylev<<", "<Commlev[lev],GH->start_rank[lev],"between RestrictProlong"); + + // RestrictProlong_aux(lev,0,fgt(PhysTime-dT_lev,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + // RestrictProlong_aux(lev,1,fgt(PhysTime-dT_levp1,StartTime,dT_levp1/2),StateList,OldStateList,SynchList_cor); + RestrictProlong(lev + 1, 0, fgt(PhysTime - dT_lev, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + RestrictProlong(lev + 1, 1, fgt(PhysTime - dT_levp1, StartTime, dT_levp1 / 2), StateList, OldStateList, SynchList_cor); + } + } + + // if(myrank==GH->start_rank[lev]) cout<mylev<<", "<Commlev[lev],GH->start_rank[lev],a_stream.str()); + + RestrictProlong(lev, YN, fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), StateList, OldStateList, SynchList_cor); + // RestrictProlong(lev,YN,false,StateList,OldStateList,SynchList_cor); + +// if(myrank==GH->start_rank[lev]) cout<mylev<Commlev[lev],GH->start_rank[lev],a_stream.str()); +#endif + + // Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT_lev); + + { + MPI_Status status; + // receive + if (lev < GH->levels - 1) + { + if (myrank == GH->start_rank[lev]) + { + MPI_Recv(tporgo, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev + 1], 1, MPI_COMM_WORLD, &status); + // cout<Commlev[lev]); + + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + Porg0[i][j] = tporg[3 * i + j]; + + // if(myrank==GH->start_rank[lev]) cout< 0 && YN == 1 && myrank == GH->start_rank[lev]) + { + for (int i = 0; i < BH_num; i++) + for (int j = 0; j < 3; j++) + tporg[3 * i + j] = Porg0[i][j]; + + MPI_Send(tporg, 3 * BH_num, MPI_DOUBLE, GH->start_rank[lev - 1], 1, MPI_COMM_WORLD); + } + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + } +#if (REGLEV == 0) + // for higher level + if (lev < GH->levels - 1) + { + if (lev + 1 >= GH->movls) + { + // GH->Regrid_Onelevel_aux(lev,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev + 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_levp1, StartTime, dT_levp1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for higher level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + + // for this level + if (YN == 1) + { + GH->Regrid_Onelevel(lev, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_lev / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + + // for lower level + if (lev - 1 >= GH->movls) + { + if (lev - 1 <= trfls) + { + if (YN == 1) + { + // GH->Regrid_Onelevel_aux(lev-2,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev - 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_levm1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for lower level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + else + { + if (i % 4 == 3) + { + // GH->Regrid_Onelevel_aux(lev-2,Symmetry,BH_num,Porgbr,Porg0, + GH->Regrid_Onelevel(lev - 1, Symmetry, BH_num, Porgbr, Porg0, + SynchList_cor, OldStateList, StateList, SynchList_pre, + fgt(PhysTime - dT_lev, StartTime, dT_levm1 / 2), ErrorMonitor); + + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Regrid_Onelevel_aux for lower level"; + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],a_stream.str()); + } + } + } +#endif + } + +#ifdef WithShell + SHStep(); + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + +#if (RPS == 1) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(StateList, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + // a_stream.clear(); + // a_stream.str(""); + // a_stream<Commlev[lev],GH->start_rank[lev],a_stream.str()); + } +#endif + +#endif + +#if 0 + if(lev>0) Parallel::Restrict_after(GH->PatL[lev-1],GH->PatL[lev],StateList,StateList,Symmetry); +#endif + + delete[] tporg; + delete[] tporgo; +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// This member function configures the single-step time evolution for each grid level +// during the time evolution process. +// For the case PSTR == 0 + +//================================================================================================ + +#if (PSTR == 0) +#if 1 +void bssn_class::Step(int lev, int YN) +{ + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets up the single-step time evolution for each grid level (alternate version) + +//================================================================================================ + +#else // #if 1 (comment may be incorrect; should be #if 0) +// ICN for bam comparison +void bssn_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 3; iter_count++) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_icn_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, cor)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets up the single-step time evolution for each grid level +// For the case PSTR == 1 + +//================================================================================================ + +#elif (PSTR == 1) +void bssn_class::Step(int lev, int YN) +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif //(MAPBH == 1) + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], + varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Predictor rhs calculation"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime + << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector"); + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"head of Corrector"); + + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Lap->sgfn], + cg->fgfs[Sfx->sgfn], cg->fgfs[Sfy->sgfn], cg->fgfs[Sfz->sgfn], + cg->fgfs[dtSfx->sgfn], cg->fgfs[dtSfy->sgfn], cg->fgfs[dtSfz->sgfn], + cg->fgfs[phi1->sgfn], cg->fgfs[trK1->sgfn], + cg->fgfs[gxx1->sgfn], cg->fgfs[gxy1->sgfn], cg->fgfs[gxz1->sgfn], + cg->fgfs[gyy1->sgfn], cg->fgfs[gyz1->sgfn], cg->fgfs[gzz1->sgfn], + cg->fgfs[Axx1->sgfn], cg->fgfs[Axy1->sgfn], cg->fgfs[Axz1->sgfn], + cg->fgfs[Ayy1->sgfn], cg->fgfs[Ayz1->sgfn], cg->fgfs[Azz1->sgfn], + cg->fgfs[Gmx1->sgfn], cg->fgfs[Gmy1->sgfn], cg->fgfs[Gmz1->sgfn], + cg->fgfs[Lap1->sgfn], + cg->fgfs[Sfx1->sgfn], cg->fgfs[Sfy1->sgfn], cg->fgfs[Sfz1->sgfn], + cg->fgfs[dtSfx1->sgfn], cg->fgfs[dtSfy1->sgfn], cg->fgfs[dtSfz1->sgfn], + cg->fgfs[rho->sgfn], + cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, cor)) + { + cout << "find NaN in domain: (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], + Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, + cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], + varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector error check"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Corrector sync"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] + << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Corrector of black hole position"); +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after pre cor swap"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"tail of corrector"); + } +#if (RPS == 0) + // mesh refinement boundary part + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before RestrictProlong"); + RestrictProlong(lev, YN, BB); +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + // if(myrank==GH->start_rank[lev]) + // cout<start_rank[lev]) cout<mylev<Commlev[lev],GH->start_rank[lev],"complet GH Step"); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets up the single-step time evolution for the spherical shell +// grid part during the time evolution process + +//================================================================================================ + +#ifdef WithShell +void bssn_class::SHStep() +{ + int lev = 0; + // #if (PSTR == 1) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + // #endif + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + + // #if (PSTR == 1) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + // #endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + +#ifdef USE_GPU + if (use_gpu == 1) + { + + if (gpu_rhs_ss(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_FIRST_TIME)) + + { + + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + } + } + else + { + if (f_compute_rhs_bssn_ss(RHS_PARA_CALLED_FIRST_TIME)) + + { + + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + } + } + +#else + if (f_compute_rhs_bssn_ss(RHS_PARA_CALLED_FIRST_TIME)) + + { + + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + } +#endif // USE_GPU + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + +#if (PSTR == 1) +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor's error check"); +#endif + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + +#ifdef USE_GPU + if (use_gpu == 1) + { + + if(gpu_rhs_ss(CALLED_BY_STEP,myrank,RHS_PARA_CALLED_THEN) + + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + + } + } + else + { + if (f_compute_rhs_bssn_ss(RHS_PARA_CALLED_THEN)) + + { + + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + } + } + +#else + if (f_compute_rhs_bssn_ss(RHS_PARA_CALLED_THEN)) + + { + + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" + << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + + ERROR = 1; + } +#endif // USE_GPU + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; + // we do not check the correspondence here + + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], + sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], + varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, + cg->fgfs[varl0->data->sgfn], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count + << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " + << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } + + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#if (RPS == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) + << " seconds!" << endl; + } + } +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +} +#endif +#endif // withshell + +//================================================================================================ + + + +//================================================================================================ + +// 0: do not use mixing two levels data for OutBD; 1: do use + +#define MIXOUTB 0 +void bssn_class::RestrictProlong(int lev, int YN, bool BB, + MyList *SL, MyList *OL, MyList *corL) +// we assume +// StateList 1 ----------- +// +// OldStateList 0 ----------- +// +// SynchList_cor old ----------- +{ +#if (PSTR == 1) +// stringstream a_stream; +// a_stream.setf(ios::left); +#endif + + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, SL, OL, corL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, SL, OL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + +#if (PSTR == 1) +// Pp->data->checkPatch(0,GH->start_rank[GH->mylev]); +#endif + Pp = Pp->next; + } + +#if (PSTR == 1) +// Pp=GH->PatL[lev]; +// while(Pp) +// { +// Pp->data->checkPatch(0,GH->start_rank[GH->mylev]); +// Pp=Pp->next; +// } + +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 before Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SL, GH->bdsul[lev], Symmetry); +#endif + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 0 after OutBdLow2Hi"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } + else // no time refinement levels and for all same time levels + { + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 before Restrict"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->rsul[lev], Symmetry); +#endif + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 before Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SL, Symmetry); + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SL, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SL, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->bdsul[lev], Symmetry); +#endif + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": 1 after OutBdLow2Hi"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } + + Parallel::Sync(GH->PatL[lev], SL, Symmetry); + +#if (PSTR == 1) +// a_stream.clear(); +// a_stream.str(""); +// a_stream<mylev<<": after Sync"; +// misc::tillherecheck(GH->Commlev[GH->mylev],GH->start_rank[GH->mylev],a_stream.str()); +#endif + } +} + +//================================================================================================ + + + +//================================================================================================ + +// auxiliary operation, input lev means original lev-1 + +void bssn_class::RestrictProlong_aux(int lev, int YN, bool BB, + MyList *SL, MyList *OL, MyList *corL) +// we assume +// StateList 1 ----------- +// +// OldStateList 0 ----------- +// +// SynchList_cor old ----------- +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"starting RestrictProlong_aux"); + + if (lev >= GH->levels - 1) + return; + lev = lev + 1; + + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, SL, OL, corL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, SL, OL, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SL, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SL, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SL, SL, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SL, SL, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SL,SL,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SL, SL, GH->bdsul[lev], Symmetry); +#endif + } + + Parallel::Sync(GH->PatL[lev], SL, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::RestrictProlong(int lev, int YN, bool BB) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + // we assume for fine + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // for coarse + // StateList 1 ----------- + // + // OldStateList 0 ----------- + // + // SynchList_cor old ----------- + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + if (myrank == 0) + cout << "/=: " << GH->Lt[lev - 1] << "," << GH->Lt[lev] + dT_lev << endl; + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, SynchList_pre, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,SynchList_pre,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, SynchList_pre, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { + if (myrank == 0) + cout << "===: " << GH->Lt[lev - 1] << "," << GH->Lt[lev] + dT_lev << endl; +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); +#elif (RPB == 1) + // Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, GH->rsul[lev], Symmetry); +#endif + + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],StateList,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], StateList, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::ProlongRestrict(int lev, int YN, bool BB) +{ + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_pre,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], SynchList_pre, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + } + else // no time refinement levels and for all same time levels + { +#if (RPB == 0) + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { +#if (MIXOUTB == 0) + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#elif (MIXOUTB == 1) + Parallel::OutBdLow2Himix(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); +#endif + Pp = Pp->next; + } + Ppc = Ppc->next; + } +#elif (RPB == 1) + // Parallel::OutBdLow2Hi_bam(GH->PatL[lev-1],GH->PatL[lev],StateList,SynchList_cor,Symmetry); + Parallel::OutBdLow2Hi_bam(GH->PatL[lev - 1], GH->PatL[lev], StateList, SynchList_cor, GH->bdsul[lev], Symmetry); +#endif + +#if 0 +#if (RPB == 0) + Parallel::Restrict(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); +#elif (RPB == 1) +// Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,Symmetry); + Parallel::Restrict_bam(GH->PatL[lev-1],GH->PatL[lev],SynchList_cor,StateList,GH->rsul[lev],Symmetry); +#endif +#else + Parallel::Restrict_after(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); +#endif + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} +#undef MIXOUTB + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes the gravitational radiation scalar Psi4 + +//================================================================================================ + +void bssn_class::Compute_Psi4(int lev) +{ + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + +#if 0 // test showes this operation does not help +for(int ilev = GH->levels-1;ilev>=lev;ilev--) +{ + MyList *Pp=GH->PatL[ilev]; +#else + MyList *Pp = GH->PatL[lev]; +#endif + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + if (0) // if Gamma^i_jk and R_ij can be reused from the rhs calculation + f_ricci_gamma(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + Symmetry); + // the input arguments Gamma^i_jk and R_ij do not need synch, because we do not need to derivate them + f_getnp4(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#elif (Psi4type == 1) + f_getnp4old(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry); +#else +#error "not recognized Psi4type" +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#if 0 + Parallel::Sync(GH->PatL[ilev],DG_List,Symmetry); +} +// because of double level data change, you can not do this in above loop +// prolong restrict Psi4 +for(int ilev=GH->levels-1;ilev>lev;ilev--) + RestrictProlong(ilev,1,false,DG_List,DG_List,DG_List); +#else + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); +#endif + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { +#if (Psi4type == 0) + if (0) // if Gamma^i_jk and R_ij can be reused from the rhs calculation + f_ricci_gamma_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + Symmetry, lev, Pp->data->sst); + + f_getnp4_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#elif (Psi4type == 1) + f_getnp4old_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[Rpsi4->sgfn], cg->fgfs[Ipsi4->sgfn], + Symmetry, Pp->data->sst); +#else +#error "not recognized Psi4type" +#endif + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + + SH->Synch(DG_List, Symmetry); +#if 0 +// interpolate Psi4 + SH->CS_Inter(DG_List,Symmetry); +#endif + } +#endif + + DG_List->clearList(); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"end of Compute_Psi4"); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function sets the puncture positions of black holes at the initial time + +//================================================================================================ + +void bssn_class::Setup_Black_Hole_position() +{ + char filename[50]; + strcpy(filename, "input.par"); + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + { + BH_num_input = BH_num = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + // set up the data for black holes + // these arrays will be deleted when bssn_class is deleted + Pmom = new double[3 * BH_num]; + Spin = new double[3 * BH_num]; + Mass = new double[BH_num]; + Porg0 = new double *[BH_num]; + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + for (int i = 0; i < BH_num; i++) + { + Porg0[i] = new double[3]; + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename + << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_num) + { + if (skey == "Mass") + Mass[sind] = atof(sval.c_str()); + else if (skey == "Porgx") + Porg0[sind][0] = atof(sval.c_str()); + else if (skey == "Porgy") + Porg0[sind][1] = atof(sval.c_str()); + else if (skey == "Porgz") + Porg0[sind][2] = atof(sval.c_str()); + else if (skey == "Spinx") + Spin[sind * 3] = atof(sval.c_str()); + else if (skey == "Spiny") + Spin[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Spinz") + Spin[sind * 3 + 2] = atof(sval.c_str()); + else if (skey == "Pmomx") + Pmom[sind * 3] = atof(sval.c_str()); + else if (skey == "Pmomy") + Pmom[sind * 3 + 1] = atof(sval.c_str()); + else if (skey == "Pmomz") + Pmom[sind * 3 + 2] = atof(sval.c_str()); + } + } + inf.close(); + } + // echo information of Black holes + if (myrank == 0) + { + cout << "initial information of " << BH_num << " Black Hole(s)" << endl; + cout << setw(16) << "Mass" + << setw(16) << "x" + << setw(16) << "y" + << setw(16) << "z" + << setw(16) << "Px" + << setw(16) << "Py" + << setw(16) << "Pz" + << setw(16) << "Sx" + << setw(16) << "Sy" + << setw(16) << "Sz" << endl; + for (int i = 0; i < BH_num; i++) + { + cout << setw(16) << Mass[i] + << setw(16) << Porg0[i][0] + << setw(16) << Porg0[i][1] + << setw(16) << Porg0[i][2] + << setw(16) << Pmom[i * 3] + << setw(16) << Pmom[i * 3 + 1] + << setw(16) << Pmom[i * 3 + 2] + << setw(16) << Spin[i * 3] + << setw(16) << Spin[i * 3 + 1] + << setw(16) << Spin[i * 3 + 2] << endl; + } + } + + int maxl = 1; + int levels; + int *grids; + double bbox[6]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "bssn_class::Setup_Black_Hole_position: Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "levels") + { + levels = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + grids = new int[levels]; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "bssn_class::Setup_Black_Hole_position: Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1, sind2, sind3); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "grids" && sind1 < levels) + grids[sind1] = atoi(sval.c_str()); + if (sgrp == "cgh" && skey == "bbox" && sind1 == 0 && sind2 == 0) + bbox[sind3] = atof(sval.c_str()); + } + inf.close(); + } + for (int i = 0; i < levels; i++) + if (maxl < grids[i]) + maxl = grids[i]; + + delete[] grids; + + if (BH_num > maxl) + { + int BH_numc = BH_num; + for (int i = 0; i < BH_num; i++) + if (Porg0[i][0] < bbox[0] || Porg0[i][0] > bbox[3] || + Porg0[i][1] < bbox[1] || Porg0[i][1] > bbox[4] || + Porg0[i][2] < bbox[2] || Porg0[i][2] > bbox[5]) + { + delete[] Porg0[i]; + Porg0[i] = 0; + BH_numc--; + } + + if (BH_num > BH_numc) + { + maxl = BH_numc; + int bhi; + double *tmp; + + tmp = Pmom; + Pmom = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + for (int j = 0; j < 3; j++) + Pmom[3 * bhi + j] = tmp[3 * i + j]; + bhi++; + } + delete[] tmp; + + tmp = Spin; + Spin = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + for (int j = 0; j < 3; j++) + Spin[3 * bhi + j] = tmp[3 * i + j]; + bhi++; + } + delete[] tmp; + + tmp = Mass; + Mass = new double[3 * maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (Porg0[i]) + { + Mass[bhi] = tmp[i]; + bhi++; + } + delete[] tmp; + + double **ttmp; + ttmp = Porg0; + Porg0 = new double *[maxl]; + bhi = 0; + for (int i = 0; i < BH_num; i++) + if (ttmp[i]) + { + Porg0[bhi] = ttmp[i]; + bhi++; + } + delete[] ttmp; + + for (int i = 0; i < BH_num; i++) + { + delete[] Porgbr[i]; + delete[] Porg[i]; + delete[] Porg1[i]; + delete[] Porg_rhs[i]; + } + delete[] Porgbr; + delete[] Porg; + delete[] Porg1; + delete[] Porg_rhs; + + BH_num = maxl; + + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + + for (int i = 0; i < BH_num; i++) + { + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + } + } + } + + for (int i = 0; i < BH_num; i++) + { + for (int j = 0; j < dim; j++) + Porgbr[i][j] = Porg0[i][j]; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes black hole positions + +//================================================================================================ + +#if 0 +// old code + +void bssn_class::compute_Porg_rhs(double **BH_PS,double **BH_RHS,var *forx,var *fory,var *forz,int lev) +{ + const int InList = 3; + + MyList * DG_List=new MyList(forx); + DG_List->insert(fory); DG_List->insert(forz); + + int n; + double *x1,*y1,*z1; + double *shellf; + shellf=new double[3*BH_num]; + double *pox[3]; + for(int i=0;i<3;i++) pox[i] = new double[BH_num]; + for( n = 0; n < BH_num; n++) + { + pox[0][n] = BH_PS[n][0]; + pox[1][n] = BH_PS[n][1]; + pox[2][n] = BH_PS[n][2]; + } + + if(!Parallel::PatList_Interp_Points(GH->PatL[lev],DG_List,BH_num,pox,shellf,Symmetry)) + { + ErrorMonitor->outfile<<"fail to find black holes at t = "<outfile<<"(x,y,z) = ("<clearList(); + delete[] shellf; + for(int i=0;i<3;i++) delete[] pox[i]; +} + +#else + +// new code considering diferent levels for different black hole + +void bssn_class::compute_Porg_rhs(double **BH_PS, double **BH_RHS, var *forx, var *fory, var *forz, int ilev) +{ + const int InList = 3; + + MyList *DG_List = new MyList(forx); + DG_List->insert(fory); + DG_List->insert(forz); + + double *x1, *y1, *z1; + double *shellf; + shellf = new double[3]; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[1]; + + for (int n = 0; n < BH_num; n++) + { + pox[0][0] = BH_PS[n][0]; + pox[1][0] = BH_PS[n][1]; + pox[2][0] = BH_PS[n][2]; + + int lev = ilev; + +#if (PSTR == 0) + while (!Parallel::PatList_Interp_Points(GH->PatL[lev], DG_List, 1, pox, shellf, Symmetry)) +#elif (PSTR == 1) + while (!Parallel::PatList_Interp_Points(GH->PatL[lev], DG_List, 1, pox, shellf, Symmetry, GH->Commlev[lev])) +#endif + { + lev--; + if (lev < 0) + { + ErrorMonitor->outfile << "fail to find black holes at t = " << PhysTime << endl; + for (n = 0; n < BH_num; n++) + ErrorMonitor->outfile << "(x,y,z) = (" << pox[0][n] << "," << pox[1][n] << "," << pox[2][n] << ")" << endl; + break; + } + } + + if (lev >= 0) + { + BH_RHS[n][0] = -shellf[0]; + BH_RHS[n][1] = -shellf[1]; + BH_RHS[n][2] = -shellf[2]; + } + } + + DG_List->clearList(); + delete[] shellf; + for (int i = 0; i < 3; i++) + delete[] pox[i]; +} +#endif + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes gravitational-wave related data + +//================================================================================================ + +void bssn_class::AnalysisStuff(int lev, double dT_lev) +{ + LastAnas += dT_lev; + + if (LastAnas >= AnasTime) + { +#ifdef Point_Psi4 +#error "not support parallel levels yet" + // Gam_ijk and R_ij have been calculated in Interp_Constraint() + double SYM = 1, ANT = -1; + for (int levh = lev; levh < GH->levels; levh++) + { + MyList *Pp = GH->PatL[levh]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_fderivs(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[phix->sgfn], cg->fgfs[phiy->sgfn], cg->fgfs[phiz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[trK0->sgfn], + cg->fgfs[trKx->sgfn], cg->fgfs[trKy->sgfn], cg->fgfs[trKz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axx0->sgfn], + cg->fgfs[Axxx->sgfn], cg->fgfs[Axxy->sgfn], cg->fgfs[Axxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axy0->sgfn], + cg->fgfs[Axyx->sgfn], cg->fgfs[Axyy->sgfn], cg->fgfs[Axyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, ANT, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Axz0->sgfn], + cg->fgfs[Axzx->sgfn], cg->fgfs[Axzy->sgfn], cg->fgfs[Axzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, SYM, ANT, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Ayy0->sgfn], + cg->fgfs[Ayyx->sgfn], cg->fgfs[Ayyy->sgfn], cg->fgfs[Ayyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Ayz0->sgfn], + cg->fgfs[Ayzx->sgfn], cg->fgfs[Ayzy->sgfn], cg->fgfs[Ayzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, ANT, ANT, Symmetry, levh); + f_fderivs(cg->shape, cg->fgfs[Azz0->sgfn], + cg->fgfs[Azzx->sgfn], cg->fgfs[Azzy->sgfn], cg->fgfs[Azzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, levh); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + // ShellPatch part + if (lev == 0) + { + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_fderivs_shc(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[phix->sgfn], cg->fgfs[phiy->sgfn], cg->fgfs[phiz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + phi0->SoA[0], phi0->SoA[1], phi0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[trK0->sgfn], + cg->fgfs[trKx->sgfn], cg->fgfs[trKy->sgfn], cg->fgfs[trKz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + trK0->SoA[0], trK0->SoA[1], trK0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axx0->sgfn], + cg->fgfs[Axxx->sgfn], cg->fgfs[Axxy->sgfn], cg->fgfs[Axxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axx0->SoA[0], Axx0->SoA[1], Axx0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axy0->sgfn], + cg->fgfs[Axyx->sgfn], cg->fgfs[Axyy->sgfn], cg->fgfs[Axyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axy0->SoA[0], Axy0->SoA[1], Axy0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Axz0->sgfn], + cg->fgfs[Axzx->sgfn], cg->fgfs[Axzy->sgfn], cg->fgfs[Axzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Axz0->SoA[0], Axz0->SoA[1], Axz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Ayy0->sgfn], + cg->fgfs[Ayyx->sgfn], cg->fgfs[Ayyy->sgfn], cg->fgfs[Ayyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Ayy0->SoA[0], Ayy0->SoA[1], Ayy0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Ayz0->sgfn], + cg->fgfs[Ayzx->sgfn], cg->fgfs[Ayzy->sgfn], cg->fgfs[Ayzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Ayz0->SoA[0], Ayz0->SoA[1], Ayz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + f_fderivs_shc(cg->shape, cg->fgfs[Azz0->sgfn], + cg->fgfs[Azzx->sgfn], cg->fgfs[Azzy->sgfn], cg->fgfs[Azzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + Azz0->SoA[0], Azz0->SoA[1], Azz0->SoA[2], + Symmetry, levh, Pp->data->sst, + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz]); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } +#endif + } +#else + Compute_Psi4(lev); +#endif + double *RP, *IP, *RoutMAP; + int NN = 0; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; + RoutMAP = new double[7]; + double Rex = maxrex; + for (int i = 0; i < decn; i++) + { +#ifdef Point_Psi4 + Waveshell->surf_Wave(Rex, GH, SH, + phi, trK, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + phix, phiy, phiz, + trKx, trKy, trKz, + Axxx, Axxy, Axxz, + Axyx, Axyy, Axyz, + Axzx, Axzy, Axzz, + Ayyx, Ayyy, Ayyz, + Ayzx, Ayzy, Ayzz, + Azzx, Azzy, Azzz, + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz, + 2, maxl, NN, RP, IP, ErrorMonitor); +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } + else + { + Waveshell->surf_MassPAng(Rex, lev, SH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } +#else + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); +#endif +#else +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before surface integral"); +#ifdef WithShell + if (lev > 0 || Rex < GH->bbox[0][0][3]) + { + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } + else + { + Waveshell->surf_Wave(Rex, lev, SH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, SH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); + } +#else +#if (PSTR == 0) + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor); +#elif (PSTR == 1) + Waveshell->surf_Wave(Rex, lev, GH, Rpsi4, Ipsi4, 2, maxl, NN, RP, IP, ErrorMonitor, GH->Commlev[lev]); + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after surf_Wave"); + Waveshell->surf_MassPAng(Rex, lev, GH, phi0, trK0, + gxx0, gxy0, gxz0, gyy0, gyz0, gzz0, + Axx0, Axy0, Axz0, Ayy0, Ayz0, Azz0, + Gmx0, Gmy0, Gmz0, Sfx1, Sfy1, Sfz1, // here we can not touch rhs variables, but 1 variables + RoutMAP, ErrorMonitor, GH->Commlev[lev]); +#endif +#endif +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"end surface integral"); +#endif + if (i == 0) + { + ADMMass = RoutMAP[0]; + } +#if (PSTR == 1) + if (GH->start_rank[a_lev] > 0) + { + MPI_Status status; + // receive + if (myrank == 0) + { + MPI_Recv(RP, NN, MPI_DOUBLE, GH->start_rank[a_lev], 1, MPI_COMM_WORLD, &status); + MPI_Recv(IP, NN, MPI_DOUBLE, GH->start_rank[a_lev], 2, MPI_COMM_WORLD, &status); + MPI_Recv(RoutMAP, 7, MPI_DOUBLE, GH->start_rank[a_lev], 3, MPI_COMM_WORLD, &status); + } + // send + if (myrank == GH->start_rank[a_lev]) + { + MPI_Send(RP, NN, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD); + MPI_Send(IP, NN, MPI_DOUBLE, 0, 2, MPI_COMM_WORLD); + MPI_Send(RoutMAP, 7, MPI_DOUBLE, 0, 3, MPI_COMM_WORLD); + } + } +#endif + Psi4Monitor->writefile(PhysTime, NN, RP, IP); + MAPMonitor->writefile(PhysTime, 7, RoutMAP); + Rex = Rex - drex; + } + delete[] RP; + delete[] IP; + delete[] RoutMAP; + + // black hole's position + { + double *pox; + pox = new double[dim * BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + for (int i = 0; i < dim; i++) + pox[dim * bhi + i] = Porg0[bhi][i]; + BHMonitor->writefile(PhysTime, dim * BH_num, pox); + delete[] pox; + } + + LastAnas = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes and outputs constraint violations + +//================================================================================================ + +void bssn_class::Constraint_Out() +{ + LastConsOut += dT * pow(0.5, Mymax(0, trfls)); + + if (LastConsOut >= AnasTime) + // Constraint violation + { + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) // if the constrait quantities can be reused from the step rhs calculation + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +// added by yangquan +#ifdef USE_GPU + if (use_gpu == 1) + gpu_rhs(CALLED_BY_CONSTRAINT, myrank, RHS_PARA_CALLED_Constraint_Out); + + else + f_compute_rhs_bssn(RHS_PARA_CALLED_Constraint_Out); +#else + f_compute_rhs_bssn(RHS_PARA_CALLED_Constraint_Out); +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + if (0) // if the constrait quantities can be reused from the step rhs calculation + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + double TRK4 = PhysTime; + int pre = 0; + int lev = 0; + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#ifdef USE_GPU + if (use_gpu == 1) + + gpu_rhs_ss(CALLED_BY_CONSTRAINT, myrank, RHS_PARA_CALLED_Constraint_Out_SS); + else + f_compute_rhs_bssn_ss(RHS_PARA_CALLED_Constraint_Out_SS); +#else + f_compute_rhs_bssn_ss(RHS_PARA_CALLED_Constraint_Out_SS); + +#endif // USE_GPU + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); +#endif + + double ConV[7]; +#if (PSTR == 1) + double ConV_h[7]; +#endif + +#ifdef WithShell + ConV[0] = SH->L2Norm(Cons_Ham); + ConV[1] = SH->L2Norm(Cons_Px); + ConV[2] = SH->L2Norm(Cons_Py); + ConV[3] = SH->L2Norm(Cons_Pz); + ConV[4] = SH->L2Norm(Cons_Gx); + ConV[5] = SH->L2Norm(Cons_Gy); + ConV[6] = SH->L2Norm(Cons_Gz); + ConVMonitor->writefile(PhysTime, 7, ConV); +#endif + for (int levi = 0; levi < GH->levels; levi++) + { +#if (PSTR == 0) + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz); +#elif (PSTR == 1) + ConV[0] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Ham, GH->Commlev[levi]); + ConV[1] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Px, GH->Commlev[levi]); + ConV[2] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Py, GH->Commlev[levi]); + ConV[3] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Pz, GH->Commlev[levi]); + ConV[4] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gx, GH->Commlev[levi]); + ConV[5] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gy, GH->Commlev[levi]); + ConV[6] = Parallel::L2Norm(GH->PatL[levi]->data, Cons_Gz, GH->Commlev[levi]); + // misc::tillherecheck("before collect data to cpu0"); + // MPI_ALLREDUCE( sendbuf, recvbuf, count, datatype, op, comm), sendbu and recvbuf must be different + if (levi > 0) + { + if (GH->mylev == levi && myrank == GH->start_rank[levi]) + for (int i = 0; i < 7; i++) + ConV_h[i] = ConV[i]; + else + for (int i = 0; i < 7; i++) + ConV_h[i] = 0; + MPI_Allreduce(ConV_h, ConV, 7, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + } +#endif + ConVMonitor->writefile(PhysTime, 7, ConV); + /* + if(fabs(ConV[0])<0.00001) + { + MyList * DG_List=new MyList(Cons_Ham); + DG_List->insert(Cons_Px); DG_List->insert(Cons_Py); DG_List->insert(Cons_Px); + DG_List->insert(Cons_Gx); DG_List->insert(Cons_Gy); DG_List->insert(Cons_Gx); + Parallel::Dump_Data(GH->PatL[levi],DG_List,"jiu",0,1); + DG_List->clearList(); + if(myrank==0) MPI_Abort(MPI_COMM_WORLD,1); + } + */ + } + + Interp_Constraint(false); + + LastConsOut = 0; + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes derivatives required by the apparent-horizon routines + +//================================================================================================ + +#ifdef With_AHF +void bssn_class::AH_Prepare_derivatives() +{ + double SYM = 1.0, ANT = -1.0; + int ZEO = 0; + + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_fderivs(cg->shape, cg->fgfs[phi0->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxx0->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamzxx->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxy0->sgfn], + cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamzxy->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, ANT, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gxz0->sgfn], + cg->fgfs[Gamxxz->sgfn], cg->fgfs[Gamyxz->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + ANT, SYM, ANT, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gyy0->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamzyy->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gyz0->sgfn], + cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamzyz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, ANT, ANT, Symmetry, ZEO); + f_fderivs(cg->shape, cg->fgfs[gzz0->sgfn], + cg->fgfs[Gamxzz->sgfn], cg->fgfs[Gamyzz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->X[0], cg->X[1], cg->X[2], + SYM, SYM, SYM, Symmetry, ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + Parallel::Sync(GH->PatL[lev], AHDList, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function interpolates apparent-horizon data + +//================================================================================================ + +bool bssn_class::AH_Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetryi) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double pox[3]; + for (int i = 0; i < NN; i++) + { + for (int j = 0; j < 3; j++) + pox[j] = XX[j][i]; + int lev = GH->levels - 1; + bool notfound = true; + + while (notfound) + { + if (lev < 0) + { +#ifdef WithShell + if (SH->Interp_One_Point(VarList, pox, Shellf + i * num_var, Symmetryi)) + { + return true; + } + if (myrank == 0) + cout << "bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh and shell domain!" << endl; +#else + if (myrank == 0) + cout << "bssn_class::AH_Interp_Points: point (" + << pox[0] << "," << pox[1] << "," << pox[2] + << ") is out of cgh domain!" << endl; +#endif + return false; + } + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + if (Pp->data->Interp_ONE_Point(VarList, pox, Shellf + i * num_var, Symmetryi)) + { + notfound = false; + break; + } + Pp = Pp->next; + } + lev--; + } + } + return true; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes the apparent horizon at the current iteration step + +//================================================================================================ + +void bssn_class::AH_Step_Find(int lev, double dT_lev) +{ + if ((lev == GH->levels - 1)) + { + int ncount = int(PhysTime / dT_lev); + bool tf = false; + for (int ihn = 0; ihn < HN_num; ihn++) + { + if (ncount % findeveryl[ihn] == 0) + { + tf = true; + break; + } + } + if (tf) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + prev_clock = clock(); + const int cdumpid = int(PhysTime / AHdumptime) + 1; + for (int ihn = 0; ihn < HN_num; ihn++) + dumpid[ihn] = cdumpid; + + double gam; + for (int ihn = 0; ihn < BH_num; ihn++) + { + xc[ihn] = Porg0[ihn][0]; + yc[ihn] = Porg0[ihn][1]; + zc[ihn] = Porg0[ihn][2]; + gam = fabs(Pmom[ihn * 3]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + xr[ihn] = Mass[ihn] * gam; + gam = fabs(Pmom[ihn * 3 + 1]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + yr[ihn] = Mass[ihn] * gam; + gam = fabs(Pmom[ihn * 3 + 2]) / (Mass[ihn]); + gam = sqrt(1 - gam * gam); + zr[ihn] = Mass[ihn] * gam; + dTT[ihn] = -1; + + if (ncount % findeveryl[ihn] == 0) + { + trigger[ihn] = true; + dTT[ihn] = findeveryl[ihn] * dT_lev; + } + else + trigger[ihn] = false; + if (trigger[ihn] && (dumpid[ihn] > lastahdumpid[ihn])) + lastahdumpid[ihn] = dumpid[ihn]; + else + dumpid[ihn] = 0; + } + int ihn = BH_num; + for (int ia = 0; ia < BH_num; ia++) + for (int ib = ia + 1; ib < BH_num; ib++) + { + xc[ihn] = (Porg0[ia][0] + Porg0[ib][0]) / 2; + yc[ihn] = (Porg0[ia][1] + Porg0[ib][1]) / 2; + zc[ihn] = (Porg0[ia][2] + Porg0[ib][2]) / 2; + + xr[ihn] = yr[ihn] = zr[ihn] = Mass[ia] + Mass[ib]; + + dTT[ihn] = -1; + + if (fabs(Porg0[ia][0] - Porg0[ib][0]) < 2 * xr[ihn] && + fabs(Porg0[ia][1] - Porg0[ib][1]) < 2 * xr[ihn] && + fabs(Porg0[ia][2] - Porg0[ib][2]) < 2 * xr[ihn] && + (ncount % findeveryl[ihn] == 0)) + { + trigger[ihn] = true; + dTT[ihn] = findeveryl[ihn] * dT_lev; + } + else + trigger[ihn] = false; + + if (trigger[ihn] && (dumpid[ihn] > lastahdumpid[ihn])) + lastahdumpid[ihn] = dumpid[ihn]; + else + dumpid[ihn] = 0; + + ihn++; + } +#if (ABEtype == 1) + if (PhysTime > 10) + { + ihn--; + trigger[ihn] = true; + xr[ihn] = yr[ihn] = zr[ihn] = 50; + // if(myrank==0) for(ihn=0;ihn 0) + return; + + // recompute least the constraint data lost for moved new grid + for (int lev = 0; lev < GH->levels; lev++) + { + // make sure the data consistent for higher levels + if (lev > 0) // if the constrait quantities can be reused from the step rhs calculation + { + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +// added by yangquan +#ifdef USE_GPU + if (use_gpu == 1) + gpu_rhs(CALLED_BY_CONSTRAINT, myrank, RHS_PARA_CALLED_Interp_Constraint); + else + f_compute_rhs_bssn(RHS_PARA_CALLED_Interp_Constraint); +#else + f_compute_rhs_bssn(RHS_PARA_CALLED_Interp_Constraint); +#endif + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } +#ifdef WithShell + if (0) // if the constrait quantities can be reused from the step rhs calculation + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + double TRK4 = PhysTime; + int pre = 0; + int lev = 0; + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#ifdef USE_GPU + if (use_gpu == 1) + + gpu_rhs_ss(CALLED_BY_CONSTRAINT, myrank, RHS_PARA_CALLED_Intrp_Constraint_Out_SS); + else + f_compute_rhs_bssn_ss(RHS_PARA_CALLED_Intrp_Constraint_Out_SS); +#else + f_compute_rhs_bssn_ss(RHS_PARA_CALLED_Intrp_Constraint_Out_SS); + +#endif // USE_GPU + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); +#endif + } + // interpolate + double *x1, *y1, *z1; + const int n = 1000; + double lmax, lmin, dd; + lmin = 0; +#ifdef WithShell + lmax = SH->Rrange[1]; +#else + lmax = GH->bbox[0][0][4]; +#endif +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (lmax - lmin) / (n - 1); +#else +#ifdef Cell + dd = (lmax - lmin) / n; +#else +#error Not define Vertex nor Cell +#endif +#endif + x1 = new double[n]; + y1 = new double[n]; + z1 = new double[n]; + for (int i = 0; i < n; i++) + { + x1[i] = 0; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + y1[i] = lmin + i * dd; +#else +#ifdef Cell + y1[i] = lmin + (i + 0.5) * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + z1[i] = 0; + } + + int InList = 0; + + MyList *varl = ConstraintList; + while (varl) + { + InList++; + varl = varl->next; + } + double *shellf; + shellf = new double[n * InList]; + for (int i = 0; i < n; i++) + { + double XX[3]; + XX[0] = x1[i]; + XX[1] = y1[i]; + XX[2] = z1[i]; + bool fg = GH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#ifdef WithShell + if (!fg) + fg = SH->Interp_One_Point(ConstraintList, XX, shellf + i * InList, Symmetry); +#endif + if (!fg && myrank == 0) + { + cout << "bssn_class::Interp_Constraint meets wrong" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + if (myrank == 0) + { + ofstream outfile; + char filename[50]; + sprintf(filename, "%s/interp_constraint_%05d.dat", ErrorMonitor->out_dir.c_str(), int(PhysTime / dT + 0.5)); + // 0.5 for round off + + outfile.open(filename); + outfile << "# corrdinate, H_Res, Px_Res, Py_Res, Pz_Res, Gx_Res, Gy_Res, Gz_Res, ...." << endl; + for (int i = 0; i < n; i++) + { + outfile << setw(10) << setprecision(10) << y1[i]; + for (int j = 0; j < InList; j++) + outfile << " " << setw(16) << setprecision(15) << shellf[InList * i + j]; + outfile << endl; + } + outfile.close(); + } + + delete[] shellf; +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function computes constraint violations + +//================================================================================================ + +void bssn_class::Compute_Constraint() +{ + double TRK4 = PhysTime; + double ndeps = numepsb; + int pre = 0; + int lev; + + for (lev = 0; lev < GH->levels; lev++) + { + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, ndeps, pre); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + } + Parallel::Sync(GH->PatL[lev], ConstraintList, Symmetry); + } + // prolong restrict constraint quantities + for (lev = GH->levels - 1; lev > 0; lev--) + RestrictProlong(lev, 1, false, ConstraintList, ConstraintList, ConstraintList); + +#ifdef WithShell + lev = 0; + { + MyList *sPp; + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_compute_rhs_bssn_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], + cg->fgfs[fngfs + ShellPatch::gy], + cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], + cg->fgfs[fngfs + ShellPatch::drhody], + cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], + cg->fgfs[fngfs + ShellPatch::dsigmady], + cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], + cg->fgfs[fngfs + ShellPatch::dRdy], + cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], + cg->fgfs[fngfs + ShellPatch::drhodxy], + cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], + cg->fgfs[fngfs + ShellPatch::drhodyz], + cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], + cg->fgfs[fngfs + ShellPatch::dsigmadxy], + cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], + cg->fgfs[fngfs + ShellPatch::dsigmadyz], + cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], + cg->fgfs[fngfs + ShellPatch::dRdxy], + cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], + cg->fgfs[fngfs + ShellPatch::dRdyz], + cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[phi0->sgfn], cg->fgfs[trK0->sgfn], + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn], + cg->fgfs[Gmx0->sgfn], cg->fgfs[Gmy0->sgfn], cg->fgfs[Gmz0->sgfn], + cg->fgfs[Lap0->sgfn], + cg->fgfs[Sfx0->sgfn], cg->fgfs[Sfy0->sgfn], cg->fgfs[Sfz0->sgfn], + cg->fgfs[dtSfx0->sgfn], cg->fgfs[dtSfy0->sgfn], cg->fgfs[dtSfz0->sgfn], + cg->fgfs[phi_rhs->sgfn], cg->fgfs[trK_rhs->sgfn], + cg->fgfs[gxx_rhs->sgfn], cg->fgfs[gxy_rhs->sgfn], cg->fgfs[gxz_rhs->sgfn], + cg->fgfs[gyy_rhs->sgfn], cg->fgfs[gyz_rhs->sgfn], cg->fgfs[gzz_rhs->sgfn], + cg->fgfs[Axx_rhs->sgfn], cg->fgfs[Axy_rhs->sgfn], cg->fgfs[Axz_rhs->sgfn], + cg->fgfs[Ayy_rhs->sgfn], cg->fgfs[Ayz_rhs->sgfn], cg->fgfs[Azz_rhs->sgfn], + cg->fgfs[Gmx_rhs->sgfn], cg->fgfs[Gmy_rhs->sgfn], cg->fgfs[Gmz_rhs->sgfn], + cg->fgfs[Lap_rhs->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + cg->fgfs[dtSfx_rhs->sgfn], cg->fgfs[dtSfy_rhs->sgfn], cg->fgfs[dtSfz_rhs->sgfn], + cg->fgfs[rho->sgfn], cg->fgfs[Sx->sgfn], cg->fgfs[Sy->sgfn], cg->fgfs[Sz->sgfn], + cg->fgfs[Sxx->sgfn], cg->fgfs[Sxy->sgfn], cg->fgfs[Sxz->sgfn], + cg->fgfs[Syy->sgfn], cg->fgfs[Syz->sgfn], cg->fgfs[Szz->sgfn], + cg->fgfs[Gamxxx->sgfn], cg->fgfs[Gamxxy->sgfn], cg->fgfs[Gamxxz->sgfn], + cg->fgfs[Gamxyy->sgfn], cg->fgfs[Gamxyz->sgfn], cg->fgfs[Gamxzz->sgfn], + cg->fgfs[Gamyxx->sgfn], cg->fgfs[Gamyxy->sgfn], cg->fgfs[Gamyxz->sgfn], + cg->fgfs[Gamyyy->sgfn], cg->fgfs[Gamyyz->sgfn], cg->fgfs[Gamyzz->sgfn], + cg->fgfs[Gamzxx->sgfn], cg->fgfs[Gamzxy->sgfn], cg->fgfs[Gamzxz->sgfn], + cg->fgfs[Gamzyy->sgfn], cg->fgfs[Gamzyz->sgfn], cg->fgfs[Gamzzz->sgfn], + cg->fgfs[Rxx->sgfn], cg->fgfs[Rxy->sgfn], cg->fgfs[Rxz->sgfn], + cg->fgfs[Ryy->sgfn], cg->fgfs[Ryz->sgfn], cg->fgfs[Rzz->sgfn], + cg->fgfs[Cons_Ham->sgfn], + cg->fgfs[Cons_Px->sgfn], cg->fgfs[Cons_Py->sgfn], cg->fgfs[Cons_Pz->sgfn], + cg->fgfs[Cons_Gx->sgfn], cg->fgfs[Cons_Gy->sgfn], cg->fgfs[Cons_Gz->sgfn], + Symmetry, lev, numepsh, sPp->data->sst, pre); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + SH->Synch(ConstraintList, Symmetry); + // interpolate constraint quantities + SH->CS_Inter(ConstraintList, Symmetry); +#endif +} + + +void bssn_class::testRestrict() +{ + MyList *DG_List = new MyList(phi0); + int lev = 0; + double ZEO = 0, ONE = 1; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 1; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ONE); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], DG_List, DG_List, Symmetry); + Parallel::Sync(GH->PatL[lev - 1], DG_List, Symmetry); + + Parallel::Dump_Data(GH->PatL[lev - 1], DG_List, 0, PhysTime, dT); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT); + + DG_List->clearList(); + exit(0); +} + +//================================================================================================ + + + +//================================================================================================ + +void bssn_class::testOutBd() +{ + MyList *DG_List = new MyList(phi0); + int lev = 1; + double ZEO = 0, ONE = 1; + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ZEO); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 0; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_set_value(cg->shape, cg->fgfs[phi0->sgfn], ONE); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + lev = 1; + MyList *Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, DG_List, DG_List, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + + Parallel::Sync(GH->PatL[lev], DG_List, Symmetry); + + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT); + Parallel::Dump_Data(GH->PatL[lev - 1], DG_List, 0, PhysTime, dT); + + DG_List->clearList(); + exit(0); +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function enforces/checks the trace-free condition + +//================================================================================================ + +void bssn_class::Enforce_algcon(int lev, int fg) +{ + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (fg == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); + else + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + +#ifdef WithShell + if (lev == 0) + { + MyList *sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (fg == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], + cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], + cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); + else + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], + cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], + cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif +} + +// added by yangquan +void bssn_class::Get_runtime_envirment() +{ + // get processor name + char pname[MPI_MAX_PROCESSOR_NAME]; + int resultlen = 0, pcode = 0; + MPI_Get_processor_name(pname, &resultlen); + cout << "MPI rank: " << myrank << "Processor name:" << pname << endl; + for (int i = 0; i < resultlen; ++i) + { + pcode += ((int)(pname[i]) - 65) * i; + } + + /*if(myrank % 2 == 0){ + + } */ +} + +//================================================================================================ + diff --git a/AMSS_NCKU_source/bssn_gpu_class.h b/AMSS_NCKU_source/bssn_gpu_class.h new file mode 100644 index 0000000..98e844d --- /dev/null +++ b/AMSS_NCKU_source/bssn_gpu_class.h @@ -0,0 +1,210 @@ + +#ifndef BSSN_GPU_CLASS_H +#define BSSN_GPU_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" +#include "surface_integral.h" +#include "checkpoint.h" + +// added by yangquan +#include "bssn_macro.h" + +extern void setpbh(int iBHN, double **iPBH, double *iMass, int rBHN); + +class bssn_class +{ +public: + // added by yangquan + //---------------------- + int gpu_num_mynode; + int cpu_core_num_mynode; + int mpi_process_num_mynode; + int my_sequence_mynode; + int mynode_id; + int use_gpu; + + virtual void Step_GPU(int lev, int YN); + virtual void Get_runtime_envirment(); + // virtual void Step_OPENMP(int lev,int YN); + //---------------------- + + int ngfs; + int nprocs, myrank; + cgh *GH; + ShellPatch *SH; + double PhysTime; + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, d2DumpTime, CheckTime; + double LastAnas, LastConsOut; + double Courant; + double numepss, numepsb, numepsh; + int Symmetry; + int maxl, decn; + double maxrex, drex; + int trfls, a_lev; + + double dT; + double chitiny; + + double **Porg0, **Porgbr, **Porg, **Porg1, **Porg_rhs; + int BH_num, BH_num_input; + double *Mass, *Pmom, *Spin; + double ADMMass; + + var *phio, *trKo; + var *gxxo, *gxyo, *gxzo, *gyyo, *gyzo, *gzzo; + var *Axxo, *Axyo, *Axzo, *Ayyo, *Ayzo, *Azzo; + var *Gmxo, *Gmyo, *Gmzo; + var *Lapo, *Sfxo, *Sfyo, *Sfzo; + var *dtSfxo, *dtSfyo, *dtSfzo; + + var *phi0, *trK0; + var *gxx0, *gxy0, *gxz0, *gyy0, *gyz0, *gzz0; + var *Axx0, *Axy0, *Axz0, *Ayy0, *Ayz0, *Azz0; + var *Gmx0, *Gmy0, *Gmz0; + var *Lap0, *Sfx0, *Sfy0, *Sfz0; + var *dtSfx0, *dtSfy0, *dtSfz0; + + var *phi, *trK; + var *gxx, *gxy, *gxz, *gyy, *gyz, *gzz; + var *Axx, *Axy, *Axz, *Ayy, *Ayz, *Azz; + var *Gmx, *Gmy, *Gmz; + var *Lap, *Sfx, *Sfy, *Sfz; + var *dtSfx, *dtSfy, *dtSfz; + + var *phi1, *trK1; + var *gxx1, *gxy1, *gxz1, *gyy1, *gyz1, *gzz1; + var *Axx1, *Axy1, *Axz1, *Ayy1, *Ayz1, *Azz1; + var *Gmx1, *Gmy1, *Gmz1; + var *Lap1, *Sfx1, *Sfy1, *Sfz1; + var *dtSfx1, *dtSfy1, *dtSfz1; + + var *phi_rhs, *trK_rhs; + var *gxx_rhs, *gxy_rhs, *gxz_rhs, *gyy_rhs, *gyz_rhs, *gzz_rhs; + var *Axx_rhs, *Axy_rhs, *Axz_rhs, *Ayy_rhs, *Ayz_rhs, *Azz_rhs; + var *Gmx_rhs, *Gmy_rhs, *Gmz_rhs; + var *Lap_rhs, *Sfx_rhs, *Sfy_rhs, *Sfz_rhs; + var *dtSfx_rhs, *dtSfy_rhs, *dtSfz_rhs; + + var *rho, *Sx, *Sy, *Sz, *Sxx, *Sxy, *Sxz, *Syy, *Syz, *Szz; + + var *Gamxxx, *Gamxxy, *Gamxxz, *Gamxyy, *Gamxyz, *Gamxzz; + var *Gamyxx, *Gamyxy, *Gamyxz, *Gamyyy, *Gamyyz, *Gamyzz; + var *Gamzxx, *Gamzxy, *Gamzxz, *Gamzyy, *Gamzyz, *Gamzzz; + + var *Rxx, *Rxy, *Rxz, *Ryy, *Ryz, *Rzz; + + var *Rpsi4, *Ipsi4; + var *t1Rpsi4, *t1Ipsi4, *t2Rpsi4, *t2Ipsi4; + + var *Cons_Ham, *Cons_Px, *Cons_Py, *Cons_Pz, *Cons_Gx, *Cons_Gy, *Cons_Gz; + +#ifdef Point_Psi4 + var *phix, *phiy, *phiz; + var *trKx, *trKy, *trKz; + var *Axxx, *Axxy, *Axxz; + var *Axyx, *Axyy, *Axyz; + var *Axzx, *Axzy, *Axzz; + var *Ayyx, *Ayyy, *Ayyz; + var *Ayzx, *Ayzy, *Ayzz; + var *Azzx, *Azzy, *Azzz; +#endif + // FIXME: uc = StateList, up = OldStateList, upp = SynchList_cor; so never touch these three data + MyList *StateList, *SynchList_pre, *SynchList_cor, *RHSList; + MyList *OldStateList, *DumpList; + MyList *ConstraintList; + + monitor *ErrorMonitor, *Psi4Monitor, *BHMonitor, *MAPMonitor; + monitor *ConVMonitor; + surface_integral *Waveshell; + checkpoint *CheckPoint; + +public: + bssn_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double d2DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, double numepshi, + int a_levi, int maxli, int decni, double maxrexi, double drexi); + ~bssn_class(); + + void Evolve(int Steps); + void RecursiveStep(int lev); +#if (PSTR == 1) + void ParallelStep(); + void SHStep(); +#endif + void RestrictProlong(int lev, int YN, bool BB, MyList *SL, MyList *OL, MyList *corL); + void RestrictProlong_aux(int lev, int YN, bool BB, MyList *SL, MyList *OL, MyList *corL); + void RestrictProlong(int lev, int YN, bool BB); + void ProlongRestrict(int lev, int YN, bool BB); + void Setup_Black_Hole_position(); + void compute_Porg_rhs(double **BH_PS, double **BH_RHS, var *forx, var *fory, var *forz, int lev); + bool read_Pablo_file(int *ext, double *datain, char *filename); + void write_Pablo_file(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax, + char *filename); + void AnalysisStuff(int lev, double dT_lev); + void Setup_KerrSchild(); + void Enforce_algcon(int lev, int fg); + + void testRestrict(); + void testOutBd(); + + virtual void Setup_Initial_Data_Lousto(); + virtual void Setup_Initial_Data_Cao(); + virtual void Initialize(); + virtual void Read_Ansorg(); + virtual void Read_Pablo() {}; + virtual void Compute_Psi4(int lev); + virtual void Step(int lev, int YN); + virtual void Interp_Constraint(bool infg); + virtual void Constraint_Out(); + virtual void Compute_Constraint(); + +#ifdef With_AHF +protected: + MyList *AHList, *AHDList, *GaugeList; + int AHfindevery; + double AHdumptime; + int *lastahdumpid, HN_num; // number of possible horizons + int *findeveryl; + double *xc, *yc, *zc, *xr, *yr, *zr; + bool *trigger; + double *dTT; + int *dumpid; + +public: + void AH_Prepare_derivatives(); + bool AH_Interp_Points(MyList *VarList, + int NN, double **XX, + double *Shellf, int Symmetryi); + void AH_Step_Find(int lev, double dT_lev); +#endif +}; +#endif /* BSSN_GPU_CLASS_H */ diff --git a/AMSS_NCKU_source/bssn_gpu_rhs_ss.cu b/AMSS_NCKU_source/bssn_gpu_rhs_ss.cu new file mode 100644 index 0000000..11530ae --- /dev/null +++ b/AMSS_NCKU_source/bssn_gpu_rhs_ss.cu @@ -0,0 +1,2525 @@ +// includes, system +#include +#include +#include +#include +#include +#include +#include +//#include "cutil.h" +#ifdef RESULT_CHECK +#include +#endif +using namespace std; + +//includes, bssn +#include "gpu_rhsSS_mem.h" +#include "bssn_gpu.h" + +#ifdef WithShell + +__device__ volatile unsigned int global_count = 0; + +void compare_result_gpu(int ftag1,double * datac,int data_num){ + double * data = (double*)malloc(sizeof(double)*data_num); + cudaMemcpy(data, datac, data_num * sizeof(double), cudaMemcpyDeviceToHost); + compare_result(ftag1,data,data_num); + free(data); +} + +__global__ void sub_symmetry_bd_ss_partF(int ord, double * func, double *funcc) +{ + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); //= ps % ex_c[0]; + + funcc[i+ ord + (ord +j)* _1D_SIZE[ord] + k * _2D_SIZE[ord]] = func[curr]; + + curr += STEP_SIZE; + } +} + +#ifdef Vertex +__global__ void sub_symmetry_bd_ss_partI(int ord, double * func, double * funcc,double S1){ + //for i + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps,ps2; + int m; + while(curr < (ex_c[1]+ord*2)*ex_c[2] ){ + m = ord * 2; + ps = curr * _1D_SIZE[ord]; + ps2 = ps + _1D_SIZE[ord] - 1; + for(int i = 0;i < ord; ++i){ + //funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1) + + //funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-1-i,1:extc(2),1:extc(3))*SoA(1) + funcc[ps] = funcc [ps + m] * S1; + funcc[ps2] = funcc[ps2 - m] * S1; + ps ++; + ps2 --; + m -= 2; + } + curr+= STEP_SIZE; + } + __syncthreads(); +} +__global__ void sub_symmetry_bd_ss_partJ(int ord,double * func, double * funcc,double S2){ + //for j + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps,ps2; + int m; + + while(curr < (ex_c[0]+ord*2)*ex_c[2]) + { + m = (2 * ord) * _1D_SIZE[ord]; + ps = (curr/_1D_SIZE[ord])*_2D_SIZE[ord] + (curr % _1D_SIZE[ord]); + //noticed that length_j == length_i, + //in other words, (ex[2]+ord*2) == (ex[2]+ord*2) == 1D_size[ord] + //so here we use "(_1D_SIZE[ord] - 1)" instead of "(ex[2]+ord*2) - 1" + ps2 = ps + (_1D_SIZE[ord] - 1) * _1D_SIZE[ord]; + for(int i = 0;i>>(ord,func,funcc); + cudaThreadSynchronize(); + sub_symmetry_bd_ss_partI<<>>(ord,func,funcc,SoA[0]); + cudaThreadSynchronize(); + sub_symmetry_bd_ss_partJ<<>>(ord,func,funcc,SoA[1]); + cudaThreadSynchronize(); +} + +__global__ void sub_fderivs_shc_part1(double *fx,double *fy,double *fz){ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int t_ = tid; + while(t_ < _3D_SIZE[0]) + { + fx[t_] = Ms_ dRdx[t_] * Ms_ gz[t_] + Ms_ drhodx[t_] * Ms_ gx[t_] + Ms_ dsigmadx[t_] * Ms_ gy[t_]; + + fy[t_] = Ms_ dRdy[t_] * Ms_ gz[t_] + Ms_ drhody[t_] * Ms_ gx[t_] + Ms_ dsigmady[t_] * Ms_ gy[t_]; + + fz[t_] = Ms_ dRdz[t_] * Ms_ gz[t_] + Ms_ drhodz[t_] * Ms_ gx[t_] + Ms_ dsigmadz[t_] * Ms_ gy[t_]; + + t_ += STEP_SIZE; + } +} + +__global__ void sub_fderivs_sh(double * fh,double *fx,double *fy,double *fz ) +{ + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2] || i == ex_c[0] || j == ex_c[1]){ + curr += STEP_SIZE; + continue; + } + + //X-- + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0]) + fx[curr] = d12dxyz[0]*(fh[i+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] - + 8*fh[i+1+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] + + 8*fh[i+3+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] - + fh[i+4+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] ); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0]) + fx[curr] = d2dxyz[0]*(-fh[i+1+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] + + fh[i+3+(j+2)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] ); + + //Y-- + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1]) + fy[curr]=d12dxyz[1]*(fh[i+2+j*_1D_SIZE[2]+(k)*_2D_SIZE[2]]- + 8*fh[i+2+(j+1)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] + + 8*fh[i+2+(j+3)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] - + fh[i+2+(j+4)*_1D_SIZE[2]+(k)*_2D_SIZE[2]]); + + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1]) + fy[curr]=d2dxyz[1]*(-fh[i+2+(j+1)*_1D_SIZE[2]+(k)*_2D_SIZE[2]] + + fh[i+2+(j+3)*_1D_SIZE[2]+(k)*_2D_SIZE[2]]); + //Z-- + + if(k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fz[curr]=d12dxyz[2]*( fh[i+2+(j+2)*_1D_SIZE[2]+(k-2) *_2D_SIZE[2]] - + 8* fh[i+2+(j+2)*_1D_SIZE[2]+(k-1)*_2D_SIZE[2]] + + 8* fh[i+2+(j+2)*_1D_SIZE[2]+(k+1)*_2D_SIZE[2]] - + fh[i+2+(j+2)*_1D_SIZE[2]+(k+2)*_2D_SIZE[2]]); + + else if(k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fz[curr]=d2dxyz[2]*(-fh[i+2+(j+2)*_1D_SIZE[2]+(k-1)*_2D_SIZE[2]]+ + fh[i+2+(j+2)*_1D_SIZE[2]+(k+1)*_2D_SIZE[2]]); + + curr += STEP_SIZE; + } +} +inline void sub_fderivs_shc(int& sst,double * f,double * fh,double *fx,double *fy,double *fz, double * SoA) +{ + double SoA1[2]; + if(sst == 0){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[1]; + } + else if(sst == 2 || sst == 3 ){ + SoA1[0] = SoA[1]; + SoA1[1] = SoA[2]; + } + else if(sst == 4 || sst==5){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[2]; + } + //cudaMemset(Msh_ gx,0,h_3D_SIZE[0] * sizeof(double)); + //cudaMemset(Msh_ gy,0,h_3D_SIZE[0] * sizeof(double)); + //cudaMemset(Msh_ gz,0,h_3D_SIZE[0] * sizeof(double)); + sub_symmetry_bd_ss(2,f,fh,SoA1); + cudaThreadSynchronize(); + //compare_result_gpu(0,fh,h_3D_SIZE[2]); + sub_fderivs_sh<<>>(fh,Msh_ gx,Msh_ gy,Msh_ gz); + cudaThreadSynchronize(); + + sub_fderivs_shc_part1<<>>(fx,fy,fz); + cudaThreadSynchronize(); + //compare_result_gpu(1,fx,h_3D_SIZE[0]); + //compare_result_gpu(2,fy,h_3D_SIZE[0]); + //compare_result_gpu(3,fz,h_3D_SIZE[0]); +} +__global__ void compute_rhs_ss_part1() +{ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int t_ = tid; + while(t_ < _3D_SIZE[0]) + { + metac.alpn1[t_] = metac.Lap[t_] + 1; + metac.chin1[t_] = metac.chi[t_] + 1; + metac.gxx[t_] = metac.dxx[t_] + 1; + metac.gyy[t_] = metac.dyy[t_] + 1; + metac.gzz[t_] = metac.dzz[t_] + 1; + + t_ += STEP_SIZE; + } +} + +__global__ void sub_fdderivs_shc_part1(double *fxx,double *fxy,double *fxz,double *fyy,double *fyz,double *fzz) +{ + int tid = blockIdx.x*blockDim.x+threadIdx.x; + int t_ = tid; + while(t_ < _3D_SIZE[0]) + { + fxx[t_] = Ms_ dRdxx[t_] * Ms_ gz[t_] + Ms_ drhodxx[t_] * Ms_ gx[t_] + Ms_ dsigmadxx[t_] * Ms_ gy[t_] + + + Ms_ dRdx[t_] * Ms_ dRdx[t_] * Ms_ gzz[t_] + Ms_ drhodx[t_] * Ms_ drhodx[t_] * Ms_ gxx[t_] + Ms_ dsigmadx[t_] * Ms_ dsigmadx[t_] * Ms_ gyy[t_] + + + 2 * (Ms_ dRdx[t_] * Ms_ drhodx[t_] * Ms_ gxz[t_] + Ms_ dRdx[t_] * Ms_ dsigmadx[t_] * Ms_ gyz[t_] + Ms_ drhodx[t_] * Ms_ dsigmadx[t_] * Ms_ gxy[t_]); + + + fyy[t_] = Ms_ dRdyy[t_] * Ms_ gz[t_] + Ms_ drhodyy[t_] * Ms_ gx[t_] + Ms_ dsigmadyy[t_] * Ms_ gy[t_] + + + Ms_ dRdy[t_] * Ms_ dRdy[t_] * Ms_ gzz[t_] + Ms_ drhody[t_] * Ms_ drhody[t_] * Ms_ gxx[t_] + Ms_ dsigmady[t_] * Ms_ dsigmady[t_] * Ms_ gyy[t_] + + + 2 * (Ms_ dRdy[t_] * Ms_ drhody[t_] * Ms_ gxz[t_] + Ms_ dRdy[t_] * Ms_ dsigmady[t_] * Ms_ gyz[t_] + Ms_ drhody[t_] * Ms_ dsigmady[t_] * Ms_ gxy[t_]); + + + fzz[t_] = Ms_ dRdzz[t_] * Ms_ gz[t_] + Ms_ drhodzz[t_] * Ms_ gx[t_] + Ms_ dsigmadzz[t_] * Ms_ gy[t_] + + + Ms_ dRdz[t_] * Ms_ dRdz[t_] * Ms_ gzz[t_] + Ms_ drhodz[t_] * Ms_ drhodz[t_] * Ms_ gxx[t_] + Ms_ dsigmadz[t_] * Ms_ dsigmadz[t_] * Ms_ gyy[t_] + + + 2 * (Ms_ dRdz[t_] * Ms_ drhodz[t_] * Ms_ gxz[t_] + Ms_ dRdz[t_] * Ms_ dsigmadz[t_] * Ms_ gyz[t_] + Ms_ drhodz[t_] * Ms_ dsigmadz[t_] * Ms_ gxy[t_]); + + + fxy[t_] = Ms_ dRdxy[t_] * Ms_ gz[t_] + Ms_ drhodxy[t_] * Ms_ gx[t_] + Ms_ dsigmadxy[t_] * Ms_ gy[t_] + + + Ms_ dRdx[t_] * Ms_ drhody[t_] * Ms_ gxz[t_] + Ms_ dRdx[t_] * Ms_ dsigmady[t_] * Ms_ gyz[t_] + Ms_ drhodx[t_] * Ms_ dsigmady[t_] * Ms_ gxy[t_] + + + Ms_ dRdy[t_] * Ms_ drhodx[t_] * Ms_ gxz[t_] + Ms_ dRdy[t_] * Ms_ dsigmadx[t_] * Ms_ gyz[t_] + Ms_ drhody[t_] * Ms_ dsigmadx[t_] * Ms_ gxy[t_] + + + Ms_ dRdx[t_] * Ms_ dRdy[t_] * Ms_ gzz[t_] + Ms_ drhodx[t_] * Ms_ drhody[t_] * Ms_ gxx[t_] + Ms_ dsigmadx[t_] * Ms_ dsigmady[t_] * Ms_ gyy[t_]; + + + fxz[t_] = Ms_ dRdxz[t_] * Ms_ gz[t_] + Ms_ drhodxz[t_] * Ms_ gx[t_] + Ms_ dsigmadxz[t_] * Ms_ gy[t_] + + + Ms_ dRdx[t_] * Ms_ drhodz[t_] * Ms_ gxz[t_] + Ms_ dRdx[t_] * Ms_ dsigmadz[t_] * Ms_ gyz[t_] + Ms_ drhodx[t_] * Ms_ dsigmadz[t_] * Ms_ gxy[t_] + + + Ms_ dRdz[t_] * Ms_ drhodx[t_] * Ms_ gxz[t_] + Ms_ dRdz[t_] * Ms_ dsigmadx[t_] * Ms_ gyz[t_] + Ms_ drhodz[t_] * Ms_ dsigmadx[t_] * Ms_ gxy[t_] + + + Ms_ dRdx[t_] * Ms_ dRdz[t_] * Ms_ gzz[t_] + Ms_ drhodx[t_] * Ms_ drhodz[t_] * Ms_ gxx[t_] + Ms_ dsigmadx[t_] * Ms_ dsigmadz[t_] * Ms_ gyy[t_]; + + + fyz[t_] = Ms_ dRdyz[t_] * Ms_ gz[t_] + Ms_ drhodyz[t_] * Ms_ gx[t_] + Ms_ dsigmadyz[t_] * Ms_ gy[t_] + + + Ms_ dRdz[t_] * Ms_ drhody[t_] * Ms_ gxz[t_] + Ms_ dRdz[t_] * Ms_ dsigmady[t_] * Ms_ gyz[t_] + Ms_ drhodz[t_] * Ms_ dsigmady[t_] * Ms_ gxy[t_] + + + Ms_ dRdy[t_] * Ms_ drhodz[t_] * Ms_ gxz[t_] + Ms_ dRdy[t_] * Ms_ dsigmadz[t_] * Ms_ gyz[t_] + Ms_ drhody[t_] * Ms_ dsigmadz[t_] * Ms_ gxy[t_] + + + Ms_ dRdz[t_] * Ms_ dRdy[t_] * Ms_ gzz[t_] + Ms_ drhodz[t_] * Ms_ drhody[t_] * Ms_ gxx[t_] + Ms_ dsigmadz[t_] * Ms_ dsigmady[t_] * Ms_ gyy[t_]; + + t_ += STEP_SIZE; + } +} + +__global__ void sub_fdderivs_sh(double *fh,double *fxx,double *fxy,double *fxz,double *fyy,double *fyz,double *fzz) + { + int curr = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + + while(curr < _3D_SIZE[0]) + { + int k = curr / _2D_SIZE[0]; + ps = curr - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2] || i == ex_c[0] || j == ex_c[1]){ + curr += STEP_SIZE; + continue; + } + else + { + //xx + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0]){ + fxx[curr] = Fdxdx*(-_FH2_(i,(j+2),(k))+16*_FH2_((i+1),(j+2),(k))-30*_FH2_((i+2),(j+2),(k)) + -_FH2_((i+4),(j+2),(k))+16*_FH2_((i+3),(j+2),(k)) ); + + } + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0]){ + fxx[curr] = Sdxdx*(_FH2_((i+1),(j+2),(k))-2*_FH2_((i+2),(j+2),(k)) + +_FH2_(i+3,(j+2),(k)) ); + } + + + + //zz-- + if(k+2 <= ijk_max[2] && k-2 >= ijk_min[2]){ + fzz[curr] = Fdzdz * (-_FH2_((i+2),(j+2),(k-2)) + 16 *_FH2_((i+2),(j+2),(k-1))- 30*_FH2_((i+2),(j+2),(k)) + -_FH2_((i+2),(j+2),(k+2))+ 16*_FH2_((i+2),(j+2),(k+1))); + + } + else if(k+1 <= ijk_max[2] && k-1 >= ijk_min[2]){ + fzz[curr] = Sdzdz*(_FH2_((i+2),(j+2),(k-1))- 2 * _FH2_((i+2),(j+2),(k)) + + _FH2_((i+2),(j+2),(k+1)) ); + + //fzz[curr] = 256; + } + + //yy-- + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1]){ + fyy[curr] = Fdydy*(-_FH2_((i+2),j,(k))+16*_FH2_((i+2),(j+1),(k))-30*_FH2_((i+2),(j+2),(k)) + -_FH2_((i+2),(j+4),(k))+16*_FH2_((i+2),(j+3),(k)) ); + } + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1]){ + fyy[curr] = Sdydy*(_FH2_((i+2),(j+1),(k))-2*_FH2_((i+2),(j+2),(k)) + +_FH2_((i+2),(j+3),(k)) ); + } + + + + //xy + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0] && j+2 <= ijk_max[1] && j-2 >= ijk_min[1]) + fxy[curr] = Fdxdy*((_FH2_(i,j,(k))-8*_FH2_((i+1),j,(k))+8*_FH2_((i+3),j,(k))-_FH2_((i+4),j,(k))) + -8 *(_FH2_(i,(j+1),(k))-8*_FH2_((i+1),(j+1),(k))+8*_FH2_((i+3),(j+1),(k))-_FH2_((i+4),(j+1),(k))) + +8 *(_FH2_(i,(j+3),(k))-8*_FH2_((i+1),(j+3),(k))+8*_FH2_((i+3),(j+3),(k))-_FH2_((i+4),(j+3),(k))) + - (_FH2_(i,(j+4),(k))-8*_FH2_((i+1),(j+4),(k))+8*_FH2_((i+3),(j+4),(k))-_FH2_((i+4),(j+4),(k)))); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0] && j+1 <= ijk_max[1] && j-1 >= ijk_min[1]) + + fxy[curr] = Sdxdy*(_FH2_((i+1),(j+1),(k))-_FH2_((i+3),(j+1),(k))-_FH2_((i+1),(j+3),(k))+_FH2_((i+3),(j+3),(k))); + //xz + if(i+2 <= ijk_max[0] && i-2 >= ijk_min[0] && k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fxz[curr] = Fdxdz*((_FH2_(i,(j+2),(k-2))-8*_FH2_((i+1),(j+2),(k-2))+8*_FH2_((i+3),(j+2),(k-2))-_FH2_((i+4),(j+2),(k-2))) + -8 *(_FH2_(i,(j+2),(k-1))-8*_FH2_((i+1),(j+2),(k-1))+8*_FH2_((i+3),(j+2),(k-1))-_FH2_((i+4),(j+2),(k-1))) + +8 *(_FH2_(i,(j+2),(k+1))-8*_FH2_((i+1),(j+2),(k+1))+8*_FH2_((i+3),(j+2),(k+1))-_FH2_((i+4),(j+2),(k+1))) + - (_FH2_(i,(j+2),(k+2))-8*_FH2_((i+1),(j+2),(k+2))+8*_FH2_((i+3),(j+2),(k+2))-_FH2_((i+4),(j+2),(k+2)))); + + else if(i+1 <= ijk_max[0] && i-1 >= ijk_min[0] && k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fxz[curr] = Sdxdz*(_FH2_((i+1),(j+2),(k-1))-_FH2_((i+3),(j+2),(k-1))-_FH2_((i+1),(j+2),(k+1))+_FH2_((i+3),(j+2),(k+1))); + //yz + if(j+2 <= ijk_max[1] && j-2 >= ijk_min[1] && k+2 <= ijk_max[2] && k-2 >= ijk_min[2]) + fyz[curr] = Fdydz*( (_FH2_((i+2),j,(k-2))-8*_FH2_((i+2),(j+1),(k-2))+8*_FH2_((i+2),(j+3),(k-2))-_FH2_((i+2),(j+4),(k-2))) + -8 *(_FH2_((i+2),j,(k-1))-8*_FH2_((i+2),(j+1),(k-1))+8*_FH2_((i+2),(j+3),(k-1))-_FH2_((i+2),(j+4),(k-1))) + +8 *(_FH2_((i+2),j,(k+1))-8*_FH2_((i+2),(j+1),(k+1))+8*_FH2_((i+2),(j+3),(k+1))-_FH2_((i+2),(j+4),(k+1))) + - (_FH2_((i+2),j,(k+2))-8*_FH2_((i+2),(j+1),(k+2))+8*_FH2_((i+2),(j+3),(k+2))-_FH2_((i+2),(j+4),(k+2)))); + + else if(j+1 <= ijk_max[1] && j-1 >= ijk_min[1] && k+1 <= ijk_max[2] && k-1 >= ijk_min[2]) + fyz[curr] = Sdydz*(_FH2_((i+2),(j+1),(k-1))-_FH2_((i+2),(j+3),(k-1))-_FH2_((i+2),(j+1),(k+1))+_FH2_((i+2),(j+3),(k+1))); + + curr += STEP_SIZE; + } + } + __syncthreads(); + } + +inline void sub_fdderivs_shc(int& sst,double * f,double * fh, + double * fxx,double * fxy,double * fxz, + double * fyy,double * fyz,double * fzz, double * SoA) +{ + double SoA1[2]; + if(sst == 0){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[1]; + } + else if(sst == 2 || sst == 3 ){ + SoA1[0] = SoA[1]; + SoA1[1] = SoA[2]; + } + else if(sst == 4 || sst==5){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[2]; + } + cudaMemset(Msh_ gx,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gy,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gz,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gxx,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gxy,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gxz,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gyy,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gyz,0,h_3D_SIZE[0] * sizeof(double)); + cudaMemset(Msh_ gzz,0,h_3D_SIZE[0] * sizeof(double)); + + //fderivs_sh + sub_symmetry_bd_ss(2,f,fh,SoA1); + cudaThreadSynchronize(); + //compare_result_gpu(1,fh,h_3D_SIZE[2]); + sub_fderivs_sh<<>>(fh,Msh_ gx,Msh_ gy,Msh_ gz); + cudaThreadSynchronize(); + + //fdderivs_sh + sub_symmetry_bd_ss(2,f,fh,SoA1); + cudaThreadSynchronize(); + //compare_result_gpu(21,fh,h_3D_SIZE[2]); + sub_fdderivs_sh<<>>(fh,Msh_ gxx,Msh_ gxy,Msh_ gxz,Msh_ gyy,Msh_ gyz,Msh_ gzz); + cudaThreadSynchronize(); + /*compare_result_gpu(11,Msh_ gx,h_3D_SIZE[0]); + compare_result_gpu(12,Msh_ gy,h_3D_SIZE[0]); + compare_result_gpu(13,Msh_ gz,h_3D_SIZE[0]); + compare_result_gpu(1,Msh_ gxx,h_3D_SIZE[0]); + compare_result_gpu(2,Msh_ gxy,h_3D_SIZE[0]); + compare_result_gpu(3,Msh_ gxz,h_3D_SIZE[0]); + compare_result_gpu(4,Msh_ gyy,h_3D_SIZE[0]); + compare_result_gpu(5,Msh_ gyz,h_3D_SIZE[0]); + compare_result_gpu(6,Msh_ gzz,h_3D_SIZE[0]);*/ + sub_fdderivs_shc_part1<<>>(fxx,fxy,fxz,fyy,fyz,fzz); + cudaThreadSynchronize(); + /*compare_result_gpu(1,fxx,h_3D_SIZE[0]); + compare_result_gpu(2,fxy,h_3D_SIZE[0]); + compare_result_gpu(3,fxz,h_3D_SIZE[0]); + compare_result_gpu(4,fyy,h_3D_SIZE[0]); + compare_result_gpu(5,fyz,h_3D_SIZE[0]); + compare_result_gpu(6,fzz,h_3D_SIZE[0]);*/ +} + +__global__ void computeRicci_ss_part1(double * dst) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + dst[_t] = M_ gupxx [_t]* M_ fxx [_t]+ M_ gupyy[_t]* M_ fyy[_t]+ M_ gupzz[_t]* M_ fzz[_t]+ + ( M_ gupxy[_t]* M_ fxy[_t]+ M_ gupxz[_t]* M_ fxz[_t]+ M_ gupyz[_t]* M_ fyz[_t]) * 2; + + _t += STEP_SIZE; + } +} + + inline void computeRicci_ss(int &sst,double * src,double* dst,double * SoA, Meta* meta) +{ + sub_fdderivs_shc(sst,src,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,SoA); + cudaThreadSynchronize(); + computeRicci_ss_part1<<>>(dst); + cudaThreadSynchronize(); + +} +__global__ void sub_lopsided_ss_part1(double * dst) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + dst[_t] += M_ betax[_t] * M_ fxx[_t] + + M_ betay[_t] * M_ fxy[_t] + + M_ betaz[_t] * M_ fxz[_t]; + + _t += STEP_SIZE; + } +} +inline void sub_lopsided_ss(int& sst,double *src,double* dst,double *SoA) +{ + sub_fderivs_shc(sst,src,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,SoA); + cudaThreadSynchronize(); + sub_lopsided_ss_part1<<>>(dst); + cudaThreadSynchronize(); +} + +__global__ void sub_kodis_sh_part1(double *f,double *fh,double *f_rhs) +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + int ps; //TOTRY: i,j,k; double value; + double inc_f_rhs; + while(_t < _3D_SIZE[0]) + { + int k = _t / _2D_SIZE[0]; + ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + if(k == ex_c[2] && i == ex_c[0] && j == ex_c[1]){ + _t += STEP_SIZE; + continue; + } + + if(i-3 >= ijk_min3[0] && i+3 <= ijk_max3[0] && + j-3 >= ijk_min3[1] && j+3 <= ijk_max3[1] && + k-3 >= ijk_min3[2] && k+3 <= ijk_max3[2]) + { + + // x direction + inc_f_rhs = ( (_FH3_(i,(j+3),(k))+_FH3_((i+6),(j+3),(k))) - + 6*(_FH3_((i+1),(j+3),(k))+_FH3_((i+5),(j+3),(k))) + + 15*(_FH3_((i+2),(j+3),(k))+_FH3_((i+4),(j+3),(k))) - + 20* _FH3_((i+3),(j+3),(k)) ) /dX; + + + // y direction + + inc_f_rhs += ( (_FH3_((i+3),j,(k))+_FH3_((i+3),(j+6),(k))) - + 6*(_FH3_((i+3),(j+1),(k))+_FH3_((i+3),(j+5),(k))) + + 15*(_FH3_((i+3),(j+2),(k))+_FH3_((i+3),(j+4),(k))) - + 20* _FH3_((i+3),(j+3),(k)) )/dY; + + // z direction + + inc_f_rhs += ( (_FH3_((i+3),(j+3),(k-3))+_FH3_((i+3),(j+3),(k+3))) - + 6*(_FH3_((i+3),(j+3),(k-2))+_FH3_((i+3),(j+3),(k+2))) + + 15*(_FH3_((i+3),(j+3),(k-1))+_FH3_((i+3),(j+3),(k+1))) - + 20* _FH3_((i+3),(j+3),(k)) )/dZ; + inc_f_rhs *= eps_c; + inc_f_rhs /= 64; + + f_rhs[_t] += inc_f_rhs; //be careful the mark is "+=" not "==" ! + } + + _t += STEP_SIZE; + } +} + +inline void sub_kodis_ss(int &sst,double *f,double *fh,double *f_rhs,double *SoA) +{ + double SoA1[2]; + if(sst == 0){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[1]; + } + else if(sst == 2 || sst == 3 ){ + SoA1[0] = SoA[1]; + SoA1[1] = SoA[2]; + } + else if(sst == 4 || sst==5){ + SoA1[0] = SoA[0]; + SoA1[1] = SoA[2]; + } + //compare_result_gpu(10,f,h_3D_SIZE[0]); + sub_symmetry_bd_ss(3,f,fh,SoA1); + cudaThreadSynchronize(); + //compare_result_gpu(0,fh,h_3D_SIZE[3]); + + sub_kodis_sh_part1<<>>(f,fh,f_rhs); + cudaThreadSynchronize(); + //compare_result_gpu(1,f_rhs,h_3D_SIZE[0]); +} + +__global__ void compute_rhs_ss_part2() +{ + //__shared__ int judge = 1; + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + if(co_c == 0) + { + // M_ Gam^i_Res = M_ Gam^i + M_ gup^ij_,j + M_ Gmx_Res[_t] = M_ Gamx[_t] - (M_ gupxx[_t]*(M_ gupxx[_t]*M_ gxxx[_t]+M_ gupxy[_t]*M_ gxyx[_t]+M_ gupxz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxx[_t]*M_ gxyx[_t]+M_ gupxy[_t]*M_ gyyx[_t]+M_ gupxz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxx[_t]*M_ gxzx[_t]+M_ gupxy[_t]*M_ gyzx[_t]+M_ gupxz[_t]*M_ gzzx[_t]) + +M_ gupxx[_t]*(M_ gupxy[_t]*M_ gxxy[_t]+M_ gupyy[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gxzy[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxyy[_t]+M_ gupyy[_t]*M_ gyyy[_t]+M_ gupyz[_t]*M_ gyzy[_t]) + +M_ gupxz[_t]*(M_ gupxy[_t]*M_ gxzy[_t]+M_ gupyy[_t]*M_ gyzy[_t]+M_ gupyz[_t]*M_ gzzy[_t]) + +M_ gupxx[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + M_ Gmy_Res[_t] = M_ Gamy[_t] - (M_ gupxx[_t]*(M_ gupxy[_t]*M_ gxxx[_t]+M_ gupyy[_t]*M_ gxyx[_t]+M_ gupyz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxyx[_t]+M_ gupyy[_t]*M_ gyyx[_t]+M_ gupyz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxy[_t]*M_ gxzx[_t]+M_ gupyy[_t]*M_ gyzx[_t]+M_ gupyz[_t]*M_ gzzx[_t]) + +M_ gupxy[_t]*(M_ gupxy[_t]*M_ gxxy[_t]+M_ gupyy[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gxzy[_t]) + +M_ gupyy[_t]*(M_ gupxy[_t]*M_ gxyy[_t]+M_ gupyy[_t]*M_ gyyy[_t]+M_ gupyz[_t]*M_ gyzy[_t]) + +M_ gupyz[_t]*(M_ gupxy[_t]*M_ gxzy[_t]+M_ gupyy[_t]*M_ gyzy[_t]+M_ gupyz[_t]*M_ gzzy[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupyy[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + M_ Gmz_Res[_t] = M_ Gamz[_t] - (M_ gupxx[_t]*(M_ gupxz[_t]*M_ gxxx[_t]+M_ gupyz[_t]*M_ gxyx[_t]+M_ gupzz[_t]*M_ gxzx[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxyx[_t]+M_ gupyz[_t]*M_ gyyx[_t]+M_ gupzz[_t]*M_ gyzx[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxzx[_t]+M_ gupyz[_t]*M_ gyzx[_t]+M_ gupzz[_t]*M_ gzzx[_t]) + +M_ gupxy[_t]*(M_ gupxz[_t]*M_ gxxy[_t]+M_ gupyz[_t]*M_ gxyy[_t]+M_ gupzz[_t]*M_ gxzy[_t]) + +M_ gupyy[_t]*(M_ gupxz[_t]*M_ gxyy[_t]+M_ gupyz[_t]*M_ gyyy[_t]+M_ gupzz[_t]*M_ gyzy[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxzy[_t]+M_ gupyz[_t]*M_ gyzy[_t]+M_ gupzz[_t]*M_ gzzy[_t]) + +M_ gupxz[_t]*(M_ gupxz[_t]*M_ gxxz[_t]+M_ gupyz[_t]*M_ gxyz[_t]+M_ gupzz[_t]*M_ gxzz[_t]) + +M_ gupyz[_t]*(M_ gupxz[_t]*M_ gxyz[_t]+M_ gupyz[_t]*M_ gyyz[_t]+M_ gupzz[_t]*M_ gyzz[_t]) + +M_ gupzz[_t]*(M_ gupxz[_t]*M_ gxzz[_t]+M_ gupyz[_t]*M_ gyzz[_t]+M_ gupzz[_t]*M_ gzzz[_t])); + }//if(co == 0) + + M_ div_beta[_t] = M_ betaxx[_t] + M_ betayy[_t] + M_ betazz[_t]; + M_ chi_rhs[_t] = F2o3 *M_ chin1[_t]*( M_ alpn1[_t] * M_ trK[_t] - M_ div_beta[_t] ); //rhs[_t] for M_ chi + + M_ gxx_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axx[_t] - F2o3 * M_ gxx[_t]* M_ div_beta[_t] + + 2 *( M_ gxx[_t]* M_ betaxx[_t]+ M_ gxy[_t]* M_ betayx[_t]+ M_ gxz[_t]* M_ betazx[_t]); + M_ gyy_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Ayy[_t] - F2o3 * M_ gyy[_t]* M_ div_beta[_t] + + 2 *( M_ gxy[_t]* M_ betaxy[_t]+ M_ gyy[_t]* M_ betayy[_t]+ M_ gyz[_t]* M_ betazy[_t]); + + M_ gzz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Azz[_t] - F2o3 * M_ gzz[_t]* M_ div_beta[_t] + + 2 *( M_ gxz[_t]* M_ betaxz[_t]+ M_ gyz[_t]* M_ betayz[_t]+ M_ gzz[_t]* M_ betazz[_t]); + + M_ gxy_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axy[_t] + F1o3 * M_ gxy[_t] * M_ div_beta[_t] + + M_ gxx[_t]* M_ betaxy[_t] + M_ gxz[_t]* M_ betazy[_t]+ + M_ gyy[_t]* M_ betayx[_t]+ M_ gyz[_t]* M_ betazx[_t] + - M_ gxy[_t]* M_ betazz[_t]; + + M_ gyz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Ayz[_t] + F1o3 * M_ gyz[_t] * M_ div_beta[_t] + + M_ gxy[_t]* M_ betaxz[_t]+ M_ gyy[_t]* M_ betayz[_t] + + M_ gxz[_t]* M_ betaxy[_t] + M_ gzz[_t]* M_ betazy[_t] + - M_ gyz[_t]* M_ betaxx[_t]; + + M_ gxz_rhs[_t] = - 2 * M_ alpn1[_t] * M_ Axz[_t] + F1o3 * M_ gxz[_t] * M_ div_beta[_t] + + M_ gxx[_t]* M_ betaxz[_t]+ M_ gxy[_t]* M_ betayz[_t] + + M_ gyz[_t]* M_ betayx[_t]+ M_ gzz[_t]* M_ betazx[_t] + - M_ gxz[_t]* M_ betayy[_t]; //rhs[_t] for gij + + // invert tilted metric + M_ gupzz[_t]= M_ gxx[_t]* M_ gyy[_t]* M_ gzz[_t]+ M_ gxy[_t]* M_ gyz[_t]* M_ gxz[_t]+ M_ gxz[_t]* M_ gxy[_t]* M_ gyz[_t]- + M_ gxz[_t]* M_ gyy[_t]* M_ gxz[_t]- M_ gxy[_t]* M_ gxy[_t]* M_ gzz[_t]- M_ gxx[_t]* M_ gyz[_t]* M_ gyz[_t]; + M_ gupxx[_t]= ( M_ gyy[_t]* M_ gzz[_t]- M_ gyz[_t]* M_ gyz[_t]) / M_ gupzz[_t]; + M_ gupxy[_t]= - ( M_ gxy[_t]* M_ gzz[_t]- M_ gyz[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupxz[_t]= ( M_ gxy[_t]* M_ gyz[_t]- M_ gyy[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupyy[_t]= ( M_ gxx[_t]* M_ gzz[_t]- M_ gxz[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupyz[_t]= - ( M_ gxx[_t]* M_ gyz[_t]- M_ gxy[_t]* M_ gxz[_t]) / M_ gupzz[_t]; + M_ gupzz[_t]= ( M_ gxx[_t]* M_ gyy[_t]- M_ gxy[_t]* M_ gxy[_t]) / M_ gupzz[_t]; + //if(threadIdx.x == 0){ + // judge = co_c; + //} + //__syncthreads(); + + + + // second kind of connection + M_ Gamxxx[_t]=HALF*( M_ gupxx[_t]*M_ gxxx[_t]+ M_ gupxy[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupxz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + M_ Gamyxx[_t]=HALF*( M_ gupxy[_t]*M_ gxxx[_t]+ M_ gupyy[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupyz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + M_ Gamzxx[_t]=HALF*( M_ gupxz[_t]*M_ gxxx[_t]+ M_ gupyz[_t]*(2*M_ gxyx[_t]- M_ gxxy[_t]) + M_ gupzz[_t]*(2*M_ gxzx[_t]- M_ gxxz[_t])); + + M_ Gamxyy[_t]=HALF*( M_ gupxx[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupxy[_t]*M_ gyyy[_t]+ M_ gupxz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + M_ Gamyyy[_t]=HALF*( M_ gupxy[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupyy[_t]*M_ gyyy[_t]+ M_ gupyz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + M_ Gamzyy[_t]=HALF*( M_ gupxz[_t]*(2*M_ gxyy[_t]- M_ gyyx[_t]) + M_ gupyz[_t]*M_ gyyy[_t]+ M_ gupzz[_t]*(2*M_ gyzy[_t]- M_ gyyz[_t])); + + M_ Gamxzz[_t]=HALF*( M_ gupxx[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupxy[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupxz[_t]*M_ gzzz[_t]); + M_ Gamyzz[_t]=HALF*( M_ gupxy[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupyy[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupyz[_t]*M_ gzzz[_t]); + M_ Gamzzz[_t]=HALF*( M_ gupxz[_t]*(2*M_ gxzz[_t]- M_ gzzx[_t]) + M_ gupyz[_t]*(2*M_ gyzz[_t]- M_ gzzy[_t]) + M_ gupzz[_t]*M_ gzzz[_t]); + + M_ Gamxxy[_t]=HALF*( M_ gupxx[_t]*M_ gxxy[_t]+ M_ gupxy[_t]*M_ gyyx[_t]+ M_ gupxz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + M_ Gamyxy[_t]=HALF*( M_ gupxy[_t]*M_ gxxy[_t]+ M_ gupyy[_t]*M_ gyyx[_t]+ M_ gupyz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + M_ Gamzxy[_t]=HALF*( M_ gupxz[_t]*M_ gxxy[_t]+ M_ gupyz[_t]*M_ gyyx[_t]+ M_ gupzz[_t]*( M_ gxzy[_t]+ M_ gyzx[_t]- M_ gxyz[_t]) ); + + M_ Gamxxz[_t]=HALF*( M_ gupxx[_t]*M_ gxxz[_t]+ M_ gupxy[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupxz[_t]*M_ gzzx[_t]); + M_ Gamyxz[_t]=HALF*( M_ gupxy[_t]*M_ gxxz[_t]+ M_ gupyy[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupyz[_t]*M_ gzzx[_t]); + M_ Gamzxz[_t]=HALF*( M_ gupxz[_t]*M_ gxxz[_t]+ M_ gupyz[_t]*( M_ gxyz[_t]+ M_ gyzx[_t]- M_ gxzy[_t]) + M_ gupzz[_t]*M_ gzzx[_t]); + + M_ Gamxyz[_t]=HALF*( M_ gupxx[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupxy[_t]*M_ gyyz[_t]+ M_ gupxz[_t]*M_ gzzy[_t]); + M_ Gamyyz[_t]=HALF*( M_ gupxy[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupyy[_t]*M_ gyyz[_t]+ M_ gupyz[_t]*M_ gzzy[_t]); + M_ Gamzyz[_t]=HALF*( M_ gupxz[_t]*( M_ gxyz[_t]+ M_ gxzy[_t]- M_ gyzx[_t]) + M_ gupyz[_t]*M_ gyyz[_t]+ M_ gupzz[_t]*M_ gzzy[_t]); + // Raise indices of \tilde A_{ij} and store in R_ij + + M_ Rxx[_t]= M_ gupxx[_t]* M_ gupxx[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupxy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupxz[_t]* M_ Azz[_t]+ + 2*(M_ gupxx[_t]* M_ gupxy[_t]* M_ Axy[_t]+ M_ gupxx[_t]* M_ gupxz[_t]* M_ Axz[_t]+ M_ gupxy[_t]* M_ gupxz[_t]* M_ Ayz[_t]); + + M_ Ryy[_t]= M_ gupxy[_t]* M_ gupxy[_t]* M_ Axx[_t]+ M_ gupyy[_t]* M_ gupyy[_t]* M_ Ayy[_t]+ M_ gupyz[_t]* M_ gupyz[_t]* M_ Azz[_t]+ + 2*(M_ gupxy[_t]* M_ gupyy[_t]* M_ Axy[_t]+ M_ gupxy[_t]* M_ gupyz[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ gupyz[_t]* M_ Ayz[_t]); + + M_ Rzz[_t]= M_ gupxz[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupyz[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + 2*(M_ gupxz[_t]* M_ gupyz[_t]* M_ Axy[_t]+ M_ gupxz[_t]* M_ gupzz[_t]* M_ Axz[_t]+ M_ gupyz[_t]* M_ gupzz[_t]* M_ Ayz[_t]); + + M_ Rxy[_t]= M_ gupxx[_t]* M_ gupxy[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupyy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupyz[_t]* M_ Azz[_t]+ + (M_ gupxx[_t]* M_ gupyy[_t] + M_ gupxy[_t]* M_ gupxy[_t])* M_ Axy[_t] + + (M_ gupxx[_t]* M_ gupyz[_t] + M_ gupxz[_t]* M_ gupxy[_t])* M_ Axz[_t] + + (M_ gupxy[_t]* M_ gupyz[_t] + M_ gupxz[_t]* M_ gupyy[_t])* M_ Ayz[_t]; + + M_ Rxz[_t]= M_ gupxx[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupxy[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + (M_ gupxx[_t]* M_ gupyz[_t] + M_ gupxy[_t]* M_ gupxz[_t])* M_ Axy[_t] + + (M_ gupxx[_t]* M_ gupzz[_t] + M_ gupxz[_t]* M_ gupxz[_t])* M_ Axz[_t] + + (M_ gupxy[_t]* M_ gupzz[_t] + M_ gupxz[_t]* M_ gupyz[_t])* M_ Ayz[_t]; + + M_ Ryz[_t]= M_ gupxy[_t]* M_ gupxz[_t]* M_ Axx[_t]+ M_ gupyy[_t]* M_ gupyz[_t]* M_ Ayy[_t]+ M_ gupyz[_t]* M_ gupzz[_t]* M_ Azz[_t]+ + (M_ gupxy[_t]* M_ gupyz[_t] + M_ gupyy[_t]* M_ gupxz[_t])* M_ Axy[_t] + + (M_ gupxy[_t]* M_ gupzz[_t] + M_ gupyz[_t]* M_ gupxz[_t])* M_ Axz[_t] + + (M_ gupyy[_t]* M_ gupzz[_t] + M_ gupyz[_t]* M_ gupyz[_t])* M_ Ayz[_t]; + + // Right hand side for M_ Gam^i without shift terms... + + M_ Gamx_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxx[_t]+ M_ Lapy[_t] * M_ Rxy[_t]+ M_ Lapz[_t] * M_ Rxz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxx[_t]+ M_ chiy[_t] * M_ Rxy[_t]+ M_ chiz[_t] * M_ Rxz[_t]) - + M_ gupxx[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupxy[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupxz[_t]* ( F2o3 * M_ Kz[_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamxxx[_t]* M_ Rxx[_t]+ M_ Gamxyy[_t]* M_ Ryy[_t]+ M_ Gamxzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamxxy[_t]* M_ Rxy[_t]+ M_ Gamxxz[_t]* M_ Rxz[_t]+ M_ Gamxyz[_t]* M_ Ryz[_t]) ); + + M_ Gamy_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxy[_t]+ M_ Lapy[_t] * M_ Ryy[_t]+ M_ Lapz[_t] * M_ Ryz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxy[_t]+ M_ chiy[_t] * M_ Ryy[_t]+ M_ chiz[_t] * M_ Ryz[_t]) - + M_ gupxy[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupyy[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupyz[_t]* ( F2o3 * M_ Kz [_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamyxx[_t]* M_ Rxx[_t]+ M_ Gamyyy[_t]* M_ Ryy[_t]+ M_ Gamyzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamyxy[_t]* M_ Rxy[_t]+ M_ Gamyxz[_t]* M_ Rxz[_t]+ M_ Gamyyz[_t]* M_ Ryz[_t]) ); + + M_ Gamz_rhs[_t] = - 2 * ( M_ Lapx[_t] * M_ Rxz[_t]+ M_ Lapy[_t] * M_ Ryz[_t]+ M_ Lapz[_t] * M_ Rzz[_t]) + + 2 * M_ alpn1[_t] * ( + -F3o2/M_ chin1[_t] * ( M_ chix[_t] * M_ Rxz[_t]+ M_ chiy[_t] * M_ Ryz[_t]+ M_ chiz[_t] * M_ Rzz[_t]) - + M_ gupxz[_t]* ( F2o3 * M_ Kx[_t] + 8 * PI * M_ Sx[_t] ) - + M_ gupyz[_t]* ( F2o3 * M_ Ky[_t] + 8 * PI * M_ Sy[_t] ) - + M_ gupzz[_t]* ( F2o3 * M_ Kz[_t] + 8 * PI * M_ Sz[_t] ) + + M_ Gamzxx[_t]* M_ Rxx[_t]+ M_ Gamzyy[_t]* M_ Ryy[_t]+ M_ Gamzzz[_t]* M_ Rzz[_t] + + 2 * ( M_ Gamzxy[_t]* M_ Rxy[_t]+ M_ Gamzxz[_t]* M_ Rxz[_t]+ M_ Gamzyz[_t]* M_ Ryz[_t]) ); + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_ss_part3() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ fxx [_t]= M_ gxxx[_t]+ M_ gxyy[_t]+ M_ gxzz[_t]; + M_ fxy[_t]= M_ gxyx[_t]+ M_ gyyy[_t]+ M_ gyzz[_t]; + M_ fxz[_t]= M_ gxzx[_t]+ M_ gyzy[_t]+ M_ gzzz[_t]; + + M_ Gamxa[_t]= M_ gupxx [_t]* M_ Gamxxx [_t]+ M_ gupyy[_t]* M_ Gamxyy[_t]+ M_ gupzz[_t]* M_ Gamxzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamxxy[_t]+ M_ gupxz[_t]* M_ Gamxxz[_t]+ M_ gupyz[_t]* M_ Gamxyz[_t]); + M_ Gamya[_t]= M_ gupxx [_t]* M_ Gamyxx [_t]+ M_ gupyy[_t]* M_ Gamyyy[_t]+ M_ gupzz[_t]* M_ Gamyzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamyxy[_t]+ M_ gupxz[_t]* M_ Gamyxz[_t]+ M_ gupyz[_t]* M_ Gamyyz[_t]); + M_ Gamza[_t]= M_ gupxx [_t]* M_ Gamzxx [_t]+ M_ gupyy[_t]* M_ Gamzyy[_t]+ M_ gupzz[_t]* M_ Gamzzz[_t]+ + 2*( M_ gupxy[_t]* M_ Gamzxy[_t]+ M_ gupxz[_t]* M_ Gamzxz[_t]+ M_ gupyz[_t]* M_ Gamzyz[_t]); + + + + M_ Gamx_rhs[_t] = M_ Gamx_rhs[_t] + F2o3 * M_ Gamxa[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betaxx [_t]- M_ Gamya[_t]* M_ betaxy[_t]- M_ Gamza[_t]* M_ betaxz[_t] + + F1o3 * (M_ gupxx [_t]* M_ fxx [_t] + M_ gupxy[_t]* M_ fxy[_t] + M_ gupxz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxx [_t] + M_ gupyy[_t]* M_ gyyx [_t] + M_ gupzz[_t]* M_ gzzx [_t] + + 2 * (M_ gupxy[_t]* M_ gxyx [_t] + M_ gupxz[_t]* M_ gxzx [_t] + M_ gupyz[_t]* M_ gyzx [_t] ); + + M_ Gamy_rhs[_t] = M_ Gamy_rhs[_t] + F2o3 * M_ Gamya[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betayx [_t]- M_ Gamya[_t]* M_ betayy[_t]- M_ Gamza[_t]* M_ betayz[_t] + + F1o3 * (M_ gupxy[_t]* M_ fxx [_t] + M_ gupyy[_t]* M_ fxy[_t] + M_ gupyz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxy[_t] + M_ gupyy[_t]* M_ gyyy[_t] + M_ gupzz[_t]* M_ gzzy[_t] + + 2 * (M_ gupxy[_t]* M_ gxyy[_t] + M_ gupxz[_t]* M_ gxzy[_t] + M_ gupyz[_t]* M_ gyzy[_t] ); + + M_ Gamz_rhs[_t] = M_ Gamz_rhs[_t] + F2o3 * M_ Gamza[_t]* M_ div_beta[_t] - + M_ Gamxa[_t]* M_ betazx [_t]- M_ Gamya[_t]* M_ betazy[_t]- M_ Gamza[_t]* M_ betazz[_t] + + F1o3 * (M_ gupxz[_t]* M_ fxx [_t] + M_ gupyz[_t]* M_ fxy[_t] + M_ gupzz[_t]* M_ fxz[_t] ) + + M_ gupxx [_t]* M_ gxxz[_t] + M_ gupyy[_t]* M_ gyyz[_t] + M_ gupzz[_t]* M_ gzzz[_t] + + 2 * (M_ gupxy[_t]* M_ gxyz[_t] + M_ gupxz[_t]* M_ gxzz[_t] + M_ gupyz[_t]* M_ gyzz[_t] ) ; //rhs M_ for M_ Gam^i + + //first kind of connection stored in M_ gij,k + M_ gxxx [_t]= M_ gxx [_t]* M_ Gamxxx [_t]+ M_ gxy[_t]* M_ Gamyxx [_t]+ M_ gxz[_t]* M_ Gamzxx[_t]; + M_ gxyx [_t]= M_ gxx [_t]* M_ Gamxxy[_t]+ M_ gxy[_t]* M_ Gamyxy[_t]+ M_ gxz[_t]* M_ Gamzxy[_t]; + M_ gxzx [_t]= M_ gxx [_t]* M_ Gamxxz[_t]+ M_ gxy[_t]* M_ Gamyxz[_t]+ M_ gxz[_t]* M_ Gamzxz[_t]; + M_ gyyx [_t]= M_ gxx [_t]* M_ Gamxyy[_t]+ M_ gxy[_t]* M_ Gamyyy[_t]+ M_ gxz[_t]* M_ Gamzyy[_t]; + M_ gyzx [_t]= M_ gxx [_t]* M_ Gamxyz[_t]+ M_ gxy[_t]* M_ Gamyyz[_t]+ M_ gxz[_t]* M_ Gamzyz[_t]; + M_ gzzx [_t]= M_ gxx [_t]* M_ Gamxzz[_t]+ M_ gxy[_t]* M_ Gamyzz[_t]+ M_ gxz[_t]* M_ Gamzzz[_t]; + M_ gxxy[_t]= M_ gxy[_t]* M_ Gamxxx [_t]+ M_ gyy[_t]* M_ Gamyxx [_t]+ M_ gyz[_t]* M_ Gamzxx[_t]; + M_ gxyy[_t]= M_ gxy[_t]* M_ Gamxxy[_t]+ M_ gyy[_t]* M_ Gamyxy[_t]+ M_ gyz[_t]* M_ Gamzxy[_t]; + M_ gxzy[_t]= M_ gxy[_t]* M_ Gamxxz[_t]+ M_ gyy[_t]* M_ Gamyxz[_t]+ M_ gyz[_t]* M_ Gamzxz[_t]; + M_ gyyy[_t]= M_ gxy[_t]* M_ Gamxyy[_t]+ M_ gyy[_t]* M_ Gamyyy[_t]+ M_ gyz[_t]* M_ Gamzyy[_t]; + M_ gyzy[_t]= M_ gxy[_t]* M_ Gamxyz[_t]+ M_ gyy[_t]* M_ Gamyyz[_t]+ M_ gyz[_t]* M_ Gamzyz[_t]; + M_ gzzy[_t]= M_ gxy[_t]* M_ Gamxzz[_t]+ M_ gyy[_t]* M_ Gamyzz[_t]+ M_ gyz[_t]* M_ Gamzzz[_t]; + M_ gxxz[_t]= M_ gxz[_t]* M_ Gamxxx [_t]+ M_ gyz[_t]* M_ Gamyxx [_t]+ M_ gzz[_t]* M_ Gamzxx[_t]; + M_ gxyz[_t]= M_ gxz[_t]* M_ Gamxxy[_t]+ M_ gyz[_t]* M_ Gamyxy[_t]+ M_ gzz[_t]* M_ Gamzxy[_t]; + M_ gxzz[_t]= M_ gxz[_t]* M_ Gamxxz[_t]+ M_ gyz[_t]* M_ Gamyxz[_t]+ M_ gzz[_t]* M_ Gamzxz[_t]; + M_ gyyz[_t]= M_ gxz[_t]* M_ Gamxyy[_t]+ M_ gyz[_t]* M_ Gamyyy[_t]+ M_ gzz[_t]* M_ Gamzyy[_t]; + M_ gyzz[_t]= M_ gxz[_t]* M_ Gamxyz[_t]+ M_ gyz[_t]* M_ Gamyyz[_t]+ M_ gzz[_t]* M_ Gamzyz[_t]; + M_ gzzz[_t]= M_ gxz[_t]* M_ Gamxzz[_t]+ M_ gyz[_t]* M_ Gamyzz[_t]+ M_ gzz[_t]* M_ Gamzzz[_t]; + + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_ss_part4() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ Rxx [_t]= - HALF *M_ Rxx [_t] + + M_ gxx [_t]* M_ Gamxx[_t] +M_ gxy[_t]* M_ Gamyx [_t] + M_ gxz[_t]* M_ Gamzx [_t]+ + M_ Gamxa[_t]*M_ gxxx [_t]+ M_ Gamya[_t]*M_ gxyx [_t]+ M_ Gamza[_t]*M_ gxzx [_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxx [_t]*M_ gxxx [_t]+ M_ Gamyxx [_t]*M_ gxyx [_t]+ M_ Gamzxx [_t]*M_ gxzx[_t]) + + M_ Gamxxx [_t]*M_ gxxx [_t]+ M_ Gamyxx [_t]*M_ gxxy[_t]+ M_ Gamzxx [_t]*M_ gxxz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gyyx [_t]+ M_ Gamzxx [_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxyx [_t]+ M_ Gamzxy[_t]*M_ gxzx[_t]) + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxxy[_t]+ M_ Gamzxy[_t]*M_ gxxz[_t] + + M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxyz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gyzx [_t]+ M_ Gamzxx [_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxyx [_t]+ M_ Gamzxz[_t]*M_ gxzx[_t]) + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxxy[_t]+ M_ Gamzxz[_t]*M_ gxxz[_t] + + M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gxzy[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gyyx [_t]+ M_ Gamzxy[_t]*M_ gyzx[_t]) + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gyzx [_t]+ M_ Gamzxy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gyyx [_t]+ M_ Gamzxz[_t]*M_ gyzx[_t]) + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gyzx [_t]+ M_ Gamzxz[_t]*M_ gzzx[_t]) + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t]); + + M_ Ryy[_t]= - HALF *M_ Ryy[_t] + + M_ gxy[_t]* M_ Gamxy[_t]+ M_ gyy[_t]* M_ Gamyy[_t] + M_ gyz[_t]* M_ Gamzy[_t] + + M_ Gamxa[_t]*M_ gxyy[_t]+ M_ Gamya[_t]*M_ gyyy[_t]+ M_ Gamza[_t]*M_ gyzy[_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxy[_t]*M_ gxxy[_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxzy[_t]) + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxyy[_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxxy[_t]+ M_ Gamyyy[_t]*M_ gxyy[_t]+ M_ Gamzyy[_t]*M_ gxzy[_t]) + + M_ Gamxyy[_t]*M_ gxyx [_t]+ M_ Gamyyy[_t]*M_ gxyy[_t]+ M_ Gamzyy[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gyyx [_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyyz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxy[_t]*M_ gxzy[_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxxy[_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxzy[_t]) + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxyy[_t]*M_ gxyy[_t]+ M_ Gamyyy[_t]*M_ gyyy[_t]+ M_ Gamzyy[_t]*M_ gyzy[_t]) + + M_ Gamxyy[_t]*M_ gyyx [_t]+ M_ Gamyyy[_t]*M_ gyyy[_t]+ M_ Gamzyy[_t]*M_ gyyz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxyy[_t]*M_ gxzy[_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxyy[_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyzy[_t]) + + M_ Gamxyz[_t]*M_ gyyx [_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyyz[_t] + + M_ Gamxyy[_t]*M_ gyzx [_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxzy[_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gzzy[_t]) + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t]); + + M_ Rzz[_t]= - HALF *M_ Rzz[_t] + + M_ gxz[_t]* M_ Gamxz[_t] +M_ gyz[_t]* M_ Gamyz[_t] + M_ gzz[_t]* M_ Gamzz[_t] + + M_ Gamxa[_t]*M_ gxzz[_t]+ M_ Gamya[_t]*M_ gyzz[_t]+ M_ Gamza[_t]*M_ gzzz[_t] + + M_ gupxx [_t]*( + 2*(M_ Gamxxz[_t]*M_ gxxz[_t]+ M_ Gamyxz[_t]*M_ gxyz[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t]) + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxyz[_t]+ M_ Gamyxz[_t]*M_ gyyz[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxxz[_t]+ M_ Gamyyz[_t]*M_ gxyz[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t]) + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gxzy[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + 2*(M_ Gamxxz[_t]*M_ gxzz[_t]+ M_ Gamyxz[_t]*M_ gyzz[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxxz[_t]+ M_ Gamyzz[_t]*M_ gxyz[_t]+ M_ Gamzzz[_t]*M_ gxzz[_t]) + + M_ Gamxzz[_t]*M_ gxzx [_t]+ M_ Gamyzz[_t]*M_ gxzy[_t]+ M_ Gamzzz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gzzx [_t]+ M_ Gamyxz[_t]*M_ gzzy[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxyz[_t]+ M_ Gamyyz[_t]*M_ gyyz[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t]) + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + 2*(M_ Gamxyz[_t]*M_ gxzz[_t]+ M_ Gamyyz[_t]*M_ gyzz[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxyz[_t]+ M_ Gamyzz[_t]*M_ gyyz[_t]+ M_ Gamzzz[_t]*M_ gyzz[_t]) + + M_ Gamxzz[_t]*M_ gyzx [_t]+ M_ Gamyzz[_t]*M_ gyzy[_t]+ M_ Gamzzz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gzzx [_t]+ M_ Gamyyz[_t]*M_ gzzy[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + 2*(M_ Gamxzz[_t]*M_ gxzz[_t]+ M_ Gamyzz[_t]*M_ gyzz[_t]+ M_ Gamzzz[_t]*M_ gzzz[_t]) + + M_ Gamxzz[_t]*M_ gzzx [_t]+ M_ Gamyzz[_t]*M_ gzzy[_t]+ M_ Gamzzz[_t]*M_ gzzz[_t]); + + M_ Rxy[_t]= HALF*( -M_ Rxy[_t] + + M_ gxx [_t]* M_ Gamxy[_t]+ M_ gxy[_t]* M_ Gamyy[_t]+M_ gxz[_t]* M_ Gamzy[_t] + + M_ gxy[_t]* M_ Gamxx [_t]+ M_ gyy[_t]* M_ Gamyx [_t]+M_ gyz[_t]* M_ Gamzx [_t] + + M_ Gamxa[_t]*M_ gxyx [_t]+ M_ Gamya[_t]*M_ gyyx [_t]+ M_ Gamza[_t]*M_ gyzx [_t] + + M_ Gamxa[_t]*M_ gxxy[_t]+ M_ Gamya[_t]*M_ gxyy[_t]+ M_ Gamza[_t]*M_ gxzy[_t])+ + M_ gupxx [_t]*( + M_ Gamxxx [_t]*M_ gxxy[_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gxxx [_t]+ M_ Gamyxy[_t]*M_ gxyx [_t]+ M_ Gamzxy[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gxyx [_t]+ M_ Gamyxx [_t]*M_ gxyy[_t]+ M_ Gamzxx [_t]*M_ gxyz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxx [_t]*M_ gxyy[_t]+ M_ Gamyxx [_t]*M_ gyyy[_t]+ M_ Gamzxx [_t]*M_ gyzy[_t] + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gyyx [_t]+ M_ Gamzxy[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxyx [_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxyz[_t] + + M_ Gamxxy[_t]*M_ gxxy[_t]+ M_ Gamyxy[_t]*M_ gxyy[_t]+ M_ Gamzxy[_t]*M_ gxzy[_t] + + M_ Gamxyy[_t]*M_ gxxx [_t]+ M_ Gamyyy[_t]*M_ gxyx [_t]+ M_ Gamzyy[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyyx [_t]+ M_ Gamyxx [_t]*M_ gyyy[_t]+ M_ Gamzxx [_t]*M_ gyyz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxx [_t]*M_ gxzy[_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gzzy[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gyzx [_t]+ M_ Gamzxy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxyz[_t] + + M_ Gamxxz[_t]*M_ gxxy[_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxzy[_t] + + M_ Gamxyz[_t]*M_ gxxx [_t]+ M_ Gamyyz[_t]*M_ gxyx [_t]+ M_ Gamzyz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyzx [_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxxy[_t]*M_ gxyy[_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxyx [_t]+ M_ Gamyyy[_t]*M_ gyyx [_t]+ M_ Gamzyy[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyyx [_t]+ M_ Gamyxy[_t]*M_ gyyy[_t]+ M_ Gamzxy[_t]*M_ gyyz[_t])+ + M_ gupyz[_t]*( + M_ Gamxxy[_t]*M_ gxzy[_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gzzy[_t] + + M_ Gamxyy[_t]*M_ gxzx [_t]+ M_ Gamyyy[_t]*M_ gyzx [_t]+ M_ Gamzyy[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyyx [_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyyz[_t] + + M_ Gamxxz[_t]*M_ gxyy[_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyzy[_t] + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gyyx [_t]+ M_ Gamzyz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxxz[_t]*M_ gxzy[_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gyzx [_t]+ M_ Gamzyz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t]); + + M_ Rxz[_t]= HALF*( -M_ Rxz[_t] + + M_ gxx [_t]* M_ Gamxz[_t]+ M_ gxy[_t]* M_ Gamyz[_t]+M_ gxz[_t]* M_ Gamzz[_t] + + M_ gxz[_t]* M_ Gamxx [_t]+ M_ gyz[_t]* M_ Gamyx [_t]+M_ gzz[_t]* M_ Gamzx [_t] + + M_ Gamxa[_t]*M_ gxzx [_t]+ M_ Gamya[_t]*M_ gyzx [_t]+ M_ Gamza[_t]*M_ gzzx [_t] + + M_ Gamxa[_t]*M_ gxxz[_t]+ M_ Gamya[_t]*M_ gxyz[_t]+ M_ Gamza[_t]*M_ gxzz[_t])+ + M_ gupxx [_t]*( + M_ Gamxxx [_t]*M_ gxxz[_t]+ M_ Gamyxx [_t]*M_ gxyz[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxx [_t]+ M_ Gamyxz[_t]*M_ gxyx [_t]+ M_ Gamzxz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gxzx [_t]+ M_ Gamyxx [_t]*M_ gxzy[_t]+ M_ Gamzxx [_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxx [_t]*M_ gxyz[_t]+ M_ Gamyxx [_t]*M_ gyyz[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyx [_t]+ M_ Gamyxz[_t]*M_ gyyx [_t]+ M_ Gamzxz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxxy[_t]*M_ gxxz[_t]+ M_ Gamyxy[_t]*M_ gxyz[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxx [_t]+ M_ Gamyyz[_t]*M_ gxyx [_t]+ M_ Gamzyz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gyzx [_t]+ M_ Gamyxx [_t]*M_ gyzy[_t]+ M_ Gamzxx [_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxx [_t]*M_ gxzz[_t]+ M_ Gamyxx [_t]*M_ gyzz[_t]+ M_ Gamzxx [_t]*M_ gzzz[_t] + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gyzx [_t]+ M_ Gamzxz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gxzx [_t]+ M_ Gamyxz[_t]*M_ gxzy[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxz[_t]+ M_ Gamyxz[_t]*M_ gxyz[_t]+ M_ Gamzxz[_t]*M_ gxzz[_t] + + M_ Gamxzz[_t]*M_ gxxx [_t]+ M_ Gamyzz[_t]*M_ gxyx [_t]+ M_ Gamzzz[_t]*M_ gxzx [_t] + + M_ Gamxxx [_t]*M_ gzzx [_t]+ M_ Gamyxx [_t]*M_ gzzy[_t]+ M_ Gamzxx [_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxxy[_t]*M_ gxyz[_t]+ M_ Gamyxy[_t]*M_ gyyz[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyx [_t]+ M_ Gamyyz[_t]*M_ gyyx [_t]+ M_ Gamzyz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + M_ Gamxxy[_t]*M_ gxzz[_t]+ M_ Gamyxy[_t]*M_ gyzz[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gyzx [_t]+ M_ Gamzyz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gyzx [_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyz[_t]+ M_ Gamyxz[_t]*M_ gyyz[_t]+ M_ Gamzxz[_t]*M_ gyzz[_t] + + M_ Gamxzz[_t]*M_ gxyx [_t]+ M_ Gamyzz[_t]*M_ gyyx [_t]+ M_ Gamzzz[_t]*M_ gyzx [_t] + + M_ Gamxxy[_t]*M_ gzzx [_t]+ M_ Gamyxy[_t]*M_ gzzy[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxxz[_t]*M_ gxzz[_t]+ M_ Gamyxz[_t]*M_ gyzz[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxzx [_t]+ M_ Gamyzz[_t]*M_ gyzx [_t]+ M_ Gamzzz[_t]*M_ gzzx [_t] + + M_ Gamxxz[_t]*M_ gzzx [_t]+ M_ Gamyxz[_t]*M_ gzzy[_t]+ M_ Gamzxz[_t]*M_ gzzz[_t]); + + M_ Ryz[_t]= HALF*( -M_ Ryz[_t] + + M_ gxy[_t]* M_ Gamxz[_t]+M_ gyy[_t]* M_ Gamyz[_t]+M_ gyz[_t]* M_ Gamzz[_t] + + M_ gxz[_t]* M_ Gamxy[_t]+M_ gyz[_t]* M_ Gamyy[_t]+M_ gzz[_t]* M_ Gamzy[_t] + + M_ Gamxa[_t]*M_ gxzy[_t]+ M_ Gamya[_t]*M_ gyzy[_t]+ M_ Gamza[_t]*M_ gzzy[_t] + + M_ Gamxa[_t]*M_ gxyz[_t]+ M_ Gamya[_t]*M_ gyyz[_t]+ M_ Gamza[_t]*M_ gyzz[_t])+ + M_ gupxx [_t]*( + M_ Gamxxy[_t]*M_ gxxz[_t]+ M_ Gamyxy[_t]*M_ gxyz[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t] + + M_ Gamxxz[_t]*M_ gxxy[_t]+ M_ Gamyxz[_t]*M_ gxyy[_t]+ M_ Gamzxz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gxzx [_t]+ M_ Gamyxy[_t]*M_ gxzy[_t]+ M_ Gamzxy[_t]*M_ gxzz[_t])+ + M_ gupxy[_t]*( + M_ Gamxxy[_t]*M_ gxyz[_t]+ M_ Gamyxy[_t]*M_ gyyz[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t] + + M_ Gamxxz[_t]*M_ gxyy[_t]+ M_ Gamyxz[_t]*M_ gyyy[_t]+ M_ Gamzxz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gxzx [_t]+ M_ Gamyyy[_t]*M_ gxzy[_t]+ M_ Gamzyy[_t]*M_ gxzz[_t] + + M_ Gamxyy[_t]*M_ gxxz[_t]+ M_ Gamyyy[_t]*M_ gxyz[_t]+ M_ Gamzyy[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxy[_t]+ M_ Gamyyz[_t]*M_ gxyy[_t]+ M_ Gamzyz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gyzx [_t]+ M_ Gamyxy[_t]*M_ gyzy[_t]+ M_ Gamzxy[_t]*M_ gyzz[_t])+ + M_ gupxz[_t]*( + M_ Gamxxy[_t]*M_ gxzz[_t]+ M_ Gamyxy[_t]*M_ gyzz[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t] + + M_ Gamxxz[_t]*M_ gxzy[_t]+ M_ Gamyxz[_t]*M_ gyzy[_t]+ M_ Gamzxz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gxzx [_t]+ M_ Gamyyz[_t]*M_ gxzy[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxyz[_t]*M_ gxxz[_t]+ M_ Gamyyz[_t]*M_ gxyz[_t]+ M_ Gamzyz[_t]*M_ gxzz[_t] + + M_ Gamxzz[_t]*M_ gxxy[_t]+ M_ Gamyzz[_t]*M_ gxyy[_t]+ M_ Gamzzz[_t]*M_ gxzy[_t] + + M_ Gamxxy[_t]*M_ gzzx [_t]+ M_ Gamyxy[_t]*M_ gzzy[_t]+ M_ Gamzxy[_t]*M_ gzzz[_t])+ + M_ gupyy[_t]*( + M_ Gamxyy[_t]*M_ gxyz[_t]+ M_ Gamyyy[_t]*M_ gyyz[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyy[_t]+ M_ Gamyyz[_t]*M_ gyyy[_t]+ M_ Gamzyz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gyzx [_t]+ M_ Gamyyy[_t]*M_ gyzy[_t]+ M_ Gamzyy[_t]*M_ gyzz[_t])+ + M_ gupyz[_t]*( + M_ Gamxyy[_t]*M_ gxzz[_t]+ M_ Gamyyy[_t]*M_ gyzz[_t]+ M_ Gamzyy[_t]*M_ gzzz[_t] + + M_ Gamxyz[_t]*M_ gxzy[_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gyzx [_t]+ M_ Gamyyz[_t]*M_ gyzy[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t] + + M_ Gamxyz[_t]*M_ gxyz[_t]+ M_ Gamyyz[_t]*M_ gyyz[_t]+ M_ Gamzyz[_t]*M_ gyzz[_t] + + M_ Gamxzz[_t]*M_ gxyy[_t]+ M_ Gamyzz[_t]*M_ gyyy[_t]+ M_ Gamzzz[_t]*M_ gyzy[_t] + + M_ Gamxyy[_t]*M_ gzzx [_t]+ M_ Gamyyy[_t]*M_ gzzy[_t]+ M_ Gamzyy[_t]*M_ gzzz[_t])+ + M_ gupzz[_t]*( + M_ Gamxyz[_t]*M_ gxzz[_t]+ M_ Gamyyz[_t]*M_ gyzz[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t] + + M_ Gamxzz[_t]*M_ gxzy[_t]+ M_ Gamyzz[_t]*M_ gyzy[_t]+ M_ Gamzzz[_t]*M_ gzzy[_t] + + M_ Gamxyz[_t]*M_ gzzx [_t]+ M_ Gamyyz[_t]*M_ gzzy[_t]+ M_ Gamzyz[_t]*M_ gzzz[_t]); + + _t += STEP_SIZE; + } +} +__global__ void compute_rhs_ss_part5() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ fxx [_t]=M_ fxx [_t]- M_ Gamxxx [_t]* M_ chix [_t]- M_ Gamyxx [_t]* M_ chiy[_t]- M_ Gamzxx [_t]* M_ chiz[_t]; + M_ fxy[_t]=M_ fxy[_t]- M_ Gamxxy[_t]* M_ chix [_t]- M_ Gamyxy[_t]* M_ chiy[_t]- M_ Gamzxy[_t]* M_ chiz[_t]; + M_ fxz[_t]=M_ fxz[_t]- M_ Gamxxz[_t]* M_ chix [_t]- M_ Gamyxz[_t]* M_ chiy[_t]- M_ Gamzxz[_t]* M_ chiz[_t]; + M_ fyy[_t]=M_ fyy[_t]- M_ Gamxyy[_t]* M_ chix [_t]- M_ Gamyyy[_t]* M_ chiy[_t]- M_ Gamzyy[_t]* M_ chiz[_t]; + M_ fyz[_t]=M_ fyz[_t]- M_ Gamxyz[_t]* M_ chix [_t]- M_ Gamyyz[_t]* M_ chiy[_t]- M_ Gamzyz[_t]* M_ chiz[_t]; + M_ fzz[_t]=M_ fzz[_t]- M_ Gamxzz[_t]* M_ chix [_t]- M_ Gamyzz[_t]* M_ chiy[_t]- M_ Gamzzz[_t]* M_ chiz[_t]; + // M_ Store D^l D_l M_ chi - 3/(2*M_ chi) D^l M_ chi D_l M_ chi inM_ f[_t] + + M_ f[_t] = M_ gupxx [_t]* (M_ fxx [_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chix [_t]) + + M_ gupyy[_t]* (M_ fyy[_t]- F3o2/M_ chin1[_t] * M_ chiy[_t]* M_ chiy[_t]) + + M_ gupzz[_t]* (M_ fzz[_t]- F3o2/M_ chin1[_t] * M_ chiz[_t]* M_ chiz[_t]) + + 2 *M_ gupxy[_t]* (M_ fxy[_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chiy[_t]) + + 2 *M_ gupxz[_t]* (M_ fxz[_t]- F3o2/M_ chin1[_t] * M_ chix [_t]* M_ chiz[_t]) + + 2 *M_ gupyz[_t]* (M_ fyz[_t]- F3o2/M_ chin1[_t] * M_ chiy[_t]* M_ chiz[_t]); + // M_ Add M_ chi part toM_ Ricci tensor: + + M_ Rxx [_t]=M_ Rxx [_t]+ (M_ fxx [_t]- M_ chix[_t]*M_ chix[_t]/M_ chin1[_t]/2 +M_ gxx [_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Ryy[_t]=M_ Ryy[_t]+ (M_ fyy[_t]- M_ chiy[_t]*M_ chiy[_t]/M_ chin1[_t]/2 +M_ gyy[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rzz[_t]=M_ Rzz[_t]+ (M_ fzz[_t]- M_ chiz[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gzz[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rxy[_t]=M_ Rxy[_t]+ (M_ fxy[_t]- M_ chix[_t]*M_ chiy[_t]/M_ chin1[_t]/2 +M_ gxy[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Rxz[_t]=M_ Rxz[_t]+ (M_ fxz[_t]- M_ chix[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gxz[_t]*M_ f[_t])/M_ chin1[_t]/2; + M_ Ryz[_t]=M_ Ryz[_t]+ (M_ fyz[_t]- M_ chiy[_t]*M_ chiz[_t]/M_ chin1[_t]/2 +M_ gyz[_t]*M_ f[_t])/M_ chin1[_t]/2; + + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_ss_part6() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ gxxx [_t]= (M_ gupxx [_t]* M_ chix [_t]+M_ gupxy[_t]* M_ chiy[_t]+M_ gupxz[_t]* M_ chiz[_t])/M_ chin1[_t]; + M_ gxxy[_t]= (M_ gupxy[_t]* M_ chix [_t]+M_ gupyy[_t]* M_ chiy[_t]+M_ gupyz[_t]* M_ chiz[_t])/M_ chin1[_t]; + M_ gxxz[_t]= (M_ gupxz[_t]* M_ chix [_t]+M_ gupyz[_t]* M_ chiy[_t]+M_ gupzz[_t]* M_ chiz[_t])/M_ chin1[_t]; + // nowM_ get physical second kind of connection + M_ Gamxxx [_t]= M_ Gamxxx [_t]- ( (M_ chix [_t]+ M_ chix[_t])/M_ chin1[_t] -M_ gxx [_t]*M_ gxxx [_t])*HALF; + M_ Gamyxx [_t]= M_ Gamyxx [_t]- ( -M_ gxx [_t]*M_ gxxy[_t])*HALF; + M_ Gamzxx [_t]= M_ Gamzxx [_t]- ( -M_ gxx [_t]*M_ gxxz[_t])*HALF; + M_ Gamxyy[_t]= M_ Gamxyy[_t]- ( -M_ gyy[_t]*M_ gxxx [_t])*HALF; + M_ Gamyyy[_t]= M_ Gamyyy[_t]- ( (M_ chiy[_t]+ M_ chiy[_t])/M_ chin1[_t] -M_ gyy[_t]*M_ gxxy[_t])*HALF; + M_ Gamzyy[_t]= M_ Gamzyy[_t]- ( -M_ gyy[_t]*M_ gxxz[_t])*HALF; + M_ Gamxzz[_t]= M_ Gamxzz[_t]- ( -M_ gzz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyzz[_t]= M_ Gamyzz[_t]- ( -M_ gzz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzzz[_t]= M_ Gamzzz[_t]- ( (M_ chiz[_t]+ M_ chiz[_t])/M_ chin1[_t] -M_ gzz[_t]*M_ gxxz[_t])*HALF; + M_ Gamxxy[_t]= M_ Gamxxy[_t]- ( M_ chiy[_t] /M_ chin1[_t] -M_ gxy[_t]*M_ gxxx [_t])*HALF; + M_ Gamyxy[_t]= M_ Gamyxy[_t]- ( M_ chix [_t]/M_ chin1[_t] -M_ gxy[_t]*M_ gxxy[_t])*HALF; + M_ Gamzxy[_t]= M_ Gamzxy[_t]- ( -M_ gxy[_t]*M_ gxxz[_t])*HALF; + M_ Gamxxz[_t]= M_ Gamxxz[_t]- ( M_ chiz[_t] /M_ chin1[_t] -M_ gxz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyxz[_t]= M_ Gamyxz[_t]- ( -M_ gxz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzxz[_t]= M_ Gamzxz[_t]- ( M_ chix [_t]/M_ chin1[_t] -M_ gxz[_t]*M_ gxxz[_t])*HALF; + M_ Gamxyz[_t]= M_ Gamxyz[_t]- ( -M_ gyz[_t]*M_ gxxx [_t])*HALF; + M_ Gamyyz[_t]= M_ Gamyyz[_t]- ( M_ chiz[_t] /M_ chin1[_t] -M_ gyz[_t]*M_ gxxy[_t])*HALF; + M_ Gamzyz[_t]= M_ Gamzyz[_t]- ( M_ chiy[_t]/M_ chin1[_t] -M_ gyz[_t]*M_ gxxz[_t])*HALF; + + M_ fxx [_t]=M_ fxx [_t]- M_ Gamxxx[_t]*M_ Lapx [_t]- M_ Gamyxx[_t]*M_ Lapy[_t]- M_ Gamzxx[_t]*M_ Lapz[_t]; + M_ fyy[_t]=M_ fyy[_t]- M_ Gamxyy[_t]*M_ Lapx [_t]- M_ Gamyyy[_t]*M_ Lapy[_t]- M_ Gamzyy[_t]*M_ Lapz[_t]; + M_ fzz[_t]=M_ fzz[_t]- M_ Gamxzz[_t]*M_ Lapx [_t]- M_ Gamyzz[_t]*M_ Lapy[_t]- M_ Gamzzz[_t]*M_ Lapz[_t]; + M_ fxy[_t]=M_ fxy[_t]- M_ Gamxxy[_t]*M_ Lapx [_t]- M_ Gamyxy[_t]*M_ Lapy[_t]- M_ Gamzxy[_t]*M_ Lapz[_t]; + M_ fxz[_t]=M_ fxz[_t]- M_ Gamxxz[_t]*M_ Lapx [_t]- M_ Gamyxz[_t]*M_ Lapy[_t]- M_ Gamzxz[_t]*M_ Lapz[_t]; + M_ fyz[_t]=M_ fyz[_t]- M_ Gamxyz[_t]*M_ Lapx [_t]- M_ Gamyyz[_t]*M_ Lapy[_t]- M_ Gamzyz[_t]*M_ Lapz[_t]; + + // store D^i D_i Lap in M_ trK_rhs[_t] upto M_ chi + M_ trK_rhs[_t] = M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t]+ + 2* (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]); + // M_ Add lapse and M_ S_ij parts toM_ Ricci tensor: + + M_ fxx [_t]= M_ alpn1[_t]* (M_ Rxx [_t]- 8 * PI * M_ Sxx[_t]) -M_ fxx[_t]; + M_ fxy[_t]= M_ alpn1[_t]* (M_ Rxy[_t]- 8 * PI * M_ Sxy[_t]) -M_ fxy[_t]; + M_ fxz[_t]= M_ alpn1[_t]* (M_ Rxz[_t]- 8 * PI * M_ Sxz[_t]) -M_ fxz[_t]; + M_ fyy[_t]= M_ alpn1[_t]* (M_ Ryy[_t]- 8 * PI * M_ Syy[_t]) -M_ fyy[_t]; + M_ fyz[_t]= M_ alpn1[_t]* (M_ Ryz[_t]- 8 * PI * M_ Syz[_t]) -M_ fyz[_t]; + M_ fzz[_t]= M_ alpn1[_t]* (M_ Rzz[_t]- 8 * PI * M_ Szz[_t]) -M_ fzz[_t]; + + // Compute trace-free part (note: M_ chi^-1 and M_ chi cancel//): + + M_ f[_t] = F1o3 *( M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t]+ + 2* (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]) ); + + M_ Axx_rhs[_t] =M_ fxx [_t]-M_ gxx [_t]*M_ f[_t]; + M_ Ayy_rhs[_t] =M_ fyy[_t]-M_ gyy[_t]*M_ f[_t]; + M_ Azz_rhs[_t] =M_ fzz[_t]-M_ gzz[_t]*M_ f[_t]; + M_ Axy_rhs[_t] =M_ fxy[_t]-M_ gxy[_t]*M_ f[_t]; + M_ Axz_rhs[_t] =M_ fxz[_t]-M_ gxz[_t]*M_ f[_t]; + M_ Ayz_rhs[_t] =M_ fyz[_t]-M_ gyz[_t]*M_ f[_t]; + + // Now: store M_ A_il M_ A^l_j intoM_ fij: + + M_ fxx [_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axx [_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Axy[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Axz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axx [_t]* M_ Axy[_t]+M_ gupxz[_t]* M_ Axx [_t]* M_ Axz[_t]+M_ gupyz[_t]* M_ Axy[_t]* M_ Axz[_t]); + + M_ fyy[_t]= M_ gupxx [_t]* M_ Axy[_t]* M_ Axy[_t]+M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayy[_t]+M_ gupzz[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axy[_t]* M_ Ayy[_t]+M_ gupxz[_t]* M_ Axy[_t]* M_ Ayz[_t]+M_ gupyz[_t]* M_ Ayy[_t]* M_ Ayz[_t]); + + M_ fzz[_t]= M_ gupxx [_t]* M_ Axz[_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Ayz[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Azz[_t]* M_ Azz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axz[_t]* M_ Ayz[_t]+M_ gupxz[_t]* M_ Axz[_t]* M_ Azz[_t]+M_ gupyz[_t]* M_ Ayz[_t]* M_ Azz[_t]); + + M_ fxy[_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axy[_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Ayy[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Ayz[_t]+ + M_ gupxy[_t]*(M_ Axx [_t]* M_ Ayy[_t]+ M_ Axy[_t]* M_ Axy[_t]) + + M_ gupxz[_t]*(M_ Axx [_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Axy[_t]) + + M_ gupyz[_t]*(M_ Axy[_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Ayy[_t]); + M_ fxz[_t]= M_ gupxx [_t]* M_ Axx [_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Axy[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Axz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]*(M_ Axx [_t]* M_ Ayz[_t]+ M_ Axy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]*(M_ Axx [_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]*(M_ Axy[_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Ayz[_t]); + M_ fyz[_t]= M_ gupxx [_t]* M_ Axy[_t]* M_ Axz[_t]+M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayz[_t]+M_ gupzz[_t]* M_ Ayz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]*(M_ Axy[_t]* M_ Ayz[_t]+ M_ Ayy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]*(M_ Axy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]*(M_ Ayy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Ayz[_t]); + + M_ f[_t] = M_ chin1[_t]; + // store D^i D_i Lap in M_ trK_rhs[_t] + M_ trK_rhs[_t] =M_ f[_t]*M_ trK_rhs[_t]; + + M_ Axx_rhs[_t] = M_ f[_t] * M_ Axx_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Axx [_t]- 2 *M_ fxx[_t]) + + 2 * ( M_ Axx [_t]* M_ betaxx [_t]+ M_ Axy[_t]* M_ betayx [_t]+ M_ Axz[_t]* M_ betazx [_t])- + F2o3 * M_ Axx [_t]* M_ div_beta[_t]; + + M_ Ayy_rhs[_t] = M_ f[_t] * M_ Ayy_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Ayy[_t]- 2 *M_ fyy[_t]) + + 2 * ( M_ Axy[_t]* M_ betaxy[_t]+ M_ Ayy[_t]* M_ betayy[_t]+ M_ Ayz[_t]* M_ betazy[_t])- + F2o3 * M_ Ayy[_t]* M_ div_beta[_t]; + + M_ Azz_rhs[_t] = M_ f[_t] * M_ Azz_rhs[_t]+ M_ alpn1[_t]* (M_ trK[_t]* M_ Azz[_t]- 2 *M_ fzz[_t]) + + 2 * ( M_ Axz[_t]* M_ betaxz[_t]+ M_ Ayz[_t]* M_ betayz[_t]+ M_ Azz[_t]* M_ betazz[_t])- + F2o3 * M_ Azz[_t]* M_ div_beta[_t]; + + M_ Axy_rhs[_t] = M_ f[_t] * M_ Axy_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Axy[_t] - 2 *M_ fxy[_t])+ + M_ Axx [_t]* M_ betaxy[_t] + M_ Axz[_t]* M_ betazy[_t] + + M_ Ayy[_t]* M_ betayx [_t]+ M_ Ayz[_t]* M_ betazx [_t] + + F1o3 * M_ Axy[_t]* M_ div_beta[_t] - M_ Axy[_t]* M_ betazz[_t]; + + M_ Ayz_rhs[_t] = M_ f[_t] * M_ Ayz_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Ayz[_t] - 2 *M_ fyz[_t])+ + M_ Axy[_t]* M_ betaxz[_t]+ M_ Ayy[_t]* M_ betayz[_t] + + M_ Axz[_t]* M_ betaxy[_t] + M_ Azz[_t]* M_ betazy[_t] + + F1o3 * M_ Ayz[_t]* M_ div_beta[_t] - M_ Ayz[_t]* M_ betaxx[_t]; + + M_ Axz_rhs[_t] = M_ f[_t] * M_ Axz_rhs[_t]+ M_ alpn1[_t]*( M_ trK[_t]* M_ Axz[_t] - 2 *M_ fxz[_t])+ + M_ Axx [_t]* M_ betaxz[_t]+ M_ Axy[_t]* M_ betayz[_t] + + M_ Ayz[_t]* M_ betayx [_t]+ M_ Azz[_t]* M_ betazx [_t] + + F1o3 * M_ Axz[_t]* M_ div_beta[_t] - M_ Axz[_t]* M_ betayy[_t] ; //rhsM_ for M_ Aij + + // Compute trace of M_ S_ij + + M_ S[_t] = M_ f[_t] * (M_ gupxx [_t]* M_ Sxx [_t]+M_ gupyy[_t]* M_ Syy[_t]+M_ gupzz[_t]* M_ Szz[_t]+ + 2 * (M_ gupxy[_t]* M_ Sxy[_t]+M_ gupxz[_t]* M_ Sxz[_t]+M_ gupyz[_t]* M_ Syz[_t]) ); + + M_ trK_rhs[_t] = - M_ trK_rhs[_t] + M_ alpn1[_t]*( F1o3 * M_ trK[_t]* M_ trK[_t] + + M_ gupxx [_t]*M_ fxx [_t]+M_ gupyy[_t]*M_ fyy[_t]+M_ gupzz[_t]*M_ fzz[_t] + + 2 * (M_ gupxy[_t]*M_ fxy[_t]+M_ gupxz[_t]*M_ fxz[_t]+M_ gupyz[_t]*M_ fyz[_t]) + + 4 * PI * ( M_ rho[_t] + M_ S[_t] )) ; //rhsM_ for M_ trK[_t] + + ////////M_ gauge variable part + + M_ Lap_rhs[_t] = -2*M_ alpn1[_t] * M_ trK[_t]; + +#if (GAUGE == 0) + M_ betax_rhs[_t] =0.75*M_ dtSfx[_t]; + M_ betay_rhs[_t] =0.75*M_ dtSfy[_t]; + M_ betaz_rhs[_t] =0.75*M_ dtSfz[_t]; + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] -2*M_ dtSfx[_t]; + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] -2*M_ dtSfy[_t]; + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] -2*M_ dtSfz[_t]; + +#elif (GAUGE == 1) + M_ betax_rhs[_t] =M_ Gamx[_t] - 2 * M_ betax[_t] ; + + M_ betay_rhs[_t] =M_ Gamy[_t] - 2 * M_ betay[_t] ; + + M_ betaz_rhs[_t] =M_ Gamz[_t] - 2 * M_ betaz[_t] ; + + M_ dtSfx_rhs[_t] = 0; + M_ dtSfy_rhs[_t] = 0; + M_ dtSfz_rhs[_t] = 0; + +#elif (GAUGE == 2 || GAUGE == 3) + + M_ betax_rhs[_t] = 0.75* M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75* M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ dtSfz[_t]; + +#elif (GAUGE == 6) + if(BHN==2) + { + int k = _t / _2D_SIZE[0]; + int ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + r1 = ( pow2((Porg[0]-X[i]))+ pow2((Porg[1]-Y[j]))+ pow2((Porg[2]-Z[k])) ) / + + ( pow2((Porg[0]-Porg[3]))+ pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + r2 = ( pow2((Porg[3]-X[i])) + pow2((Porg[4]-Y[j])) + pow2((Porg[5]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + reta[i+ j*_1D_SIZE[0]+ k*_2D_SIZE[0] ] = A + C1/(1 + 12 * r1) + C2/(1 + 12 *r2); + }//BHN == 2 + + M_ betax_rhs[_t] = 0.75*M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75*M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75*M_ dtSfz[_t]; + + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t] * M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t] * M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t] * M_ dtSfz[_t]; + +#elif (GAUGE == 7) + if(BHN==2){ + int k = _t / _2D_SIZE[0]; + int ps = _t - (_2D_SIZE[0] * k); //TOTRY: = curr % _2D_SIZE[0]; + int j = ps / ex_c[0]; + int i = ps - (j * ex_c[0]); + + r1 = ( pow2((Porg[0]-X[i])) + pow2((Porg[1]-Y[j])) + pow2((Porg[2]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + r2 = ( pow2((Porg[3]-X[i])) + pow2((Porg[4]-Y[j])) + pow2((Porg[5]-Z[k])) )/ + + ( pow2((Porg[0]-Porg[3])) + pow2((Porg[1]-Porg[4])) + pow2((Porg[2]-Porg[5])) ); + + + M_ reta[_t][i+ j*_1D_SIZE[0]+ k*_2D_SIZE[0] ] = A + C1* exp(-12 *r1) + C2*exp(- 12*r2); + }//BHN ==2 + + M_ betax_rhs[_t] = 0.75*M_ dtSfx[_t]; + + M_ betay_rhs[_t] = 0.75*M_ dtSfy[_t]; + + M_ betaz_rhs[_t] = 0.75*M_ dtSfz[_t]; + + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]*M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]*M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]*M_ dtSfz[_t]; + +#endif //if (GAUGE == ?) + + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_bssn_ss_part6_gauge() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { +#if (GAUGE == 2) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1[_t])/ pow2( ( 1-sqrt(M_ chin1[_t]) ) ); + + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]* M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]* M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]* M_ dtSfz[_t]; + +#elif (GAUGE == 3) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13/2 * sqrt( M_ reta[_t]/ M_ chin1[_t])/ pow2((1-M_ chin1[_t])); + + M_ dtSfx_rhs[_t] = M_ Gamx_rhs[_t] - M_ reta[_t]* M_ dtSfx[_t]; + + M_ dtSfy_rhs[_t] = M_ Gamy_rhs[_t] - M_ reta[_t]* M_ dtSfy[_t]; + + M_ dtSfz_rhs[_t] = M_ Gamz_rhs[_t] - M_ reta[_t]* M_ dtSfz[_t]; + +#elif (GAUGE == 4) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * + M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * + M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1[_t])/ pow( (1-sqrt(M_ chin1[_t]))); + + + M_ betax_rhs[_t] = 0.75* M_ Gamx[_t] - M_ reta[_t]*M_ betax[_t]; + + M_ betay_rhs[_t] = 0.75* M_ Gamy[_t] - M_ reta[_t]*M_ betay[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ Gamz[_t] - M_ reta[_t]*M_ betaz[_t]; + +#elif (GAUGE == 5) + M_ reta[_t] = M_ gupxx[_t] * M_ dtSfx_rhs[_t] * M_ dtSfx_rhs[_t] + M_ gupyy[_t] * M_ dtSfy_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupzz[_t] * M_ dtSfz_rhs[_t] * M_ dtSfz_rhs[_t] + + + 2 * ( M_ gupxy[_t] * M_ dtSfx_rhs[_t] * M_ dtSfy_rhs[_t] + M_ gupxz[_t] * M_ dtSfx_rhs[_t] * M_ dtSfz_rhs[_t] + M_ gupyz[_t] * M_ dtSfy_rhs[_t] * M_ dtSfz_rhs[_t]); + + + M_ reta[_t] = 1.13 / 2 * sqrt( M_ reta[_t]/M_ chin1)/ pow( (1-M_ chin1[_t]) ); + + M_ betax_rhs[_t] = 0.75* M_ Gamx[_t] - M_ reta[_t]*M_ betax[_t]; + + M_ betay_rhs[_t] = 0.75* M_ Gamy[_t] - M_ reta[_t]*M_ betay[_t]; + + M_ betaz_rhs[_t] = 0.75* M_ Gamz[_t] - M_ reta[_t]*M_ betaz[_t]; + + + + M_ dtSfx_rhs[_t] = 0; + + M_ dtSfy_rhs[_t] = 0; + + M_ dtSfz_rhs[_t] = 0; +#endif + _t += STEP_SIZE; + } +} + +__global__ void compute_rhs_ss_part7() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ ham_Res[_t] = M_ gupxx [_t]* M_ Rxx [_t]+ M_ gupyy[_t]* M_ Ryy[_t]+ M_ gupzz[_t]* M_ Rzz[_t]+ + 2* ( M_ gupxy[_t]* M_ Rxy[_t]+ M_ gupxz[_t]* M_ Rxz[_t]+ M_ gupyz[_t]* M_ Ryz[_t]); + + M_ ham_Res[_t] = M_ chin1[_t]*M_ ham_Res[_t] + F2o3 * M_ trK[_t] * M_ trK[_t] -( + M_ gupxx [_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axx [_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Axy[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Axz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axx [_t]* M_ Axy[_t]+ M_ gupxz[_t]* M_ Axx [_t]* M_ Axz[_t]+ M_ gupyz[_t]* M_ Axy[_t]* M_ Axz[_t]) ) + + M_ gupyy[_t]* ( + M_ gupxx [_t]* M_ Axy[_t]* M_ Axy[_t]+ M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axy[_t]* M_ Ayy[_t]+ M_ gupxz[_t]* M_ Axy[_t]* M_ Ayz[_t]+ M_ gupyz[_t]* M_ Ayy[_t]* M_ Ayz[_t]) ) + + M_ gupzz[_t]* ( + M_ gupxx [_t]* M_ Axz[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Ayz[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Azz[_t]* M_ Azz[_t]+ + 2 * (M_ gupxy[_t]* M_ Axz[_t]* M_ Ayz[_t]+ M_ gupxz[_t]* M_ Axz[_t]* M_ Azz[_t]+ M_ gupyz[_t]* M_ Ayz[_t]* M_ Azz[_t]) ) + + 2 * ( + M_ gupxy[_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axy[_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Ayy[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Ayz[_t]+ + M_ gupxy[_t]* (M_ Axx [_t]* M_ Ayy[_t]+ M_ Axy[_t]* M_ Axy[_t]) + + M_ gupxz[_t]* (M_ Axx [_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Axy[_t]) + + M_ gupyz[_t]* (M_ Axy[_t]* M_ Ayz[_t]+ M_ Axz[_t]* M_ Ayy[_t]) ) + + M_ gupxz[_t]* ( + M_ gupxx [_t]* M_ Axx [_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Axy[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Axz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]* (M_ Axx [_t]* M_ Ayz[_t]+ M_ Axy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]* (M_ Axx [_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]* (M_ Axy[_t]* M_ Azz[_t]+ M_ Axz[_t]* M_ Ayz[_t]) ) + + M_ gupyz[_t]* ( + M_ gupxx [_t]* M_ Axy[_t]* M_ Axz[_t]+ M_ gupyy[_t]* M_ Ayy[_t]* M_ Ayz[_t]+ M_ gupzz[_t]* M_ Ayz[_t]* M_ Azz[_t]+ + M_ gupxy[_t]* (M_ Axy[_t]* M_ Ayz[_t]+ M_ Ayy[_t]* M_ Axz[_t]) + + M_ gupxz[_t]* (M_ Axy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Axz[_t]) + + M_ gupyz[_t]* (M_ Ayy[_t]* M_ Azz[_t]+ M_ Ayz[_t]* M_ Ayz[_t]) ) ))- 16 * PI * M_ rho[_t]; + + _t += STEP_SIZE; + } +} +__global__ void compute_rhs_ss_part8() +{ + int _t = blockIdx.x*blockDim.x+threadIdx.x; + while(_t < _3D_SIZE[0]) + { + M_ gxxx [_t]= M_ gxxx [_t]- ( M_ Gamxxx [_t]* M_ Axx [_t]+ M_ Gamyxx [_t]* M_ Axy[_t]+ M_ Gamzxx [_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axx [_t]+ M_ Gamyxx [_t]* M_ Axy[_t]+ M_ Gamzxx [_t]* M_ Axz[_t]) - M_ chix[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyx [_t]= M_ gxyx [_t]- ( M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axy[_t]+ M_ Gamyxx [_t]* M_ Ayy[_t]+ M_ Gamzxx [_t]* M_ Ayz[_t]) - M_ chix[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzx [_t]= M_ gxzx [_t]- ( M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t] + + M_ Gamxxx [_t]* M_ Axz[_t]+ M_ Gamyxx [_t]* M_ Ayz[_t]+ M_ Gamzxx [_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyx [_t]= M_ gyyx [_t]- ( M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t] + + M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t]) - M_ chix[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzx [_t]= M_ gyzx [_t]- ( M_ Gamxxz[_t]* M_ Axy[_t]+ M_ Gamyxz[_t]* M_ Ayy[_t]+ M_ Gamzxz[_t]* M_ Ayz[_t] + + M_ Gamxxy[_t]* M_ Axz[_t]+ M_ Gamyxy[_t]* M_ Ayz[_t]+ M_ Gamzxy[_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzx [_t]= M_ gzzx [_t]- ( M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t] + + M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t]) - M_ chix[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ gxxy[_t]= M_ gxxy[_t]- ( M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axx [_t]+ M_ Gamyxy[_t]* M_ Axy[_t]+ M_ Gamzxy[_t]* M_ Axz[_t]) - M_ chiy[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyy[_t]= M_ gxyy[_t]- ( M_ Gamxyy[_t]* M_ Axx [_t]+ M_ Gamyyy[_t]* M_ Axy[_t]+ M_ Gamzyy[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axy[_t]+ M_ Gamyxy[_t]* M_ Ayy[_t]+ M_ Gamzxy[_t]* M_ Ayz[_t]) - M_ chiy[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzy[_t]= M_ gxzy[_t]- ( M_ Gamxyz[_t]* M_ Axx [_t]+ M_ Gamyyz[_t]* M_ Axy[_t]+ M_ Gamzyz[_t]* M_ Axz[_t] + + M_ Gamxxy[_t]* M_ Axz[_t]+ M_ Gamyxy[_t]* M_ Ayz[_t]+ M_ Gamzxy[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyy[_t]= M_ gyyy[_t]- ( M_ Gamxyy[_t]* M_ Axy[_t]+ M_ Gamyyy[_t]* M_ Ayy[_t]+ M_ Gamzyy[_t]* M_ Ayz[_t] + + M_ Gamxyy[_t]* M_ Axy[_t]+ M_ Gamyyy[_t]* M_ Ayy[_t]+ M_ Gamzyy[_t]* M_ Ayz[_t]) - M_ chiy[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzy[_t]= M_ gyzy[_t]- ( M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t] + + M_ Gamxyy[_t]* M_ Axz[_t]+ M_ Gamyyy[_t]* M_ Ayz[_t]+ M_ Gamzyy[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzy[_t]= M_ gzzy[_t]- ( M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t] + + M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t]) - M_ chiy[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ gxxz[_t]= M_ gxxz[_t]- ( M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axx [_t]+ M_ Gamyxz[_t]* M_ Axy[_t]+ M_ Gamzxz[_t]* M_ Axz[_t]) - M_ chiz[_t]*M_ Axx[_t]/M_ chin1[_t]; + + M_ gxyz[_t]= M_ gxyz[_t]- ( M_ Gamxyz[_t]* M_ Axx [_t]+ M_ Gamyyz[_t]* M_ Axy[_t]+ M_ Gamzyz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axy[_t]+ M_ Gamyxz[_t]* M_ Ayy[_t]+ M_ Gamzxz[_t]* M_ Ayz[_t]) - M_ chiz[_t]*M_ Axy[_t]/M_ chin1[_t]; + + M_ gxzz[_t]= M_ gxzz[_t]- ( M_ Gamxzz[_t]* M_ Axx [_t]+ M_ Gamyzz[_t]* M_ Axy[_t]+ M_ Gamzzz[_t]* M_ Axz[_t] + + M_ Gamxxz[_t]* M_ Axz[_t]+ M_ Gamyxz[_t]* M_ Ayz[_t]+ M_ Gamzxz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Axz[_t]/M_ chin1[_t]; + + M_ gyyz[_t]= M_ gyyz[_t]- ( M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t] + + M_ Gamxyz[_t]* M_ Axy[_t]+ M_ Gamyyz[_t]* M_ Ayy[_t]+ M_ Gamzyz[_t]* M_ Ayz[_t]) - M_ chiz[_t]*M_ Ayy[_t]/M_ chin1[_t]; + + M_ gyzz[_t]= M_ gyzz[_t]- ( M_ Gamxzz[_t]* M_ Axy[_t]+ M_ Gamyzz[_t]* M_ Ayy[_t]+ M_ Gamzzz[_t]* M_ Ayz[_t] + + M_ Gamxyz[_t]* M_ Axz[_t]+ M_ Gamyyz[_t]* M_ Ayz[_t]+ M_ Gamzyz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Ayz[_t]/M_ chin1[_t]; + + M_ gzzz[_t]= M_ gzzz[_t]- ( M_ Gamxzz[_t]* M_ Axz[_t]+ M_ Gamyzz[_t]* M_ Ayz[_t]+ M_ Gamzzz[_t]* M_ Azz[_t] + + M_ Gamxzz[_t]* M_ Axz[_t]+ M_ Gamyzz[_t]* M_ Ayz[_t]+ M_ Gamzzz[_t]* M_ Azz[_t]) - M_ chiz[_t]*M_ Azz[_t]/M_ chin1[_t]; + + M_ movx_Res[_t] = M_ gupxx[_t]*M_ gxxx [_t]+ M_ gupyy[_t]*M_ gxyy[_t]+ M_ gupzz[_t]*M_ gxzz[_t] + +M_ gupxy[_t]*M_ gxyx [_t]+ M_ gupxz[_t]*M_ gxzx [_t]+ M_ gupyz[_t]*M_ gxzy[_t] + +M_ gupxy[_t]*M_ gxxy[_t]+ M_ gupxz[_t]*M_ gxxz[_t]+ M_ gupyz[_t]*M_ gxyz[_t]; + M_ movy_Res[_t] = M_ gupxx[_t]*M_ gxyx [_t]+ M_ gupyy[_t]*M_ gyyy[_t]+ M_ gupzz[_t]*M_ gyzz[_t] + +M_ gupxy[_t]*M_ gyyx [_t]+ M_ gupxz[_t]*M_ gyzx [_t]+ M_ gupyz[_t]*M_ gyzy[_t] + +M_ gupxy[_t]*M_ gxyy[_t]+ M_ gupxz[_t]*M_ gxyz[_t]+ M_ gupyz[_t]*M_ gyyz[_t]; + + M_ movz_Res[_t] = M_ gupxx[_t]*M_ gxzx [_t]+ M_ gupyy[_t]*M_ gyzy[_t]+ M_ gupzz[_t]*M_ gzzz[_t] + +M_ gupxy[_t]*M_ gyzx [_t]+ M_ gupxz[_t]*M_ gzzx [_t]+ M_ gupyz[_t]*M_ gzzy[_t] + +M_ gupxy[_t]*M_ gxzy[_t]+ M_ gupxz[_t]*M_ gxzz[_t]+ M_ gupyz[_t]*M_ gyzz[_t]; + + M_ movx_Res[_t] = M_ movx_Res[_t] - F2o3*M_ Kx [_t]- 8*PI*M_ Sx[_t]; + M_ movy_Res[_t] = M_ movy_Res[_t] - F2o3*M_ Ky[_t]- 8*PI*M_ Sy[_t]; + M_ movz_Res[_t] = M_ movz_Res[_t] - F2o3*M_ Kz[_t]- 8*PI*M_ Sz[_t]; + + _t += STEP_SIZE; + } +} + +void destroy_meta(Meta *meta,Metass *metass) +{ + if(Mh_ X) cudaFree(Mh_ X); + if(Mh_ Y) cudaFree(Mh_ Y); + if(Mh_ Z) cudaFree(Mh_ Z); + if(Mh_ chi) cudaFree(Mh_ chi); + if(Mh_ dxx) cudaFree(Mh_ dxx); + if(Mh_ dyy) cudaFree(Mh_ dyy); + if(Mh_ dzz) cudaFree(Mh_ dzz); + if(Mh_ trK) cudaFree(Mh_ trK); + if(Mh_ gxy) cudaFree(Mh_ gxy); + if(Mh_ gxz) cudaFree(Mh_ gxz); + if(Mh_ gyz) cudaFree(Mh_ gyz); + if(Mh_ Axx) cudaFree(Mh_ Axx); + if(Mh_ Axy) cudaFree(Mh_ Axy); + if(Mh_ Axz) cudaFree(Mh_ Axz); + if(Mh_ Ayz) cudaFree(Mh_ Ayz); + if(Mh_ Ayy) cudaFree(Mh_ Ayy); + if(Mh_ Azz) cudaFree(Mh_ Azz); + if(Mh_ Gamx) cudaFree(Mh_ Gamx); + if(Mh_ Gamy) cudaFree(Mh_ Gamy); + if(Mh_ Gamz) cudaFree(Mh_ Gamz); + if(Mh_ Lap) cudaFree(Mh_ Lap); + if(Mh_ betax) cudaFree(Mh_ betax); + if(Mh_ betay) cudaFree(Mh_ betay); + if(Mh_ betaz) cudaFree(Mh_ betaz); + if(Mh_ dtSfx) cudaFree(Mh_ dtSfx); + if(Mh_ dtSfy) cudaFree(Mh_ dtSfy); + if(Mh_ dtSfz) cudaFree(Mh_ dtSfz); + if(Mh_ chi_rhs) cudaFree(Mh_ chi_rhs); + if(Mh_ trK_rhs) cudaFree(Mh_ trK_rhs); + if(Mh_ gxy_rhs) cudaFree(Mh_ gxy_rhs); + if(Mh_ gxz_rhs) cudaFree(Mh_ gxz_rhs); + if(Mh_ gyz_rhs) cudaFree(Mh_ gyz_rhs); + if(Mh_ Axx_rhs) cudaFree(Mh_ Axx_rhs); + if(Mh_ Axy_rhs) cudaFree(Mh_ Axy_rhs); + if(Mh_ Axz_rhs) cudaFree(Mh_ Axz_rhs); + if(Mh_ Ayz_rhs) cudaFree(Mh_ Ayz_rhs); + if(Mh_ Ayy_rhs) cudaFree(Mh_ Ayy_rhs); + if(Mh_ Azz_rhs) cudaFree(Mh_ Azz_rhs); + if(Mh_ Gamx_rhs) cudaFree(Mh_ Gamx_rhs); + if(Mh_ Gamy_rhs) cudaFree(Mh_ Gamy_rhs); + if(Mh_ Gamz_rhs) cudaFree(Mh_ Gamz_rhs); + if(Mh_ Lap_rhs) cudaFree(Mh_ Lap_rhs); + if(Mh_ betax_rhs) cudaFree(Mh_ betax_rhs); + if(Mh_ betay_rhs) cudaFree(Mh_ betay_rhs); + if(Mh_ betaz_rhs) cudaFree(Mh_ betaz_rhs); + if(Mh_ dtSfx_rhs) cudaFree(Mh_ dtSfx_rhs); + if(Mh_ dtSfy_rhs) cudaFree(Mh_ dtSfy_rhs); + if(Mh_ dtSfz_rhs) cudaFree(Mh_ dtSfz_rhs); + if(Mh_ rho) cudaFree(Mh_ rho); + if(Mh_ Sx) cudaFree(Mh_ Sx); + if(Mh_ Sy) cudaFree(Mh_ Sy); + if(Mh_ Sz) cudaFree(Mh_ Sz); + if(Mh_ Sxx) cudaFree(Mh_ Sxx); + if(Mh_ Sxy) cudaFree(Mh_ Sxy); + if(Mh_ Sxz) cudaFree(Mh_ Sxz); + if(Mh_ Syz) cudaFree(Mh_ Syz); + if(Mh_ Syy) cudaFree(Mh_ Syy); + if(Mh_ Szz) cudaFree(Mh_ Szz); + if(Mh_ Gamxxx) cudaFree(Mh_ Gamxxx); + if(Mh_ Gamxxy) cudaFree(Mh_ Gamxxy); + if(Mh_ Gamxxz) cudaFree(Mh_ Gamxxz); + if(Mh_ Gamxyy) cudaFree(Mh_ Gamxyy); + if(Mh_ Gamxyz) cudaFree(Mh_ Gamxyz); + if(Mh_ Gamxzz) cudaFree(Mh_ Gamxzz); + if(Mh_ Gamyxx) cudaFree(Mh_ Gamyxx); + if(Mh_ Gamyxy) cudaFree(Mh_ Gamyxy); + if(Mh_ Gamyxz) cudaFree(Mh_ Gamyxz); + if(Mh_ Gamyyy) cudaFree(Mh_ Gamyyy); + if(Mh_ Gamyyz) cudaFree(Mh_ Gamyyz); + if(Mh_ Gamyzz) cudaFree(Mh_ Gamyzz); + if(Mh_ Gamzxx) cudaFree(Mh_ Gamzxx); + if(Mh_ Gamzxy) cudaFree(Mh_ Gamzxy); + if(Mh_ Gamzxz) cudaFree(Mh_ Gamzxz); + if(Mh_ Gamzyz) cudaFree(Mh_ Gamzyz); + if(Mh_ Gamzyy) cudaFree(Mh_ Gamzyy); + if(Mh_ Gamzzz) cudaFree(Mh_ Gamzzz); + if(Mh_ Rxx) cudaFree(Mh_ Rxx); + if(Mh_ Rxy) cudaFree(Mh_ Rxy); + if(Mh_ Rxz) cudaFree(Mh_ Rxz); + if(Mh_ Ryy) cudaFree(Mh_ Ryy); + if(Mh_ Ryz) cudaFree(Mh_ Ryz); + if(Mh_ Rzz) cudaFree(Mh_ Rzz); + if(Mh_ ham_Res) cudaFree(Mh_ ham_Res); + if(Mh_ movx_Res) cudaFree(Mh_ movx_Res); + if(Mh_ movy_Res) cudaFree(Mh_ movy_Res); + if(Mh_ movz_Res) cudaFree(Mh_ movz_Res); + if(Mh_ Gmx_Res) cudaFree(Mh_ Gmx_Res); + if(Mh_ Gmy_Res) cudaFree(Mh_ Gmy_Res); + if(Mh_ Gmz_Res) cudaFree(Mh_ Gmz_Res); + if(Mh_ gxx) cudaFree(Mh_ gxx); + if(Mh_ gyy) cudaFree(Mh_ gyy); + if(Mh_ gzz) cudaFree(Mh_ gzz); + if(Mh_ chix) cudaFree(Mh_ chix); + if(Mh_ chiy) cudaFree(Mh_ chiy); + if(Mh_ chiz) cudaFree(Mh_ chiz); + if(Mh_ gxxx) cudaFree(Mh_ gxxx); + if(Mh_ gxyx) cudaFree(Mh_ gxyx); + if(Mh_ gxzx) cudaFree(Mh_ gxzx); + if(Mh_ gyyx) cudaFree(Mh_ gyyx); + if(Mh_ gyzx) cudaFree(Mh_ gyzx); + if(Mh_ gzzx) cudaFree(Mh_ gzzx); + if(Mh_ gxxy) cudaFree(Mh_ gxxy); + if(Mh_ gxyy) cudaFree(Mh_ gxyy); + if(Mh_ gxzy) cudaFree(Mh_ gxzy); + if(Mh_ gyyy) cudaFree(Mh_ gyyy); + if(Mh_ gyzy) cudaFree(Mh_ gyzy); + if(Mh_ gzzy) cudaFree(Mh_ gzzy); + if(Mh_ gxxz) cudaFree(Mh_ gxxz); + if(Mh_ gxyz) cudaFree(Mh_ gxyz); + if(Mh_ gxzz) cudaFree(Mh_ gxzz); + if(Mh_ gyyz) cudaFree(Mh_ gyyz); + if(Mh_ gyzz) cudaFree(Mh_ gyzz); + if(Mh_ gzzz) cudaFree(Mh_ gzzz); + if(Mh_ Lapx) cudaFree(Mh_ Lapx); + if(Mh_ Lapy) cudaFree(Mh_ Lapy); + if(Mh_ Lapz) cudaFree(Mh_ Lapz); + if(Mh_ betaxx) cudaFree(Mh_ betaxx); + if(Mh_ betaxy) cudaFree(Mh_ betaxy); + if(Mh_ betaxz) cudaFree(Mh_ betaxz); + if(Mh_ betayy) cudaFree(Mh_ betayy); + if(Mh_ betayz) cudaFree(Mh_ betayz); + if(Mh_ betazz) cudaFree(Mh_ betazz); + if(Mh_ betayx) cudaFree(Mh_ betayx); + if(Mh_ betazy) cudaFree(Mh_ betazy); + if(Mh_ betazx) cudaFree(Mh_ betazx); + if(Mh_ Kx) cudaFree(Mh_ Kx); + if(Mh_ Ky) cudaFree(Mh_ Ky); + if(Mh_ Kz) cudaFree(Mh_ Kz); + if(Mh_ Gamxx) cudaFree(Mh_ Gamxx); + if(Mh_ Gamxy) cudaFree(Mh_ Gamxy); + if(Mh_ Gamxz) cudaFree(Mh_ Gamxz); + if(Mh_ Gamyy) cudaFree(Mh_ Gamyy); + if(Mh_ Gamyz) cudaFree(Mh_ Gamyz); + if(Mh_ Gamzz) cudaFree(Mh_ Gamzz); + if(Mh_ Gamyx) cudaFree(Mh_ Gamyx); + if(Mh_ Gamzy) cudaFree(Mh_ Gamzy); + if(Mh_ Gamzx) cudaFree(Mh_ Gamzx); + if(Mh_ div_beta) cudaFree(Mh_ div_beta); + if(Mh_ S) cudaFree(Mh_ S); + if(Mh_ f) cudaFree(Mh_ f); + if(Mh_ fxx) cudaFree(Mh_ fxx); + if(Mh_ fxy) cudaFree(Mh_ fxy); + if(Mh_ fxz) cudaFree(Mh_ fxz); + if(Mh_ fyy) cudaFree(Mh_ fyy); + if(Mh_ fyz) cudaFree(Mh_ fyz); + if(Mh_ fzz) cudaFree(Mh_ fzz); + if(Mh_ gupxx) cudaFree(Mh_ gupxx); + if(Mh_ gupxy) cudaFree(Mh_ gupxy); + if(Mh_ gupxz) cudaFree(Mh_ gupxz); + if(Mh_ gupyy) cudaFree(Mh_ gupyy); + if(Mh_ gupyz) cudaFree(Mh_ gupyz); + if(Mh_ gupzz) cudaFree(Mh_ gupzz); + if(Mh_ Gamxa) cudaFree(Mh_ Gamxa); + if(Mh_ Gamya) cudaFree(Mh_ Gamya); + if(Mh_ Gamza) cudaFree(Mh_ Gamza); + if(Mh_ alpn1) cudaFree(Mh_ alpn1); + if(Mh_ chin1) cudaFree(Mh_ chin1); + if(Mh_ fh) cudaFree(Mh_ fh); + if(Mh_ fh2) cudaFree(Mh_ fh2); + if(Mh_ gxx_rhs) cudaFree(Mh_ gxx_rhs); + if(Mh_ gyy_rhs) cudaFree(Mh_ gyy_rhs); + if(Mh_ gzz_rhs) cudaFree(Mh_ gzz_rhs); + + //-----------SS----------------- + if(Msh_ crho) cudaFree(Msh_ crho); + if(Msh_ sigma) cudaFree(Msh_ sigma); + if(Msh_ R) cudaFree(Msh_ R); + if(Msh_ drhodx) cudaFree(Msh_ drhodx); + if(Msh_ drhody) cudaFree(Msh_ drhody); + if(Msh_ drhodz) cudaFree(Msh_ drhodz); + if(Msh_ dsigmadx) cudaFree(Msh_ dsigmadx); + if(Msh_ dsigmady) cudaFree(Msh_ dsigmady); + if(Msh_ dsigmadz) cudaFree(Msh_ dsigmadz); + if(Msh_ dRdx) cudaFree(Msh_ dRdx); + if(Msh_ dRdy) cudaFree(Msh_ dRdy); + if(Msh_ dRdz) cudaFree(Msh_ dRdz); + if(Msh_ drhodxx) cudaFree(Msh_ drhodxx); + if(Msh_ drhodxy) cudaFree(Msh_ drhodxy); + if(Msh_ drhodxz) cudaFree(Msh_ drhodxz); + if(Msh_ drhodyy) cudaFree(Msh_ drhodyy); + if(Msh_ drhodyz) cudaFree(Msh_ drhodyz); + if(Msh_ drhodzz) cudaFree(Msh_ drhodzz); + if(Msh_ dsigmadxx) cudaFree(Msh_ dsigmadxx); + if(Msh_ dsigmadxy) cudaFree(Msh_ dsigmadxy); + if(Msh_ dsigmadxz) cudaFree(Msh_ dsigmadxz); + if(Msh_ dsigmadyy) cudaFree(Msh_ dsigmadyy); + if(Msh_ dsigmadyz) cudaFree(Msh_ dsigmadyz); + if(Msh_ dsigmadzz) cudaFree(Msh_ dsigmadzz); + if(Msh_ dRdxx) cudaFree(Msh_ dRdxx); + if(Msh_ dRdxy) cudaFree(Msh_ dRdxy); + if(Msh_ dRdxz) cudaFree(Msh_ dRdxz); + if(Msh_ dRdyy) cudaFree(Msh_ dRdyy); + if(Msh_ dRdyz) cudaFree(Msh_ dRdyz); + if(Msh_ dRdzz) cudaFree(Msh_ dRdzz); + if(Msh_ gx) cudaFree(Msh_ gx); + if(Msh_ gy) cudaFree(Msh_ gy); + if(Msh_ gz) cudaFree(Msh_ gz); + + if(Msh_ gxx) cudaFree(Msh_ gxx); + if(Msh_ gxy) cudaFree(Msh_ gxy); + if(Msh_ gxz) cudaFree(Msh_ gxz); + if(Msh_ gyy) cudaFree(Msh_ gyy); + if(Msh_ gyz) cudaFree(Msh_ gyz); + if(Msh_ gzz) cudaFree(Msh_ gzz); + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + if(Mh_ reta) CUDA_SAFE_CALL(cudaFree(Mh_ reta)); + +#endif + + //if(Mh_ other_int) cudaFree(Mh_ other_int); + //if(Mh_ other_double) cudaFree(Mh_ other_double); + //cout<<"Address of meta:"<<&meta<>>(); + cudaThreadSynchronize(); + + sub_fderivs_shc(sst,Mh_ betax,Mh_ fh,Mh_ betaxx,Mh_ betaxy,Mh_ betaxz,ass); + sub_fderivs_shc(sst,Mh_ betay,Mh_ fh,Mh_ betayx,Mh_ betayy,Mh_ betayz,sas); + sub_fderivs_shc(sst,Mh_ betaz,Mh_ fh,Mh_ betazx,Mh_ betazy,Mh_ betazz,ssa); + sub_fderivs_shc(sst,Mh_ chi,Mh_ fh,Mh_ chix,Mh_ chiy,Mh_ chiz, sss); + sub_fderivs_shc(sst,Mh_ Lap,Mh_ fh,Mh_ Lapx,Mh_ Lapy,Mh_ Lapz, sss); + sub_fderivs_shc(sst,Mh_ trK,Mh_ fh,Mh_ Kx,Mh_ Ky,Mh_ Kz, sss); + sub_fderivs_shc(sst,Mh_ dxx,Mh_ fh,Mh_ gxxx,Mh_ gxxy,Mh_ gxxz, sss); + sub_fderivs_shc(sst,Mh_ dyy,Mh_ fh,Mh_ gyyx,Mh_ gyyy,Mh_ gyyz, sss); + sub_fderivs_shc(sst,Mh_ dzz,Mh_ fh,Mh_ gzzx,Mh_ gzzy,Mh_ gzzz, sss); + sub_fderivs_shc(sst,Mh_ gxy,Mh_ fh,Mh_ gxyx,Mh_ gxyy,Mh_ gxyz, aas); + sub_fderivs_shc(sst,Mh_ gxz,Mh_ fh,Mh_ gxzx,Mh_ gxzy,Mh_ gxzz, asa); + sub_fderivs_shc(sst,Mh_ gyz,Mh_ fh,Mh_ gyzx,Mh_ gyzy,Mh_ gyzz, saa); + + compute_rhs_ss_part2<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs_shc(sst,Mh_ betax,Mh_ fh,Mh_ gxxx,Mh_ gxyx,Mh_ gxzx,Mh_ gyyx,Mh_ gyzx,Mh_ gzzx,ass); + sub_fdderivs_shc(sst,Mh_ betay,Mh_ fh,Mh_ gxxy,Mh_ gxyy,Mh_ gxzy,Mh_ gyyy,Mh_ gyzy,Mh_ gzzy,sas); + sub_fdderivs_shc(sst,Mh_ betaz,Mh_ fh,Mh_ gxxz,Mh_ gxyz,Mh_ gxzz,Mh_ gyyz,Mh_ gyzz,Mh_ gzzz,ssa); + sub_fderivs_shc( sst,Mh_ Gamx, Mh_ fh,Mh_ Gamxx, Mh_ Gamxy, Mh_ Gamxz,ass); + sub_fderivs_shc( sst,Mh_ Gamy, Mh_ fh,Mh_ Gamyx, Mh_ Gamyy, Mh_ Gamyz,sas); + sub_fderivs_shc( sst,Mh_ Gamz, Mh_ fh,Mh_ Gamzx, Mh_ Gamzy, Mh_ Gamzz,ssa); + + compute_rhs_ss_part3<<>>(); + cudaThreadSynchronize(); + + computeRicci_ss(sst,Mh_ dxx,Mh_ Rxx,sss, meta); + computeRicci_ss(sst,Mh_ dyy,Mh_ Ryy,sss, meta); + computeRicci_ss(sst,Mh_ dzz,Mh_ Rzz,sss, meta); + computeRicci_ss(sst,Mh_ gxy,Mh_ Rxy,aas, meta); + computeRicci_ss(sst,Mh_ gxz,Mh_ Rxz,asa, meta); + computeRicci_ss(sst,Mh_ gyz,Mh_ Ryz,saa, meta); + cudaThreadSynchronize(); + + compute_rhs_ss_part4<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs_shc(sst,Mh_ chi,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,sss); + + //cudaThreadSynchronize(); + //compare_result_gpu(0,Mh_ chi,h_3D_SIZE[0]); + //compare_result_gpu(1,Mh_ chi,h_3D_SIZE[0]); + //compare_result_gpu(2,Mh_ fyz,h_3D_SIZE[0]); + + compute_rhs_ss_part5<<>>(); + cudaThreadSynchronize(); + + sub_fdderivs_shc(sst,Mh_ Lap,Mh_ fh,Mh_ fxx,Mh_ fxy,Mh_ fxz,Mh_ fyy,Mh_ fyz,Mh_ fzz,sss); + + compute_rhs_ss_part6<<>>(); + cudaThreadSynchronize(); + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5) + sub_fderivs_shc(sst,Mh_ chi,Mh_ fh, Mh_ dtSfx_rhs, Mh_ dtSfy_rhs, Mh_ dtSfz_rhs,sss); + compute_rhs_bssn_ss_part6_gauge<<>>(); +#endif + //sub_lopsided_ss(int& sst,double *src,double* dst,double *SOA) + sub_lopsided_ss(sst,Mh_ gxx,Mh_ gxx_rhs,sss); + sub_lopsided_ss(sst,Mh_ gxy,Mh_ gxy_rhs,aas); + sub_lopsided_ss(sst,Mh_ gxz,Mh_ gxz_rhs,asa); + sub_lopsided_ss(sst,Mh_ gyy,Mh_ gyy_rhs,sss); + sub_lopsided_ss(sst,Mh_ gyz,Mh_ gyz_rhs,saa); + sub_lopsided_ss(sst,Mh_ gzz,Mh_ gzz_rhs,sss); + sub_lopsided_ss(sst,Mh_ Axx,Mh_ Axx_rhs,sss); + sub_lopsided_ss(sst,Mh_ Axy,Mh_ Axy_rhs,aas); + sub_lopsided_ss(sst,Mh_ Axz,Mh_ Axz_rhs,asa); + sub_lopsided_ss(sst,Mh_ Ayy,Mh_ Ayy_rhs,sss); + sub_lopsided_ss(sst,Mh_ Ayz,Mh_ Ayz_rhs,saa); + sub_lopsided_ss(sst,Mh_ Azz,Mh_ Azz_rhs,sss); + sub_lopsided_ss(sst,Mh_ chi,Mh_ chi_rhs,sss); + sub_lopsided_ss(sst,Mh_ trK,Mh_ trK_rhs,sss); + sub_lopsided_ss(sst,Mh_ Gamx,Mh_ Gamx_rhs,ass); + sub_lopsided_ss(sst,Mh_ Gamy,Mh_ Gamy_rhs,sas); + sub_lopsided_ss(sst,Mh_ Gamz,Mh_ Gamz_rhs,ssa); + sub_lopsided_ss(sst,Mh_ Lap,Mh_ Lap_rhs,sss); +#if (GAUGE == 0 || GAUGE == 1 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + sub_lopsided_ss(sst,Mh_ betax,Mh_ betax_rhs,ass); + sub_lopsided_ss(sst,Mh_ betay,Mh_ betay_rhs,sas); + sub_lopsided_ss(sst,Mh_ betaz,Mh_ betaz_rhs,ssa); +#endif +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + sub_lopsided_ss(sst,Mh_ dtSfx,Mh_ dtSfx_rhs,ass); + sub_lopsided_ss(sst,Mh_ dtSfy,Mh_ dtSfy_rhs,sas); + sub_lopsided_ss(sst,Mh_ dtSfz,Mh_ dtSfz_rhs,ssa); +#endif + if(eps > 0){ + sub_kodis_ss(sst,Mh_ chi,Mh_ fh2, Mh_ chi_rhs,sss); + sub_kodis_ss(sst,Mh_ trK,Mh_ fh2, Mh_ trK_rhs,sss); + sub_kodis_ss(sst,Mh_ dxx,Mh_ fh2, Mh_ gxx_rhs,sss); + sub_kodis_ss(sst,Mh_ gxy,Mh_ fh2, Mh_ gxy_rhs,aas); + sub_kodis_ss(sst,Mh_ gxz,Mh_ fh2, Mh_ gxz_rhs,asa); + sub_kodis_ss(sst,Mh_ dyy,Mh_ fh2, Mh_ gyy_rhs,sss); + sub_kodis_ss(sst,Mh_ gyz,Mh_ fh2, Mh_ gyz_rhs,saa); + sub_kodis_ss(sst,Mh_ dzz,Mh_ fh2, Mh_ gzz_rhs,sss); + sub_kodis_ss(sst,Mh_ Axx,Mh_ fh2, Mh_ Axx_rhs,sss); + sub_kodis_ss(sst,Mh_ Axy,Mh_ fh2, Mh_ Axy_rhs,aas); + sub_kodis_ss(sst,Mh_ Axz,Mh_ fh2, Mh_ Axz_rhs,asa); + sub_kodis_ss(sst,Mh_ Ayy,Mh_ fh2, Mh_ Ayy_rhs,sss); + sub_kodis_ss(sst,Mh_ Ayz,Mh_ fh2, Mh_ Ayz_rhs,saa); + sub_kodis_ss(sst,Mh_ Azz,Mh_ fh2, Mh_ Azz_rhs,sss); + sub_kodis_ss(sst,Mh_ Gamx,Mh_ fh2, Mh_ Gamx_rhs,ass); + sub_kodis_ss(sst,Mh_ Gamy,Mh_ fh2, Mh_ Gamy_rhs,sas); + sub_kodis_ss(sst,Mh_ Gamz,Mh_ fh2, Mh_ Gamz_rhs,ssa); + sub_kodis_ss(sst,Mh_ Lap,Mh_ fh2, Mh_ Lap_rhs,sss); + sub_kodis_ss(sst,Mh_ betax,Mh_ fh2, Mh_ betax_rhs,ass); + sub_kodis_ss(sst,Mh_ betay,Mh_ fh2, Mh_ betay_rhs,sas); + sub_kodis_ss(sst,Mh_ betaz,Mh_ fh2, Mh_ betaz_rhs,ssa); +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + sub_kodis_ss(sst,Mh_ dtSfx,Mh_ fh2, Mh_ dtSfx_rhs,ass); + sub_kodis_ss(sst,Mh_ dtSfy,Mh_ fh2, Mh_ dtSfy_rhs,sas); + sub_kodis_ss(sst,Mh_ dtSfz,Mh_ fh2, Mh_ dtSfz_rhs,ssa); +#endif + } + if(co == 0){ + compute_rhs_ss_part7<<>>(); + cudaThreadSynchronize(); + + sub_fderivs_shc(sst,Mh_ Axx,Mh_ fh,Mh_ gxxx,Mh_ gxxy,Mh_ gxxz,sss); + sub_fderivs_shc(sst,Mh_ Axy,Mh_ fh,Mh_ gxyx,Mh_ gxyy,Mh_ gxyz,aas); + sub_fderivs_shc(sst,Mh_ Axz,Mh_ fh,Mh_ gxzx,Mh_ gxzy,Mh_ gxzz,asa); + sub_fderivs_shc(sst,Mh_ Ayy,Mh_ fh,Mh_ gyyx,Mh_ gyyy,Mh_ gyyz,sss); + sub_fderivs_shc(sst,Mh_ Ayz,Mh_ fh,Mh_ gyzx,Mh_ gyzy,Mh_ gyzz,saa); + sub_fderivs_shc(sst,Mh_ Azz,Mh_ fh,Mh_ gzzx,Mh_ gzzy,Mh_ gzzz,sss); + compute_rhs_ss_part8<<>>(); + cudaThreadSynchronize(); + } + +#if (ABV == 1) + cout<<"TODO: bssn_gpu.cu::2373 (ABV == 1)"< +#include +#include +using namespace std; + +int compare_two_file(char *fname1, char *fname2, int data_num) +{ + // read file + fstream file1(fname1, ios_base::in); + fstream file2(fname2, ios_base::in); + double *d1, *d2; + d1 = (double *)malloc(sizeof(double) * data_num); + d2 = (double *)malloc(sizeof(double) * data_num); + + for (int i = 0; i < data_num; ++i) + { + file1.read((char *)(d1 + i), sizeof(double)); + file2.read((char *)(d2 + i), sizeof(double)); + } + + // compare data + bool is_match = true; + for (int i = 0; i < data_num; ++i) + { + if (d1[i] != d2[i]) + { + is_match = false; + cout << "miss match at position " << i << endl; + break; + } + } + if (is_match) + cout << "Result is right." << endl; + + free(d1); + free(d2); + file1.close(); + file2.close(); + return 0; +} +void printMatrix(int ftag1, int ftag2, double *d1, double *d2, int ord) +{ + char fname1[32]; + char fname2[32]; + // char ftag1[32]; char ftag2[32]; + // sprintf(ftag1,"%d",ftag1); + strcpy(fname1, "matrix_f.show"); + // strcat(fname1,ftag1); + + // sprintf(ftag2,"%d",ftag2); + strcpy(fname2, "matrix_g.show"); + // strcat(fname2,ftag2); + + ofstream fout0, fout1, fout2; + fout1.open(fname1); + fout2.open(fname2); + + for (int k = 0; k < 65; k++) + { + fout1 << "---------square " << k << " ----------" << endl; + fout2 << "---------square " << k << " ----------" << endl; + for (int j = 0; j < 67 + ord * 2; j++) + { + for (int i = 0; i < 67 + ord * 2; i++) + { + fout1 << d1[i + j * (67 + ord * 2) + k * ((67 + ord * 2) * (67 + ord * 2))] << ' '; + fout2 << d2[i + j * (67 + ord * 2) + k * ((67 + ord * 2) * (67 + ord * 2))] << ' '; + // fout1<shape[0]) + k*(_2d_size)] <<' '; + // fout2<shape[0]) + k*(_2d_size)] <<' '; + } + fout1 << endl; + fout2 << endl; + } + } +} + +int compare_result(int ftag1, double *d2, int data_num) +{ + // read file + char fname1[32]; + char ftag[32]; + // itoa(filetag,ftag,10); + sprintf(ftag, "%d", ftag1); + strcpy(fname1, "matrix_f.out"); + strcat(fname1, ftag); + + fstream file1(fname1, ios_base::in); + double *d1; + d1 = (double *)malloc(sizeof(double) * data_num); + + for (int i = 0; i < data_num; ++i) + { + file1.read((char *)(d1 + i), sizeof(double)); + } + + // compare data + bool is_match = true; + double delta; + for (int i = 0; i < data_num; ++i) + { + delta = d1[i] - d2[i]; + if (delta < 0) + delta = -delta; + if (delta > 1e-14) + { + is_match = false; + cout << fname1 << "::miss match at position " << i << endl; + break; + } + // if(i<100 && i>50) + // cout<shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,ndeps,pre + +#define RHS_PARA_CALLED_THEN cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[phi->sgfn],cg->fgfs[trK->sgfn],cg->fgfs[gxx->sgfn],cg->fgfs[gxy->sgfn],cg->fgfs[gxz->sgfn],cg->fgfs[gyy->sgfn],cg->fgfs[gyz->sgfn],cg->fgfs[gzz->sgfn],cg->fgfs[Axx->sgfn],cg->fgfs[Axy->sgfn],cg->fgfs[Axz->sgfn],cg->fgfs[Ayy->sgfn],cg->fgfs[Ayz->sgfn],cg->fgfs[Azz->sgfn],cg->fgfs[Gmx->sgfn],cg->fgfs[Gmy->sgfn],cg->fgfs[Gmz->sgfn],cg->fgfs[Lap->sgfn],cg->fgfs[Sfx->sgfn],cg->fgfs[Sfy->sgfn],cg->fgfs[Sfz->sgfn],cg->fgfs[dtSfx->sgfn],cg->fgfs[dtSfy->sgfn],cg->fgfs[dtSfz->sgfn],cg->fgfs[phi1->sgfn],cg->fgfs[trK1->sgfn],cg->fgfs[gxx1->sgfn],cg->fgfs[gxy1->sgfn],cg->fgfs[gxz1->sgfn],cg->fgfs[gyy1->sgfn],cg->fgfs[gyz1->sgfn],cg->fgfs[gzz1->sgfn],cg->fgfs[Axx1->sgfn],cg->fgfs[Axy1->sgfn],cg->fgfs[Axz1->sgfn],cg->fgfs[Ayy1->sgfn],cg->fgfs[Ayz1->sgfn],cg->fgfs[Azz1->sgfn],cg->fgfs[Gmx1->sgfn],cg->fgfs[Gmy1->sgfn],cg->fgfs[Gmz1->sgfn],cg->fgfs[Lap1->sgfn],cg->fgfs[Sfx1->sgfn],cg->fgfs[Sfy1->sgfn],cg->fgfs[Sfz1->sgfn],cg->fgfs[dtSfx1->sgfn],cg->fgfs[dtSfy1->sgfn],cg->fgfs[dtSfz1->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,ndeps,cor + +#define RHS_PARA_CALLED_Constraint_Out cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,ndeps,pre + + +#define RHS_PARA_CALLED_Interp_Constraint cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,ndeps,pre + +#define RHS_SS_PARA_CALLED_FIRST_TIME cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[fngfs+ShellPatch::gx],cg->fgfs[fngfs+ShellPatch::gy],cg->fgfs[fngfs+ShellPatch::gz],cg->fgfs[fngfs+ShellPatch::drhodx],cg->fgfs[fngfs+ShellPatch::drhody],cg->fgfs[fngfs+ShellPatch::drhodz],cg->fgfs[fngfs+ShellPatch::dsigmadx],cg->fgfs[fngfs+ShellPatch::dsigmady],cg->fgfs[fngfs+ShellPatch::dsigmadz],cg->fgfs[fngfs+ShellPatch::dRdx],cg->fgfs[fngfs+ShellPatch::dRdy],cg->fgfs[fngfs+ShellPatch::dRdz],cg->fgfs[fngfs+ShellPatch::drhodxx],cg->fgfs[fngfs+ShellPatch::drhodxy],cg->fgfs[fngfs+ShellPatch::drhodxz],cg->fgfs[fngfs+ShellPatch::drhodyy],cg->fgfs[fngfs+ShellPatch::drhodyz],cg->fgfs[fngfs+ShellPatch::drhodzz],cg->fgfs[fngfs+ShellPatch::dsigmadxx],cg->fgfs[fngfs+ShellPatch::dsigmadxy],cg->fgfs[fngfs+ShellPatch::dsigmadxz],cg->fgfs[fngfs+ShellPatch::dsigmadyy],cg->fgfs[fngfs+ShellPatch::dsigmadyz],cg->fgfs[fngfs+ShellPatch::dsigmadzz],cg->fgfs[fngfs+ShellPatch::dRdxx],cg->fgfs[fngfs+ShellPatch::dRdxy],cg->fgfs[fngfs+ShellPatch::dRdxz],cg->fgfs[fngfs+ShellPatch::dRdyy],cg->fgfs[fngfs+ShellPatch::dRdyz],cg->fgfs[fngfs+ShellPatch::dRdzz],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,numepsh,sPp->data->sst,pre + +#define RHS_SS_PARA_CALLED_THEN cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[fngfs+ShellPatch::gx],cg->fgfs[fngfs+ShellPatch::gy],cg->fgfs[fngfs+ShellPatch::gz],cg->fgfs[fngfs+ShellPatch::drhodx],cg->fgfs[fngfs+ShellPatch::drhody],cg->fgfs[fngfs+ShellPatch::drhodz],cg->fgfs[fngfs+ShellPatch::dsigmadx],cg->fgfs[fngfs+ShellPatch::dsigmady],cg->fgfs[fngfs+ShellPatch::dsigmadz],cg->fgfs[fngfs+ShellPatch::dRdx],cg->fgfs[fngfs+ShellPatch::dRdy],cg->fgfs[fngfs+ShellPatch::dRdz],cg->fgfs[fngfs+ShellPatch::drhodxx],cg->fgfs[fngfs+ShellPatch::drhodxy],cg->fgfs[fngfs+ShellPatch::drhodxz],cg->fgfs[fngfs+ShellPatch::drhodyy],cg->fgfs[fngfs+ShellPatch::drhodyz],cg->fgfs[fngfs+ShellPatch::drhodzz],cg->fgfs[fngfs+ShellPatch::dsigmadxx],cg->fgfs[fngfs+ShellPatch::dsigmadxy],cg->fgfs[fngfs+ShellPatch::dsigmadxz],cg->fgfs[fngfs+ShellPatch::dsigmadyy],cg->fgfs[fngfs+ShellPatch::dsigmadyz],cg->fgfs[fngfs+ShellPatch::dsigmadzz],cg->fgfs[fngfs+ShellPatch::dRdxx],cg->fgfs[fngfs+ShellPatch::dRdxy],cg->fgfs[fngfs+ShellPatch::dRdxz],cg->fgfs[fngfs+ShellPatch::dRdyy],cg->fgfs[fngfs+ShellPatch::dRdyz],cg->fgfs[fngfs+ShellPatch::dRdzz],cg->fgfs[phi->sgfn],cg->fgfs[trK->sgfn],cg->fgfs[gxx->sgfn],cg->fgfs[gxy->sgfn],cg->fgfs[gxz->sgfn],cg->fgfs[gyy->sgfn],cg->fgfs[gyz->sgfn],cg->fgfs[gzz->sgfn],cg->fgfs[Axx->sgfn],cg->fgfs[Axy->sgfn],cg->fgfs[Axz->sgfn],cg->fgfs[Ayy->sgfn],cg->fgfs[Ayz->sgfn],cg->fgfs[Azz->sgfn],cg->fgfs[Gmx->sgfn],cg->fgfs[Gmy->sgfn],cg->fgfs[Gmz->sgfn],cg->fgfs[Lap->sgfn],cg->fgfs[Sfx->sgfn],cg->fgfs[Sfy->sgfn],cg->fgfs[Sfz->sgfn],cg->fgfs[dtSfx->sgfn],cg->fgfs[dtSfy->sgfn],cg->fgfs[dtSfz->sgfn],cg->fgfs[phi1->sgfn],cg->fgfs[trK1->sgfn],cg->fgfs[gxx1->sgfn],cg->fgfs[gxy1->sgfn],cg->fgfs[gxz1->sgfn],cg->fgfs[gyy1->sgfn],cg->fgfs[gyz1->sgfn],cg->fgfs[gzz1->sgfn],cg->fgfs[Axx1->sgfn],cg->fgfs[Axy1->sgfn],cg->fgfs[Axz1->sgfn],cg->fgfs[Ayy1->sgfn],cg->fgfs[Ayz1->sgfn],cg->fgfs[Azz1->sgfn],cg->fgfs[Gmx1->sgfn],cg->fgfs[Gmy1->sgfn],cg->fgfs[Gmz1->sgfn],cg->fgfs[Lap1->sgfn],cg->fgfs[Sfx1->sgfn],cg->fgfs[Sfy1->sgfn],cg->fgfs[Sfz1->sgfn],cg->fgfs[dtSfx1->sgfn],cg->fgfs[dtSfy1->sgfn],cg->fgfs[dtSfz1->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,numepsh,sPp->data->sst,cor + + +#define RHS_PARA_CALLED_Constraint_Out_SS cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[fngfs+ShellPatch::gx],cg->fgfs[fngfs+ShellPatch::gy],cg->fgfs[fngfs+ShellPatch::gz],cg->fgfs[fngfs+ShellPatch::drhodx],cg->fgfs[fngfs+ShellPatch::drhody],cg->fgfs[fngfs+ShellPatch::drhodz],cg->fgfs[fngfs+ShellPatch::dsigmadx],cg->fgfs[fngfs+ShellPatch::dsigmady],cg->fgfs[fngfs+ShellPatch::dsigmadz],cg->fgfs[fngfs+ShellPatch::dRdx],cg->fgfs[fngfs+ShellPatch::dRdy],cg->fgfs[fngfs+ShellPatch::dRdz],cg->fgfs[fngfs+ShellPatch::drhodxx],cg->fgfs[fngfs+ShellPatch::drhodxy],cg->fgfs[fngfs+ShellPatch::drhodxz],cg->fgfs[fngfs+ShellPatch::drhodyy],cg->fgfs[fngfs+ShellPatch::drhodyz],cg->fgfs[fngfs+ShellPatch::drhodzz],cg->fgfs[fngfs+ShellPatch::dsigmadxx],cg->fgfs[fngfs+ShellPatch::dsigmadxy],cg->fgfs[fngfs+ShellPatch::dsigmadxz],cg->fgfs[fngfs+ShellPatch::dsigmadyy],cg->fgfs[fngfs+ShellPatch::dsigmadyz],cg->fgfs[fngfs+ShellPatch::dsigmadzz],cg->fgfs[fngfs+ShellPatch::dRdxx],cg->fgfs[fngfs+ShellPatch::dRdxy],cg->fgfs[fngfs+ShellPatch::dRdxz],cg->fgfs[fngfs+ShellPatch::dRdyy],cg->fgfs[fngfs+ShellPatch::dRdyz],cg->fgfs[fngfs+ShellPatch::dRdzz],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,numepsh,sPp->data->sst,pre + +#define RHS_PARA_CALLED_Intrp_Constraint_Out_SS cg->shape,TRK4,cg->X[0],cg->X[1],cg->X[2],cg->fgfs[fngfs+ShellPatch::gx],cg->fgfs[fngfs+ShellPatch::gy],cg->fgfs[fngfs+ShellPatch::gz],cg->fgfs[fngfs+ShellPatch::drhodx],cg->fgfs[fngfs+ShellPatch::drhody],cg->fgfs[fngfs+ShellPatch::drhodz],cg->fgfs[fngfs+ShellPatch::dsigmadx],cg->fgfs[fngfs+ShellPatch::dsigmady],cg->fgfs[fngfs+ShellPatch::dsigmadz],cg->fgfs[fngfs+ShellPatch::dRdx],cg->fgfs[fngfs+ShellPatch::dRdy],cg->fgfs[fngfs+ShellPatch::dRdz],cg->fgfs[fngfs+ShellPatch::drhodxx],cg->fgfs[fngfs+ShellPatch::drhodxy],cg->fgfs[fngfs+ShellPatch::drhodxz],cg->fgfs[fngfs+ShellPatch::drhodyy],cg->fgfs[fngfs+ShellPatch::drhodyz],cg->fgfs[fngfs+ShellPatch::drhodzz],cg->fgfs[fngfs+ShellPatch::dsigmadxx],cg->fgfs[fngfs+ShellPatch::dsigmadxy],cg->fgfs[fngfs+ShellPatch::dsigmadxz],cg->fgfs[fngfs+ShellPatch::dsigmadyy],cg->fgfs[fngfs+ShellPatch::dsigmadyz],cg->fgfs[fngfs+ShellPatch::dsigmadzz],cg->fgfs[fngfs+ShellPatch::dRdxx],cg->fgfs[fngfs+ShellPatch::dRdxy],cg->fgfs[fngfs+ShellPatch::dRdxz],cg->fgfs[fngfs+ShellPatch::dRdyy],cg->fgfs[fngfs+ShellPatch::dRdyz],cg->fgfs[fngfs+ShellPatch::dRdzz],cg->fgfs[phi0->sgfn],cg->fgfs[trK0->sgfn],cg->fgfs[gxx0->sgfn],cg->fgfs[gxy0->sgfn],cg->fgfs[gxz0->sgfn],cg->fgfs[gyy0->sgfn],cg->fgfs[gyz0->sgfn],cg->fgfs[gzz0->sgfn],cg->fgfs[Axx0->sgfn],cg->fgfs[Axy0->sgfn],cg->fgfs[Axz0->sgfn],cg->fgfs[Ayy0->sgfn],cg->fgfs[Ayz0->sgfn],cg->fgfs[Azz0->sgfn],cg->fgfs[Gmx0->sgfn],cg->fgfs[Gmy0->sgfn],cg->fgfs[Gmz0->sgfn],cg->fgfs[Lap0->sgfn],cg->fgfs[Sfx0->sgfn],cg->fgfs[Sfy0->sgfn],cg->fgfs[Sfz0->sgfn],cg->fgfs[dtSfx0->sgfn],cg->fgfs[dtSfy0->sgfn],cg->fgfs[dtSfz0->sgfn],cg->fgfs[phi_rhs->sgfn],cg->fgfs[trK_rhs->sgfn],cg->fgfs[gxx_rhs->sgfn],cg->fgfs[gxy_rhs->sgfn],cg->fgfs[gxz_rhs->sgfn],cg->fgfs[gyy_rhs->sgfn],cg->fgfs[gyz_rhs->sgfn],cg->fgfs[gzz_rhs->sgfn],cg->fgfs[Axx_rhs->sgfn],cg->fgfs[Axy_rhs->sgfn],cg->fgfs[Axz_rhs->sgfn],cg->fgfs[Ayy_rhs->sgfn],cg->fgfs[Ayz_rhs->sgfn],cg->fgfs[Azz_rhs->sgfn],cg->fgfs[Gmx_rhs->sgfn],cg->fgfs[Gmy_rhs->sgfn],cg->fgfs[Gmz_rhs->sgfn],cg->fgfs[Lap_rhs->sgfn],cg->fgfs[Sfx_rhs->sgfn],cg->fgfs[Sfy_rhs->sgfn],cg->fgfs[Sfz_rhs->sgfn],cg->fgfs[dtSfx_rhs->sgfn],cg->fgfs[dtSfy_rhs->sgfn],cg->fgfs[dtSfz_rhs->sgfn],cg->fgfs[rho->sgfn],cg->fgfs[Sx->sgfn],cg->fgfs[Sy->sgfn],cg->fgfs[Sz->sgfn],cg->fgfs[Sxx->sgfn],cg->fgfs[Sxy->sgfn],cg->fgfs[Sxz->sgfn],cg->fgfs[Syy->sgfn],cg->fgfs[Syz->sgfn],cg->fgfs[Szz->sgfn],cg->fgfs[Gamxxx->sgfn],cg->fgfs[Gamxxy->sgfn],cg->fgfs[Gamxxz->sgfn],cg->fgfs[Gamxyy->sgfn],cg->fgfs[Gamxyz->sgfn],cg->fgfs[Gamxzz->sgfn],cg->fgfs[Gamyxx->sgfn],cg->fgfs[Gamyxy->sgfn],cg->fgfs[Gamyxz->sgfn],cg->fgfs[Gamyyy->sgfn],cg->fgfs[Gamyyz->sgfn],cg->fgfs[Gamyzz->sgfn],cg->fgfs[Gamzxx->sgfn],cg->fgfs[Gamzxy->sgfn],cg->fgfs[Gamzxz->sgfn],cg->fgfs[Gamzyy->sgfn],cg->fgfs[Gamzyz->sgfn],cg->fgfs[Gamzzz->sgfn],cg->fgfs[Rxx->sgfn],cg->fgfs[Rxy->sgfn],cg->fgfs[Rxz->sgfn],cg->fgfs[Ryy->sgfn],cg->fgfs[Ryz->sgfn],cg->fgfs[Rzz->sgfn],cg->fgfs[Cons_Ham->sgfn],cg->fgfs[Cons_Px->sgfn],cg->fgfs[Cons_Py->sgfn],cg->fgfs[Cons_Pz->sgfn],cg->fgfs[Cons_Gx->sgfn],cg->fgfs[Cons_Gy->sgfn],cg->fgfs[Cons_Gz->sgfn],Symmetry,lev,numepsh,sPp->data->sst,pre +//4------------tool------------------------------ +int compare_result(int ftag1,double * d2,int data_num); + + + +#endif diff --git a/AMSS_NCKU_source/bssn_rhs.f90 b/AMSS_NCKU_source/bssn_rhs.f90 new file mode 100644 index 0000000..80908cb --- /dev/null +++ b/AMSS_NCKU_source/bssn_rhs.f90 @@ -0,0 +1,1186 @@ + + +#include "macrodef.fh" + + function compute_rhs_bssn(ex, T,X, Y, Z, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,eps,co) result(gont) +! calculate constraint violation when co=0 + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,co + real*8, intent(in ):: T + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8,intent(in) :: eps + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gmx_Res, Gmy_Res, Gmz_Res +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO = 0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + double precision,parameter::FF = 0.75d0,eta=2.d0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + real*8, parameter :: F16=1.6d1,F8=8.d0 + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5) + real*8, dimension(ex(1),ex(2),ex(3)) :: reta +#endif + +#if (GAUGE == 6 || GAUGE == 7) + integer :: BHN,i,j,k + real*8, dimension(9) :: Porg + real*8, dimension(3) :: Mass + real*8 :: r1,r2,M,A,w1,w2,C1,C2 + real*8, dimension(ex(1),ex(2),ex(3)) :: reta + + call getpbh(BHN,Porg,Mass) +#endif + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"bssn.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"bssn.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"bssn.f90: find NaN in dxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"bssn.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"bssn.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"bssn.f90: find NaN in dyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"bssn.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"bssn.f90: find NaN in dzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"bssn.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"bssn.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"bssn.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"bssn.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"bssn.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"bssn.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"bssn.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"bssn.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"bssn.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"bssn.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"bssn.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"bssn.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"bssn.f90: find NaN in betaz" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs(ex,betax,betaxx,betaxy,betaxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ex,betay,betayx,betayy,betayz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ex,betaz,betazx,betazy,betazz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + + div_beta = betaxx + betayy + betazz + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + chi_rhs = F2o3 *chin1*( alpn1 * trK - div_beta ) !rhs for chi + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,Lev) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,Lev) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + if(co == 0)then +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gamx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gamy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gamz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + endif + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... + call fderivs(ex,Lap,Lapx,Lapy,Lapz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + call fderivs(ex,trK,Kx,Ky,Kz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,& + X,Y,Z,ANTI,SYM, SYM ,Symmetry,Lev) + call fdderivs(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,& + X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fdderivs(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,& + X,Y,Z,SYM ,SYM, ANTI,Symmetry,Lev) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs(ex,Gamx,Gamxx,Gamxy,Gamxz,X,Y,Z,ANTI,SYM ,SYM ,Symmetry,Lev) + call fderivs(ex,Gamy,Gamyx,Gamyy,Gamyz,X,Y,Z,SYM ,ANTI,SYM ,Symmetry,Lev) + call fderivs(ex,Gamz,Gamzx,Gamzy,Gamzz,X,Y,Z,SYM ,SYM ,ANTI,Symmetry,Lev) + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,Lev) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI, ANTI,SYM ,symmetry,Lev) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI ,SYM ,ANTI,symmetry,Lev) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,ANTI ,ANTI,symmetry,Lev) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + +! covariant second derivatives of the lapse respect to physical metric + call fdderivs(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM,SYM,SYM,symmetry,Lev) + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +#if 1 +!! follow bam code + S = chin1 * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + f = F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) )) -1.6d1*PI*rho + EIGHT * PI * S + f = - F1o3 *( gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + alpn1/chin1*f) + + fxx = alpn1 * (Rxx - EIGHT * PI * Sxx) - fxx + fxy = alpn1 * (Rxy - EIGHT * PI * Sxy) - fxy + fxz = alpn1 * (Rxz - EIGHT * PI * Sxz) - fxz + fyy = alpn1 * (Ryy - EIGHT * PI * Syy) - fyy + fyz = alpn1 * (Ryz - EIGHT * PI * Syz) - fyz + fzz = alpn1 * (Rzz - EIGHT * PI * Szz) - fzz +#else +! Add lapse and S_ij parts to Ricci tensor: + + fxx = alpn1 * (Rxx - EIGHT * PI * Sxx) - fxx + fxy = alpn1 * (Rxy - EIGHT * PI * Sxy) - fxy + fxz = alpn1 * (Rxz - EIGHT * PI * Sxz) - fxz + fyy = alpn1 * (Ryy - EIGHT * PI * Syy) - fyy + fyz = alpn1 * (Ryz - EIGHT * PI * Syz) - fyz + fzz = alpn1 * (Rzz - EIGHT * PI * Szz) - fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + + f = F1o3 *( gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) ) +#endif + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trK * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx )- & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trK * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy )- & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trK * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz )- & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trK * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trK * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trK * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trK * trK + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!! gauge variable part + + Lap_rhs = -TWO*alpn1*trK +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 2) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + call fderivs(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-dsqrt(chin1))**2 + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 3) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + call fderivs(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-chin1)**2 + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 4) + call fderivs(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-dsqrt(chin1))**2 + betax_rhs = FF*Gamx - reta*betax + betay_rhs = FF*Gamy - reta*betay + betaz_rhs = FF*Gamz - reta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 5) + call fderivs(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-chin1)**2 + betax_rhs = FF*Gamx - reta*betax + betay_rhs = FF*Gamy - reta*betay + betaz_rhs = FF*Gamz - reta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 6) + if(BHN==2)then + M = Mass(1)+Mass(2) + A = 2.d0/M + w1 = 1.2d1 + w2 = w1 + C1 = 1.d0/Mass(1) - A + C2 = 1.d0/Mass(2) - A + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + r1 = ((Porg(1)-X(i))**2+(Porg(2)-Y(j))**2+(Porg(3)-Z(k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + r2 = ((Porg(4)-X(i))**2+(Porg(5)-Y(j))**2+(Porg(6)-Z(k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + reta(i,j,k) = A + C1/(ONE+w1*r1) + C2/(ONE+w2*r2) + enddo + enddo + enddo + else + write(*,*) "not support BH_num in Jason's form 1",BHN + endif + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 7) + if(BHN==2)then + M = Mass(1)+Mass(2) + A = 2.d0/M + w1 = 1.2d1 + w2 = w1 + C1 = 1.d0/Mass(1) - A + C2 = 1.d0/Mass(2) - A + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + r1 = ((Porg(1)-X(i))**2+(Porg(2)-Y(j))**2+(Porg(3)-Z(k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + r2 = ((Porg(4)-X(i))**2+(Porg(5)-Y(j))**2+(Porg(6)-Z(k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + reta(i,j,k) = A + C1*dexp(-w1*r1) + C2*dexp(-w2*r2) + enddo + enddo + enddo + else + write(*,*) "not support BH_num in Jason's form 2",BHN + endif + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part + + call lopsided(ex,X,Y,Z,gxx,gxx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gxy,gxy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,gxz,gxz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,gyy,gyy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,gyz,gyz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,gzz,gzz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Axx,Axx_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Axy,Axy_rhs,betax,betay,betaz,Symmetry,AAS) + call lopsided(ex,X,Y,Z,Axz,Axz_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ex,X,Y,Z,Ayy,Ayy_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,Ayz,Ayz_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ex,X,Y,Z,Azz,Azz_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,chi,chi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ex,X,Y,Z,trK,trK_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ex,X,Y,Z,Gamx,Gamx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,Gamy,Gamy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,Gamz,Gamz_rhs,betax,betay,betaz,Symmetry,SSA) +!! + call lopsided(ex,X,Y,Z,Lap,Lap_rhs,betax,betay,betaz,Symmetry,SSS) + +#if (GAUGE == 0 || GAUGE == 1 || GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + call lopsided(ex,X,Y,Z,betax,betax_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,betay,betay_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,betaz,betaz_rhs,betax,betay,betaz,Symmetry,SSA) +#endif + +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + call lopsided(ex,X,Y,Z,dtSfx,dtSfx_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ex,X,Y,Z,dtSfy,dtSfy_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ex,X,Y,Z,dtSfz,dtSfz_rhs,betax,betay,betaz,Symmetry,SSA) +#endif + + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis(ex,X,Y,Z,chi,chi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,trK,trK_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,dxx,gxx_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxy,gxy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,gxz,gxz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,dyy,gyy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,gyz,gyz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,dzz,gzz_rhs,SSS,Symmetry,eps) +#if 0 +#define i 42 +#define j 40 +#define k 40 +if(Lev == 1)then +write(*,*) X(i),Y(j),Z(k) +write(*,*) "before",Axx_rhs(i,j,k) +endif +#undef i +#undef j +#undef k +!!stop +#endif + call kodis(ex,X,Y,Z,Axx,Axx_rhs,SSS,Symmetry,eps) +#if 0 +#define i 42 +#define j 40 +#define k 40 +if(Lev == 1)then +write(*,*) X(i),Y(j),Z(k) +write(*,*) "after",Axx_rhs(i,j,k) +endif +#undef i +#undef j +#undef k +!!stop +#endif + call kodis(ex,X,Y,Z,Axy,Axy_rhs,AAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Axz,Axz_rhs,ASA,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayy,Ayy_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Ayz,Ayz_rhs,SAA,Symmetry,eps) + call kodis(ex,X,Y,Z,Azz,Azz_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamx,Gamx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamy,Gamy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,Gamz,Gamz_rhs,SSA,Symmetry,eps) + +#if 1 +!! bam does not apply dissipation on gauge variables + call kodis(ex,X,Y,Z,Lap,Lap_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,betax,betax_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,betay,betay_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,betaz,betaz_rhs,SSA,Symmetry,eps) +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + call kodis(ex,X,Y,Z,dtSfx,dtSfx_rhs,ASS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfy,dtSfy_rhs,SAS,Symmetry,eps) + call kodis(ex,X,Y,Z,dtSfz,dtSfz_rhs,SSA,Symmetry,eps) +#endif +#endif + + endif + + if(co == 0)then +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + call fderivs(ex,Axx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Axz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Ayy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Ayz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Azz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +movx_Res = movx_Res - F2o3*Kx - F8*PI*sx +movy_Res = movy_Res - F2o3*Ky - F8*PI*sy +movz_Res = movz_Res - F2o3*Kz - F8*PI*sz + endif + +#if (ABV == 1) + call ricci_gamma(ex, X, Y, Z, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) + call constraint_bssn(ex, X, Y, Z,& + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res,movx_Res,movy_Res,movz_Res,Gmx_Res,Gmy_Res,Gmz_Res, & + Symmetry) +#endif +#if 0 +#define i 2 +if(Lev == 1)then +write(*,*) X(i),Y(i),Z(i) +write(*,*) Axx(i,i,i),Axy(i,i,i),Axz(i,i,i),Ayy(i,i,i),Ayz(i,i,i),Azz(i,i,i) +write(*,*) 1+Lap(i,i,i),dtSfx(i,i,i),dtSfy(i,i,i),dtSfz(i,i,i) +write(*,*) betax(i,i,i),betay(i,i,i),betaz(i,i,i) +write(*,*) 1+chi(i,i,i),Gamx(i,i,i),Gamy(i,i,i),Gamz(i,i,i) +write(*,*) gxx(i,i,i),gxy(i,i,i),gxz(i,i,i),gyy(i,i,i),gyz(i,i,i),gzz(i,i,i) +write(*,*) trK(i,i,i) +write(*,*) "=====" +write(*,*) Axx_rhs(i,i,i),Axy_rhs(i,i,i),Axz_rhs(i,i,i),Ayy_rhs(i,i,i),Ayz_rhs(i,i,i),Azz_rhs(i,i,i) +write(*,*) Lap_rhs(i,i,i),dtSfx_rhs(i,i,i),dtSfy_rhs(i,i,i),dtSfz_rhs(i,i,i) +write(*,*) betax_rhs(i,i,i),betay_rhs(i,i,i),betaz_rhs(i,i,i) +write(*,*) chi_rhs(i,i,i),Gamx_rhs(i,i,i),Gamy_rhs(i,i,i),Gamz_rhs(i,i,i) +write(*,*) gxx_rhs(i,i,i),gxy_rhs(i,i,i),gxz_rhs(i,i,i),gyy_rhs(i,i,i),gyz_rhs(i,i,i),gzz_rhs(i,i,i) +write(*,*) trK_rhs(i,i,i) +endif +#undef i +!!stop +#endif + + gont = 0 + + return + + end function compute_rhs_bssn diff --git a/AMSS_NCKU_source/bssn_rhs.h b/AMSS_NCKU_source/bssn_rhs.h new file mode 100644 index 0000000..363420d --- /dev/null +++ b/AMSS_NCKU_source/bssn_rhs.h @@ -0,0 +1,231 @@ + +#ifndef BSSN_H +#define BSSN_H + +#ifdef fortran1 +#define f_compute_rhs_bssn compute_rhs_bssn +#define f_compute_rhs_bssn_ss compute_rhs_bssn_ss +#define f_compute_rhs_bssn_escalar compute_rhs_bssn_escalar +#define f_compute_rhs_bssn_escalar_ss compute_rhs_bssn_escalar_ss +#define f_compute_rhs_Z4c compute_rhs_z4c +#define f_compute_rhs_Z4cnot compute_rhs_z4cnot +#define f_compute_rhs_Z4c_ss compute_rhs_z4c_ss +#define f_compute_constraint_fr compute_constraint_fr +#endif +#ifdef fortran2 +#define f_compute_rhs_bssn COMPUTE_RHS_BSSN +#define f_compute_rhs_bssn_ss COMPUTE_RHS_BSSN_SS +#define f_compute_rhs_bssn_escalar COMPUTE_RHS_BSSN_ESCALAR +#define f_compute_rhs_bssn_escalar_ss COMPUTE_RHS_BSSN_ESCALAR_SS +#define f_compute_rhs_Z4c COMPUTE_RHS_Z4C +#define f_compute_rhs_Z4cnot COMPUTE_RHS_Z4CNOT +#define f_compute_rhs_Z4c_ss COMPUTE_RHS_Z4C_SS +#define f_compute_constraint_fr COMPUTE_CONSTRAINT_FR +#endif +#ifdef fortran3 +#define f_compute_rhs_bssn compute_rhs_bssn_ +#define f_compute_rhs_bssn_ss compute_rhs_bssn_ss_ +#define f_compute_rhs_bssn_escalar compute_rhs_bssn_escalar_ +#define f_compute_rhs_bssn_escalar_ss compute_rhs_bssn_escalar_ss_ +#define f_compute_rhs_Z4c compute_rhs_z4c_ +#define f_compute_rhs_Z4cnot compute_rhs_z4cnot_ +#define f_compute_rhs_Z4c_ss compute_rhs_z4c_ss_ +#define f_compute_constraint_fr compute_constraint_fr_ +#endif +extern "C" +{ + int f_compute_rhs_bssn(int *, double &, double *, double *, double *, // ex,T,X,Y,Z + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, // stress-energy + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, double *, double *, double *, double *, // constraint violation + int &, int &, double &, int &); +} + +extern "C" +{ + int f_compute_rhs_bssn_ss(int *, double &, double *, double *, double *, // ex,T,rho,sigma,R + double *, double *, double *, // X,Y,Z + double *, double *, double *, // drhodx,drhody,drhodz + double *, double *, double *, // dsigmadx,dsigmady,dsigmadz + double *, double *, double *, // dRdx,dRdy,dRdz + double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, // stress-energy + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, double *, double *, double *, double *, // constraint violation + int &, int &, double &, int &, int &); +} + +extern "C" +{ + int f_compute_rhs_bssn_escalar(int *, double &, double *, double *, double *, // ex,T,X,Y,Z + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // Sphi, Spi + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // Sphi, Spi + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, // stress-energy + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, double *, double *, double *, double *, // constraint violation + int &, int &, double &, int &); +} + +extern "C" +{ + int f_compute_rhs_bssn_escalar_ss(int *, double &, double *, double *, double *, // ex,T,rho,sigma,R + double *, double *, double *, // X,Y,Z + double *, double *, double *, // drhodx,drhody,drhodz + double *, double *, double *, // dsigmadx,dsigmady,dsigmadz + double *, double *, double *, // dRdx,dRdy,dRdz + double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // Sphi,Spi + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, // Sphi,Spi + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, // stress-energy + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, double *, double *, double *, double *, // constraint violation + int &, int &, double &, int &, int &); +} + +extern "C" +{ + int f_compute_rhs_Z4c(int *, double &, double *, double *, double *, // ex,T,X,Y,Z + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // Z4 + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // Z4 + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + int &, int &, double &, int &); +} + +extern "C" +{ + int f_compute_rhs_Z4c_ss(int *, double &, double *, double *, double *, // ex,T,rho,sigma,R + double *, double *, double *, // X,Y,Z + double *, double *, double *, // drhodx,drhody,drhodz + double *, double *, double *, // dsigmadx,dsigmady,dsigmadz + double *, double *, double *, // dRdx,dRdy,dRdz + double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // TZ + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // TZ + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, // stress-energy + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, double *, double *, double *, double *, // constraint violation + int &, int &, double &, int &, int &); +} + +extern "C" +{ + int f_compute_rhs_Z4cnot(int *, double &, double *, double *, double *, // ex,T,X,Y,Z + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // Z4 + double *, double *, // chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, // Z4 + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + int &, int &, double &, int &, double &); +} + +extern "C" +{ + void f_compute_constraint_fr(int *, double *, double *, double *, // ex,X,Y,Z + double *, double *, double *, double *, // chi, trK,rho,Sphi + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, double *, double *, double *, // Rij + double *, double *, double *, double *, double *, double *, // Sij + double *); +} // FR_cons + +#endif /* BSSN_H */ diff --git a/AMSS_NCKU_source/bssn_rhs_ss.f90 b/AMSS_NCKU_source/bssn_rhs_ss.f90 new file mode 100644 index 0000000..7ee3608 --- /dev/null +++ b/AMSS_NCKU_source/bssn_rhs_ss.f90 @@ -0,0 +1,1358 @@ + + +#include "macrodef.fh" + + function compute_rhs_bssn_ss(ex, T,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , trK , & + dxx , gxy , gxz , dyy , gyz , dzz, & + Axx , Axy , Axz , Ayy , Ayz , Azz, & + Gamx , Gamy , Gamz , & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + chi_rhs, trK_rhs, & + gxx_rhs, gxy_rhs, gxz_rhs, gyy_rhs, gyz_rhs, gzz_rhs, & + Axx_rhs, Axy_rhs, Axz_rhs, Ayy_rhs, Ayz_rhs, Azz_rhs, & + Gamx_rhs, Gamy_rhs, Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz, & + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz, & + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res, movx_Res, movy_Res, movz_Res, & + Gmx_Res, Gmy_Res, Gmz_Res, & + Symmetry,Lev,eps,sst,co) result(gont) +! calculate constraint violation when co=0 + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,co + real*8, intent(in ):: T + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sxx,Sxy,Sxz,Syy,Syz,Szz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8,intent(in) :: eps + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gmx_Res, Gmy_Res, Gmz_Res +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ex(1),ex(2),ex(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ex(1),ex(2),ex(3)) :: betayx,betayy,betayz + real*8, dimension(ex(1),ex(2),ex(3)) :: betazx,betazy,betazz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,div_beta,S + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ZEO = 0.d0,ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: EIGHT = 8.D0, HALF = 0.5D0, THR = 3.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + double precision,parameter::FF = 0.75d0,eta=2.d0 + real*8, parameter :: F1o3 = 1.D0/3.D0, F2o3 = 2.D0/3.D0,F3o2=1.5d0, F1o6 = 1.D0/6.D0 + real*8, parameter :: F16=1.6d1,F8=8.d0 + +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5) + real*8, dimension(ex(1),ex(2),ex(3)) :: reta +#endif + +#if (GAUGE == 6 || GAUGE == 7) + integer :: BHN,i,j,k + real*8, dimension(9) :: Porg + real*8, dimension(3) :: Mass + real*8 :: r1,r2,M,A,w1,w2,C1,C2 + real*8, dimension(ex(1),ex(2),ex(3)) :: reta + + call getpbh(BHN,Porg,Mass) +#endif + +!!! sanity check + dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) & + +sum(Axx)+sum(Axy)+sum(Axz)+sum(Ayy)+sum(Ayz)+sum(Azz) & + +sum(Gamx)+sum(Gamy)+sum(Gamz) & + +sum(Lap)+sum(betax)+sum(betay)+sum(betaz) + if(dX.ne.dX) then + if(sum(chi).ne.sum(chi))write(*,*)"bssn.f90: find NaN in chi" + if(sum(trK).ne.sum(trK))write(*,*)"bssn.f90: find NaN in trk" + if(sum(dxx).ne.sum(dxx))write(*,*)"bssn.f90: find NaN in dxx" + if(sum(gxy).ne.sum(gxy))write(*,*)"bssn.f90: find NaN in gxy" + if(sum(gxz).ne.sum(gxz))write(*,*)"bssn.f90: find NaN in gxz" + if(sum(dyy).ne.sum(dyy))write(*,*)"bssn.f90: find NaN in dyy" + if(sum(gyz).ne.sum(gyz))write(*,*)"bssn.f90: find NaN in gyz" + if(sum(dzz).ne.sum(dzz))write(*,*)"bssn.f90: find NaN in dzz" + if(sum(Axx).ne.sum(Axx))write(*,*)"bssn.f90: find NaN in Axx" + if(sum(Axy).ne.sum(Axy))write(*,*)"bssn.f90: find NaN in Axy" + if(sum(Axz).ne.sum(Axz))write(*,*)"bssn.f90: find NaN in Axz" + if(sum(Ayy).ne.sum(Ayy))write(*,*)"bssn.f90: find NaN in Ayy" + if(sum(Ayz).ne.sum(Ayz))write(*,*)"bssn.f90: find NaN in Ayz" + if(sum(Azz).ne.sum(Azz))write(*,*)"bssn.f90: find NaN in Azz" + if(sum(Gamx).ne.sum(Gamx))write(*,*)"bssn.f90: find NaN in Gamx" + if(sum(Gamy).ne.sum(Gamy))write(*,*)"bssn.f90: find NaN in Gamy" + if(sum(Gamz).ne.sum(Gamz))write(*,*)"bssn.f90: find NaN in Gamz" + if(sum(Lap).ne.sum(Lap))write(*,*)"bssn.f90: find NaN in Lap" + if(sum(betax).ne.sum(betax))write(*,*)"bssn.f90: find NaN in betax" + if(sum(betay).ne.sum(betay))write(*,*)"bssn.f90: find NaN in betay" + if(sum(betaz).ne.sum(betaz))write(*,*)"bssn.f90: find NaN in betaz" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = crho(2) - crho(1) + dY = sigma(2) - sigma(1) + dZ = R(2) - R(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs_shc(ex,betax,betaxx,betaxy,betaxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,betay,betayx,betayy,betayz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,betaz,betazx,betazy,betazz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + div_beta = betaxx + betayy + betazz + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + chi_rhs = F2o3 *chin1*( alpn1 * trK - div_beta ) !rhs for chi + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + if(co == 0)then +! Gam^i_Res = Gam^i + gup^ij_,j + Gmx_Res = Gamx - (gupxx*(gupxx*gxxx+gupxy*gxyx+gupxz*gxzx)& + +gupxy*(gupxx*gxyx+gupxy*gyyx+gupxz*gyzx)& + +gupxz*(gupxx*gxzx+gupxy*gyzx+gupxz*gzzx)& + +gupxx*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupxy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupxz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxx*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupxy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupxz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmy_Res = Gamy - (gupxx*(gupxy*gxxx+gupyy*gxyx+gupyz*gxzx)& + +gupxy*(gupxy*gxyx+gupyy*gyyx+gupyz*gyzx)& + +gupxz*(gupxy*gxzx+gupyy*gyzx+gupyz*gzzx)& + +gupxy*(gupxy*gxxy+gupyy*gxyy+gupyz*gxzy)& + +gupyy*(gupxy*gxyy+gupyy*gyyy+gupyz*gyzy)& + +gupyz*(gupxy*gxzy+gupyy*gyzy+gupyz*gzzy)& + +gupxy*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyy*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupyz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + Gmz_Res = Gamz - (gupxx*(gupxz*gxxx+gupyz*gxyx+gupzz*gxzx)& + +gupxy*(gupxz*gxyx+gupyz*gyyx+gupzz*gyzx)& + +gupxz*(gupxz*gxzx+gupyz*gyzx+gupzz*gzzx)& + +gupxy*(gupxz*gxxy+gupyz*gxyy+gupzz*gxzy)& + +gupyy*(gupxz*gxyy+gupyz*gyyy+gupzz*gyzy)& + +gupyz*(gupxz*gxzy+gupyz*gyzy+gupzz*gzzy)& + +gupxz*(gupxz*gxxz+gupyz*gxyz+gupzz*gxzz)& + +gupyz*(gupxz*gxyz+gupyz*gyyz+gupzz*gyzz)& + +gupzz*(gupxz*gxzz+gupyz*gyzz+gupzz*gzzz)) + endif + + gxx_rhs = - TWO * alpn1 * Axx - F2o3 * gxx * div_beta + & + TWO *( gxx * betaxx + gxy * betayx + gxz * betazx) + + gyy_rhs = - TWO * alpn1 * Ayy - F2o3 * gyy * div_beta + & + TWO *( gxy * betaxy + gyy * betayy + gyz * betazy) + + gzz_rhs = - TWO * alpn1 * Azz - F2o3 * gzz * div_beta + & + TWO *( gxz * betaxz + gyz * betayz + gzz * betazz) + + gxy_rhs = - TWO * alpn1 * Axy + F1o3 * gxy * div_beta + & + gxx * betaxy + gxz * betazy + & + gyy * betayx + gyz * betazx & + - gxy * betazz + + gyz_rhs = - TWO * alpn1 * Ayz + F1o3 * gyz * div_beta + & + gxy * betaxz + gyy * betayz + & + gxz * betaxy + gzz * betazy & + - gyz * betaxx + + gxz_rhs = - TWO * alpn1 * Axz + F1o3 * gxz * div_beta + & + gxx * betaxz + gxy * betayz + & + gyz * betayx + gzz * betazx & + - gxz * betayy !rhs for gij + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) +! Raise indices of \tilde A_{ij} and store in R_ij + + Rxx = gupxx * gupxx * Axx + gupxy * gupxy * Ayy + gupxz * gupxz * Azz + & + TWO*(gupxx * gupxy * Axy + gupxx * gupxz * Axz + gupxy * gupxz * Ayz) + + Ryy = gupxy * gupxy * Axx + gupyy * gupyy * Ayy + gupyz * gupyz * Azz + & + TWO*(gupxy * gupyy * Axy + gupxy * gupyz * Axz + gupyy * gupyz * Ayz) + + Rzz = gupxz * gupxz * Axx + gupyz * gupyz * Ayy + gupzz * gupzz * Azz + & + TWO*(gupxz * gupyz * Axy + gupxz * gupzz * Axz + gupyz * gupzz * Ayz) + + Rxy = gupxx * gupxy * Axx + gupxy * gupyy * Ayy + gupxz * gupyz * Azz + & + (gupxx * gupyy + gupxy * gupxy)* Axy + & + (gupxx * gupyz + gupxz * gupxy)* Axz + & + (gupxy * gupyz + gupxz * gupyy)* Ayz + + Rxz = gupxx * gupxz * Axx + gupxy * gupyz * Ayy + gupxz * gupzz * Azz + & + (gupxx * gupyz + gupxy * gupxz)* Axy + & + (gupxx * gupzz + gupxz * gupxz)* Axz + & + (gupxy * gupzz + gupxz * gupyz)* Ayz + + Ryz = gupxy * gupxz * Axx + gupyy * gupyz * Ayy + gupyz * gupzz * Azz + & + (gupxy * gupyz + gupyy * gupxz)* Axy + & + (gupxy * gupzz + gupyz * gupxz)* Axz + & + (gupyy * gupzz + gupyz * gupyz)* Ayz + +! Right hand side for Gam^i without shift terms... + call fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + Gamx_rhs = - TWO * ( Lapx * Rxx + Lapy * Rxy + Lapz * Rxz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxx + chiy * Rxy + chiz * Rxz ) - & + gupxx * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupxy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupxz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamxxx * Rxx + Gamxyy * Ryy + Gamxzz * Rzz + & + TWO * ( Gamxxy * Rxy + Gamxxz * Rxz + Gamxyz * Ryz ) ) + + Gamy_rhs = - TWO * ( Lapx * Rxy + Lapy * Ryy + Lapz * Ryz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxy + chiy * Ryy + chiz * Ryz ) - & + gupxy * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyy * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupyz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamyxx * Rxx + Gamyyy * Ryy + Gamyzz * Rzz + & + TWO * ( Gamyxy * Rxy + Gamyxz * Rxz + Gamyyz * Ryz ) ) + + Gamz_rhs = - TWO * ( Lapx * Rxz + Lapy * Ryz + Lapz * Rzz ) + & + TWO * alpn1 * ( & + -F3o2/chin1 * ( chix * Rxz + chiy * Ryz + chiz * Rzz ) - & + gupxz * ( F2o3 * Kx + EIGHT * PI * Sx ) - & + gupyz * ( F2o3 * Ky + EIGHT * PI * Sy ) - & + gupzz * ( F2o3 * Kz + EIGHT * PI * Sz ) + & + Gamzxx * Rxx + Gamzyy * Ryy + Gamzzz * Rzz + & + TWO * ( Gamzxy * Rxy + Gamzxz * Rxz + Gamzyz * Ryz ) ) + + call fdderivs_shc(ex,betax,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betay,gxxy,gxyy,gxzy,gyyy,gyzy,gzzy,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,betaz,gxxz,gxyz,gxzz,gyyz,gyzz,gzzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = gxxx + gxyy + gxzz + fxy = gxyx + gyyy + gyzz + fxz = gxzx + gyzy + gzzz + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + Gamx_rhs = Gamx_rhs + F2o3 * Gamxa * div_beta - & + Gamxa * betaxx - Gamya * betaxy - Gamza * betaxz + & + F1o3 * (gupxx * fxx + gupxy * fxy + gupxz * fxz ) + & + gupxx * gxxx + gupyy * gyyx + gupzz * gzzx + & + TWO * (gupxy * gxyx + gupxz * gxzx + gupyz * gyzx ) + + Gamy_rhs = Gamy_rhs + F2o3 * Gamya * div_beta - & + Gamxa * betayx - Gamya * betayy - Gamza * betayz + & + F1o3 * (gupxy * fxx + gupyy * fxy + gupyz * fxz ) + & + gupxx * gxxy + gupyy * gyyy + gupzz * gzzy + & + TWO * (gupxy * gxyy + gupxz * gxzy + gupyz * gyzy ) + + Gamz_rhs = Gamz_rhs + F2o3 * Gamza * div_beta - & + Gamxa * betazx - Gamya * betazy - Gamza * betazz + & + F1o3 * (gupxz * fxx + gupyz * fxy + gupzz * fxz ) + & + gupxx * gxxz + gupyy * gyyz + gupzz * gzzz + & + TWO * (gupxy * gxyz + gupxz * gxzz + gupyz * gyzz ) !rhs for Gam^i + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs_shc(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs_shc(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + +! covariant second derivatives of the lapse respect to physical metric + call fdderivs_shc(ex,Lap,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + + fxx = fxx - Gamxxx*Lapx - Gamyxx*Lapy - Gamzxx*Lapz + fyy = fyy - Gamxyy*Lapx - Gamyyy*Lapy - Gamzyy*Lapz + fzz = fzz - Gamxzz*Lapx - Gamyzz*Lapy - Gamzzz*Lapz + fxy = fxy - Gamxxy*Lapx - Gamyxy*Lapy - Gamzxy*Lapz + fxz = fxz - Gamxxz*Lapx - Gamyxz*Lapy - Gamzxz*Lapz + fyz = fyz - Gamxyz*Lapx - Gamyyz*Lapy - Gamzyz*Lapz + +! store D^i D_i Lap in trK_rhs upto chi + trK_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) +! Add lapse and S_ij parts to Ricci tensor: + + fxx = alpn1 * (Rxx - EIGHT * PI * Sxx) - fxx + fxy = alpn1 * (Rxy - EIGHT * PI * Sxy) - fxy + fxz = alpn1 * (Rxz - EIGHT * PI * Sxz) - fxz + fyy = alpn1 * (Ryy - EIGHT * PI * Syy) - fyy + fyz = alpn1 * (Ryz - EIGHT * PI * Syz) - fyz + fzz = alpn1 * (Rzz - EIGHT * PI * Szz) - fzz + +! Compute trace-free part (note: chi^-1 and chi cancel!): + + f = F1o3 *( gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO* ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) ) + + Axx_rhs = fxx - gxx * f + Ayy_rhs = fyy - gyy * f + Azz_rhs = fzz - gzz * f + Axy_rhs = fxy - gxy * f + Axz_rhs = fxz - gxz * f + Ayz_rhs = fyz - gyz * f + +! Now: store A_il A^l_j into fij: + + fxx = gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) + fyy = gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) + fzz = gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) + fxy = gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy *(Axx * Ayy + Axy * Axy) + & + gupxz *(Axx * Ayz + Axz * Axy) + & + gupyz *(Axy * Ayz + Axz * Ayy) + fxz = gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy *(Axx * Ayz + Axy * Axz) + & + gupxz *(Axx * Azz + Axz * Axz) + & + gupyz *(Axy * Azz + Axz * Ayz) + fyz = gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy *(Axy * Ayz + Ayy * Axz) + & + gupxz *(Axy * Azz + Ayz * Axz) + & + gupyz *(Ayy * Azz + Ayz * Ayz) + + f = chin1 +! store D^i D_i Lap in trK_rhs + trK_rhs = f*trK_rhs + + Axx_rhs = f * Axx_rhs+ alpn1 * (trK * Axx - TWO * fxx) + & + TWO * ( Axx * betaxx + Axy * betayx + Axz * betazx )- & + F2o3 * Axx * div_beta + + Ayy_rhs = f * Ayy_rhs+ alpn1 * (trK * Ayy - TWO * fyy) + & + TWO * ( Axy * betaxy + Ayy * betayy + Ayz * betazy )- & + F2o3 * Ayy * div_beta + + Azz_rhs = f * Azz_rhs+ alpn1 * (trK * Azz - TWO * fzz) + & + TWO * ( Axz * betaxz + Ayz * betayz + Azz * betazz )- & + F2o3 * Azz * div_beta + + Axy_rhs = f * Axy_rhs+ alpn1 *( trK * Axy - TWO * fxy )+ & + Axx * betaxy + Axz * betazy + & + Ayy * betayx + Ayz * betazx + & + F1o3 * Axy * div_beta - Axy * betazz + + Ayz_rhs = f * Ayz_rhs+ alpn1 *( trK * Ayz - TWO * fyz )+ & + Axy * betaxz + Ayy * betayz + & + Axz * betaxy + Azz * betazy + & + F1o3 * Ayz * div_beta - Ayz * betaxx + + Axz_rhs = f * Axz_rhs+ alpn1 *( trK * Axz - TWO * fxz )+ & + Axx * betaxz + Axy * betayz + & + Ayz * betayx + Azz * betazx + & + F1o3 * Axz * div_beta - Axz * betayy !rhs for Aij + +! Compute trace of S_ij + + S = f * ( gupxx * Sxx + gupyy * Syy + gupzz * Szz + & + TWO * ( gupxy * Sxy + gupxz * Sxz + gupyz * Syz ) ) + + trK_rhs = - trK_rhs + alpn1 *( F1o3 * trK * trK + & + gupxx * fxx + gupyy * fyy + gupzz * fzz + & + TWO * ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) + & + FOUR * PI * ( rho + S )) !rhs for trK + +!!!! gauge variable part + + Lap_rhs = -TWO*alpn1*trK + +#if (GAUGE == 0) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - eta*dtSfx + dtSfy_rhs = Gamy_rhs - eta*dtSfy + dtSfz_rhs = Gamz_rhs - eta*dtSfz +#elif (GAUGE == 1) + betax_rhs = Gamx - eta*betax + betay_rhs = Gamy - eta*betay + betaz_rhs = Gamz - eta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 2) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + call fderivs_shc(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-dsqrt(chin1))**2 + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 3) + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + call fderivs_shc(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-chin1)**2 + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 4) + call fderivs_shc(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-dsqrt(chin1))**2 + betax_rhs = FF*Gamx - reta*betax + betay_rhs = FF*Gamy - reta*betay + betaz_rhs = FF*Gamz - reta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 5) + call fderivs_shc(ex,chi,dtSfx_rhs,dtSfy_rhs,dtSfz_rhs,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + reta = gupxx * dtSfx_rhs * dtSfx_rhs + gupyy * dtSfy_rhs * dtSfy_rhs + gupzz * dtSfz_rhs * dtSfz_rhs + & + TWO * (gupxy * dtSfx_rhs * dtSfy_rhs + gupxz * dtSfx_rhs * dtSfz_rhs + gupyz * dtSfy_rhs * dtSfz_rhs) + reta = 1.31d0/2*dsqrt(reta/chin1)/(1-chin1)**2 + betax_rhs = FF*Gamx - reta*betax + betay_rhs = FF*Gamy - reta*betay + betaz_rhs = FF*Gamz - reta*betaz + + dtSfx_rhs = ZEO + dtSfy_rhs = ZEO + dtSfz_rhs = ZEO +#elif (GAUGE == 6) + if(BHN==2)then + M = Mass(1)+Mass(2) + A = 2.d0/M + w1 = 1.2d1 + w2 = w1 + C1 = 1.d0/Mass(1) - A + C2 = 1.d0/Mass(2) - A + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + r1 = ((Porg(1)-X(i,j,k))**2+(Porg(2)-Y(i,j,k))**2+(Porg(3)-Z(i,j,k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + r2 = ((Porg(4)-X(i,j,k))**2+(Porg(5)-Y(i,j,k))**2+(Porg(6)-Z(i,j,k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + reta(i,j,k) = A + C1/(ONE+w1*r1) + C2/(ONE+w2*r2) + enddo + enddo + enddo + else + write(*,*) "not support BH_num in Jason's form 1",BHN + endif + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#elif (GAUGE == 7) + if(BHN==2)then + M = Mass(1)+Mass(2) + A = 2.d0/M + w1 = 1.2d1 + w2 = w1 + C1 = 1.d0/Mass(1) - A + C2 = 1.d0/Mass(2) - A + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + r1 = ((Porg(1)-X(i,j,k))**2+(Porg(2)-Y(i,j,k))**2+(Porg(3)-Z(i,j,k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + r2 = ((Porg(4)-X(i,j,k))**2+(Porg(5)-Y(i,j,k))**2+(Porg(6)-Z(i,j,k))**2)/ & + ((Porg(1)-Porg(4))**2+(Porg(2)-Porg(5))**2+(Porg(3)-Porg(6))**2) + reta(i,j,k) = A + C1*dexp(-w1*r1) + C2*dexp(-w2*r2) + enddo + enddo + enddo + else + write(*,*) "not support BH_num in Jason's form 2",BHN + endif + betax_rhs = FF*dtSfx + betay_rhs = FF*dtSfy + betaz_rhs = FF*dtSfz + + dtSfx_rhs = Gamx_rhs - reta*dtSfx + dtSfy_rhs = Gamy_rhs - reta*dtSfy + dtSfz_rhs = Gamz_rhs - reta*dtSfz +#endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part +!g_ij + call fderivs_shc(ex,dxx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxx_rhs = gxx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxy_rhs = gxy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gxz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gxz_rhs = gxz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dyy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyy_rhs = gyy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,gyz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gyz_rhs = gyz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dzz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + gzz_rhs = gzz_rhs + betax*fxx+betay*fxy+betaz*fxz +!A_ij + call fderivs_shc(ex,Axx,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axx_rhs = Axx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axy,fxx,fxy,fxz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axy_rhs = Axy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Axz,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Axz_rhs = Axz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayy,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayy_rhs = Ayy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Ayz,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Ayz_rhs = Ayz_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Azz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Azz_rhs = Azz_rhs + betax*fxx+betay*fxy+betaz*fxz +!chi and trK + call fderivs_shc(ex,chi,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + chi_rhs = chi_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,trK,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + trK_rhs = trK_rhs + betax*fxx+betay*fxy+betaz*fxz +!Gam^i + call fderivs_shc(ex,Gamx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamx_rhs = Gamx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamy_rhs = Gamy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,Gamz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Gamz_rhs = Gamz_rhs + betax*fxx+betay*fxy+betaz*fxz +!gauge variables + call fderivs_shc(ex,Lap,fxx,fxy,fxz,crho,sigma,R,SYM,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Lap_rhs = Lap_rhs + betax*fxx+betay*fxy+betaz*fxz + +#if (GAUGE == 0 || GAUGE == 1 || GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + call fderivs_shc(ex,betax,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betax_rhs = betax_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betay,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betay_rhs = betay_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,betaz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + betaz_rhs = betaz_rhs + betax*fxx+betay*fxy+betaz*fxz +#endif + +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + call fderivs_shc(ex,dtSfx,fxx,fxy,fxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfx_rhs = dtSfx_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfy,fxx,fxy,fxz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfy_rhs = dtSfy_rhs + betax*fxx+betay*fxy+betaz*fxz + call fderivs_shc(ex,dtSfz,fxx,fxy,fxz,crho,sigma,R,SYM ,SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + dtSfz_rhs = dtSfz_rhs + betax*fxx+betay*fxy+betaz*fxz +#endif + + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) + +#if (GAUGE == 0 || GAUGE == 2 || GAUGE == 3 || GAUGE == 6 || GAUGE == 7) + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) +#endif + + endif + + if(co == 0)then +! ham_Res = trR + 2/3 * K^2 - A_ij * A^ij - 16 * PI * rho +! here trR is respect to physical metric + ham_Res = gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + & + TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz ) + + ham_Res = chin1*ham_Res + F2o3 * trK * trK -(& + gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) ))- F16 * PI * rho + +! mov_Res_j = gupkj*(-1/chi d_k chi*A_ij + D_k A_ij) - 2/3 d_j trK - 8 PI s_j where D respect to physical metric +! store D_i A_jk - 1/chi d_i chi*A_jk in gjk_i + + call fderivs_shc(ex,Axx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + gxxx = gxxx - ( Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz & + + Gamxxx * Axx + Gamyxx * Axy + Gamzxx * Axz) - chix*Axx/chin1 + gxyx = gxyx - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxx * Axy + Gamyxx * Ayy + Gamzxx * Ayz) - chix*Axy/chin1 + gxzx = gxzx - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxx * Axz + Gamyxx * Ayz + Gamzxx * Azz) - chix*Axz/chin1 + gyyx = gyyx - ( Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chix*Ayy/chin1 + gyzx = gyzx - ( Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chix*Ayz/chin1 + gzzx = gzzx - ( Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chix*Azz/chin1 + gxxy = gxxy - ( Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz & + + Gamxxy * Axx + Gamyxy * Axy + Gamzxy * Axz) - chiy*Axx/chin1 + gxyy = gxyy - ( Gamxyy * Axx + Gamyyy * Axy + Gamzyy * Axz & + + Gamxxy * Axy + Gamyxy * Ayy + Gamzxy * Ayz) - chiy*Axy/chin1 + gxzy = gxzy - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxy * Axz + Gamyxy * Ayz + Gamzxy * Azz) - chiy*Axz/chin1 + gyyy = gyyy - ( Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz & + + Gamxyy * Axy + Gamyyy * Ayy + Gamzyy * Ayz) - chiy*Ayy/chin1 + gyzy = gyzy - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyy * Axz + Gamyyy * Ayz + Gamzyy * Azz) - chiy*Ayz/chin1 + gzzy = gzzy - ( Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiy*Azz/chin1 + gxxz = gxxz - ( Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz & + + Gamxxz * Axx + Gamyxz * Axy + Gamzxz * Axz) - chiz*Axx/chin1 + gxyz = gxyz - ( Gamxyz * Axx + Gamyyz * Axy + Gamzyz * Axz & + + Gamxxz * Axy + Gamyxz * Ayy + Gamzxz * Ayz) - chiz*Axy/chin1 + gxzz = gxzz - ( Gamxzz * Axx + Gamyzz * Axy + Gamzzz * Axz & + + Gamxxz * Axz + Gamyxz * Ayz + Gamzxz * Azz) - chiz*Axz/chin1 + gyyz = gyyz - ( Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz & + + Gamxyz * Axy + Gamyyz * Ayy + Gamzyz * Ayz) - chiz*Ayy/chin1 + gyzz = gyzz - ( Gamxzz * Axy + Gamyzz * Ayy + Gamzzz * Ayz & + + Gamxyz * Axz + Gamyyz * Ayz + Gamzyz * Azz) - chiz*Ayz/chin1 + gzzz = gzzz - ( Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz & + + Gamxzz * Axz + Gamyzz * Ayz + Gamzzz * Azz) - chiz*Azz/chin1 +movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz & + +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy & + +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz +movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz & + +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy & + +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz +movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz & + +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy & + +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz + +movx_Res = movx_Res - F2o3*Kx - F8*PI*sx +movy_Res = movy_Res - F2o3*Ky - F8*PI*sy +movz_Res = movz_Res - F2o3*Kz - F8*PI*sz + endif + +#if (ABV == 1) + call ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + call constraint_bssn_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz,& + Lap,betax,betay,betaz,rho,Sx,Sy,Sz,& + Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + ham_Res,movx_Res,movy_Res,movz_Res,Gmx_Res,Gmy_Res,Gmz_Res, & + Symmetry,Lev,sst) +#endif + + gont = 0 + + return + + end function compute_rhs_bssn_ss diff --git a/AMSS_NCKU_source/bssn_step_gpu.C b/AMSS_NCKU_source/bssn_step_gpu.C new file mode 100644 index 0000000..45ee555 --- /dev/null +++ b/AMSS_NCKU_source/bssn_step_gpu.C @@ -0,0 +1,1942 @@ +// includes, system +#include +#include +#include +#include +#include +#include + +#ifdef RESULT_CHECK +#include +#endif + +// include BSSN class files +#include "macrodef.h" +#include "fmisc.h" +#include "bssn_gpu_class.h" +#include "bssn_rhs.h" +#include "enforce_algebra.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" + +// include gpu files +#include "bssn_gpu.h" + +#if (PSTR == 0) +#if 1 +void bssn_class::Step_GPU(int lev, int YN) +{ + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs_ss(CALLED_BY_STEP, myrank, RHS_SS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } +#endif + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_THEN)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count << " variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs_ss(CALLED_BY_STEP, myrank, RHS_SS_PARA_CALLED_THEN)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} +#else // #if 1 +// ICN for bam comparison +void bssn_class::Step_GPU(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_icn_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs_ss(CALLED_BY_STEP, myrank, RHS_SS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_icn_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check rhs + { + SH->Dump_Data(RHSList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check rhs"<Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + AnalysisStuff(lev, dT_lev); + } + // corrector + for (iter_count = 1; iter_count < 3; iter_count++) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_THEN)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_icn_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count << " variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs_ss(CALLED_BY_STEP, myrank, RHS_SS_PARA_CALLED_THEN)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_icn_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_icn_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } + } + } +#if (RPS == 0) + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); + +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +#if 0 +// check StateList + { + SH->Dump_Data(StateList,0,PhysTime,dT_lev); + if(myrank == 0) + { + cout<<"check StateList"< 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + } + } +} +#endif + +#elif (PSTR == 1) +void bssn_class::Step_GPU(int lev, int YN) +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + +// new code 2013-2-15, zjcao +#if (MAPBH == 1) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + for (int ith = 0; ith < 3; ith++) + Porg1[ithBH][ith] = Porg0[ithBH][ith] + Porg_rhs[ithBH][ith] * dT_lev; + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif //(MAPBH == 1) + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) +#warning "shell part still bam type" + if (lev == 0) // Shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, pre); +#endif + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Predictor rhs calculation"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg0, Porg_rhs, Sfx0, Sfy0, Sfz0, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg[ithBH][2] = fabs(Porg[ithBH][2]); + if (Symmetry == 2) + { + Porg[ithBH][0] = fabs(Porg[ithBH][0]); + Porg[ithBH][1] = fabs(Porg[ithBH][1]); + } + if (!finite(Porg[ithBH][0]) || !finite(Porg[ithBH][1]) || !finite(Porg[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "predictor step finds NaN for BH's position from (" + << Porg0[ithBH][0] << "," << Porg0[ithBH][1] << "," << Porg0[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } +#endif + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector"); + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"head of Corrector"); + + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs(CALLED_BY_STEP, myrank, RHS_PARA_CALLED_THEN)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#if (SommerType == 0) +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); + +#if (SommerType == 1) + if (lev == 1) // shibata type sommerfeld + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[phi0->sgfn], + cg->fgfs[Lap0->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); +#endif + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector error check"); + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, GH->Commlev[lev]); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count << " variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Corrector sync"); + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Corrector sync"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + compute_Porg_rhs(Porg, Porg1, Sfx, Sfy, Sfz, lev); + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][0], Porg1[ithBH][0], Porg_rhs[ithBH][0], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][1], Porg1[ithBH][1], Porg_rhs[ithBH][1], iter_count); + f_rungekutta4_scalar(dT_lev, Porg0[ithBH][2], Porg1[ithBH][2], Porg_rhs[ithBH][2], iter_count); + if (Symmetry > 0) + Porg1[ithBH][2] = fabs(Porg1[ithBH][2]); + if (Symmetry == 2) + { + Porg1[ithBH][0] = fabs(Porg1[ithBH][0]); + Porg1[ithBH][1] = fabs(Porg1[ithBH][1]); + } + if (!finite(Porg1[ithBH][0]) || !finite(Porg1[ithBH][1]) || !finite(Porg1[ithBH][2])) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << iter_count << " corrector step finds NaN for BH's position from (" + << Porg[ithBH][0] << "," << Porg[ithBH][1] << "," << Porg[ithBH][2] << ")" << endl; + + MyList *DG_List = new MyList(Sfx0); + DG_List->insert(Sfx0); + DG_List->insert(Sfy0); + DG_List->insert(Sfz0); + Parallel::Dump_Data(GH->PatL[lev], DG_List, 0, PhysTime, dT_lev); + DG_List->clearList(); + } + } + } + misc::tillherecheck(GH->Commlev[lev], GH->start_rank[lev], "after Corrector of black hole position"); +#endif + + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after pre cor swap"); + +#if (MAPBH == 0) + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg[ithBH][0] = Porg1[ithBH][0]; + Porg[ithBH][1] = Porg1[ithBH][1]; + Porg[ithBH][2] = Porg1[ithBH][2]; + } + } +#endif + } + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"tail of corrector"); + } +#if (RPS == 0) + // mesh refinement boundary part + misc::tillherecheck(GH->Commlev[lev], GH->start_rank[lev], "before RestrictProlong"); + RestrictProlong(lev, YN, BB); +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + // for black hole position + if (BH_num > 0 && lev == GH->levels - 1) + { + for (int ithBH = 0; ithBH < BH_num; ithBH++) + { + Porg0[ithBH][0] = Porg1[ithBH][0]; + Porg0[ithBH][1] = Porg1[ithBH][1]; + Porg0[ithBH][2] = Porg1[ithBH][2]; + // if(myrank==GH->start_rank[lev]) cout<start_rank[lev]) cout<mylev<Commlev[lev],GH->start_rank[lev],"complet GH Step"); +} +#endif // PSTR == ? + +//--------------------------With Shell-------------------------- + +#ifdef WithShell +void bssn_class::SHStep() +{ + int lev = 0; + // #if (PSTR == 1) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start Step"); + // #endif + + setpbh(BH_num, Porg0, Mass, BH_num_input); + + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + + // #if (PSTR == 1) + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor"); + // #endif + +#ifdef With_AHF + AH_Step_Find(lev, dT_lev); +#endif + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + // Predictor + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx0->sgfn], cg->fgfs[gxy0->sgfn], cg->fgfs[gxz0->sgfn], cg->fgfs[gyy0->sgfn], cg->fgfs[gyz0->sgfn], cg->fgfs[gzz0->sgfn], + cg->fgfs[Axx0->sgfn], cg->fgfs[Axy0->sgfn], cg->fgfs[Axz0->sgfn], cg->fgfs[Ayy0->sgfn], cg->fgfs[Ayz0->sgfn], cg->fgfs[Azz0->sgfn]); +#endif + + if (gpu_rhs_ss(RHS_SS_PARA_CALLED_FIRST_TIME)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + +#if (PSTR == 1) +// misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Predictor's error check"); +#endif + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } + + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { +#if (AGM == 0) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#elif (AGM == 1) + if (iter_count == 3) + f_enforce_ga(cg->shape, + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn]); +#endif + + if (gpu_rhs_ss(RHS_SS_PARA_CALLED_THEN)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + f_lowerboundset(cg->shape, cg->fgfs[phi1->sgfn], chitiny); + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } + + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } + + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#if (RPS == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << "CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds!" << endl; + } + } +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } +} +d +#endif // withshell diff --git a/AMSS_NCKU_source/cctk.h b/AMSS_NCKU_source/cctk.h new file mode 100644 index 0000000..094e388 --- /dev/null +++ b/AMSS_NCKU_source/cctk.h @@ -0,0 +1,58 @@ +#ifndef _CCTK_H_ +#define _CCTK_H_ 1 + +/* Grab the main configuration info. */ +#include "cctk_Config.h" + +#define CCTK_THORNSTRING "AHFinderDirect" + +/* Include the constants */ +#include "cctk_Constants.h" + +/* get the definition of ptrdiff_t */ +#include +int CCTK_VInfo(const char *thorn, const char *format, ...); +int CCTK_VWarn(int level, + int line, + const char *file, + const char *thorn, + const char *format, + ...); +#define CCTK_ERROR_INTERP_GHOST_SIZE_TOO_SMALL (-1001) +#ifdef __cplusplus +#define HAVE_INLINE +#else +#ifndef inline +#define HAVE_INLINE +#endif +#endif + +#define CCTK_PRINTSEPARATOR \ + printf("--------------------------------------------------------------------------------\n"); + +#define _DECLARE_CCTK_ARGUMENTS _DECLARE_CCTK_CARGUMENTS +#define _DECLARE_CCTK_CARGUMENTS \ + ptrdiff_t cctki_dummy_int; \ + CCTK_REAL cctk_time = cctkGH->PhysTime; \ + int cctk_iteration = 1; \ + int cctk_dim = 3; + +#define CCTK_EQUALS(a, b) (CCTK_Equals((a), (b))) + +#define CCTK_PASS_CTOC cctkGH + +#define CCTK_ORIGIN_SPACE(x) (cctk_origin_space[x] + cctk_delta_space[x] / cctk_levfac[x] * cctk_levoff[x] / cctk_levoffdenom[x]) +#define CCTK_DELTA_SPACE(x) (cctk_delta_space[x] / cctk_levfac[x]) +#define CCTK_DELTA_TIME (cctk_delta_time / cctk_timefac) +#define CCTK_LSSH(stag, dim) cctk_lssh[(stag) + CCTK_NSTAGGER * (dim)] +#define CCTK_LSSH_IDX(stag, dim) ((stag) + CCTK_NSTAGGER * (dim)) + +#define CCTK_WARN(a, b) CCTK_Warn(a, __LINE__, __FILE__, CCTK_THORNSTRING, b) + +#define CCTK_MALLOC(s) CCTKi_Malloc(s, __LINE__, __FILE__) +#define CCTK_FREE(p) CCTKi_Free(p) + +#define CCTK_INFO(a) CCTK_Info(CCTK_THORNSTRING, (a)) +#define CCTK_PARAMWARN(a) CCTK_ParamWarn(CCTK_THORNSTRING, (a)) + +#endif diff --git a/AMSS_NCKU_source/cctk_Config.h b/AMSS_NCKU_source/cctk_Config.h new file mode 100644 index 0000000..ca00555 --- /dev/null +++ b/AMSS_NCKU_source/cctk_Config.h @@ -0,0 +1,168 @@ +#ifndef _CCTK_CONFIG_H_ +#define _CCTK_CONFIG_H_ + +#define STDC_HEADERS 1 + +#define CCTK_FCALL + +#define HAVE_GETHOSTBYNAME 1 +#define HAVE_GETOPT_LONG_ONLY 1 +#define HAVE_CRYPT 1 +#define HAVE_FINITE 1 +#define HAVE_ISNAN 1 +#define HAVE_ISINF 1 +#define HAVE_MKSTEMP 1 +#define HAVE_VA_COPY 1 + +/* Do we have mode_t ? */ +#define HAVE_MODE_T 1 + +#define HAVE_SOCKLEN_T 1 +#ifdef HAVE_SOCKLEN_T +# define CCTK_SOCKLEN_T socklen_t +#else +# define CCTK_SOCKLEN_T int +#endif + +#define HAVE_TIME_H 1 +#define HAVE_SYS_IOCTL_H 1 +#define HAVE_SYS_SOCKET_H 1 +#define HAVE_SYS_TIME_H 1 +#define HAVE_SYS_TYPES_H 1 +#define HAVE_UNISTD_H 1 +#define HAVE_STRING_H 1 +#define HAVE_ASSERT_H 1 +#define HAVE_TGMATH_H 1 +#define HAVE_SYS_STAT_H 1 +#define HAVE_GETOPT_H 1 +#define HAVE_REGEX_H 1 +#define HAVE_NETINET_IN_H 1 +#define HAVE_NETDB_H 1 +#define HAVE_ARPA_INET_H 1 +#define HAVE_CRYPT_H 1 +#define HAVE_DIRENT_H 1 +#define HAVE_SIGNAL_H 1 +#define HAVE_MALLOC_H 1 +#define HAVE_MALLINFO 1 +#define HAVE_MALLOPT 1 +#define HAVE_M_MMAP_THRESHOLD_VALUE 1 + +#define TIME_WITH_SYS_TIME 1 + +#define HAVE_VECTOR 1 +#define HAVE_VECTOR_H 1 + +#define GETTIMEOFDAY_NEEDS_TIMEZONE 1 + +#define CCTK_CACHELINE_BYTES 64 +#define CCTK_CACHE_SIZE 1024*1024 + +#define NULL_DEVICE "/dev/null" + +#define CCTK_BUILD_OS "linux-gnu" +#define CCTK_BUILD_CPU "x86_64" +#define CCTK_BUILD_VENDOR "unknown" + +#define SIZEOF_SHORT_INT 2 +#define SIZEOF_INT 4 +#define SIZEOF_LONG_INT 8 +#define SIZEOF_LONG_LONG 8 +#define SIZEOF_LONG_DOUBLE 16 +#define SIZEOF_DOUBLE 8 +#define SIZEOF_FLOAT 4 +#define SIZEOF_CHAR_P 8 + +#define CCTK_REAL_PRECISION_8 1 + +#define CCTK_INTEGER_PRECISION_4 1 + +#define HAVE_CCTK_INT8 1 +#define HAVE_CCTK_INT4 1 +#define HAVE_CCTK_INT2 1 +#define HAVE_CCTK_INT1 1 + +#define HAVE_CCTK_REAL16 1 +#define HAVE_CCTK_REAL8 1 +#define HAVE_CCTK_REAL4 1 + +#define CCTK_INT8 long int +#define CCTK_INT4 int +#define CCTK_INT2 short int +#define CCTK_INT1 signed char + +#define CCTK_REAL16 long double +#define CCTK_REAL8 double +#define CCTK_REAL4 float + +#ifndef __cplusplus + +#ifdef CCTK_C_RESTRICT +#define restrict CCTK_C_RESTRICT +#endif + +/* Allow the use of CCTK_RESTRICT as a qualifier always. */ +#ifdef CCTK_C_RESTRICT +#define CCTK_RESTRICT CCTK_C_RESTRICT +#else +#define CCTK_RESTRICT restrict +#endif + +#ifdef HAVE_CCTK_C_BOOL +#define CCTK_HAVE_C_BOOL +#endif + +#endif /* ! defined __cplusplus */ +/****************************************************************************/ + +/****************************************************************************/ +/* C++ specific stuff */ +/****************************************************************************/ +#ifdef __cplusplus + +/* Some C++ compilers don't have bool ! */ +#define HAVE_CCTK_CXX_BOOL 1 + +#ifndef HAVE_CCTK_CXX_BOOL +typedef enum {false, true} bool; +#else +/* deprecated in beta15 */ +#define CCTK_HAVE_CXX_BOOL +#endif + +/* Some C++ compilers recognise the restrict keyword */ +#define CCTK_CXX_RESTRICT __restrict__ + +/* Since this is non-standard leave commented out for the moment */ +#if 0 +/* Define to empty if the keyword does not work. */ +#ifdef CCTK_CXX_RESTRICT +#define restrict CCTK_CXX_RESTRICT +#endif +#endif + +/* Allow the use of CCTK_RESTRICT as a qualifier always. */ +#ifdef CCTK_CXX_RESTRICT +#define CCTK_RESTRICT CCTK_CXX_RESTRICT +#else +#define CCTK_RESTRICT restrict +#endif + +#endif /* __cplusplus */ +/****************************************************************************/ + +#ifdef FCODE + +#define HAVE_CCTK_FORTRAN_REAL4 1 +#define HAVE_CCTK_FORTRAN_REAL8 1 +#define HAVE_CCTK_FORTRAN_REAL16 1 + +#define HAVE_CCTK_FORTRAN_COMPLEX8 1 +#define HAVE_CCTK_FORTRAN_COMPLEX16 1 +#define HAVE_CCTK_FORTRAN_COMPLEX32 1 + +#endif /* FCODE */ + +/* Now include the code to pick an appropriate precison for reals and ints */ +#include "cctk_Types.h" + +#endif /* _CCTK_CONFIG_H_ */ diff --git a/AMSS_NCKU_source/cctk_Constants.h b/AMSS_NCKU_source/cctk_Constants.h new file mode 100644 index 0000000..238f25e --- /dev/null +++ b/AMSS_NCKU_source/cctk_Constants.h @@ -0,0 +1,57 @@ +#ifndef _CCTK_CONSTANTS_H_ +#define _CCTK_CONSTANTS_H_ + +#define CCTK_VARIABLE_VOID 100 +#define CCTK_VARIABLE_BYTE 101 +#define CCTK_VARIABLE_INT 102 +#define CCTK_VARIABLE_INT1 103 +#define CCTK_VARIABLE_INT2 104 +#define CCTK_VARIABLE_INT4 105 +#define CCTK_VARIABLE_INT8 106 +#define CCTK_VARIABLE_REAL 107 +#define CCTK_VARIABLE_REAL4 108 +#define CCTK_VARIABLE_REAL8 109 +#define CCTK_VARIABLE_REAL16 110 +#define CCTK_VARIABLE_COMPLEX 111 +#define CCTK_VARIABLE_COMPLEX8 112 +#define CCTK_VARIABLE_COMPLEX16 113 +#define CCTK_VARIABLE_COMPLEX32 114 +#define CCTK_VARIABLE_CHAR 115 +#define CCTK_VARIABLE_STRING 116 +#define CCTK_VARIABLE_POINTER 117 +#define CCTK_VARIABLE_POINTER_TO_CONST 118 +#define CCTK_VARIABLE_FPOINTER 119 + +/* DEPRECATED IN BETA 12 */ +#define CCTK_VARIABLE_FN_POINTER CCTK_VARIABLE_FPOINTER + +/* steerable status of parameters */ +#define CCTK_STEERABLE_NEVER 200 +#define CCTK_STEERABLE_ALWAYS 201 +#define CCTK_STEERABLE_RECOVER 202 + +/* number of staggerings */ +#define CCTK_NSTAGGER 3 + +/* group distributions */ +#define CCTK_DISTRIB_CONSTANT 301 +#define CCTK_DISTRIB_DEFAULT 302 + +/* group types */ +#define CCTK_SCALAR 401 +#define CCTK_GF 402 +#define CCTK_ARRAY 403 + +/* group scopes */ +#define CCTK_PRIVATE 501 +#define CCTK_PROTECTED 502 +#define CCTK_PUBLIC 503 + +/* constants for CCTK_TraverseString() */ +#define CCTK_VAR 601 +#define CCTK_GROUP 602 +#define CCTK_GROUP_OR_VAR 603 + + +#endif /* _CCTK_CONSTANTS_ */ + diff --git a/AMSS_NCKU_source/cctk_Types.h b/AMSS_NCKU_source/cctk_Types.h new file mode 100644 index 0000000..aa5f536 --- /dev/null +++ b/AMSS_NCKU_source/cctk_Types.h @@ -0,0 +1,180 @@ +#ifndef _CCTK_TYPES_H_ +#define _CCTK_TYPES_H_ + +#ifndef _CCTK_CONFIG_H_ +#include "cctk_Config.h" +#endif + +typedef void *CCTK_POINTER; +typedef const void *CCTK_POINTER_TO_CONST; +typedef void (*CCTK_FPOINTER)(void); +#define HAVE_CCTK_POINTER 1 +#define HAVE_CCTK_POINTER_TO_CONST 1 +#define HAVE_CCTK_FPOINTER 1 + +/* Character types */ +typedef char CCTK_CHAR; +typedef const char * CCTK_STRING; +#define HAVE_CCTK_CHAR 1 +#define HAVE_CCTK_STRING 1 + +/* Structures for complex types */ + +#ifdef HAVE_CCTK_REAL16 +#define HAVE_CCTK_COMPLEX32 1 +typedef struct CCTK_COMPLEX32 +{ + CCTK_REAL16 Re; + CCTK_REAL16 Im; +#ifdef __cplusplus + CCTK_REAL16 real() const { return Re; } + CCTK_REAL16 imag() const { return Im; } +#endif +} CCTK_COMPLEX32; +#endif + +#ifdef HAVE_CCTK_REAL8 +#define HAVE_CCTK_COMPLEX16 1 +typedef struct CCTK_COMPLEX16 +{ + CCTK_REAL8 Re; + CCTK_REAL8 Im; +#ifdef __cplusplus + CCTK_REAL8 real() const { return Re; } + CCTK_REAL8 imag() const { return Im; } +#endif +} CCTK_COMPLEX16; +#endif + +#ifdef HAVE_CCTK_REAL4 +#define HAVE_CCTK_COMPLEX8 1 +typedef struct CCTK_COMPLEX8 +{ + CCTK_REAL4 Re; + CCTK_REAL4 Im; +#ifdef __cplusplus + CCTK_REAL4 real() const { return Re; } + CCTK_REAL4 imag() const { return Im; } +#endif +} CCTK_COMPLEX8; +#endif + +/* Small positive integer type */ +typedef unsigned char CCTK_BYTE; +#define HAVE_CCTK_BYTE 1 + +/* Define stuff for fortran. */ +#ifdef FCODE + +#define CCTK_POINTER integer*SIZEOF_CHAR_P +#define CCTK_POINTER_TO_CONST integer*SIZEOF_CHAR_P +/* TODO: add autoconf for determining the size of function pointers */ +#define CCTK_FPOINTER integer*SIZEOF_CHAR_P +#define HAVE_CCTK_POINTER 1 +#define HAVE_CCTK_POINTER_TO_CONST 1 +#define HAVE_CCTK_FPOINTER 1 + +/* Character types */ +/* A single character does not exist in Fortran; in Fortran, all + character types are strings. Hence we do not define CCTK_CHAR. */ +/* #define CCTK_CHAR CHARACTER */ +/* #define HAVE_CCTK_CHAR 1 */ +/* This is a C-string, i.e., only a pointer */ +#define CCTK_STRING CCTK_POINTER_TO_CONST +#define HAVE_CCTK_STRING 1 + +#ifdef HAVE_CCTK_INT8 +#define CCTK_INT8 INTEGER*8 +#endif +#ifdef HAVE_CCTK_INT4 +#define CCTK_INT4 INTEGER*4 +#endif +#ifdef HAVE_CCTK_INT2 +#define CCTK_INT2 INTEGER*2 +#endif +#ifdef HAVE_CCTK_INT1 +#define CCTK_INT1 INTEGER*1 +#endif + +#ifdef HAVE_CCTK_REAL16 +#define CCTK_REAL16 REAL*16 +#define HAVE_CCTK_COMPLEX32 1 +#define CCTK_COMPLEX32 COMPLEX*32 +#endif + +#ifdef HAVE_CCTK_REAL8 +#define CCTK_REAL8 REAL*8 +#define HAVE_CCTK_COMPLEX16 1 +#define CCTK_COMPLEX16 COMPLEX*16 +#endif + +#ifdef HAVE_CCTK_REAL4 +#define CCTK_REAL4 REAL*4 +#define HAVE_CCTK_COMPLEX8 1 +#define CCTK_COMPLEX8 COMPLEX*8 +#endif + +/* Should be unsigned, but Fortran doesn't have that */ +#define CCTK_BYTE INTEGER*1 +#define HAVE_CCTK_BYTE 1 + +#endif /*FCODE */ + +/* Now pick the types based upon the precision variable. */ + +/* Floating point precision */ +#ifdef CCTK_REAL_PRECISION_16 +#define CCTK_REAL_PRECISION 16 +#define CCTK_REAL CCTK_REAL16 +#endif + +#ifdef CCTK_REAL_PRECISION_8 +#define CCTK_REAL_PRECISION 8 +#define CCTK_REAL CCTK_REAL8 +#endif + +#ifdef CCTK_REAL_PRECISION_4 +#define CCTK_REAL_PRECISION 4 +#define CCTK_REAL CCTK_REAL4 +#endif + +/* Integer precision */ + +#ifdef CCTK_INTEGER_PRECISION_8 +#define CCTK_INTEGER_PRECISION 8 +#define CCTK_INT CCTK_INT8 +#endif + +#ifdef CCTK_INTEGER_PRECISION_4 +#define CCTK_INTEGER_PRECISION 4 +#define CCTK_INT CCTK_INT4 +#endif + +#ifdef CCTK_INTEGER_PRECISION_2 +#define CCTK_INTEGER_PRECISION 2 +#define CCTK_INT CCTK_INT2 +#endif + +#ifdef CCTK_INTEGER_PRECISION_1 +#define CCTK_INTEGER_PRECISION 1 +#define CCTK_INT CCTK_INT1 +#endif + +/* Complex precision */ +#ifdef CCTK_REAL_PRECISION_16 +#define CCTK_COMPLEX_PRECISION 32 +#define CCTK_COMPLEX CCTK_COMPLEX32 +#endif + +#ifdef CCTK_REAL_PRECISION_8 +#define CCTK_COMPLEX_PRECISION 16 +#define CCTK_COMPLEX CCTK_COMPLEX16 +#endif + +#ifdef CCTK_REAL_PRECISION_4 +#define CCTK_COMPLEX_PRECISION 8 +#define CCTK_COMPLEX CCTK_COMPLEX8 +#endif + +#endif /*_CCTK_TYPES_H_ */ + diff --git a/AMSS_NCKU_source/cgh.C b/AMSS_NCKU_source/cgh.C new file mode 100644 index 0000000..e27ccd6 --- /dev/null +++ b/AMSS_NCKU_source/cgh.C @@ -0,0 +1,1707 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "cgh.h" +#include "Parallel.h" +#include "parameters.h" + +//================================================================================================ + +// define cgh class + +//================================================================================================ + +cgh::cgh(int ingfsi, int fngfsi, int Symmetry, char *filename, int checkrun, + monitor *ErrorMonitor) : ingfs(ingfsi), fngfs(fngfsi), trfls(0) +{ +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + Commlev = 0; + start_rank = 0; + end_rank = 0; +#endif + + if (!checkrun) + { + read_bbox(Symmetry, filename); + sethandle(ErrorMonitor); + for (int lev = 0; lev < levels; lev++) + PatL[lev] = construct_patchlist(lev, Symmetry); + } +} + +//================================================================================================ + + + +//================================================================================================ + +// This member function is the destructor; it releases allocated resources and deletes variables + +//================================================================================================ + +cgh::~cgh() +{ + for (int lev = 0; lev < levels; lev++) + { + for (int grd = 0; grd < grids[lev]; grd++) + { + delete[] bbox[lev][grd]; + delete[] shape[lev][grd]; + delete[] handle[lev][grd]; + } + delete[] bbox[lev]; + delete[] shape[lev]; + delete[] handle[lev]; + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); +#if (RPB == 1) + Parallel::destroypsuList_bam(bdsul[lev]); + Parallel::destroypsuList_bam(rsul[lev]); +#endif + } + delete[] grids; + delete[] Lt; + delete[] bbox; + delete[] shape; + delete[] handle; + delete[] PatL; +#if (RPB == 1) + delete[] bdsul; + delete[] rsul; +#endif + +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + for (int lev = 0; lev < levels; lev++) + { + MPI_Comm_free(&Commlev[lev]); + } + + if (Commlev) + delete[] Commlev; + if (start_rank) + delete[] start_rank; + if (end_rank) + delete[] end_rank; +#endif + for (int lev = 0; lev < levels; lev++) + { + for (int ibh = 0; ibh < BH_num_in; ibh++) + delete[] Porgls[lev][ibh]; + delete[] Porgls[lev]; + } + delete[] Porgls; +} + +//================================================================================================ + + +//================================================================================================ + +// This member function constructs the computational grid + +//================================================================================================ + +#if (PSTR == 0) +void cgh::compose_cgh(int nprocs) +{ + for (int lev = 0; lev < levels; lev++) + { + checkPatchList(PatL[lev], false); + Parallel::distribute(PatL[lev], nprocs, ingfs, fngfs, false); +#if (RPB == 1) + // we need distributed box of PatL[lev] and PatL[lev-1] + if (lev > 0) + { + Parallel::Constr_pointstr_OutBdLow2Hi(PatL[lev], PatL[lev - 1], bdsul[lev]); + Parallel::Constr_pointstr_Restrict(PatL[lev], PatL[lev - 1], rsul[lev]); + } + else + { + bdsul[lev] = 0; + rsul[lev] = 0; + } +#endif + } +} + +//================================================================================================ + + +//================================================================================================ + +// This member function constructs the computational grid +// For the cases PSTR == 1 and PSTR == 2 + +//================================================================================================ + +#elif (PSTR == 1 || PSTR == 2) +void cgh::compose_cgh(int nprocs) +{ + Commlev = new MPI_Comm[levels]; + construct_mylev(nprocs); + for (int lev = 0; lev < levels; lev++) + { + MPI_Comm_split(MPI_COMM_WORLD, mylev, lev, &Commlev[lev]); + checkPatchList(PatL[lev], false); + Parallel::distribute(PatL[lev], end_rank[lev] - start_rank[lev] + 1, ingfs, fngfs, false, start_rank[lev], end_rank[lev]); +#if (RPB == 1) +#error "not support yet" +#endif + } + /* note different comm field has its own rank index + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD,&myrank); + if(myrank==nprocs-1) + { + cout<<"myrank = "<= start_rank[lev] && myrank <= end_rank[lev]) + mylev = lev; + } +} +#elif (PSTR == 2) +void cgh::construct_mylev(int nprocs) +{ + if (nprocs < levels) + { + cout << "Too few procs to use parallel level methods!" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + start_rank = new int[levels]; + end_rank = new int[levels]; + + int myrank; + + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int mp; + mp = nprocs / levels; + + start_rank[levels - 1] = 0; + end_rank[levels - 1] = mp - 1; + for (int lev = levels - 2; lev > 0; lev--) + { + start_rank[lev] = end_rank[lev - 1] + 1; + end_rank[lev] = end_rank[lev - 1] + mp; + } + start_rank[0] = end_rank[1] + 1; + end_rank[0] = nprocs - 1; + + for (int lev = levels - 1; lev >= 0; lev--) + { + if (myrank >= start_rank[lev] && myrank <= end_rank[lev]) + mylev = lev; + } +} +#endif + +#elif (PSTR == 3) +void cgh::construct_mylev(int nprocs) +{ + if (nprocs <= 1) + { + cout << " cgh::construct_mylev requires at least 2 procs" << endl; + exit(0); + } + + start_rank = new int[2]; + end_rank = new int[2]; + + int myrank; + + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int mp; + mp = nprocs / 2; + + // for other levels + for (int lev = 0; lev < levels - 1; lev++) + { + start_rank[lev] = 0; + end_rank[lev] = mp - 1; + } + // for finest level + start_rank[levels - 1] = end_rank[0] + 1; + end_rank[levels - 1] = nprocs - 1; + + if (myrank >= start_rank[0] && myrank <= end_rank[0]) + mylev = -1; // for other levels + else + mylev = 1; // for finest level +} + + +//----------------------------------------------------------------------- + + +void cgh::compose_cgh(int nprocs) +{ + Commlev = new MPI_Comm[levels]; + construct_mylev(nprocs); + + for (int lev = 0; lev < levels - 1; lev++) + { + MPI_Comm_split(MPI_COMM_WORLD, mylev, -1, &Commlev[lev]); + } + MPI_Comm_split(MPI_COMM_WORLD, mylev, 1, &Commlev[levels - 1]); + + for (int lev = 0; lev < levels; lev++) + { + checkPatchList(PatL[lev], false); + Parallel::distribute(PatL[lev], end_rank[lev] - start_rank[lev] + 1, ingfs, fngfs, false, start_rank[lev], end_rank[lev]); +#if (RPB == 1) +#error "not support yet" +#endif + } +} +#endif + + +void cgh::sethandle(monitor *ErrorMonitor) +{ + int BH_num; + Porgls = new double **[levels]; + char filename[100]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && ErrorMonitor && ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && skey == "BH_num") + BH_num = atoi(sval.c_str()); + else if (sgrp == "cgh" && skey == "moving levels start from") + { + movls = atoi(sval.c_str()); + movls = Mymin(movls, levels); + movls = Mymax(0, movls); + } + } + inf.close(); + } + for (int lev = 0; lev < levels; lev++) + { + Porgls[lev] = new double *[BH_num]; + for (int i = 0; i < BH_num; i++) + Porgls[lev][i] = new double[dim]; + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && ErrorMonitor && ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "Can not open parameter file " << filename + << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor && ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN" && sind < BH_num) + { + if (skey == "Porgx") + { + for (int lev = 0; lev < levels; lev++) + Porgls[lev][sind][0] = atof(sval.c_str()); + } + else if (skey == "Porgy") + { + for (int lev = 0; lev < levels; lev++) + Porgls[lev][sind][1] = atof(sval.c_str()); + } + else if (skey == "Porgz") + { + for (int lev = 0; lev < levels; lev++) + Porgls[lev][sind][2] = atof(sval.c_str()); + } + } + } + inf.close(); + } + + for (int lev = 0; lev < movls; lev++) + for (int grd = 0; grd < grids[lev]; grd++) + for (int i = 0; i < dim; i++) + handle[lev][grd][i] = 0; + + if (movls < levels) + { + if (ErrorMonitor && ErrorMonitor->I_Print) + { + cout << endl; + cout << " moving levels are lev #" << movls << "--" << levels - 1 << endl; + cout << endl; + } + + for (int lev = movls; lev < levels; lev++) + for (int grd = 0; grd < grids[lev]; grd++) + { +#if 0 + int bht=0; + for(int bhi=0;bhi bbox[lev][grd][i+dim]) {flag=true; break;} + if(flag) continue; + bht++; + if(bht==1) for(int i=0;ioutfile) + { + ErrorMonitor->outfile<<"cgh::sethandle: lev#"< dis1) + { + bht = bhi; + dis0 = dis1; + } // chose nearest one + } + } + for (int i = 0; i < dim; i++) + handle[lev][grd][i] = Porgls[0][bht][i]; +#endif + } + } + else if (ErrorMonitor && ErrorMonitor->I_Print) + { + if (levels > 1) + cout << "fixed mesh refinement!" << endl; + else + cout << "unigrid simulation!" << endl; + } + + BH_num_in = BH_num; +} +void cgh::checkPatchList(MyList *PatL, bool buflog) +{ + while (PatL) + { + PatL->data->checkPatch(buflog); + PatL = PatL->next; + } +} + + +//================================================================================================ + +// This member function moves the grid + +//================================================================================================ + +void cgh::Regrid(int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor) +{ + // for moving part + if (movls < levels) + { + bool tot_flag = false; + bool *lev_flag; + double **tmpPorg; + tmpPorg = new double *[BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + { + tmpPorg[bhi] = new double[dim]; + for (int i = 0; i < dim; i++) + tmpPorg[bhi][i] = Porgbr[bhi][i]; + } + lev_flag = new bool[levels - movls]; + for (int lev = movls; lev < levels; lev++) + { + lev_flag[lev - movls] = false; + for (int grd = 0; grd < grids[lev]; grd++) + { + int flag; + int do_every = 2; + double dX = PatL[lev]->data->blb->data->getdX(0); + double dY = PatL[lev]->data->blb->data->getdX(1); + double dZ = PatL[lev]->data->blb->data->getdX(2); + double rr; + // make sure that the grid corresponds to the black hole + int bhi = 0; + for (bhi = 0; bhi < BH_num; bhi++) + { + // because finner level may also change Porgbr, so we need factor 2 + if (feq(Porgbr[bhi][0], handle[lev][grd][0], 2 * do_every * dX) && + feq(Porgbr[bhi][1], handle[lev][grd][1], 2 * do_every * dY) && + feq(Porgbr[bhi][2], handle[lev][grd][2], 2 * do_every * dZ)) + break; + } + if (bhi == BH_num) + { + // if the box has already touched the original point + if (feq(0, bbox[lev][grd][0], dX / 2) && + feq(0, bbox[lev][grd][1], dY / 2) && + feq(0, bbox[lev][grd][2], dZ / 2)) + break; + + if (BH_num == 1) + { + bhi = 0; + break; + } // if only one black hole, it definitely match! + + if (ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "cgh::Regrid: no black hole matches with grid lev#" << lev << " grd#" << grd + << " with handle (" << handle[lev][grd][0] << "," << handle[lev][grd][1] << "," << handle[lev][grd][2] << ")" << endl; + ErrorMonitor->outfile << "black holes' old positions:" << endl; + for (bhi = 0; bhi < BH_num; bhi++) + ErrorMonitor->outfile << "#" << bhi << ": (" << Porgbr[bhi][0] << "," << Porgbr[bhi][1] << "," << Porgbr[bhi][2] << ")" << endl; + ErrorMonitor->outfile << "tolerance:" << endl; + ErrorMonitor->outfile << "(" << 2 * do_every * dX << "," << 2 * do_every * dY << "," << 2 * do_every * dZ << ")" << endl; + ErrorMonitor->outfile << "box lower boundary: (" << bbox[lev][grd][0] << "," << bbox[lev][grd][1] << "," << bbox[lev][grd][2] << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + delete[] lev_flag; + for (bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; + return; + } + // x direction + rr = (Porg0[bhi][0] - handle[lev][grd][0]) / dX; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][0] + flag * dX; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][0]; + else + rr = flag * dX; + + if (fabs(rr) > dX / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][0] = bbox[lev][grd][0] + rr; + bbox[lev][grd][3] = bbox[lev][grd][3] + rr; + handle[lev][grd][0] += rr; + tmpPorg[bhi][0] = Porg0[bhi][0]; + } + + // y direction + rr = (Porg0[bhi][1] - handle[lev][grd][1]) / dY; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][1] + flag * dY; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dY; + + if (fabs(rr) > dY / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][1] = bbox[lev][grd][1] + rr; + bbox[lev][grd][4] = bbox[lev][grd][4] + rr; + handle[lev][grd][1] += rr; + tmpPorg[bhi][1] = Porg0[bhi][1]; + } + + // z direction + rr = (Porg0[bhi][2] - handle[lev][grd][2]) / dZ; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][2] + flag * dZ; + // pay attention to the symmetric case + if (Symmetry > 0 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dZ; + + if (fabs(rr) > dZ / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][2] = bbox[lev][grd][2] + rr; + bbox[lev][grd][5] = bbox[lev][grd][5] + rr; + handle[lev][grd][2] += rr; + tmpPorg[bhi][2] = Porg0[bhi][2]; + } + } + // if(ErrorMonitor->outfile && lev_flag[lev-movls]) cout<<"lev#"< *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor) +{ + // for moving part + if (movls < levels) + { + bool tot_flag = false; + bool *lev_flag; + double **tmpPorg; + tmpPorg = new double *[BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + { + tmpPorg[bhi] = new double[dim]; + for (int i = 0; i < dim; i++) + tmpPorg[bhi][i] = Porgbr[bhi][i]; + } + lev_flag = new bool[levels - movls]; + for (int lev = movls; lev < levels; lev++) + { + lev_flag[lev - movls] = false; + for (int grd = 0; grd < grids[lev]; grd++) + { + int flag; + int do_every = 2; + double dX = PatL[lev]->data->blb->data->getdX(0); + double dY = PatL[lev]->data->blb->data->getdX(1); + double dZ = PatL[lev]->data->blb->data->getdX(2); + double rr; + // make sure that the grid corresponds to the black hole + int bhi = 0; + for (bhi = 0; bhi < BH_num; bhi++) + { + // because finner level may also change Porgbr, so we need factor 2 + if (feq(Porgbr[bhi][0], handle[lev][grd][0], 2 * do_every * dX) && + feq(Porgbr[bhi][1], handle[lev][grd][1], 2 * do_every * dY) && + feq(Porgbr[bhi][2], handle[lev][grd][2], 2 * do_every * dZ)) + break; + } + if (bhi == BH_num) + { + // if the box has already touched the original point + if (feq(0, bbox[lev][grd][0], dX / 2) && + feq(0, bbox[lev][grd][1], dY / 2) && + feq(0, bbox[lev][grd][2], dZ / 2)) + break; + + if (BH_num == 1) + { + bhi = 0; + break; + } // if only one black hole, it definitely match! + + if (ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "cgh::Regrid: no black hole matches with grid lev#" << lev << " grd#" << grd + << " with handle (" << handle[lev][grd][0] << "," << handle[lev][grd][1] << "," << handle[lev][grd][2] << ")" << endl; + ErrorMonitor->outfile << "black holes' old positions:" << endl; + for (bhi = 0; bhi < BH_num; bhi++) + ErrorMonitor->outfile << "#" << bhi << ": (" << Porgbr[bhi][0] << "," << Porgbr[bhi][1] << "," << Porgbr[bhi][2] << ")" << endl; + ErrorMonitor->outfile << "tolerance:" << endl; + ErrorMonitor->outfile << "(" << 2 * do_every * dX << "," << 2 * do_every * dY << "," << 2 * do_every * dZ << ")" << endl; + ErrorMonitor->outfile << "box lower boundary: (" << bbox[lev][grd][0] << "," << bbox[lev][grd][1] << "," << bbox[lev][grd][2] << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + delete[] lev_flag; + for (bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; + return; + } + // x direction + rr = (Porg0[bhi][0] - handle[lev][grd][0]) / dX; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][0] + flag * dX; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][0]; + else + rr = flag * dX; + + if (fabs(rr) > dX / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][0] = bbox[lev][grd][0] + rr; + bbox[lev][grd][3] = bbox[lev][grd][3] + rr; + handle[lev][grd][0] += rr; + tmpPorg[bhi][0] = Porg0[bhi][0]; + } + + // y direction + rr = (Porg0[bhi][1] - handle[lev][grd][1]) / dY; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][1] + flag * dY; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dY; + + if (fabs(rr) > dY / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][1] = bbox[lev][grd][1] + rr; + bbox[lev][grd][4] = bbox[lev][grd][4] + rr; + handle[lev][grd][1] += rr; + tmpPorg[bhi][1] = Porg0[bhi][1]; + } + + // z direction + rr = (Porg0[bhi][2] - handle[lev][grd][2]) / dZ; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][2] + flag * dZ; + // pay attention to the symmetric case + if (Symmetry > 0 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dZ; + + if (fabs(rr) > dZ / 2) + { + lev_flag[lev - movls] = tot_flag = true; + bbox[lev][grd][2] = bbox[lev][grd][2] + rr; + bbox[lev][grd][5] = bbox[lev][grd][5] + rr; + handle[lev][grd][2] += rr; + tmpPorg[bhi][2] = Porg0[bhi][2]; + } + } + // if(ErrorMonitor->outfile && lev_flag[lev-movls]) cout<<"lev#"< *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB) +{ + for (int lev = movls; lev < levels; lev++) + if (lev_flag[lev - movls]) + { + MyList *tmPat = 0; + tmPat = construct_patchlist(lev, Symmetry); + // tmPat construction completes + Parallel::distribute(tmPat, nprocs, ingfs, fngfs, false); + // checkPatchList(tmPat,true); + bool CC = (lev > trfls); + Parallel::fill_level_data(tmPat, PatL[lev], PatL[lev - 1], OldList, StateList, FutureList, tmList, Symmetry, BB, CC); + + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); + PatL[lev] = tmPat; +#if (RPB == 1) + Parallel::destroypsuList_bam(bdsul[lev]); + Parallel::destroypsuList_bam(rsul[lev]); + Parallel::Constr_pointstr_OutBdLow2Hi(PatL[lev], PatL[lev - 1], bdsul[lev]); + Parallel::Constr_pointstr_Restrict(PatL[lev], PatL[lev - 1], rsul[lev]); +#endif + } +} +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) +#warning "recompose_cgh is not implimented yet" +void cgh::recompose_cgh(int nprocs, bool *lev_flag, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB) +{ + for (int lev = movls; lev < levels; lev++) + if (lev_flag[lev - movls]) + { + MyList *tmPat = 0; + tmPat = construct_patchlist(lev, Symmetry); + // tmPat construction completes + Parallel::distribute(tmPat, end_rank[lev] - start_rank[lev] + 1, ingfs, fngfs, false, start_rank[lev], end_rank[lev]); + // checkPatchList(tmPat,true); + bool CC = (lev > trfls); + Parallel::fill_level_data(tmPat, PatL[lev], PatL[lev - 1], OldList, StateList, FutureList, tmList, Symmetry, BB, CC); + + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); + PatL[lev] = tmPat; +#if (RPB == 1) +#error "not support yet" +#endif + } +} + +//================================================================================================ + +void cgh::recompose_cgh_fake(int nprocs, bool *lev_flag, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB) +{ + for (int lev = movls; lev < levels; lev++) + if (lev_flag[lev - movls] && lev != mylev) + { + MyList *tmPat = 0; + tmPat = construct_patchlist(lev, Symmetry); + // tmPat construction completes + Parallel::distribute(tmPat, end_rank[lev] - start_rank[lev] + 1, ingfs, fngfs, false, start_rank[lev], end_rank[lev]); + + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); + PatL[lev] = tmPat; + } +} +#endif + +//================================================================================================ + +// This member function reads grid information from input files + +//================================================================================================ + +void cgh::read_bbox(int Symmetry, char *filename) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "cgh::cgh: Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "levels") + { + levels = atoi(sval.c_str()); + break; + } + } + inf.close(); + } + + grids = new int[levels]; + shape = new int **[levels]; + handle = new double **[levels]; + bbox = new double **[levels]; + PatL = new MyList *[levels]; + Lt = new double[levels]; +#if (RPB == 1) + bdsul = new MyList *[levels]; + rsul = new MyList *[levels]; +#endif + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "cgh::cgh: Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1, sind2, sind3); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && skey == "grids" && sind1 < levels) + grids[sind1] = atoi(sval.c_str()); + } + inf.close(); + } + + for (int sind1 = 0; sind1 < levels; sind1++) + { + shape[sind1] = new int *[grids[sind1]]; + handle[sind1] = new double *[grids[sind1]]; + bbox[sind1] = new double *[grids[sind1]]; + for (int sind2 = 0; sind2 < grids[sind1]; sind2++) + { + shape[sind1][sind2] = new int[dim]; + handle[sind1][sind2] = new double[dim]; + bbox[sind1][sind2] = new double[2 * dim]; + } + } + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind1, sind2, sind3; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "cgh::cgh: Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind1, sind2, sind3); + + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "cgh" && sind1 < levels && sind2 < grids[sind1]) + { + if (skey == "bbox") + bbox[sind1][sind2][sind3] = atof(sval.c_str()); + else if (skey == "shape") + shape[sind1][sind2][sind3] = atoi(sval.c_str()); + } + } + inf.close(); + } +// we always assume the input parameter is in cell center style +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + for (int lev = 0; lev < levels; lev++) + for (int grd = 0; grd < grids[lev]; grd++) + { + for (int i = 0; i < dim; i++) + { + + shape[lev][grd][i] = shape[lev][grd][i] + 1; + } + } +#endif + + { + + // boxes align check + double DH0[dim]; + for (int i = 0; i < dim; i++) +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + DH0[i] = (bbox[0][0][i + dim] - bbox[0][0][i]) / (shape[0][0][i] - 1); +#else +#ifdef Cell + DH0[i] = (bbox[0][0][i + dim] - bbox[0][0][i]) / shape[0][0][i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + for (int lev = 0; lev < levels; lev++) + for (int grd = 0; grd < grids[lev]; grd++) + Parallel::aligncheck(bbox[0][0], bbox[lev][grd], lev, DH0, shape[lev][grd]); + +#if 0 // we do not need it here, because we do it in construct_patchlist +// extend buffer points for shell overlap +#ifdef WithShell + for(int i=0;i *cgh::construct_patchlist(int lev, int Symmetry) +{ + // Construct Patches + MyList *tmPat = 0; + // construct box list + MyList *boxes = 0, *gs; + + /* + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == 0) + { + cout << " construct patchlist: " << " level = " << lev << ", grids in this level = " << grids[lev] << endl; + } + */ + + for (int grd = 0; grd < grids[lev]; grd++) + { + if (boxes) + { + gs->next = new MyList; + gs = gs->next; + gs->data = new Parallel::gridseg; + } + else + { + boxes = gs = new MyList; + gs->data = new Parallel::gridseg; + } + for (int i = 0; i < dim; i++) + { + gs->data->llb[i] = bbox[lev][grd][i]; + gs->data->uub[i] = bbox[lev][grd][dim + i]; + gs->data->shape[i] = shape[lev][grd][i]; + } + gs->data->Bg = 0; + gs->next = 0; + } + + // Merge grid boxes (merging more than three boxes may cause bugs) + // Parallel::merge_gsl(boxes, ratio); + if (grids[lev] < 3) + { + Parallel::merge_gsl(boxes, ratio); + } + + // When grid boxes overlap, re-split the boxes + // Parallel::cut_gsl(boxes); + if (grids[lev] < 3) + { + Parallel::cut_gsl(boxes); + } + + // After splitting, add new ghost regions? + // Parallel::add_ghost_touch(boxes); + if (grids[lev] < 3) + { + Parallel::add_ghost_touch(boxes); + } + + MyList *gp; + gs = boxes; + while (gs) + { + double tbb[2 * dim]; + if (tmPat) + { + gp->next = new MyList; + gp = gp->next; + for (int i = 0; i < dim; i++) + { + tbb[i] = gs->data->llb[i]; + tbb[dim + i] = gs->data->uub[i]; + } +#ifdef WithShell + gp->data = new Patch(3, gs->data->shape, tbb, lev, true, Symmetry); +#else + gp->data = new Patch(3, gs->data->shape, tbb, lev, (lev > 0), Symmetry); +#endif + } + else + { + tmPat = gp = new MyList; + for (int i = 0; i < dim; i++) + { + tbb[i] = gs->data->llb[i]; + tbb[dim + i] = gs->data->uub[i]; + } +#ifdef WithShell + gp->data = new Patch(3, gs->data->shape, tbb, lev, true, Symmetry); +#else + gp->data = new Patch(3, gs->data->shape, tbb, lev, (lev > 0), Symmetry); +#endif + } + gp->next = 0; + + gs = gs->next; + } + + boxes->destroyList(); + + return tmPat; +} + +//================================================================================================ + + +bool cgh::Interp_One_Point(MyList *VarList, + double *XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry) +{ + int lev = levels - 1; + while (lev >= 0) + { + MyList *Pp = PatL[lev]; + while (Pp) + { +#if (PSTR == 0) + if (Pp->data->Interp_ONE_Point(VarList, XX, Shellf, Symmetry)) + return true; +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) + if (Pp->data->Interp_ONE_Point(VarList, XX, Shellf, Symmetry, Commlev[lev])) + return true; +#endif + Pp = Pp->next; + } + lev--; + } + return false; +} + + +void cgh::Regrid_Onelevel(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor) +{ + if (lev < movls) + return; + +#if (0) + // #if (PSTR == 1 || PSTR == 2) + MyList *Pp = PatL[lev]; + while (Pp) + { + Pp->data->checkPatch(0, start_rank[mylev]); + Pp = Pp->next; + } + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + if (myrank == start_rank[mylev]) + { + cout << "out_rank = " << myrank << endl; + for (int grd = 0; grd < grids[lev]; grd++) + { + cout << handle[lev][grd][0] << "," << handle[lev][grd][1] << "," << handle[lev][grd][2] << endl; + } + for (int bhi = 0; bhi < BH_num; bhi++) + { + cout << Porgls[lev][bhi][0] << "," << Porgls[lev][bhi][1] << "," << Porgls[lev][bhi][2] << endl; + cout << Porg0[bhi][0] << "," << Porg0[bhi][1] << "," << Porg0[bhi][2] << endl; + } + } +#endif + + // misc::tillherecheck(Commlev[lev],start_rank[lev],"start Regrid_Onelevel"); + // for moving part + bool tot_flag = false; + double **tmpPorg; + tmpPorg = new double *[BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + { + tmpPorg[bhi] = new double[dim]; + for (int i = 0; i < dim; i++) + tmpPorg[bhi][i] = Porgls[lev][bhi][i]; + } + + for (int grd = 0; grd < grids[lev]; grd++) + { + int flag; + int do_every = 2; + double dX = PatL[lev]->data->blb->data->getdX(0); + double dY = PatL[lev]->data->blb->data->getdX(1); + double dZ = PatL[lev]->data->blb->data->getdX(2); + double rr; + // make sure that the grid corresponds to the black hole + int bhi = 0; + for (bhi = 0; bhi < BH_num; bhi++) + { + // because finner level may also change Porgbr, so we need factor 2 + // now I used Porgls + if (feq(Porgls[lev][bhi][0], handle[lev][grd][0], 2 * do_every * dX) && + feq(Porgls[lev][bhi][1], handle[lev][grd][1], 2 * do_every * dY) && + feq(Porgls[lev][bhi][2], handle[lev][grd][2], 2 * do_every * dZ)) + break; + } + if (bhi == BH_num) + { + // if the box has already touched the original point + if (feq(0, bbox[lev][grd][0], dX / 2) && + feq(0, bbox[lev][grd][1], dY / 2) && + feq(0, bbox[lev][grd][2], dZ / 2)) + break; + + if (BH_num == 1) + { + bhi = 0; + break; + } // if only one black hole, it definitely match! + + if (ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "cgh::Regrid: no black hole matches with grid lev#" << lev << " grd#" << grd + << " with handle (" << handle[lev][grd][0] << "," << handle[lev][grd][1] << "," << handle[lev][grd][2] << ")" << endl; + ErrorMonitor->outfile << "black holes' old positions:" << endl; + for (bhi = 0; bhi < BH_num; bhi++) + ErrorMonitor->outfile << "#" << bhi << ": (" << Porgls[lev][bhi][0] << "," << Porgls[lev][bhi][1] << "," + << Porgls[lev][bhi][2] << ")" << endl; + ErrorMonitor->outfile << "tolerance:" << endl; + ErrorMonitor->outfile << "(" << 2 * do_every * dX << "," << 2 * do_every * dY << "," << 2 * do_every * dZ << ")" << endl; + ErrorMonitor->outfile << "box lower boundary: (" << bbox[lev][grd][0] << "," << bbox[lev][grd][1] << "," << bbox[lev][grd][2] << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; + return; + } + // x direction + rr = (Porg0[bhi][0] - handle[lev][grd][0]) / dX; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][0] + flag * dX; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][0]; + else + rr = flag * dX; + + if (fabs(rr) > dX / 2) + { + tot_flag = true; + bbox[lev][grd][0] = bbox[lev][grd][0] + rr; + bbox[lev][grd][3] = bbox[lev][grd][3] + rr; + handle[lev][grd][0] += rr; + tmpPorg[bhi][0] = Porg0[bhi][0]; + } + + // y direction + rr = (Porg0[bhi][1] - handle[lev][grd][1]) / dY; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][1] + flag * dY; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dY; + + if (fabs(rr) > dY / 2) + { + tot_flag = true; + bbox[lev][grd][1] = bbox[lev][grd][1] + rr; + bbox[lev][grd][4] = bbox[lev][grd][4] + rr; + handle[lev][grd][1] += rr; + tmpPorg[bhi][1] = Porg0[bhi][1]; + } + + // z direction + rr = (Porg0[bhi][2] - handle[lev][grd][2]) / dZ; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][2] + flag * dZ; + // pay attention to the symmetric case + if (Symmetry > 0 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dZ; + + if (fabs(rr) > dZ / 2) + { + tot_flag = true; + bbox[lev][grd][2] = bbox[lev][grd][2] + rr; + bbox[lev][grd][5] = bbox[lev][grd][5] + rr; + handle[lev][grd][2] += rr; + tmpPorg[bhi][2] = Porg0[bhi][2]; + } + } + + // misc::tillherecheck(Commlev[lev],start_rank[lev],"after tot_flag check"); + + if (tot_flag) + { + int nprocs; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + + // misc::tillherecheck(Commlev[lev],start_rank[lev],"before recompose_cgh_Onelevel"); + + recompose_cgh_Onelevel(nprocs, lev, OldList, StateList, FutureList, tmList, Symmetry, BB); + + // misc::tillherecheck(Commlev[lev],start_rank[lev],"after recompose_cgh_Onelevel"); + + for (int bhi = 0; bhi < BH_num; bhi++) + { + for (int i = 0; i < dim; i++) + Porgls[lev][bhi][i] = tmpPorg[bhi][i]; + } + +#if (PSTR == 1 || PSTR == 2) +// MyList *Pp=PatL[lev]; +// while(Pp) +// { +// Pp->data->checkPatch(0,start_rank[mylev]); +// Pp=Pp->next; +// } +#endif + } + + for (int bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; +} + + +#if (PSTR == 0) +void cgh::recompose_cgh_Onelevel(int nprocs, int lev, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB) +{ + MyList *tmPat = 0; + tmPat = construct_patchlist(lev, Symmetry); + // tmPat construction completes + Parallel::distribute(tmPat, nprocs, ingfs, fngfs, false); + // checkPatchList(tmPat,true); + bool CC = (lev > trfls); + Parallel::fill_level_data(tmPat, PatL[lev], PatL[lev - 1], OldList, StateList, FutureList, tmList, Symmetry, BB, CC); + + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); + PatL[lev] = tmPat; +} +#elif (PSTR == 1 || PSTR == 2 || PSTR == 3) +#warning "recompose_cgh_Onelevel is not implimented yet" +void cgh::recompose_cgh_Onelevel(int nprocs, int lev, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB) +{ + MyList *tmPat = 0; + misc::tillherecheck(Commlev[lev], start_rank[lev], "before construct_patchlist"); + tmPat = construct_patchlist(lev, Symmetry); + misc::tillherecheck(Commlev[lev], start_rank[lev], "after construct_patchlist"); + // tmPat construction completes + Parallel::distribute(tmPat, end_rank[lev] - start_rank[lev] + 1, ingfs, fngfs, false, start_rank[lev], end_rank[lev]); + misc::tillherecheck(Commlev[lev], start_rank[lev], "after distribute"); + // checkPatchList(tmPat,true); + bool CC = (lev > trfls); + Parallel::fill_level_data(tmPat, PatL[lev], PatL[lev - 1], OldList, StateList, FutureList, tmList, Symmetry, BB, CC); + misc::tillherecheck(Commlev[lev], start_rank[lev], "after fill_level_data"); + + Parallel::KillBlocks(PatL[lev]); + PatL[lev]->destroyList(); + PatL[lev] = tmPat; +} + + +// the input lev is lower level for regrid +void cgh::Regrid_Onelevel_aux(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor) +{ + lev++; + if (lev < movls) + return; + + // for moving part + bool tot_flag = false; + double **tmpPorg; + tmpPorg = new double *[BH_num]; + for (int bhi = 0; bhi < BH_num; bhi++) + { + tmpPorg[bhi] = new double[dim]; + for (int i = 0; i < dim; i++) + tmpPorg[bhi][i] = Porgbr[bhi][i]; + } + + for (int grd = 0; grd < grids[lev]; grd++) + { + int flag; + int do_every = 2; + double dX = PatL[lev]->data->blb->data->getdX(0); + double dY = PatL[lev]->data->blb->data->getdX(1); + double dZ = PatL[lev]->data->blb->data->getdX(2); + double rr; + // make sure that the grid corresponds to the black hole + int bhi = 0; + for (bhi = 0; bhi < BH_num; bhi++) + { + // because finner level may also change Porgbr, so we need factor 2 + if (feq(Porgbr[bhi][0], handle[lev][grd][0], 2 * do_every * dX) && + feq(Porgbr[bhi][1], handle[lev][grd][1], 2 * do_every * dY) && + feq(Porgbr[bhi][2], handle[lev][grd][2], 2 * do_every * dZ)) + break; + } + if (bhi == BH_num) + { + // if the box has already touched the original point + if (feq(0, bbox[lev][grd][0], dX / 2) && + feq(0, bbox[lev][grd][1], dY / 2) && + feq(0, bbox[lev][grd][2], dZ / 2)) + break; + + if (BH_num == 1) + { + bhi = 0; + break; + } // if only one black hole, it definitely match! + + if (ErrorMonitor->outfile) + { + ErrorMonitor->outfile << "cgh::Regrid: no black hole matches with grid lev#" << lev << " grd#" << grd + << " with handle (" << handle[lev][grd][0] << "," << handle[lev][grd][1] << "," << handle[lev][grd][2] << ")" << endl; + ErrorMonitor->outfile << "black holes' old positions:" << endl; + for (bhi = 0; bhi < BH_num; bhi++) + ErrorMonitor->outfile << "#" << bhi << ": (" << Porgbr[bhi][0] << "," << Porgbr[bhi][1] << "," << Porgbr[bhi][2] << ")" << endl; + ErrorMonitor->outfile << "tolerance:" << endl; + ErrorMonitor->outfile << "(" << 2 * do_every * dX << "," << 2 * do_every * dY << "," << 2 * do_every * dZ << ")" << endl; + ErrorMonitor->outfile << "box lower boundary: (" << bbox[lev][grd][0] << "," << bbox[lev][grd][1] << "," << bbox[lev][grd][2] << ")" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; + return; + } + // x direction + rr = (Porg0[bhi][0] - handle[lev][grd][0]) / dX; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][0] + flag * dX; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][0]; + else + rr = flag * dX; + + if (fabs(rr) > dX / 2) + { + tot_flag = true; + bbox[lev][grd][0] = bbox[lev][grd][0] + rr; + bbox[lev][grd][3] = bbox[lev][grd][3] + rr; + handle[lev][grd][0] += rr; + tmpPorg[bhi][0] = Porg0[bhi][0]; + } + + // y direction + rr = (Porg0[bhi][1] - handle[lev][grd][1]) / dY; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][1] + flag * dY; + // pay attention to the symmetric case + if (Symmetry == 2 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dY; + + if (fabs(rr) > dY / 2) + { + tot_flag = true; + bbox[lev][grd][1] = bbox[lev][grd][1] + rr; + bbox[lev][grd][4] = bbox[lev][grd][4] + rr; + handle[lev][grd][1] += rr; + tmpPorg[bhi][1] = Porg0[bhi][1]; + } + + // z direction + rr = (Porg0[bhi][2] - handle[lev][grd][2]) / dZ; + if (rr > 0) + flag = int(rr + 0.5) / do_every; + else + flag = int(rr - 0.5) / do_every; + flag = flag * do_every; + rr = bbox[lev][grd][2] + flag * dZ; + // pay attention to the symmetric case + if (Symmetry > 0 && rr < 0) + rr = -bbox[lev][grd][1]; + else + rr = flag * dZ; + + if (fabs(rr) > dZ / 2) + { + tot_flag = true; + bbox[lev][grd][2] = bbox[lev][grd][2] + rr; + bbox[lev][grd][5] = bbox[lev][grd][5] + rr; + handle[lev][grd][2] += rr; + tmpPorg[bhi][2] = Porg0[bhi][2]; + } + } + + if (tot_flag) + { + int nprocs; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + recompose_cgh_Onelevel(nprocs, lev, OldList, StateList, FutureList, tmList, Symmetry, BB); + } + + for (int bhi = 0; bhi < BH_num; bhi++) + delete[] tmpPorg[bhi]; + delete[] tmpPorg; +} +#endif + + +void cgh::settrfls(const int lev) +{ + trfls = lev; +} diff --git a/AMSS_NCKU_source/cgh.h b/AMSS_NCKU_source/cgh.h new file mode 100644 index 0000000..79e7bf6 --- /dev/null +++ b/AMSS_NCKU_source/cgh.h @@ -0,0 +1,92 @@ + +#ifndef CGH_H +#define CGH_H + +#include +#include "MyList.h" +#include "MPatch.h" +#include "macrodef.h" +#include "monitor.h" +#include "Parallel.h" + +class cgh +{ + +public: + int levels, movls, BH_num_in; + // information of boxes + int *grids; + double ***bbox; + int ***shape; + double ***handle; + double ***Porgls; + double *Lt; + + // information of Patch list + MyList **PatL; + +// information of OutBdLow2Hi point list and Restrict point list +#if (RPB == 1) + MyList **bdsul, **rsul; +#endif + +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + int mylev; + int *start_rank, *end_rank; + MPI_Comm *Commlev; +#endif + +protected: + int ingfs, fngfs; + static constexpr double ratio = 0.75; + int trfls; + +public: + cgh(int ingfsi, int fngfsi, int Symmetry, char *filename, int checkrun, monitor *ErrorMonitor); + + ~cgh(); + + void compose_cgh(int nprocs); + void sethandle(monitor *ErrorMonitor); + void checkPatchList(MyList *PatL, bool buflog); + void Regrid(int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor); + void Regrid_fake(int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor); + void recompose_cgh(int nprocs, bool *lev_flag, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB); + void recompose_cgh_fake(int nprocs, bool *lev_flag, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB); + void read_bbox(int Symmetry, char *filename); + MyList *construct_patchlist(int lev, int Symmetry); + bool Interp_One_Point(MyList *VarList, + double *XX, /*input global Cartesian coordinate*/ + double *Shellf, int Symmetry); + void recompose_cgh_Onelevel(int nprocs, int lev, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, + int Symmetry, bool BB); + void Regrid_Onelevel(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor); + void Regrid_Onelevel_aux(int lev, int Symmetry, int BH_num, double **Porgbr, double **Porg0, + MyList *OldList, MyList *StateList, + MyList *FutureList, MyList *tmList, bool BB, + monitor *ErrorMonitor); + void settrfls(const int lev); + +#if (PSTR == 1 || PSTR == 2 || PSTR == 3) + void construct_mylev(int nprocs); +#endif +}; + +#endif /* CGH_H */ diff --git a/AMSS_NCKU_source/checkpoint.C b/AMSS_NCKU_source/checkpoint.C new file mode 100644 index 0000000..25637b6 --- /dev/null +++ b/AMSS_NCKU_source/checkpoint.C @@ -0,0 +1,893 @@ + +#ifdef newc +#include +using namespace std; +#else +#include +#endif + +#include "checkpoint.h" +#include "misc.h" +#include "fmisc.h" +#include "parameters.h" + +checkpoint::checkpoint(bool checked, const char fname[], int myrank) : filename(0), CheckList(0), checkedrun(checked) +{ + + map::iterator iter; + iter = parameters::str_par.find("output dir"); + + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + cout << "checkpoint 01" << endl; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + I_Print = (myrank == 0); + + int i = strlen(fname); + filename = new char[i+30]; + // cout << filename << endl; + // cout << i << endl; + +#ifdef CHECKDETAIL + char cmd[80]; + if (!checkedrun) + { + sprintf(cmd, "rm -rf %s/%d", out_dir.c_str(), myrank); + system(cmd); + sprintf(cmd, "mkdir %s/%d", out_dir.c_str(), myrank); + system(cmd); + } + sprintf(filename, "%s/%d/%s", out_dir.c_str(), myrank, fname); +#else + // cout << "checkpoint 5" << endl; + sprintf(filename, "%s/%s", out_dir.c_str(), fname); + // cout << "checkpoint 6" << endl; +#endif + if (myrank==0) { + cout << " checkpoint class created " << endl; + } +} +checkpoint::~checkpoint() +{ + CheckList->clearList(); + if (I_Print) + delete[] filename; +} + +void checkpoint::addvariable(var *VV) +{ + if (!VV) + return; + + if (CheckList) + CheckList->insert(VV); + else + CheckList = new MyList(VV); +} +void checkpoint::addvariablelist(MyList *VL) +{ + while (VL) + { + if (CheckList) + CheckList->insert(VL->data); + else + CheckList = new MyList(VL->data); + VL = VL->next; + } +} +#ifndef CHECKDETAIL +void checkpoint::writecheck_cgh(double time, cgh *GH) +{ + ofstream outfile; + + if (I_Print) + { + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_cgh.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.write((char *)&time, sizeof(double)); + outfile.write((char *)&(GH->levels), sizeof(int)); + outfile.write((char *)&(GH->movls), sizeof(int)); + outfile.write((char *)&(GH->BH_num_in), sizeof(int)); + outfile.write((char *)GH->grids, GH->levels * sizeof(int)); + outfile.write((char *)GH->Lt, GH->levels * sizeof(double)); + for (int lev = 0; lev < GH->levels; lev++) + { + for (int grd = 0; grd < GH->grids[lev]; grd++) + { + outfile.write((char *)GH->bbox[lev][grd], 6 * sizeof(double)); + outfile.write((char *)GH->shape[lev][grd], 3 * sizeof(int)); + outfile.write((char *)GH->handle[lev][grd], 3 * sizeof(double)); + } + for (int ibh = 0; ibh < GH->BH_num_in; ibh++) + { + outfile.write((char *)GH->Porgls[lev][ibh], 3 * sizeof(double)); + } + } + } + // write variable data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *PL = GH->PatL[lev]; + while (PL) + { + Patch *PP = PL->data; + int nn = PP->shape[0] * PP->shape[1] * PP->shape[2]; + MyList *VL = CheckList; + while (VL) + { + double *databuffer = Parallel::Collect_Data(PP, VL->data); + if (I_Print) + outfile.write((char *)databuffer, sizeof(double) * nn); + if (databuffer) + delete[] databuffer; + VL = VL->next; + } + PL = PL->next; + } + } + + if (I_Print) + outfile.close(); +} +void checkpoint::readcheck_cgh(double &time, cgh *GH, int myrank, int nprocs, int Symmetry) +{ + int DIM = dim; + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_cgh.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + infile.seekg(0, ios::beg); + infile.read((char *)&time, sizeof(double)); + if (I_Print) + cout << "check cgh in at t = " << time << endl; + infile.read((char *)&(GH->levels), sizeof(int)); + infile.read((char *)&(GH->movls), sizeof(int)); + infile.read((char *)&(GH->BH_num_in), sizeof(int)); + GH->grids = new int[GH->levels]; + GH->bbox = new double **[GH->levels]; + GH->shape = new int **[GH->levels]; + GH->handle = new double **[GH->levels]; + GH->PatL = new MyList *[GH->levels]; + GH->Lt = new double[GH->levels]; + GH->Porgls = new double **[GH->levels]; +#if (RPB == 1) + GH->bdsul = new MyList *[GH->levels]; + GH->rsul = new MyList *[GH->levels]; +#endif + infile.read((char *)GH->grids, GH->levels * sizeof(int)); + infile.read((char *)GH->Lt, GH->levels * sizeof(double)); + for (int lev = 0; lev < GH->levels; lev++) + { + GH->bbox[lev] = new double *[GH->grids[lev]]; + GH->shape[lev] = new int *[GH->grids[lev]]; + GH->handle[lev] = new double *[GH->grids[lev]]; + GH->Porgls[lev] = new double *[GH->BH_num_in]; + for (int grd = 0; grd < GH->grids[lev]; grd++) + { + GH->bbox[lev][grd] = new double[6]; + GH->shape[lev][grd] = new int[3]; + GH->handle[lev][grd] = new double[3]; + infile.read((char *)GH->bbox[lev][grd], 6 * sizeof(double)); + infile.read((char *)GH->shape[lev][grd], 3 * sizeof(int)); + infile.read((char *)GH->handle[lev][grd], 3 * sizeof(double)); + } + for (int ibh = 0; ibh < GH->BH_num_in; ibh++) + { + GH->Porgls[lev][ibh] = new double[dim]; + infile.read((char *)GH->Porgls[lev][ibh], 3 * sizeof(double)); + } + } + + for (int lev = 0; lev < GH->levels; lev++) + GH->PatL[lev] = GH->construct_patchlist(lev, Symmetry); + + GH->compose_cgh(nprocs); + // write variable data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *PL = GH->PatL[lev]; + while (PL) + { + Patch *PP = PL->data; + int nn = PP->shape[0] * PP->shape[1] * PP->shape[2]; + double *databuffer = new double[nn]; + MyList *VL = CheckList; + while (VL) + { + infile.read((char *)databuffer, sizeof(double) * nn); + + { + MyList *BL = PP->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_copy(DIM, cg->bbox, cg->bbox + DIM, cg->shape, cg->fgfs[VL->data->sgfn], + PP->bbox, PP->bbox + DIM, PP->shape, databuffer, + cg->bbox, cg->bbox + DIM); + } + if (BL == PP->ble) + break; + BL = BL->next; + } + } + + VL = VL->next; + } + delete[] databuffer; + PL = PL->next; + } + } + + infile.close(); +} +void checkpoint::writecheck_sh(double time, ShellPatch *SH) +{ + ofstream outfile; + + if (I_Print) + { + char fname[50]; + sprintf(fname, "%s_sh.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.write((char *)&time, sizeof(double)); + } + + // write variable data + MyList *Pp = SH->PatL; + while (Pp) + { + int nn = Pp->data->shape[0] * Pp->data->shape[1] * Pp->data->shape[2]; + MyList *VL = CheckList; + while (VL) + { + double *databuffer = SH->Collect_Data(Pp->data, VL->data); + if (I_Print) + outfile.write((char *)databuffer, sizeof(double) * nn); + if (databuffer) + delete[] databuffer; + VL = VL->next; + } + Pp = Pp->next; + } + + if (I_Print) + outfile.close(); +} +void checkpoint::readcheck_sh(ShellPatch *SH, int myrank) +{ + int DIM = dim; + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_sh.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + double time; + infile.seekg(0, ios::beg); + infile.read((char *)&time, sizeof(double)); + if (I_Print) + cout << "check ShellPatch in at t = " << time << endl; + + // because we assume the shell patch is fixed we can leave the composing to other routine + + MyList *Pp = SH->PatL; + while (Pp) + { + int nn = Pp->data->shape[0] * Pp->data->shape[1] * Pp->data->shape[2]; + double *databuffer = new double[nn]; + MyList *VL = CheckList; + while (VL) + { + infile.read((char *)databuffer, sizeof(double) * nn); + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_copy(DIM, cg->bbox, cg->bbox + DIM, cg->shape, cg->fgfs[VL->data->sgfn], + Pp->data->bbox, Pp->data->bbox + DIM, Pp->data->shape, databuffer, + cg->bbox, cg->bbox + DIM); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + VL = VL->next; + } + delete[] databuffer; + Pp = Pp->next; + } + + infile.close(); +} +void checkpoint::write_Black_Hole_position(int BH_num_input, int BH_num, double **Porg0, double **Porgbr, double *Mass) +{ + ofstream outfile; + + if (I_Print) + { + char fname[50]; + sprintf(fname, "%s_BHp.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.write((char *)&BH_num_input, sizeof(int)); + outfile.write((char *)&BH_num, sizeof(int)); + outfile.write((char *)Mass, 3 * sizeof(double)); + for (int i = 0; i < BH_num; i++) + { + outfile.write((char *)Porg0[i], 3 * sizeof(double)); + outfile.write((char *)Porgbr[i], 3 * sizeof(double)); + } + + outfile.close(); + } +} +void checkpoint::read_Black_Hole_position(int &BH_num_input, int &BH_num, double **&Porg0, double *&Pmom, + double *&Spin, double *&Mass, double **&Porgbr, double **&Porg, + double **&Porg1, double **&Porg_rhs) +{ + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_BHp.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (I_Print) + cout << "checking in Black_Hole_position" << endl; + + infile.seekg(0, ios::beg); + infile.read((char *)&BH_num_input, sizeof(int)); + infile.read((char *)&BH_num, sizeof(int)); + // these arrays will be deleted when bssn_class is deleted + Pmom = new double[3 * BH_num]; + Spin = new double[3 * BH_num]; + Mass = new double[BH_num]; + Porg0 = new double *[BH_num]; + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + infile.read((char *)Mass, 3 * sizeof(double)); + for (int i = 0; i < BH_num; i++) + { + Porg0[i] = new double[3]; + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + infile.read((char *)Porg0[i], 3 * sizeof(double)); + infile.read((char *)Porgbr[i], 3 * sizeof(double)); + } + + infile.close(); +} +void checkpoint::write_bssn(double LastDump, double Last2dDump, double LastAnas) +{ + ofstream outfile; + + if (I_Print) + { + char fname[50]; + sprintf(fname, "%s_bssn.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.write((char *)&LastDump, sizeof(double)); + outfile.write((char *)&Last2dDump, sizeof(double)); + outfile.write((char *)&LastAnas, sizeof(double)); + + outfile.close(); + } +} +void checkpoint::read_bssn(double &LastDump, double &Last2dDump, double &LastAnas) +{ + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_bssn.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (I_Print) + cout << "checking in bssn parameters" << endl; + + infile.seekg(0, ios::beg); + infile.read((char *)&LastDump, sizeof(double)); + infile.read((char *)&Last2dDump, sizeof(double)); + infile.read((char *)&LastAnas, sizeof(double)); + + infile.close(); +} +#else +void checkpoint::write_bssn(double LastDump, double Last2dDump, double LastAnas) +{ + ofstream outfile; + + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_bssn.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + outfile << LastDump << " "; + outfile << Last2dDump << " "; + outfile << LastAnas << " " << endl; + + outfile.close(); +} +void checkpoint::read_bssn(double &LastDump, double &Last2dDump, double &LastAnas) +{ + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_bssn.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (I_Print) + cout << "checking in bssn parameters" << endl; + + infile.seekg(0, ios::beg); + infile >> LastDump; + infile >> Last2dDump; + infile >> LastAnas; + + infile.close(); +} +void checkpoint::write_Black_Hole_position(int BH_num_input, int BH_num, double **Porg0, double **Porgbr) +{ + ofstream outfile; + + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_BHp.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + outfile << BH_num_input << " "; + outfile << BH_num << " "; + for (int i = 0; i < BH_num; i++) + { + for (int j = 0; j < 3; j++) + outfile << Porg0[i][j] << " "; + for (int j = 0; j < 3; j++) + outfile << Porgbr[i][j] << " "; + } + + outfile << endl; + outfile.close(); +} +void checkpoint::read_Black_Hole_position(int &BH_num_input, int &BH_num, double **&Porg0, double *&Pmom, + double *&Spin, double *&Mass, double **&Porgbr, double **&Porg, + double **&Porg1, double **&Porg_rhs) +{ + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_BHp.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (I_Print) + cout << "checking in Black_Hole_position" << endl; + + infile.seekg(0, ios::beg); + infile >> BH_num_input; + infile >> BH_num; + // these arrays will be deleted when bssn_class is deleted + Pmom = new double[3 * BH_num]; + Spin = new double[3 * BH_num]; + Mass = new double[BH_num]; + Porg0 = new double *[BH_num]; + Porgbr = new double *[BH_num]; + Porg = new double *[BH_num]; + Porg1 = new double *[BH_num]; + Porg_rhs = new double *[BH_num]; + for (int i = 0; i < BH_num; i++) + { + Porg0[i] = new double[3]; + Porgbr[i] = new double[3]; + Porg[i] = new double[3]; + Porg1[i] = new double[3]; + Porg_rhs[i] = new double[3]; + for (int j = 0; j < 3; j++) + infile >> Porg0[i][j]; + for (int j = 0; j < 3; j++) + infile >> Porgbr[i][j]; + } + + infile.close(); +} +void checkpoint::writecheck_cgh(double time, cgh *GH) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + ofstream outfile; + + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_cgh.CHK", filename); + + outfile.open(fname, ios::out | ios::trunc); + if (!outfile) + { + cout << "Can't open " << fname << " for check point out." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + outfile.setf(ios::scientific, ios::floatfield); + outfile.precision(16); + outfile << time << " "; + outfile << (GH->levels) << " "; + outfile << (GH->movls) << " "; + outfile << (GH->BH_num_in) << " "; + for (int j = 0; j < GH->levels; j++) + outfile << GH->grids[j] << " "; + for (int j = 0; j < GH->levels; j++) + outfile << GH->Lt[j] << " "; + for (int lev = 0; lev < GH->levels; lev++) + { + for (int grd = 0; grd < GH->grids[lev]; grd++) + { + for (int j = 0; j < 6; j++) + outfile << GH->bbox[lev][grd][j] << " "; + for (int j = 0; j < 3; j++) + outfile << GH->shape[lev][grd][j] << " "; + for (int j = 0; j < 3; j++) + outfile << GH->handle[lev][grd][j] << " "; + } + for (int ibh = 0; ibh < GH->BH_num_in; ibh++) + { + for (int j = 0; j < 3; j++) + outfile << GH->Porgls[lev][ibh][j] << " "; + } + } + // write variable data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *PL = GH->PatL[lev]; + int cnt = 0; + while (PL) + { + cnt++; + PL = PL->next; + } + outfile << cnt << " "; + PL = GH->PatL[lev]; + while (PL) + { + Patch *PP = PL->data; + outfile << PP->lev << " "; + for (int j = 0; j < 3; j++) + outfile << PP->shape[j] << " "; + for (int j = 0; j < 6; j++) + outfile << PP->bbox[j] << " "; + for (int j = 0; j < 3; j++) + outfile << PP->lli[j] << " "; + for (int j = 0; j < 3; j++) + outfile << PP->uui[j] << " "; + + MyList *BP = PP->blb; + cnt = 0; + while (BP) + { + Block *cg = BP->data; + cnt++; + if (BP == PP->ble) + break; + BP = BP->next; + } + outfile << cnt << " "; + + BP = PP->blb; + while (BP) + { + Block *cg = BP->data; + for (int j = 0; j < 3; j++) + outfile << cg->shape[j] << " "; + for (int j = 0; j < 6; j++) + outfile << cg->bbox[j] << " "; + outfile << cg->rank << " " << cg->lev << " " << cg->cgpu << " " + << cg->ingfs << " " << cg->fngfs << " "; + if (myrank == cg->rank) + { + MyList *VL = CheckList; + int NN = cg->shape[0] * cg->shape[1] * cg->shape[2]; + while (VL) + { + for (int j = 0; j < NN; j++) + outfile << cg->fgfs[VL->data->sgfn][j] << " "; + VL = VL->next; + } + } + if (BP == PP->ble) + break; + BP = BP->next; + } + PL = PL->next; + } + } + + outfile << endl; + outfile.close(); +} +void checkpoint::readcheck_cgh(double &time, cgh *GH, int myrank, int nprocs, int Symmetry) +{ + int DIM = dim; + ifstream infile; + // char fname[50]; + char fname[50+50]; + sprintf(fname, "%s_cgh.CHK", filename); + + infile.open(fname); + if (!infile) + { + cout << "Can't open " << fname << " for check point in." << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + infile.seekg(0, ios::beg); + infile >> time; + if (I_Print) + cout << "check cgh in at t = " << time << endl; + infile >> (GH->levels); + infile >> (GH->movls); + infile >> (GH->BH_num_in); + GH->grids = new int[GH->levels]; + GH->bbox = new double **[GH->levels]; + GH->shape = new int **[GH->levels]; + GH->handle = new double **[GH->levels]; + GH->PatL = new MyList *[GH->levels]; + GH->Lt = new double[GH->levels]; + GH->Porgls = new double **[GH->levels]; +#if (RPB == 1) + GH->bdsul = new MyList *[GH->levels]; + GH->rsul = new MyList *[GH->levels]; +#endif + for (int j = 0; j < GH->levels; j++) + infile >> GH->grids[j]; + for (int j = 0; j < GH->levels; j++) + infile >> GH->Lt[j]; + for (int lev = 0; lev < GH->levels; lev++) + { + GH->bbox[lev] = new double *[GH->grids[lev]]; + GH->shape[lev] = new int *[GH->grids[lev]]; + GH->handle[lev] = new double *[GH->grids[lev]]; + GH->Porgls[lev] = new double *[GH->BH_num_in]; + for (int grd = 0; grd < GH->grids[lev]; grd++) + { + GH->bbox[lev][grd] = new double[6]; + GH->shape[lev][grd] = new int[3]; + GH->handle[lev][grd] = new double[3]; + for (int j = 0; j < 6; j++) + infile >> GH->bbox[lev][grd][j]; + for (int j = 0; j < 3; j++) + infile >> GH->shape[lev][grd][j]; + for (int j = 0; j < 3; j++) + infile >> GH->handle[lev][grd][j]; + } + for (int ibh = 0; ibh < GH->BH_num_in; ibh++) + { + GH->Porgls[lev][ibh] = new double[dim]; + for (int j = 0; j < 3; j++) + infile >> GH->Porgls[lev][ibh][j]; + } + } + + // read variable data + for (int lev = 0; lev < GH->levels; lev++) + { + int cnt; + infile >> cnt; + GH->PatL[lev] = 0; + + MyList *gp; + // loop of patach + for (int cj = 0; cj < cnt; cj++) + { + if (GH->PatL[lev]) + { + gp->next = new MyList; + gp = gp->next; + } + else + { + GH->PatL[lev] = gp = new MyList; + } + gp->data = new Patch(); + infile >> gp->data->lev; + for (int j = 0; j < 3; j++) + infile >> gp->data->shape[j]; + for (int j = 0; j < 6; j++) + infile >> gp->data->bbox[j]; + for (int j = 0; j < 3; j++) + infile >> gp->data->lli[j]; + for (int j = 0; j < 3; j++) + infile >> gp->data->uui[j]; + gp->next = 0; + gp->data->blb = 0; + gp->data->ble = 0; + // loop of Block + int bnt; + infile >> bnt; + + MyList *cg; + for (int bj = 0; bj < bnt; bj++) + { + if (gp->data->blb) + { + cg->next = new MyList; + cg = cg->next; + } + else + { + gp->data->blb = cg = new MyList; + } + double tbbox[6]; + int tshape[3]; + int trank, tlev, tcgpu, tingfs, tfngfs; + for (int j = 0; j < 3; j++) + infile >> tshape[j]; + for (int j = 0; j < 6; j++) + infile >> tbbox[j]; + infile >> trank >> tlev >> tcgpu >> tingfs >> tfngfs; + cg->data = new Block(dim, tshape, tbbox, trank, tingfs, tfngfs, tlev, tcgpu); + cg->next = 0; +// if read fake check data, comment out this part +#if 1 + if (myrank == cg->data->rank) + { + MyList *VL = CheckList; + int NN = cg->data->shape[0] * cg->data->shape[1] * cg->data->shape[2]; + while (VL) + { + for (int j = 0; j < NN; j++) + infile >> cg->data->fgfs[VL->data->sgfn][j]; + VL = VL->next; + } + } +#endif + } + gp->data->ble = cg; + } + +#if (RPB == 1) + // we need distributed box of PatL[lev] and PatL[lev-1] + if (lev > 0) + { + Parallel::Constr_pointstr_OutBdLow2Hi(PatL[lev], PatL[lev - 1], bdsul[lev]); + Parallel::Constr_pointstr_Restrict(PatL[lev], PatL[lev - 1], rsul[lev]); + } + else + { + bdsul[lev] = 0; + rsul[lev] = 0; + } +#endif + } + + infile.close(); +} +#endif diff --git a/AMSS_NCKU_source/checkpoint.h b/AMSS_NCKU_source/checkpoint.h new file mode 100644 index 0000000..6571766 --- /dev/null +++ b/AMSS_NCKU_source/checkpoint.h @@ -0,0 +1,60 @@ + +#ifndef CHECKPOINT_H +#define CHECKPOINT_H + +#ifdef newc +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#endif +#include +#include + +#include + +#include "var.h" +#include "MyList.h" +#include "cgh.h" +#include "macrodef.h" +#include "ShellPatch.h" + +class checkpoint +{ + +public: + bool checkedrun; + bool I_Print; + char *filename; + MyList *CheckList; + string out_dir; + +public: + checkpoint(bool checked, const char fname[], int myrank); + // checkpoint(bool checked, char fname[50], int myrank); + + ~checkpoint(); + void addvariable(var *VV); + void addvariablelist(MyList *VL); + + void write_Black_Hole_position(int BH_num_input, int BH_num, double **Porg0, double **Porgbr, double *Mass); + void read_Black_Hole_position(int &BH_num_input, int &BH_num, double **&Porg0, double *&Pmom, + double *&Spin, double *&Mass, double **&Porgbr, double **&Porg, + double **&Porg1, double **&Porg_rhs); + void writecheck_cgh(double time, cgh *GH); + void readcheck_cgh(double &time, cgh *GH, int myrank, int nprocs, int Symmetry); + void writecheck_sh(double time, ShellPatch *SH); + void readcheck_sh(ShellPatch *SH, int myrank); + void write_bssn(double LastDump, double Last2dDump, double LastAnas); + void read_bssn(double &LastDump, double &Last2dDump, double &LastAnas); +}; + +#endif /* CHECKPOINT */ diff --git a/AMSS_NCKU_source/config.h b/AMSS_NCKU_source/config.h new file mode 100644 index 0000000..5cd90fe --- /dev/null +++ b/AMSS_NCKU_source/config.h @@ -0,0 +1,16 @@ +#ifndef AHFINDERDIRECT__CONFIG_H +#define AHFINDERDIRECT__CONFIG_H + +#include +#include +#include +#include + +size_t Util_Strlcat(char* dst, const char* src, size_t dst_size); +size_t Util_Strlcpy(char* dst, const char* src, size_t dst_size); + +typedef CCTK_REAL fp; + +typedef CCTK_INT integer; + +#endif /* AHFINDERDIRECT__CONFIG_H */ diff --git a/AMSS_NCKU_source/coords.C b/AMSS_NCKU_source/coords.C new file mode 100644 index 0000000..2058d94 --- /dev/null +++ b/AMSS_NCKU_source/coords.C @@ -0,0 +1,533 @@ +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" + +#include "coords.h" + +namespace AHFinderDirect +{ + using jtutil::arctan_xy; + using jtutil::error_exit; + using jtutil::hypot3; + using jtutil::pow2; + using jtutil::signum; + + namespace local_coords + { + + bool fuzzy_EQ_ang(fp ang1, fp ang2) + { + return jtutil::fuzzy::is_integer((ang2 - ang1) / (2.0 * PI)); + } + + bool fuzzy_EQ_dang(fp dang1, fp dang2) + { + return jtutil::fuzzy::is_integer((dang2 - dang1) / 360.0); + } + + } + + namespace local_coords + { + + fp modulo_reduce_ang(fp ang, fp min_ang, fp max_ang) + { + return jtutil::modulo_reduce(ang, 2.0 * PI, min_ang, max_ang); + } + + fp modulo_reduce_dang(fp dang, fp min_dang, fp max_dang) + { + return jtutil::modulo_reduce(dang, 360.0, min_dang, max_dang); + } + + } + + namespace local_coords + { + void xyz_of_r_mu_nu(fp r, fp mu, fp nu, fp &x, fp &y, fp &z) + { + const fp sign_y = signum(sin(mu)); + const fp sign_z_via_mu = signum(cos(mu)); + assert(jtutil::fuzzy::NE(cos(mu), 0.0)); + const fp y_over_z = tan(mu); + + const fp sign_x = signum(sin(nu)); + const fp sign_z_via_nu = signum(cos(nu)); + assert(jtutil::fuzzy::NE(cos(nu), 0.0)); + const fp x_over_z = tan(nu); + + // failure of next assert() ==> inconsistent input (mu,nu) + assert(sign_z_via_mu == sign_z_via_nu); + const fp sign_z = sign_z_via_mu; + + const fp temp = 1.0 / sqrt(1.0 + pow2(y_over_z) + pow2(x_over_z)); + + z = sign_z * r * temp; + x = x_over_z * z; + y = y_over_z * z; + } + } + + namespace local_coords + { + void xyz_of_r_mu_phi(fp r, fp mu, fp phi, fp &x, fp &y, fp &z) + { + const fp mu_bar = 0.5 * PI - mu; + const fp phi_bar = 0.5 * PI - phi; + + const fp sign_z = signum(sin(mu_bar)); + const fp sign_y_via_mu_bar = signum(cos(mu_bar)); + assert(jtutil::fuzzy::NE(cos(mu_bar), 0.0)); + const fp z_over_y = tan(mu_bar); + + const fp sign_x = signum(sin(phi_bar)); + const fp sign_y_via_phi_bar = signum(cos(phi_bar)); + assert(jtutil::fuzzy::NE(cos(phi_bar), 0.0)); + const fp x_over_y = tan(phi_bar); + + // failure of next assert() ==> inconsistent input (mu,phi) + assert(sign_y_via_mu_bar == sign_y_via_phi_bar); + const fp sign_y = sign_y_via_mu_bar; + + const fp temp = 1.0 / sqrt(1.0 + pow2(z_over_y) + pow2(x_over_y)); + + y = sign_y * r * temp; + z = z_over_y * y; + x = x_over_y * y; + } + } + namespace local_coords + { + void xyz_of_r_nu_phi(fp r, fp nu, fp phi, fp &x, fp &y, fp &z) + { + const fp nu_bar = 0.5 * PI - nu; + + const fp sign_z = signum(sin(nu_bar)); + const fp sign_x_via_nu_bar = signum(cos(nu_bar)); + assert(jtutil::fuzzy::NE(cos(nu_bar), 0.0)); + const fp z_over_x = tan(nu_bar); + + const fp sign_y = signum(sin(phi)); + const fp sign_x_via_phi = signum(cos(phi)); + assert(jtutil::fuzzy::NE(cos(phi), 0.0)); + const fp y_over_x = tan(phi); + + // failure of next assert() ==> inconsistent input (nu,phi) + assert(sign_x_via_nu_bar == sign_x_via_phi); + const fp sign_x = sign_x_via_nu_bar; + + const fp temp = 1.0 / sqrt(1.0 + pow2(z_over_x) + pow2(y_over_x)); + + x = sign_x * r * temp; + z = z_over_x * x; + y = y_over_x * x; + } + } + namespace local_coords + { + fp phi_of_mu_nu(fp mu, fp nu) + { + fp x, y, z; + xyz_of_r_mu_nu(1.0, mu, nu, x, y, z); + return phi_of_xy(x, y); + } + } + + namespace local_coords + { + fp nu_of_mu_phi(fp mu, fp phi) + { + fp x, y, z; + xyz_of_r_mu_phi(1.0, mu, phi, x, y, z); + return nu_of_xz(x, z); + } + } + + //************************************** + + // ill-conditioned near x axis + // not valid in yz plane (sin(nu) == 0 || cos(phi) == 0) + namespace local_coords + { + fp mu_of_nu_phi(fp nu, fp phi) + { + fp x, y, z; + xyz_of_r_nu_phi(1.0, nu, phi, x, y, z); + return mu_of_yz(y, z); + } + } + + //****************************************************************************** + + namespace local_coords + { + fp r_of_xyz(fp x, fp y, fp z) { return hypot3(x, y, z); } + fp mu_of_yz(fp y, fp z) { return arctan_xy(z, y); } + fp nu_of_xz(fp x, fp z) { return arctan_xy(z, x); } + fp phi_of_xy(fp x, fp y) { return arctan_xy(x, y); } + } + + namespace local_coords + { + void partial_xyz_wrt_r_mu_nu(fp r, fp mu, fp nu, + fp &partial_x_wrt_r, fp &partial_x_wrt_mu, fp &partial_x_wrt_nu, + fp &partial_y_wrt_r, fp &partial_y_wrt_mu, fp &partial_y_wrt_nu, + fp &partial_z_wrt_r, fp &partial_z_wrt_mu, fp &partial_z_wrt_nu) + { + const fp tan_mu = tan(mu); + const fp tan_nu = tan(nu); + const fp tan2_mu = pow2(tan_mu); + const fp tan2_nu = pow2(tan_nu); + + fp x, y, z; + xyz_of_r_mu_nu(r, mu, nu, x, y, z); + + assert(jtutil::fuzzy::NE(r, 0.0)); + const fp rinv = 1.0 / r; + partial_x_wrt_r = x * rinv; + partial_y_wrt_r = y * rinv; + partial_z_wrt_r = z * rinv; + + const fp t = 1 + tan2_mu + tan2_nu; // = $r^2/z^2$ + const fp partial_t_wrt_mu = 2.0 * tan_mu * (1.0 + tan2_mu); + const fp partial_t_wrt_nu = 2.0 * tan_nu * (1.0 + tan2_nu); + + const fp r2_over_zt2 = (r * r) / (z * t * t); + partial_z_wrt_mu = -0.5 * r2_over_zt2 * partial_t_wrt_mu; + partial_z_wrt_nu = -0.5 * r2_over_zt2 * partial_t_wrt_nu; + + partial_x_wrt_mu = tan_nu * partial_z_wrt_mu; + partial_x_wrt_nu = tan_nu * partial_z_wrt_nu + z * (1.0 + tan2_nu); + partial_y_wrt_mu = tan_mu * partial_z_wrt_mu + z * (1.0 + tan2_mu); + partial_y_wrt_nu = tan_mu * partial_z_wrt_nu; + } + } + + //************************************** + + namespace local_coords + { + void partial_xyz_wrt_r_mu_phi(fp r, fp mu, fp phi, + fp &partial_x_wrt_r, fp &partial_x_wrt_mu, fp &partial_x_wrt_phi, + fp &partial_y_wrt_r, fp &partial_y_wrt_mu, fp &partial_y_wrt_phi, + fp &partial_z_wrt_r, fp &partial_z_wrt_mu, fp &partial_z_wrt_phi) + { + const fp mu_bar = 0.5 * PI - mu; + const fp phi_bar = 0.5 * PI - phi; + + const fp tan_mu_bar = tan(mu_bar); + const fp tan_phi_bar = tan(phi_bar); + const fp tan2_mu_bar = pow2(tan_mu_bar); + const fp tan2_phi_bar = pow2(tan_phi_bar); + + fp x, y, z; + xyz_of_r_mu_phi(r, mu, phi, x, y, z); + + assert(jtutil::fuzzy::NE(r, 0.0)); + const fp rinv = 1.0 / r; + partial_x_wrt_r = x * rinv; + partial_y_wrt_r = y * rinv; + partial_z_wrt_r = z * rinv; + + const fp t = 1 + tan2_mu_bar + tan2_phi_bar; // = $r^2/y^2$ + const fp partial_t_wrt_mu_bar = 2.0 * tan_mu_bar * (1.0 + tan2_mu_bar); + const fp partial_t_wrt_phi_bar = 2.0 * tan_phi_bar * (1.0 + tan2_phi_bar); + + const fp r2_over_yt2 = (r * r) / (y * t * t); + partial_y_wrt_mu = 0.5 * r2_over_yt2 * partial_t_wrt_mu_bar; + partial_y_wrt_phi = 0.5 * r2_over_yt2 * partial_t_wrt_phi_bar; + + partial_x_wrt_mu = tan_phi_bar * partial_y_wrt_mu; + partial_x_wrt_phi = tan_phi_bar * partial_y_wrt_phi - y * (1.0 + tan2_phi_bar); + partial_z_wrt_mu = tan_mu_bar * partial_y_wrt_mu - y * (1.0 + tan2_mu_bar); + partial_z_wrt_phi = tan_mu_bar * partial_y_wrt_phi; + } + } + + //************************************** + + namespace local_coords + { + void partial_xyz_wrt_r_nu_phi(fp r, fp nu, fp phi, + fp &partial_x_wrt_r, fp &partial_x_wrt_nu, fp &partial_x_wrt_phi, + fp &partial_y_wrt_r, fp &partial_y_wrt_nu, fp &partial_y_wrt_phi, + fp &partial_z_wrt_r, fp &partial_z_wrt_nu, fp &partial_z_wrt_phi) + { + const fp nu_bar = 0.5 * PI - nu; + + const fp tan_nu_bar = tan(nu_bar); + const fp tan_phi = tan(phi); + const fp tan2_nu_bar = pow2(tan_nu_bar); + const fp tan2_phi = pow2(tan_phi); + + fp x, y, z; + xyz_of_r_nu_phi(r, nu, phi, x, y, z); + + assert(jtutil::fuzzy::NE(r, 0.0)); + const fp rinv = 1.0 / r; + partial_x_wrt_r = x * rinv; + partial_y_wrt_r = y * rinv; + partial_z_wrt_r = z * rinv; + + const fp t = 1 + tan2_nu_bar + tan2_phi; // = $r^2/x^2$ + const fp partial_t_wrt_nu_bar = 2.0 * tan_nu_bar * (1.0 + tan2_nu_bar); + const fp partial_t_wrt_phi = 2.0 * tan_phi * (1.0 + tan2_phi); + + const fp r2_over_xt2 = (r * r) / (x * t * t); + partial_x_wrt_nu = 0.5 * r2_over_xt2 * partial_t_wrt_nu_bar; + partial_x_wrt_phi = -0.5 * r2_over_xt2 * partial_t_wrt_phi; + + partial_y_wrt_nu = tan_phi * partial_x_wrt_nu; + partial_y_wrt_phi = tan_phi * partial_x_wrt_phi + x * (1.0 + tan2_phi); + partial_z_wrt_nu = tan_nu_bar * partial_x_wrt_nu - x * (1.0 + tan2_nu_bar); + partial_z_wrt_phi = tan_nu_bar * partial_x_wrt_phi; + } + } + + //****************************************************************************** + + // + // these functions compute the partial derivatives + // partial {mu,nu,phi} / partial {x,y,z} + // as computed by the maple file "coord_derivs.{maple,out}" in this directory + // + namespace local_coords + { + fp partial_mu_wrt_y(fp y, fp z) { return z / (y * y + z * z); } + fp partial_mu_wrt_z(fp y, fp z) { return -y / (y * y + z * z); } + + fp partial_nu_wrt_x(fp x, fp z) { return z / (x * x + z * z); } + fp partial_nu_wrt_z(fp x, fp z) { return -x / (x * x + z * z); } + + fp partial_phi_wrt_x(fp x, fp y) { return -y / (x * x + y * y); } + fp partial_phi_wrt_y(fp x, fp y) { return x / (x * x + y * y); } + } + + //****************************************************************************** + + // + // these functions compute the 2nd partial derivatives + // partial {mu,nu,phi} / partial {xx,xy,xz,yy,yz,zz} + // as computed by the maple file "coord_derivs.{maple,out}" in this directory + // + namespace local_coords + { + fp partial2_mu_wrt_yy(fp y, fp z) { return -2.0 * y * z / pow2(y * y + z * z); } + fp partial2_mu_wrt_yz(fp y, fp z) { return (y * y - z * z) / pow2(y * y + z * z); } + fp partial2_mu_wrt_zz(fp y, fp z) { return 2.0 * y * z / pow2(y * y + z * z); } + + fp partial2_nu_wrt_xx(fp x, fp z) { return -2.0 * x * z / pow2(x * x + z * z); } + fp partial2_nu_wrt_xz(fp x, fp z) { return (x * x - z * z) / pow2(x * x + z * z); } + fp partial2_nu_wrt_zz(fp x, fp z) { return 2.0 * x * z / pow2(x * x + z * z); } + + fp partial2_phi_wrt_xx(fp x, fp y) { return 2.0 * x * y / pow2(x * x + y * y); } + fp partial2_phi_wrt_xy(fp x, fp y) { return (y * y - x * x) / pow2(x * x + y * y); } + fp partial2_phi_wrt_yy(fp x, fp y) { return -2.0 * x * y / pow2(x * x + y * y); } + } + + namespace local_coords + { + void xyz_of_r_theta_phi(fp r, fp theta, fp phi, fp &x, fp &y, fp &z) + { + z = r * cos(theta); + x = r * sin(theta) * cos(phi); + y = r * sin(theta) * sin(phi); + } + } + + //************************************** + + namespace local_coords + { + void r_theta_phi_of_xyz(fp x, fp y, fp z, fp &r, fp &theta, fp &phi) + { + r = r_of_xyz(x, y, z); + theta = theta_of_xyz(x, y, z); + phi = phi_of_xy(x, y); + } + } + + //************************************** + + namespace local_coords + { + fp theta_of_xyz(fp x, fp y, fp z) + { + return arctan_xy(z, hypot(x, y)); + } + } + + //****************************************************************************** + + // + // these functions convert ((mu,nu,phi)) <--> usual polar spherical (theta,phi) + // ... note phi is the same coordinate in both systems + // + + namespace local_coords + { + void theta_phi_of_mu_nu(fp mu, fp nu, fp &ps_theta, fp &ps_phi) + { + fp x, y, z; + xyz_of_r_mu_nu(1.0, mu, nu, x, y, z); + + ps_theta = theta_of_xyz(x, y, z); + ps_phi = phi_of_xy(x, y); + } + } + + //************************************** + + // Bugs: computes ps_phi via trig, even though it's trivially == phi + namespace local_coords + { + void theta_phi_of_mu_phi(fp mu, fp phi, fp &ps_theta, fp &ps_phi) + { + fp x, y, z; + xyz_of_r_mu_phi(1.0, mu, phi, x, y, z); + + ps_theta = theta_of_xyz(x, y, z); + ps_phi = phi_of_xy(x, y); + assert(fuzzy_EQ_ang(ps_phi, phi)); + } + } + + //************************************** + + // Bugs: computes ps_phi via trig, even though it's trivially == phi + namespace local_coords + { + void theta_phi_of_nu_phi(fp nu, fp phi, fp &ps_theta, fp &ps_phi) + { + fp x, y, z; + xyz_of_r_nu_phi(1.0, nu, phi, x, y, z); + + ps_theta = theta_of_xyz(x, y, z); + ps_phi = phi_of_xy(x, y); + assert(fuzzy_EQ_ang(ps_phi, phi)); + } + } + + //****************************************************************************** + + namespace local_coords + { + void mu_nu_of_theta_phi(fp ps_theta, fp ps_phi, fp &mu, fp &nu) + { + fp x, y, z; + xyz_of_r_theta_phi(1.0, ps_theta, ps_phi, x, y, z); + + mu = mu_of_yz(y, z); + nu = nu_of_xz(x, z); + } + } + + //************************************** + + // Bugs: computes phi via trig, even though it's trivially == ps_phi + namespace local_coords + { + void mu_phi_of_theta_phi(fp ps_theta, fp ps_phi, fp &mu, fp &phi) + { + fp x, y, z; + xyz_of_r_theta_phi(1.0, ps_theta, ps_phi, x, y, z); + + mu = mu_of_yz(y, z); + phi = phi_of_xy(x, y); + assert(fuzzy_EQ_ang(phi, ps_phi)); + } + } + + //************************************** + + // Bugs: computes phi via trig, even though it's trivially == ps_phi + namespace local_coords + { + void nu_phi_of_theta_phi(fp ps_theta, fp ps_phi, fp &nu, fp &phi) + { + fp x, y, z; + xyz_of_r_theta_phi(1.0, ps_theta, ps_phi, x, y, z); + + nu = nu_of_xz(x, z); + phi = phi_of_xy(x, y); + assert(fuzzy_EQ_ang(phi, ps_phi)); + } + } + + //****************************************************************************** + + // + // these functions convert ((mu,nu,phi)) to the direction cosines + // (xcos,ycos,zcos) + // + + namespace local_coords + { + void xyzcos_of_mu_nu(fp mu, fp nu, fp &xcos, fp &ycos, fp &zcos) + { + xyz_of_r_mu_nu(1.0, mu, nu, xcos, ycos, zcos); + } + } + + namespace local_coords + { + void xyzcos_of_mu_phi(fp mu, fp phi, fp &xcos, fp &ycos, fp &zcos) + { + xyz_of_r_mu_phi(1.0, mu, phi, xcos, ycos, zcos); + } + } + + namespace local_coords + { + void xyzcos_of_nu_phi(fp nu, fp phi, fp &xcos, fp &ycos, fp &zcos) + { + xyz_of_r_nu_phi(1.0, nu, phi, xcos, ycos, zcos); + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function computes a human-readable name from a (mu,nu,phi) + // coordinates set. + // + const char *local_coords::name_of_coords_set(coords_set S) + { + // + // we have to use an if-else chain because the local_coords::set_* + // constants aren't compile-time constants and hence aren't eligible + // to be switch case labels + // + if (S == coords_set_empty) + then return "{}"; + else if (S == coords_set_mu) + then return "mu"; + else if (S == coords_set_nu) + then return "nu"; + else if (S == coords_set_phi) + then return "phi"; + else if (S == coords_set_mu | coords_set_nu) + then return "{mu,nu}"; + else if (S == coords_set_mu | coords_set_phi) + then return "{mu,phi}"; + else if (S == coords_set_nu | coords_set_phi) + then return "{nu,phi}"; + else if (S == coords_set_mu | coords_set_nu | coords_set_phi) + then return "{mu,nu,phi}"; + else + error_exit(PANIC_EXIT, + "***** local_coords::mu_nu_phi::name_of_coords_set:\n" + " S=0x%x isn't a valid coords_set bit vector!\n", + int(S)); /*NOTREACHED*/ + } + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/coords.h b/AMSS_NCKU_source/coords.h new file mode 100644 index 0000000..c93ddab --- /dev/null +++ b/AMSS_NCKU_source/coords.h @@ -0,0 +1,173 @@ +#ifndef COORDS_H +#define COORDS_H +namespace AHFinderDirect +{ + namespace local_coords + { + + // compare if two angles are fuzzily equal mod 2*pi radians (360 degrees) + bool fuzzy_EQ_ang(fp ang1, fp ang2); // radians + bool fuzzy_EQ_dang(fp dang1, fp dang2); // degrees + + // modulo-reduce {ang,dang} to be (fuzzily) within the range + // [min,max]_{ang,dang}, or error_exit() if no such value exists + fp modulo_reduce_ang(fp ang, fp min_ang, fp max_ang); + fp modulo_reduce_dang(fp dang, fp min_dang, fp max_dang); + + } // close namespace local_coords:: + + namespace local_coords + { + // (r,(mu,nu,phi)) <--> (x,y,z) + void xyz_of_r_mu_nu(fp r, fp mu, fp nu, fp &x, fp &y, fp &z); + void xyz_of_r_mu_phi(fp r, fp mu, fp phi, fp &x, fp &y, fp &z); + void xyz_of_r_nu_phi(fp r, fp nu, fp phi, fp &x, fp &y, fp &z); + fp r_of_xyz(fp x, fp y, fp z); + fp mu_of_yz(fp y, fp z); + fp nu_of_xz(fp x, fp z); + fp phi_of_xy(fp x, fp y); + + // ((mu,nu,phi)) --> the 3rd + fp phi_of_mu_nu(fp mu, fp nu); + fp nu_of_mu_phi(fp mu, fp phi); + fp mu_of_nu_phi(fp nu, fp phi); + + // partial {x,y,z} / partial {mu,nu,phi} + void partial_xyz_wrt_r_mu_nu(fp r, fp mu, fp nu, + fp &partial_x_wrt_r, fp &partial_x_wrt_mu, fp &partial_x_wrt_nu, + fp &partial_y_wrt_r, fp &partial_y_wrt_mu, fp &partial_y_wrt_nu, + fp &partial_z_wrt_r, fp &partial_z_wrt_mu, fp &partial_z_wrt_nu); + void partial_xyz_wrt_r_mu_phi(fp r, fp mu, fp phi, + fp &partial_x_wrt_r, fp &partial_x_wrt_mu, fp &partial_x_wrt_phi, + fp &partial_y_wrt_r, fp &partial_y_wrt_mu, fp &partial_y_wrt_phi, + fp &partial_z_wrt_r, fp &partial_z_wrt_mu, fp &partial_z_wrt_phi); + void partial_xyz_wrt_r_nu_phi(fp r, fp nu, fp phi, + fp &partial_x_wrt_r, fp &partial_x_wrt_nu, fp &partial_x_wrt_phi, + fp &partial_y_wrt_r, fp &partial_y_wrt_nu, fp &partial_y_wrt_phi, + fp &partial_z_wrt_r, fp &partial_z_wrt_nu, fp &partial_z_wrt_phi); + + // partial {mu,nu,phi} / partial {x,y,z} + fp partial_mu_wrt_y(fp y, fp z); + fp partial_mu_wrt_z(fp y, fp z); + fp partial_nu_wrt_x(fp x, fp z); + fp partial_nu_wrt_z(fp x, fp z); + fp partial_phi_wrt_x(fp x, fp y); + fp partial_phi_wrt_y(fp x, fp y); + + // partial^2 {mu,nu,phi} / partial {x,y,z}{x,y,z} + fp partial2_mu_wrt_yy(fp y, fp z); + fp partial2_mu_wrt_yz(fp y, fp z); + fp partial2_mu_wrt_zz(fp y, fp z); + fp partial2_nu_wrt_xx(fp x, fp z); + fp partial2_nu_wrt_xz(fp x, fp z); + fp partial2_nu_wrt_zz(fp x, fp z); + fp partial2_phi_wrt_xx(fp x, fp y); + fp partial2_phi_wrt_xy(fp x, fp y); + fp partial2_phi_wrt_yy(fp x, fp y); + + // usual polar spherical (r,theta,phi) <--> (x,y,z) + void xyz_of_r_theta_phi(fp r, fp theta, fp phi, fp &x, fp &y, fp &z); + void r_theta_phi_of_xyz(fp x, fp y, fp z, fp &r, fp &theta, fp &phi); + // ... already have r_of_xyz() + // ... already have phi_of_xy() + fp theta_of_xyz(fp x, fp y, fp z); + + // ((mu,nu,phi)) <--> usual polar spherical (theta,phi) + // ... note phi is the same coordinate in both systems + void theta_phi_of_mu_nu(fp mu, fp nu, fp &ps_theta, fp &ps_phi); + void theta_phi_of_mu_phi(fp mu, fp phi, fp &ps_theta, fp &ps_phi); + void theta_phi_of_nu_phi(fp nu, fp phi, fp &ps_theta, fp &ps_phi); + void mu_nu_of_theta_phi(fp ps_theta, fp ps_phi, fp &mu, fp &nu); + void mu_phi_of_theta_phi(fp ps_theta, fp ps_phi, fp &mu, fp &phi); + void nu_phi_of_theta_phi(fp ps_theta, fp ps_phi, fp &nu, fp &phi); + + // ((mu,nu,phi)) --> direction cosines (xcos,ycos,zcos) + void xyzcos_of_mu_nu(fp mu, fp nu, fp &xcos, fp &ycos, fp &zcos); + void xyzcos_of_mu_phi(fp mu, fp phi, fp &xcos, fp &ycos, fp &zcos); + void xyzcos_of_nu_phi(fp nu, fp phi, fp &xcos, fp &ycos, fp &zcos); + } // close namespace local_coords:: + + //***************************************************************************** + + // + // ***** bit masks for coordinates **** + // + + // + // We need to manipulate coordinates to do calculations like "which + // coordinate do these two patches have in common". We do these by + // Boolean operations on integers using the following bit masks: + // + + namespace local_coords + { + + typedef int coords_set; + + enum + { + coords_set_mu = 0x1, + coords_set_nu = 0x2, + coords_set_phi = 0x4, + + coords_set_empty = 0x0, + coords_set_all = coords_set_mu | coords_set_nu | coords_set_phi // no comma + }; + + // human-readable coordinate names for debugging etc + const char *name_of_coords_set(coords_set S); + + // set complement of coordinates + inline coords_set coords_set_not(coords_set S) + { + return coords_set_all & ~S; + } + + } // close namespace local_coords:: + + //****************************************************************************** + + // + // This class stores the origin point of our local coordinates, and + // provides conversions between local and global coordinates. + // + class global_coords + { + public: + // get global (x,y,z) coordinates of local origin point + fp origin_x() const { return origin_x_; } + fp origin_y() const { return origin_y_; } + fp origin_z() const { return origin_z_; } + + // constructor: specify global (x,y,z) coordinates of local origin point + global_coords(fp origin_x_in, fp origin_y_in, fp origin_z_in) + : origin_x_(origin_x_in), + origin_y_(origin_y_in), + origin_z_(origin_z_in) + { + } + // destructor: compiler-generated no-op is ok + + void recentering(fp x, fp y, fp z) + { + origin_x_ = x; + origin_y_ = y; + origin_z_ = z; + } + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + global_coords(const global_coords &rhs); + global_coords &operator=(const global_coords &rhs); + + private: + // global (x,y,z) coordinates of local origin point + fp origin_x_, origin_y_, origin_z_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* COORDS_H */ diff --git a/AMSS_NCKU_source/cpbc.f90 b/AMSS_NCKU_source/cpbc.f90 new file mode 100644 index 0000000..3b2b667 --- /dev/null +++ b/AMSS_NCKU_source/cpbc.f90 @@ -0,0 +1,4455 @@ + + +#include "macrodef.fh" + + subroutine get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + + implicit none + + real*8,intent(out) :: kappa1,kappa2,kappa3,FF,eta + + kappa1 = 2.d-2 + kappa2 = 0.d0 + kappa3 = 0.d0 + + FF = 0.75d0 + eta=2.0d0 + + return + + end subroutine get_Z4cparameters +#if 1 +! need CPBC_ghost_width +!PRD 83, 024025 (2011) + subroutine david_milton_cpbc_ss(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax, & + TZ,chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz, & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ_rhs,chi_rhs,trK_rhs, & + gxx_rhs,gxy_rhs,gxz_rhs,gyy_rhs,gyz_rhs,gzz_rhs, & + Axx_rhs,Axy_rhs,Axz_rhs,Ayy_rhs,Ayz_rhs,Azz_rhs, & + Gamx_rhs,Gamy_rhs,Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + pGamxxx,pGamxxy,pGamxxz,pGamxyy,pGamxyz,pGamxzz, & + pGamyxx,pGamyxy,pGamyxz,pGamyyy,pGamyyz,pGamyzz, & + pGamzxx,pGamzxy,pGamzxz,pGamzyy,pGamzyz,pGamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Gmxcon,Gmycon,Gmzcon, & + Symmetry,eps,sst) + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ,chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz,Gmxcon,Gmycon,Gmzcon + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: TZ_rhs,chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8,intent(in) :: eps +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxxx, pGamxxy, pGamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxyy, pGamxyz, pGamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyxx, pGamyxy, pGamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyyy, pGamyyz, pGamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzxx, pGamzxy, pGamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzyy, pGamzyz, pGamzzz + +!~~~~~~~~~~~> local variables + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qxx,qxy,qxz,qyy,qyz,qzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qupxx,qupxy,qupxz,qupyy,qupyz,qupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qulxx,qulxy,qulxz,qulyx,qulyy,qulyz,qulzx,qulzy,qulzz + real*8, dimension(ex(1),ex(2),ex(3)) :: slx,sly,slz,ulx,uly,ulz,wlx,wly,wlz + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: fx,fy,fz + logical :: gont + real*8 :: dR + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax +! derivatives + real*8 :: Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz + real*8 :: sfxx,sfxy,sfxz,sfyx,sfyy,sfyz,sfzx,sfzy,sfzz + real*8 :: sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz + real*8 :: sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz + real*8 :: sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz + real*8 :: TZx,TZy,TZz + real*8 :: chix,chiy,chiz,Kx,Ky,Kz + real*8 :: chixx,chixy,chixz,chiyy,chiyz,chizz + real*8 :: Axxx,Axxy,Axxz + real*8 :: Axyx,Axyy,Axyz + real*8 :: Axzx,Axzy,Axzz + real*8 :: Ayyx,Ayyy,Ayyz + real*8 :: Ayzx,Ayzy,Ayzz + real*8 :: Azzx,Azzy,Azzz + real*8 :: gxxx,gxxy,gxxz + real*8 :: gxyx,gxyy,gxyz + real*8 :: gxzx,gxzy,gxzz + real*8 :: gyyx,gyyy,gyyz + real*8 :: gyzx,gyzy,gyzz + real*8 :: gzzx,gzzy,gzzz + real*8 :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8 :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8 :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8 :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8 :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8 :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8 :: Gamxx,Gamxy,Gamxz + real*8 :: Gamyx,Gamyy,Gamyz + real*8 :: Gamzx,Gamzy,Gamzz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0,HALF=0.5d0 + real*8,parameter::TINYRR=1.d-14 +! in order to synchronize the following parameters with Z4c_rhs calculation, we +! call a routine + real*8 :: kappa1,kappa2,kappa3,FF,eta + +! real*8,parameter :: ha=0.d0,thbs=0.d0,hu=0.d0,hw=0.d0,Rhpsi0=0.d0,Ihpsi0=0.d0 + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + + dR = R(2) - R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) - CPBC_ghost_width + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) - CPBC_ghost_width +endif + +if(dabs(R(1)-zmin) < dR)then + layer(1,6) = 1 + layer(2,6) = 1 + layer(3,6) = 1 + layer(4,6) = ex(1) + layer(5,6) = ex(2) + layer(6,6) = 1 +endif +! fix BD + gp = 6 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! z direction + TZ_rhs(i,j,k) = ZEO + chi_rhs(i,j,k) = ZEO + trK_rhs(i,j,k) = ZEO + gxx_rhs(i,j,k) = ZEO + gxy_rhs(i,j,k) = ZEO + gxz_rhs(i,j,k) = ZEO + gyy_rhs(i,j,k) = ZEO + gyz_rhs(i,j,k) = ZEO + gzz_rhs(i,j,k) = ZEO + Axx_rhs(i,j,k) = ZEO + Axy_rhs(i,j,k) = ZEO + Axz_rhs(i,j,k) = ZEO + Ayy_rhs(i,j,k) = ZEO + Ayz_rhs(i,j,k) = ZEO + Azz_rhs(i,j,k) = ZEO + Gamx_rhs(i,j,k) = ZEO + Gamy_rhs(i,j,k) = ZEO + Gamz_rhs(i,j,k) = ZEO + Lap_rhs(i,j,k) = ZEO + betax_rhs(i,j,k) = ZEO + betay_rhs(i,j,k) = ZEO + betaz_rhs(i,j,k) = ZEO + dtSfx_rhs(i,j,k) = ZEO + dtSfy_rhs(i,j,k) = ZEO + dtSfz_rhs(i,j,k) = ZEO + enddo + enddo + enddo + endif + +! constraint preserving BD + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + +! cpbc real starts + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +!calculate the involved derivatives +#if 0 + Kx = 0.d0 + Ky = 0.d0 + Kz = 0.d0 + chix = 0.d0 + chiy = 0.d0 + chiz = 0.d0 + Lapx = 0.d0 + Lapy = 0.d0 + Lapz = 0.d0 + TZx = 0.d0 + TZy = 0.d0 + TZz = 0.d0 + Gamxx = 0.d0 + Gamxy = 0.d0 + Gamxz = 0.d0 + Gamyx = 0.d0 + Gamyy = 0.d0 + Gamyz = 0.d0 + Gamzx = 0.d0 + Gamzy = 0.d0 + Gamzz = 0.d0 + sfxx = 0.d0 + sfxy = 0.d0 + sfxz = 0.d0 + sfyx = 0.d0 + sfyy = 0.d0 + sfyz = 0.d0 + sfzx = 0.d0 + sfzy = 0.d0 + sfzz = 0.d0 + Axxx = 0.d0 + Axxy = 0.d0 + Axxz = 0.d0 + Axyx = 0.d0 + Axyy = 0.d0 + Axyz = 0.d0 + Axzx = 0.d0 + Axzy = 0.d0 + Axzz = 0.d0 + Ayyx = 0.d0 + Ayyy = 0.d0 + Ayyz = 0.d0 + Ayzx = 0.d0 + Ayzy = 0.d0 + Ayzz = 0.d0 + Azzx = 0.d0 + Azzy = 0.d0 + Azzz = 0.d0 + gxxx = 0.d0 + gxxy = 0.d0 + gxxz = 0.d0 + gxyx = 0.d0 + gxyy = 0.d0 + gxyz = 0.d0 + gxzx = 0.d0 + gxzy = 0.d0 + gxzz = 0.d0 + gyyx = 0.d0 + gyyy = 0.d0 + gyyz = 0.d0 + gyzx = 0.d0 + gyzy = 0.d0 + gyzz = 0.d0 + gzzx = 0.d0 + gzzy = 0.d0 + gzzz = 0.d0 +#else + call point_fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) +#if 0 + sfxx = 0.d0 + sfxy = 0.d0 + sfxz = 0.d0 + sfyx = 0.d0 + sfyy = 0.d0 + sfyz = 0.d0 + sfzx = 0.d0 + sfzy = 0.d0 + sfzz = 0.d0 +#else + call point_fderivs_shc(ex,betax,sfxx,sfxy,sfxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,betay,sfyx,sfyy,sfyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,betaz,sfzx,sfzy,sfzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) +#endif + call point_fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) +#endif + +#if 0 + Lapxx = 0.d0 + Lapxy = 0.d0 + Lapxz = 0.d0 + Lapyy = 0.d0 + Lapyz = 0.d0 + Lapzz = 0.d0 + chixx = 0.d0 + chixy = 0.d0 + chixz = 0.d0 + chiyy = 0.d0 + chiyz = 0.d0 + chizz = 0.d0 + gxxxx = 0.d0 + gxxxy = 0.d0 + gxxxz = 0.d0 + gxxyy = 0.d0 + gxxyz = 0.d0 + gxxzz = 0.d0 + gyyxx = 0.d0 + gyyxy = 0.d0 + gyyxz = 0.d0 + gyyyy = 0.d0 + gyyyz = 0.d0 + gyyzz = 0.d0 + gzzxx = 0.d0 + gzzxy = 0.d0 + gzzxz = 0.d0 + gzzyy = 0.d0 + gzzyz = 0.d0 + gzzzz = 0.d0 + gxyxx = 0.d0 + gxyxy = 0.d0 + gxyxz = 0.d0 + gxyyy = 0.d0 + gxyyz = 0.d0 + gxyzz = 0.d0 + gxzxx = 0.d0 + gxzxy = 0.d0 + gxzxz = 0.d0 + gxzyy = 0.d0 + gxzyz = 0.d0 + gxzzz = 0.d0 + gyzxx = 0.d0 + gyzxy = 0.d0 + gyzxz = 0.d0 + gyzyy = 0.d0 + gyzyz = 0.d0 + gyzzz = 0.d0 + sfxxx = 0.d0 + sfxxy = 0.d0 + sfxxz = 0.d0 + sfxyy = 0.d0 + sfxyz = 0.d0 + sfxzz = 0.d0 + sfyxx = 0.d0 + sfyxy = 0.d0 + sfyxz = 0.d0 + sfyyy = 0.d0 + sfyyz = 0.d0 + sfyzz = 0.d0 + sfzxx = 0.d0 + sfzxy = 0.d0 + sfzxz = 0.d0 + sfzyy = 0.d0 + sfzyz = 0.d0 + sfzzz = 0.d0 +#else + call point_fdderivs_shc(ex,Lap,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,chi,chixx,chixy,chixz,chiyy,chiyz,chizz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betax,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,crho,sigma,R,ANTI,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betay,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,crho,sigma,R,SYM ,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betaz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) +#endif + + call cpbc_point(R(k),x(i,j,k),y(i,j,k),z(i,j,k),TZ(i,j,k),chin1(i,j,k),trK(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + Gamx(i,j,k),Gamy(i,j,k),Gamz(i,j,k), & + alpn1(i,j,k),betax(i,j,k),betay(i,j,k),betaz(i,j,k), & + Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz, & + sfxx,sfxy,sfxz, & + sfyx,sfyy,sfyz, & + sfzx,sfzy,sfzz, & + sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz, & + sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz, & + sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz, & + chix,chiy,chiz,chixx,chixy,chixz,chiyy,chiyz,chizz, & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Kx,Ky,Kz, & + Axxx,Axyx,Axzx,Ayyx,Ayzx,Azzx, & + Axxy,Axyy,Axzy,Ayyy,Ayzy,Azzy, & + Axxz,Axyz,Axzz,Ayyz,Ayzz,Azzz, & + Gamxx,Gamxy,Gamxz, & + Gamyx,Gamyy,Gamyz, & + Gamzx,Gamzy,Gamzz, & + TZx,TZy,TZz, & + trK_rhs(i,j,k),TZ_rhs(i,j,k), & + Axx_rhs(i,j,k),Axy_rhs(i,j,k),Axz_rhs(i,j,k),Ayy_rhs(i,j,k),Ayz_rhs(i,j,k),Azz_rhs(i,j,k), & + Gamx_rhs(i,j,k),Gamy_rhs(i,j,k),Gamz_rhs(i,j,k),kappa1,kappa2,eta) + enddo + enddo + enddo + + endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) + +#if 0 + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) +#endif + + call kodis_sh(ex,crho,sigma,R,TZ,TZ_rhs,SSS,Symmetry,eps,sst) + endif + + return + + end subroutine david_milton_cpbc_ss +#elif 1 +#error "did you change sommerfeld routine for buffer points considering?" +!!! CV == 0: Sommerfeld on everything after decomposing +!!! CV == 1: Sommerfeld on only the CPBC vars after decomposing +!!! CV == 1 and replace Sommerfeld to CPBC one by one +#define CV 1 +! Sommefeld after 2+1 decomposation + subroutine david_milton_cpbc_ss(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax, & + TZ,chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz, & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ_rhs,chi_rhs,trK_rhs, & + gxx_rhs,gxy_rhs,gxz_rhs,gyy_rhs,gyz_rhs,gzz_rhs, & + Axx_rhs,Axy_rhs,Axz_rhs,Ayy_rhs,Ayz_rhs,Azz_rhs, & + Gamx_rhs,Gamy_rhs,Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + pGamxxx,pGamxxy,pGamxxz,pGamxyy,pGamxyz,pGamxzz, & + pGamyxx,pGamyxy,pGamyxz,pGamyyy,pGamyyz,pGamyzz, & + pGamzxx,pGamzxy,pGamzxz,pGamzyy,pGamzyz,pGamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Gmxcon,Gmycon,Gmzcon, & + Symmetry,eps,sst) + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ,chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz,Gmxcon,Gmycon,Gmzcon + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: TZ_rhs,chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8,intent(in) :: eps +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxxx, pGamxxy, pGamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxyy, pGamxyz, pGamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyxx, pGamyxy, pGamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyyy, pGamyyz, pGamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzxx, pGamzxy, pGamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzyy, pGamzyz, pGamzzz + +!~~~~~~~~~~~> local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: chin1,gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: toAqq,toAss,toAsx,toAsy,toAsz + real*8, dimension(ex(1),ex(2),ex(3)) :: toAxx,toAxy,toAxz,toAyy,toAyz,toAzz + real*8, dimension(ex(1),ex(2),ex(3)) :: toAqq_rhs,toAss_rhs,toAsx_rhs,toAsy_rhs,toAsz_rhs + real*8, dimension(ex(1),ex(2),ex(3)) :: toAxx_rhs,toAxy_rhs,toAxz_rhs,toAyy_rhs,toAyz_rhs,toAzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)) :: toGams,toGamx,toGamy,toGamz + real*8, dimension(ex(1),ex(2),ex(3)) :: toGams_rhs,toGamx_rhs,toGamy_rhs,toGamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)) :: tobetas,tobetax,tobetay,tobetaz + real*8, dimension(ex(1),ex(2),ex(3)) :: tobetas_rhs,tobetax_rhs,tobetay_rhs,tobetaz_rhs + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: ZEO = 0.d0 + + logical :: gont + real*8 :: dR + integer :: i, j, k + integer :: layer(1:6,1:6),gp + +! in order to synchronize the following parameters with Z4c_rhs calculation, we +! call a routine + real*8 :: kappa1,kappa2,kappa3,FF,eta + +! real*8,parameter :: ha=0.d0,thbs=0.d0,hu=0.d0,hw=0.d0,Rhpsi0=0.d0,Ihpsi0=0.d0 + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + + dR = R(2) - R(1) + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +#if 1 + chin1 = chi+1.d0 + gxx = dxx+1.d0 + gyy = dyy+1.d0 + gzz = dzz+1.d0 + +! decompose + do k = 1, ex(3) + do j = 1, ex(2) + do i = 1, ex(1) +#if (CV == 0) + call decompose2p1_1(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + betax(i,j,k),betay(i,j,k),betaz(i,j,k), & + tobetas(i,j,k),tobetax(i,j,k),tobetay(i,j,k),tobetaz(i,j,k)) +#endif + call decompose2p1_1(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + Gamx(i,j,k),Gamy(i,j,k),Gamz(i,j,k), & + toGams(i,j,k),toGamx(i,j,k),toGamy(i,j,k),toGamz(i,j,k)) + call decompose2p1_2(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + toAqq(i,j,k),toAss(i,j,k),toAsx(i,j,k),toAsy(i,j,k),toAsz(i,j,k), & + toAxx(i,j,k),toAxy(i,j,k),toAxz(i,j,k),toAyy(i,j,k),toAyz(i,j,k),toAzz(i,j,k)) + + enddo + enddo + enddo + +! sommerfeld boundary +! cpbc variables +#if 0 + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,trK_rhs,trK,1.d0,SSS,Symmetry) +#else + call cpbcrtrK(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,trK_rhs,& + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,betax,betay,betaz,TZ,Symmetry,sst,kappa1,kappa2) +#endif +#if 0 + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,TZ_rhs,TZ,1.d0,SSS,Symmetry) +#else + call cpbcrtheta(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,TZ_rhs,& + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,betax,betay,betaz,TZ,Symmetry,sst,kappa1,kappa2) +#endif +#if 1 + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toGams_rhs,toGams,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toGamx_rhs,toGamx,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toGamy_rhs,toGamy,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toGamz_rhs,toGamz,1.d0,SSA,Symmetry) +#else + call cpbcrgam(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,toGamx_rhs,toGamy_rhs,toGamz_rhs,toGams_rhs,& + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,betax,betay,betaz,TZ,Gamx,Gamy,Gamz,Symmetry,sst,eta) +#endif +#if 1 + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAss_rhs,toAss,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAsx_rhs,toAsx,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAsy_rhs,toAsy,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAsz_rhs,toAsz,1.d0,SSA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAxx_rhs,toAxx,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAxy_rhs,toAxy,1.d0,AAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAxz_rhs,toAxz,1.d0,ASA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAyy_rhs,toAyy,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAyz_rhs,toAyz,1.d0,SAA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAzz_rhs,toAzz,1.d0,SSS,Symmetry) +#else + call cpbcra(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax, & + toAxx_rhs,toAxy_rhs,toAxz_rhs,toAyy_rhs,toAyz_rhs,toAzz_rhs,& + toAsx_rhs,toAsy_rhs,toAsz_rhs,toAss_rhs, & + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Lap,betax,betay,betaz,TZ,Gamx,Gamy,Gamz,Symmetry,sst,kappa1) +#endif +! non-cpbc variables +#if (CV == 0) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,toAqq_rhs,toAqq,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,chi_rhs,chi,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxx_rhs,dxx,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxy_rhs,gxy,1.d0,AAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxz_rhs,gxz,1.d0,ASA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gyy_rhs,dyy,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gyz_rhs,gyz,1.d0,SAA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gzz_rhs,dzz,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Lap_rhs,Lap,1.d0,SSS,Symmetry) +#if 1 + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,tobetas_rhs,tobetas,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,tobetax_rhs,tobetax,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,tobetay_rhs,tobetay,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,tobetaz_rhs,tobetaz,1.d0,SSA,Symmetry) +#else + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betax_rhs,betax,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betay_rhs,betay,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betaz_rhs,betaz,1.d0,SSA,Symmetry) +#endif + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfx_rhs,dtSfx,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfy_rhs,dtSfy,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfz_rhs,dtSfz,1.d0,SSA,Symmetry) + +#else + call cpbcrACqq(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,toAqq_rhs,& + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,betax,betay,betaz,Axx,Axy,Axz,Ayy,Ayz,Azz,toAss_rhs,Symmetry,sst) +#endif +! reconstruct +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) - CPBC_ghost_width + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) - CPBC_ghost_width +endif + +if(dabs(R(1)-zmin) < dR)then + layer(1,6) = 1 + layer(2,6) = 1 + layer(3,6) = 1 + layer(4,6) = ex(1) + layer(5,6) = ex(2) + layer(6,6) = 1 +endif +! fix BD + gp = 6 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! z direction + TZ_rhs(i,j,k) = ZEO + chi_rhs(i,j,k) = ZEO + trK_rhs(i,j,k) = ZEO + gxx_rhs(i,j,k) = ZEO + gxy_rhs(i,j,k) = ZEO + gxz_rhs(i,j,k) = ZEO + gyy_rhs(i,j,k) = ZEO + gyz_rhs(i,j,k) = ZEO + gzz_rhs(i,j,k) = ZEO + Axx_rhs(i,j,k) = ZEO + Axy_rhs(i,j,k) = ZEO + Axz_rhs(i,j,k) = ZEO + Ayy_rhs(i,j,k) = ZEO + Ayz_rhs(i,j,k) = ZEO + Azz_rhs(i,j,k) = ZEO + Gamx_rhs(i,j,k) = ZEO + Gamy_rhs(i,j,k) = ZEO + Gamz_rhs(i,j,k) = ZEO + Lap_rhs(i,j,k) = ZEO + betax_rhs(i,j,k) = ZEO + betay_rhs(i,j,k) = ZEO + betaz_rhs(i,j,k) = ZEO + dtSfx_rhs(i,j,k) = ZEO + dtSfy_rhs(i,j,k) = ZEO + dtSfz_rhs(i,j,k) = ZEO + enddo + enddo + enddo + endif + +! constraint preserving BD + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +#if (CV == 0) + call compose2p1_1(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + betax_rhs(i,j,k),betay_rhs(i,j,k),betaz_rhs(i,j,k), & + tobetas_rhs(i,j,k),tobetax_rhs(i,j,k),tobetay_rhs(i,j,k),tobetaz_rhs(i,j,k)) +#endif + call compose2p1_1(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + Gamx_rhs(i,j,k),Gamy_rhs(i,j,k),Gamz_rhs(i,j,k), & + toGams_rhs(i,j,k),toGamx_rhs(i,j,k),toGamy_rhs(i,j,k),toGamz_rhs(i,j,k)) + call compose2p1_2(R(k),x(i,j,k),y(i,j,k),z(i,j,k), chin1(i,j,k), & + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), & + Axx_rhs(i,j,k),Axy_rhs(i,j,k),Axz_rhs(i,j,k),Ayy_rhs(i,j,k),Ayz_rhs(i,j,k),Azz_rhs(i,j,k), & + toAqq_rhs(i,j,k),toAss_rhs(i,j,k),toAsx_rhs(i,j,k),toAsy_rhs(i,j,k),toAsz_rhs(i,j,k), & + toAxx_rhs(i,j,k),toAxy_rhs(i,j,k),toAxz_rhs(i,j,k),toAyy_rhs(i,j,k),toAyz_rhs(i,j,k),toAzz_rhs(i,j,k)) + + enddo + enddo + enddo + + endif + +! check direct Sommerfeld BD +#else + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,trK_rhs,trK,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,TZ_rhs,TZ,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Gamx_rhs,Gamx,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Gamy_rhs,Gamy,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Gamz_rhs,Gamz,1.d0,SSA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Axx_rhs,Axx,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Axy_rhs,Axy,1.d0,AAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Axz_rhs,Axz,1.d0,ASA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Ayy_rhs,Ayy,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Ayz_rhs,Ayz,1.d0,SAA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Azz_rhs,Azz,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,chi_rhs,chi,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxx_rhs,dxx,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxy_rhs,gxy,1.d0,AAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gxz_rhs,gxz,1.d0,ASA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gyy_rhs,dyy,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gyz_rhs,gyz,1.d0,SAA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,gzz_rhs,dzz,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,Lap_rhs,Lap,1.d0,SSS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betax_rhs,betax,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betay_rhs,betay,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,betaz_rhs,betaz,1.d0,SSA,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfx_rhs,dtSfx,1.d0,ASS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfy_rhs,dtSfy,1.d0,SAS,Symmetry) + call sommerfeld_routbam_ss(ex,crho,sigma,R,xmin,ymin,zmin,xmax,ymax,zmax,dtSfz_rhs,dtSfz,1.d0,SSA,Symmetry) +#endif + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,TZ,TZ_rhs,SSS,Symmetry,eps,sst) + endif + + return + + end subroutine david_milton_cpbc_ss +#undef CV +#else +!out of time code, never debuged +! need CPBC_ghost_width +!PRD 83, 024025 (2011) + subroutine david_milton_cpbc_ss(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax, & + TZ,chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamx,Gamy,Gamz, & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz , & + TZ_rhs,chi_rhs,trK_rhs, & + gxx_rhs,gxy_rhs,gxz_rhs,gyy_rhs,gyz_rhs,gzz_rhs, & + Axx_rhs,Axy_rhs,Axz_rhs,Ayy_rhs,Ayz_rhs,Azz_rhs, & + Gamx_rhs,Gamy_rhs,Gamz_rhs, & + Lap_rhs, betax_rhs, betay_rhs, betaz_rhs, & + dtSfx_rhs, dtSfy_rhs, dtSfz_rhs, & + pGamxxx,pGamxxy,pGamxxz,pGamxyy,pGamxyz,pGamxzz, & + pGamyxx,pGamyxy,pGamyxz,pGamyyy,pGamyyz,pGamyzz, & + pGamzxx,pGamzxy,pGamzxz,pGamzyy,pGamzyz,pGamzzz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, & + Gmxcon,Gmycon,Gmzcon, & + Symmetry,eps,sst) + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: TZ,chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz,Gmxcon,Gmycon,Gmzcon + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: TZ_rhs,chi_rhs,trK_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gxx_rhs,gxy_rhs,gxz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gyy_rhs,gyz_rhs,gzz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Axx_rhs,Axy_rhs,Axz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Ayy_rhs,Ayz_rhs,Azz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamx_rhs,Gamy_rhs,Gamz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap_rhs, betax_rhs, betay_rhs, betaz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: dtSfx_rhs,dtSfy_rhs,dtSfz_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8,intent(in) :: eps +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxxx, pGamxxy, pGamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamxyy, pGamxyz, pGamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyxx, pGamyxy, pGamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamyyy, pGamyyz, pGamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzxx, pGamzxy, pGamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pGamzyy, pGamzyz, pGamzzz + +!~~~~~~~~~~~> local variables + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,alpn1,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qxx,qxy,qxz,qyy,qyz,qzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qupxx,qupxy,qupxz,qupyy,qupyz,qupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: qulxx,qulxy,qulxz,qulyx,qulyy,qulyz,qulzx,qulzy,qulzz + real*8, dimension(ex(1),ex(2),ex(3)) :: slx,sly,slz,ulx,uly,ulz,wlx,wly,wlz + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: fx,fy,fz + logical :: gont + real*8 :: dR + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8 :: toAss_rhs,toAqq_rhs,toAs1_rhs,toAs2_rhs,toA11_rhs,toA12_rhs,toA22_rhs + real*8 :: toGams_rhs,toGam1_rhs,toGam2_rhs + real*8 :: totrK_rhs,toTZ_rhs +! derivatives + real*8 :: Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz + real*8 :: sfxx,sfxy,sfxz,sfyx,sfyy,sfyz,sfzx,sfzy,sfzz + real*8 :: sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz + real*8 :: sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz + real*8 :: sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz + real*8 :: TZx,TZy,TZz + real*8 :: chix,chiy,chiz,Kx,Ky,Kz + real*8 :: Axxx,Axxy,Axxz + real*8 :: Axyx,Axyy,Axyz + real*8 :: Axzx,Axzy,Axzz + real*8 :: Ayyx,Ayyy,Ayyz + real*8 :: Ayzx,Ayzy,Ayzz + real*8 :: Azzx,Azzy,Azzz + real*8 :: gxxx,gxxy,gxxz + real*8 :: gxyx,gxyy,gxyz + real*8 :: gxzx,gxzy,gxzz + real*8 :: gyyx,gyyy,gyyz + real*8 :: gyzx,gyzy,gyzz + real*8 :: gzzx,gzzy,gzzz + real*8 :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8 :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8 :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8 :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8 :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8 :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8 :: Gamxx,Gamxy,Gamxz + real*8 :: Gamyx,Gamyy,Gamyz + real*8 :: Gamzx,Gamzy,Gamzz + real*8 :: Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz + real*8 :: Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz + real*8 :: Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz + real*8 :: Gamxa,Gamya,Gamza + real*8 :: CAZxx,CAZxy,CAZxz + real*8 :: CAZyx,CAZyy,CAZyz + real*8 :: CAZzx,CAZzy,CAZzz +! tilted A^k_iA_kj + real*8 :: AAxx,AAxy,AAxz,AAyy,AAyz,AAzz + real*8 :: Ainvxx,Ainvxy,Ainvxz,Ainvyy,Ainvyz,Ainvzz + real*8 :: liegxx,liegxy,liegxz,liegyy,liegyz,liegzz + real*8 :: fxx,fxy,fxz,fyy,fyz,fzz + real*8 :: TFxx,TFxy,TFxz,TFyy,TFyz,TFzz + + real*8 :: MapleGenVar1,MapleGenVar2,MapleGenVar3,MapleGenVar4 + real*8 :: f,betas + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0,HALF=0.5d0 + real*8,parameter::TINYRR=1.d-14 +! in order to synchronize the following parameters with Z4c_rhs calculation, we +! call a routine + real*8 :: muL,tmuSL,tmuST + real*8 :: kappa1,kappa2,kappa3,FF,eta + + real*8,parameter :: ha=0.d0,thbs=0.d0,hu=0.d0,hw=0.d0,Rhpsi0=0.d0,Ihpsi0=0.d0 + + call get_Z4cparameters(kappa1,kappa2,kappa3,FF,eta) + + dR = R(2) - R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) - CPBC_ghost_width + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) - CPBC_ghost_width +endif + +if(dabs(R(1)-zmin) < dR)then + layer(1,6) = 1 + layer(2,6) = 1 + layer(3,6) = 1 + layer(4,6) = ex(1) + layer(5,6) = ex(2) + layer(6,6) = 1 +endif +! fix BD + gp = 6 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! z direction + TZ_rhs(i,j,k) = ZEO + chi_rhs(i,j,k) = ZEO + trK_rhs(i,j,k) = ZEO + gxx_rhs(i,j,k) = ZEO + gxy_rhs(i,j,k) = ZEO + gxz_rhs(i,j,k) = ZEO + gyy_rhs(i,j,k) = ZEO + gyz_rhs(i,j,k) = ZEO + gzz_rhs(i,j,k) = ZEO + Axx_rhs(i,j,k) = ZEO + Axy_rhs(i,j,k) = ZEO + Axz_rhs(i,j,k) = ZEO + Ayy_rhs(i,j,k) = ZEO + Ayz_rhs(i,j,k) = ZEO + Azz_rhs(i,j,k) = ZEO + Gamx_rhs(i,j,k) = ZEO + Gamy_rhs(i,j,k) = ZEO + Gamz_rhs(i,j,k) = ZEO + Lap_rhs(i,j,k) = ZEO + betax_rhs(i,j,k) = ZEO + betay_rhs(i,j,k) = ZEO + betaz_rhs(i,j,k) = ZEO + dtSfx_rhs(i,j,k) = ZEO + dtSfy_rhs(i,j,k) = ZEO + dtSfz_rhs(i,j,k) = ZEO + enddo + enddo + enddo + endif + +! constraint preserving BD + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + +! cpbc real starts + + alpn1 = Lap + ONE + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz +! tetrad for 2+1 decomposation + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + +! v^i corresponds to s^i + fx = vx + fy = vy + fz = vz + slx = vx + sly = vy + slz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*chin1) + vx = vx/fx + vy = vy/fx + vz = vz/fx + slx = slx/fx + sly = sly/fx + slz = slz/fx +! 2+1: 1->u, 2->w + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx/chin1 + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx/chin1) + ux = ux/fx + uy = uy/fx + uz = uz/fx + ulx = (gxx*ux+gxy*uy+gxz*uz)/chin1 + uly = (gxy*ux+gyy*uy+gyz*uz)/chin1 + ulz = (gxz*ux+gyz*uy+gzz*uz)/chin1 + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx/chin1 + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx/chin1 + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx/chin1) + wx = wx/fx + wy = wy/fx + wz = wz/fx + wlx = (gxx*wx+gxy*wy+gxz*wz)/chin1 + wly = (gxy*wx+gyy*wy+gyz*wz)/chin1 + wlz = (gxz*wx+gyz*wy+gzz*wz)/chin1 +!~ end tetrad + + qupxx = gupxx*chin1 - vx*vx + qupxy = gupxy*chin1 - vx*vy + qupxz = gupxz*chin1 - vx*vz + qupyy = gupyy*chin1 - vy*vy + qupyz = gupyz*chin1 - vy*vz + qupzz = gupzz*chin1 - vz*vz + + qxx = gxx/chin1 - slx*slx + qxy = gxy/chin1 - slx*sly + qxz = gxz/chin1 - slx*slz + qyy = gyy/chin1 - sly*sly + qyz = gyz/chin1 - sly*slz + qzz = gzz/chin1 - slz*slz + + qulxx = ONE - vx*slx + qulyy = ONE - vy*sly + qulzz = ONE - vz*slz + qulxy = - vx*sly + qulyx = - vy*slx + qulxz = - vx*slz + qulzx = - vz*slx + qulyz = - vy*slz + qulzy = - vz*sly + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +!calculate the involved derivatives + call point_fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,betax,sfxx,sfxy,sfxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,betay,sfyx,sfyy,sfyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,betaz,sfzx,sfzy,sfzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + + liegxx = betax(i,j,k)*gxxx+gxx(i,j,k)*sfxx+betay(i,j,k)*gxxy-gxx(i,j,k)*sfyy+2.0*sfyx*gxy(i,j,k)+betaz(i,j,k)*gxxz-gxx(i,j,k)*sfzz+2.0*sfzx*gxz(i,j,k) + liegxy = betax(i,j,k)*gxyx+sfxy*gxx(i,j,k)+betay(i,j,k)*gxyy+sfyx*gyy(i,j,k)+betaz(i,j,k)*gxyz-gxy(i,j,k)*sfzz+sfzx*gyz(i,j,k)+sfzy*gxz(i,j,k) + liegxz = betax(i,j,k)*gxzx+sfxz*gxx(i,j,k)+betay(i,j,k)*gxzy-gxz(i,j,k)*sfyy+sfyx*gyz(i,j,k)+sfyz*gxy(i,j,k)+betaz(i,j,k)*gxzz+sfzx*gzz(i,j,k) + liegyy = betax(i,j,k)*gyyx-gyy(i,j,k)*sfxx+2.0*sfxy*gxy(i,j,k)+betay(i,j,k)*gyyy+gyy(i,j,k)*sfyy+betaz(i,j,k)*gyyz-gyy(i,j,k)*sfzz+2.0*sfzy*gyz(i,j,k) + liegyz = betax(i,j,k)*gyzx-gyz(i,j,k)*sfxx+sfxy*gxz(i,j,k)+sfxz*gxy(i,j,k)+betay(i,j,k)*gyzy+sfyz*gyy(i,j,k)+betaz(i,j,k)*gyzz+sfzy*gzz(i,j,k) + liegzz = betax(i,j,k)*gzzx-gzz(i,j,k)*sfxx+2.0*sfxz*gxz(i,j,k)+betay(i,j,k)*gzzy-gzz(i,j,k)*sfyy+2.0*sfyz*gyz(i,j,k)+betaz(i,j,k)*gzzz+gzz(i,j,k)*sfzz + + call point_fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + + MapleGenVar3 = gupxy(i,j,k)*gupxy(i,j,k)*gxxyy-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz+gupxy(i,j,k)*& +gupxy(i,j,k)*gxyxy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gxyy+gupxx(i,j,k)*gupyz(i,j,k)*gxyxz+gupxz(i,j,k)*gupxz(i,j,k)*gxxzz& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxxz*gxxz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzz*gxzz-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupyy(i,j,k)*gxxy*gxxy+gupxx(i,j,k)*gupyy(i,j,k)*gxyxy+gupxz(i,j,k)*gupzz(i,j,k)*gxzzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)& +*gxzx*gxzx+2.0*gupxx(i,j,k)*gupxz(i,j,k)*gxxxz+gupxz(i,j,k)*gupyy(i,j,k)*gxyyz+gupxx(i,j,k)*gupyz(i,j,k)*gxzxy+gupxy(i,j,k)*& +gupzz(i,j,k)*gxzyz+2.0*gupxy(i,j,k)*gupxz(i,j,k)*gxxyz+2.0*gupxx(i,j,k)*gupxy(i,j,k)*gxxxy+gupxz(i,j,k)*gupxy(i,j,k)*gxyxz+gupxz(i,j,k)& +*gupyz(i,j,k)*gxyzz-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gxyx-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy+& +gupxx(i,j,k)*gupxx(i,j,k)*gxxxx+gupxx(i,j,k)*gupxz(i,j,k)*gxzxx-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxzy*gxzy+gupxx(i,j,k)*gupzz(i,j,k)& +*gxzxz + MapleGenVar4 = gupxz(i,j,k)*gupyz(i,j,k)*gxzyz+gupxy(i,j,k)*gupyz(i,j,k)*gxyyz+gupxy(i,j,k)*gupyz(i,j,k)*gxzyy+& +gupxx(i,j,k)*gupxy(i,j,k)*gxyxx+gupxy(i,j,k)*gupxz(i,j,k)*gxzxy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxyz*gxyz+gupxy(i,j,k)*gupyy(i,j,k)& +*gxyyy+gupxz(i,j,k)*gupxz(i,j,k)*gxzxz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxxz-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*& +gxxx*gxxx-6.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxxz*gxyz-6.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxyx-6.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxxx*gxzx + MapleGenVar2 = MapleGenVar4-gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)& +-4.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxxy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxxx*gxyy-4.0*gupxx(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gxyy+gxyx*gxxy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-gupxx(i,j,k)& +*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-4.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gxzy+gxzx*gxxy)-& +gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxzx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxx*gzzy+gxzx*gxzy)& +-4.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxxx*gxxz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxxx*gxzz+MapleGenVar3 + MapleGenVar4 = -4.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gxyz+gxyx*gxxz)-gupxx(i,j,k)*gupxz(i,j,k)*& +gupyy(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-4.0*gupxx(i,j,k)*& +gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gxzz+gxzx*gxxz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxzx*gxyz)-gupxx(i,j,k)& +*gupxz(i,j,k)*gupzz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxxy-gupxx(i,j,k)*gupxy(i,j,k)*& +gupyy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)& +*gupyz(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-gupxx(i,j,k)*& +gupyy(i,j,k)*gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzy+gxyy*gxzy) + MapleGenVar3 = MapleGenVar4-gupxx(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-4.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxxy*gxxz-4.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gxyz+gxyy*gxxz)-gupxx(i,j,k)*& +gupyz(i,j,k)*gupyy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-4.0*& +gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gxzz+gxzy*gxxz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxzy*gxyz)& +-gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxxz-gupxx(i,j,k)*& +gupxz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxx(i,j,k)& +*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-gupxx(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-& +gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyy+gxyy*gxyz) + MapleGenVar4 = -gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)& +*(gxxz*gyzy+gxyy*gxzz)-gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*& +gupyy(i,j,k)*(gxxz*gyyz+gxyz*gxyz)-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxx(i,j,k)*& +gupzz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-2.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)& +-gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyyy+gxyx*gxyy& +)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyx*gyyy-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyx*gyzy + MapleGenVar1 = MapleGenVar4-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gxzy+gxzx*gxyy)-& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)& +-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gyzz+gxyx*gxzz& +)-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxyz-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxxx*gxzy-2.0*gupxx(i,j,k)*& +gupxz(i,j,k)*gupxy(i,j,k)*gxxx*gxyz-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxxy-6.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*& +gxxy*gxyy-6.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxxy*gxzy-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxxy*gxyz+& +MapleGenVar3+MapleGenVar2 + MapleGenVar4 = MapleGenVar1-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxxy*gxzz-2.0*gupxx(i,j,k)*& +gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxxz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxxz-6.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*& +gxxz*gxzz-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxyx*gyyx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-4.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxzx-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxyx*gyyz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*& +gupyz(i,j,k)*gxyx*gyzz-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gxzz+gxzx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(& +gxyx*gyzz+gxzx*gyyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+gxzx*gyzz) + MapleGenVar3 = MapleGenVar4-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gyyx-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gyzx-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzy*gyyx)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)& +*(gxyy*gzzx+gxzy*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*& +gupxz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(& +gxyy*gyzy+gxzy*gyyy)-gupxy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*& +(gxxy*gyyz+gxyy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gyzz+gxyy*gxzz) + MapleGenVar4 = MapleGenVar3-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gxyz-2.0*gupxy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gxyy*gyzz-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gxzz+gxzy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*& +gupyz(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-gupxy(i,j,k)*gupxy(i,j,k)& +*gupxz(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxy(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupyz(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxyz*gyzy-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzz*gyyy) + MapleGenVar2 = MapleGenVar4-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupzz(i,j,k)*(gxxz*gyyz+gxyz*gxyz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-& +gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)& +-gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*gyyx& +)-gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyzy+gxzx*& +gxyy)-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyzy+gxzx& +*gyyy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gxzy-& +gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyzz+gxzx*gxyz) + MapleGenVar4 = MapleGenVar2-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-gupxz(i,j,k)& +*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gzzz+gxzx*gyzz)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzx*gyzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzx*gzzz-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(& +gxxy*gyzx+gxyx*gxzy)-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*& +(gxyy*gyzx+gxzy*gyyx)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)& +*(gxxy*gzzy+gxzy*gxzy)-gupxz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-gupxz(i,j,k)*gupyy(i,j,k)*& +gupyz(i,j,k)*(gxyy*gzzy+gxzy*gyzy) + MapleGenVar3 = MapleGenVar4-gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyzz+gxzy*gxyz)-gupxz(i,j,k)& +*gupxz(i,j,k)*gupyz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-& +gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzy*gxzz-2.0*& +gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzy*gyzz-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-gupxz(i,j,k)*gupxz(i,j,k)& +*gupxz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-gupxz(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-4.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupxz(i,j,k)*gxyy*gxzy-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gxyy*gyyz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*& +gxyz*gyyx + MapleGenVar4 = MapleGenVar3-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxyz*gyzx-2.0*gupxy(i,j,k)*& +gupyz(i,j,k)*gupyy(i,j,k)*gxyz*gyyy-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxyz*gyyz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*& +gxyz*gyzz-4.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-2.0*& +gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxzx*gzzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxzx*gyzy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*& +gupzz(i,j,k)*gxzx*gzzy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxzy*gyzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxzy*gzzx& +-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gxzy*gzzy + CAZxx = Gamxx - (MapleGenVar4-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzy*gzzz-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gxzz*gyzx-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzz*gzzx-gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxz*& +gyzy+gxyy*gxzz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyz& +*gyzy+gxzz*gyyy)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*& +gxzz*gyzy-gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzz+& +gxzz*gyyz)-gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gxzz*& +gzzz-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzz*gzzy-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz) + MapleGenVar3 = -2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzy*gyzz+gupxy(i,j,k)*gupyz(i,j,k)*gxzxy+2.0*& +gupxy(i,j,k)*gupyy(i,j,k)*gxyxy+gupxy(i,j,k)*gupxz(i,j,k)*gxzxx+gupxy(i,j,k)*gupxy(i,j,k)*gxyxx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*& +gxxx*gxxx+2.0*gupxy(i,j,k)*gupyz(i,j,k)*gxyxz-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy+gupyz(i,j,k)*gupxz(i,j,k)*& +gxxzz+gupxy(i,j,k)*gupxy(i,j,k)*gxxxy+gupxy(i,j,k)*gupxx(i,j,k)*gxxxx+gupyy(i,j,k)*gupxx(i,j,k)*gxxxy+gupxy(i,j,k)*gupxz(i,j,k)*gxxxz+& +gupxy(i,j,k)*gupzz(i,j,k)*gxzxz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzz*gyzy+gupyy(i,j,k)*gupxy(i,j,k)*gxxyy+gupyz(i,j,k)*gupxz(i,j,k)& +*gxzxz+2.0*gupyy(i,j,k)*gupyz(i,j,k)*gxyyz+gupyz(i,j,k)*gupzz(i,j,k)*gxzzz+gupyy(i,j,k)*gupzz(i,j,k)*gxzyz-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxxy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxxx*gxyy+gupyy(i,j,k)*gupxz(i,j,k)*gxxyz+gupyz(i,j,k)*& +gupyz(i,j,k)*gxzyz-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gxyy + MapleGenVar4 = gupyz(i,j,k)*gupxx(i,j,k)*gxxxz+gupyz(i,j,k)*gupxy(i,j,k)*gxxyz+gupyy(i,j,k)*gupxz(i,j,k)*gxzxy+& +gupyz(i,j,k)*gupyz(i,j,k)*gxyzz+gupyy(i,j,k)*gupyz(i,j,k)*gxzyy+gupyy(i,j,k)*gupyy(i,j,k)*gxyyy-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*& +gzzx+gxzy*gyzx)-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxxx*gxxz-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxxx*gxyx& +-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-3.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxxx*gyzx+& +gxyx*gxzx)-gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxxx*& +gxxy + MapleGenVar2 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxxx*gxzy-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gxyy+gxyx*gxxy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gxzy+gxzx*& +gxxy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxzx*gxyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxx*gzzy+& +gxzx*gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxxx*gxyz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxxx*gxzz-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gxyz+gxyx*gxxz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxxx*gyyz+gxyx*& +gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gxzz+& +gxzx*gxxz)+MapleGenVar3 + MapleGenVar4 = -2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxzx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*& +gupzz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxxy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*& +gupyy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-2.0*& +gupxy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxxy-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxxy*gxyy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*& +gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-3.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupxy(i,j,k)*& +gupyy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxxy*gxyz + MapleGenVar3 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gxyz+gxyy*gxxz)& +-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxyy*& +gxzz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gxzz+gxzy*gxxz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*& +gyzz+gxzy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*& +gxyx*gxxz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxxz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyx+gxyx& +*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx& ++gxyx*gxzz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*& +gxxz + MapleGenVar4 = MapleGenVar3-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxyy*& +gxzz)-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxxz& +-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxxz*gxyz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyz+gxyz*gxyz)& +-3.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*& +gxzz)-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxyx-gupyy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)& +-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxyx + MapleGenVar1 = MapleGenVar4-4.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxxx*gxzx-4.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupxz(i,j,k)*gxxy*gxzy-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxxy*gxxz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*& +gxxy*gxzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxxz-4.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxxz*gxzz-2.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxyx*gyyx-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-gupyy(i,j,k)*& +gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gxyy+gxyx*gxxy)-& +gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-4.0*gupyy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy-2.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyx*gyyy+MapleGenVar2 + MapleGenVar4 = -2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gxzy+gxzx*gxyy)-2.0*gupyy(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-2.0*& +gupyy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gxyz+gxyx*gxxz)-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)& +-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyx*gyyz-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gxzz+gxzx*gxyz)& +-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-gupyy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+gxzx*& +gyzz)-gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gyyx& +-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzy*gyyx) + MapleGenVar3 = MapleGenVar4-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-2.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxyy-gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*gupyy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyy*gxzy-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(& +gxyy*gyzy+gxzy*gyyy)-gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-2.0*gupyy(i,j,k)*gupyz(i,j,k)*& +gupxx(i,j,k)*(gxxy*gxyz+gxyy*gxxz)-gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-2.0*gupyy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyyz-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxyy*gyzz-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(& +gxyy*gxzz+gxzy*gxyz)-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzy*gyyz) + MapleGenVar4 = MapleGenVar3-gupyy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-gupyy(i,j,k)& +*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyz*gyyx-2.0*gupyy(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-gupyy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-gupyy(i,j,k)& +*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxyz*gyyy-2.0*gupyy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gxyz*gyzy-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-gupyy(i,j,k)*gupyz(i,j,k)*& +gupzz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-gupyy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-2.0*gupyy(i,j,k)*& +gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxyz + MapleGenVar2 = MapleGenVar4-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gxyz*gyyz-2.0*gupyy(i,j,k)*& +gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-gupyy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*& +gupyz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxzx-gupyz(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-gupyz(i,j,k)*gupyz(i,j,k)& +*gupxx(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gxzx-2.0*gupyz(i,j,k)*gupyz(i,j,k)*& +gupxx(i,j,k)*gxzx*gyzx-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gxzy+gxzx*gxxy)-gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(& +gxxx*gzzy+gxzx*gxzy)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gxzy+gxzx*gxyy)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxzx*gyzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupxx(i,j,k)*(gxxx*gxzz+gxzx*gxxz) + MapleGenVar4 = MapleGenVar2-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-2.0*& +gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gxzz+gxzx*gxyz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyx*gzzz+gxzx*gyzz)& +-4.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzx*gyzz-gupyz(i,j,k)*gupxy(i,j,k)*& +gupxz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-2.0*gupyy(i,j,k)*gupxx(i,j,k)*& +gupxz(i,j,k)*gxyx*gxzx-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyx*gyzy-4.0*gupyy(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxyz& +-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxyx*gyzz-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gyzx + MapleGenVar3 = MapleGenVar4-4.0*gupyy(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxyz-2.0*gupyy(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gxyz*gyzx-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxyz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*& +gxyz*gyzz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxzx-2.0*& +gupyz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxzx*gzzx-4.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxzy-2.0*gupyz(i,j,k)*gupxy(i,j,k)*& +gupzz(i,j,k)*gxzx*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzx*gzzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxzy*gyzx& +-gupyz(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gzzy+gxzy*gyzy& +) + MapleGenVar4 = MapleGenVar3-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxzy*gxzy-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupyy(i,j,k)*gxzy*gyzy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*gxzz+gxzy*gxxz)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gxzz+gxzy*gxyz)-gupyz(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxzz-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupzz(i,j,k)*gxzy*gzzz-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)& +*(gxyz*gzzx+gxzz*gyzx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzz*gyzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*& +gzzy+gxzy*gxzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzy+gxzz*gyzy) + CAZyx = Gamyx - (MapleGenVar4-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzz*gzzy-gupyz(i,j,k)*gupzz(i,j,k)*& +gupxz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupyz(i,j,k)*& +gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gxzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzz*gyzz-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*& +gxzz*gzzz-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxzy*gzzx-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxzy-2.0*& +gupyz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gxzy-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gxzy*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupzz(i,j,k)*gxzz*gzzx-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxzz-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxzz& ++MapleGenVar1) + MapleGenVar3 = gupzz(i,j,k)*gupxz(i,j,k)*gxxzz+gupyz(i,j,k)*gupxz(i,j,k)*gxxyz+gupyz(i,j,k)*gupyz(i,j,k)*gxyyz+2.0*& +gupyz(i,j,k)*gupzz(i,j,k)*gxzyz+gupyz(i,j,k)*gupxx(i,j,k)*gxxxy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gxzz-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gxyz*gyzy+gupzz(i,j,k)*gupxy(i,j,k)*gxyxz+gupyz(i,j,k)*gupxy(i,j,k)*gxxyy+gupzz(i,j,k)*gupyz(i,j,k)*gxyzz+& +gupxz(i,j,k)*gupxz(i,j,k)*gxxxz+2.0*gupxz(i,j,k)*gupzz(i,j,k)*gxzxz-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxxx+gupzz(i,j,k)*& +gupxy(i,j,k)*gxxyz+gupxz(i,j,k)*gupyz(i,j,k)*gxyxz+gupxz(i,j,k)*gupxy(i,j,k)*gxxxy+gupzz(i,j,k)*gupzz(i,j,k)*gxzzz+gupyz(i,j,k)*gupyy(i,j,k)*& +gxyyy+gupxz(i,j,k)*gupyy(i,j,k)*gxyxy+gupyz(i,j,k)*gupyz(i,j,k)*gxzyy+gupxz(i,j,k)*gupxz(i,j,k)*gxzxx+gupzz(i,j,k)*gupxx(i,j,k)*gxxxz+& +2.0*gupxz(i,j,k)*gupyz(i,j,k)*gxzxy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxxz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*& +gxyy*gyzz + MapleGenVar4 = MapleGenVar3+gupzz(i,j,k)*gupyy(i,j,k)*gxyyz+gupxz(i,j,k)*gupxy(i,j,k)*gxyxx-2.0*gupzz(i,j,k)& +*gupzz(i,j,k)*gupzz(i,j,k)*gxzz*gzzz+gupxz(i,j,k)*gupxx(i,j,k)*gxxxx+gupyz(i,j,k)*gupxy(i,j,k)*gxyxy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*& +gupxz(i,j,k)*gxxx*gxzz-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxyy-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxxx*gxzx& +-gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-3.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxxx*gyzx+gxyx*& +gxzx)-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxxx*& +gxyy + MapleGenVar2 = MapleGenVar4-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxxx*gxzy-2.0*gupxz(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gxyy+gxyx*gxxy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-2.0*& +gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gxzy+gxzx*& +gxxy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxzx*gxyy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxx*gzzy+& +gxzx*gxzy)-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxxx*gxxz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxxx*gxyz-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gxyz+gxyx*gxxz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxxx*gyyz+gxyx*gxyz)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gxzz+& +gxzx*gxxz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxzx*gxyz) + MapleGenVar4 = MapleGenVar2-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)& +-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxxy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gxxy-gupxz(i,j,k)*gupxy(i,j,k)*& +gupyy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-gupxz(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)& +-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxxy-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxxy*gxzy-gupxz(i,j,k)*gupyy(i,j,k)*& +gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-3.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*& +gupxz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzy+gxzy*gxzy) + MapleGenVar3 = MapleGenVar4-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxxy*gxzz-2.0*gupxz(i,j,k)*& +gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gxyz+gxyy*gxxz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-2.0*& +gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxy*gxzz+gxzy*& +gxxz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxzy*gxyz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxy*gzzz+& +gxzy*gxzz)-4.0*gupxz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxyx-4.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxxx*gxxy-4.0*& +gupxz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxxy*gxyy-4.0*gupxz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxxy*gxxz-2.0*gupxz(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*gxxy*gxyz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxxz + MapleGenVar4 = MapleGenVar3-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxyx*gxzz)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzy*gxxz-& +gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxzy*& +gxyz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxyy*gxzz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzy+& +gxzy*gxzz)-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxxz-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxxz*gxzz-& +gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyz+gxyz*gxyz) + MapleGenVar1 = MapleGenVar4-3.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)& +-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxyx-& +gupyz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxyx-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxyx*gyzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*gupyz(i,j,k)*& +gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gxyy+gxyx*gxxy)-& +gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-4.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyx*gyzy-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gxzy+gxzx*gxyy)-gupyz(i,j,k)*& +gupyz(i,j,k)*gupxy(i,j,k)*(gxyx*gyzy+gxzx*gyyy) + MapleGenVar4 = MapleGenVar1-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)& +-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gxyz+gxyx*gxxz)-gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyyz+gxyx*& +gxyz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxyx*gyzz-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gxzz+gxzx*& +gxyz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+& +gxzx*gyzz)-gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*& +gyzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gyzx+gxzy*gyyx)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzx+& +gxzy*gyzx) + MapleGenVar3 = MapleGenVar4-gupyz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-2.0*& +gupyz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gxyy-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*& +gupyy(i,j,k)*gxyy*gyzy-gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(& +gxyy*gzzy+gxzy*gyzy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*gxyz+gxyy*gxxz)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxyz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*& +gupyy(i,j,k)*gxyy*gyyz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gxzz+gxzy*gxyz)-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(& +gxyy*gyzz+gxzy*gyyz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzy*gyzz) + MapleGenVar4 = MapleGenVar3-gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxyz*gyzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-2.0*gupyz(i,j,k)*& +gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gxyz*gyyy-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-gupyz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyz+gxyz*gxyz)-2.0*& +gupyz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxyz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxyz*gyzz-gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(& +gxyz*gyzz+gxzz*gyyz) + MapleGenVar2 = MapleGenVar4-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)& +-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxxz-4.0*gupxz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxxz*gxyz-2.0*gupyz(i,j,k)*& +gupxx(i,j,k)*gupyy(i,j,k)*gxyx*gyyx-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxzx-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*& +gxyx*gyyy-4.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxyz-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxyx*gyyz-2.0*& +gupyz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gyyx-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyy*gxzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupyy(i,j,k)*gxyz*gyyx-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxyz-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxyz*gyyz& +-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz + MapleGenVar4 = MapleGenVar2-2.0*gupzz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxzx-gupzz(i,j,k)*gupxx(i,j,k)*& +gupxy(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupzz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*gupzz(i,j,k)*& +gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gxzx-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxzx*gzzx-2.0*gupzz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(& +gxxx*gxzy+gxzx*gxxy)-gupzz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyzy+gxzx*gxyy)-2.0*gupzz(i,j,k)*gupxy(i,j,k)*& +gupxy(i,j,k)*(gxyx*gxzy+gxzx*gxyy)-gupzz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-2.0*gupzz(i,j,k)*& +gupzz(i,j,k)*gupxy(i,j,k)*gxzx*gzzy-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gxzz+gxzx*gxxz)-gupzz(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*(gxxx*gyzz+gxzx*gxyz) + MapleGenVar3 = MapleGenVar4-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gxzz+gxzx*gxyz)-& +gupzz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-4.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz-2.0*& +gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzx*gzzz-gupzz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-gupzz(i,j,k)*gupxy(i,j,k)& +*gupyy(i,j,k)*(gxyy*gyzx+gxzy*gyyx)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxzy*gzzx-gupzz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*& +(gxxy*gyzy+gxyy*gxzy)-gupzz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*gupzz(i,j,k)*gupyy(i,j,k)*& +gupxz(i,j,k)*gxzy*gxzy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxzy*gzzy-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*& +gxzz+gxzy*gxxz)-gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyzz+gxzy*gxyz) + MapleGenVar4 = MapleGenVar3-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gxzz+gxzy*gxyz)-& +gupzz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzy*gyzz-2.0*& +gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzy*gzzz-gupzz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-gupzz(i,j,k)*gupxz(i,j,k)& +*gupyy(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gzzx-gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*& +(gxxz*gyzy+gxyy*gxzz)-gupzz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-2.0*gupzz(i,j,k)*gupyz(i,j,k)*& +gupyz(i,j,k)*gxzz*gyzy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gzzy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxzz& +-gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzz+gxyz*gxzz) + CAZzx = Gamzx -(MapleGenVar4-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxzz-gupzz(i,j,k)*gupzz(i,j,k)*& +gupyy(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz-2.0*gupzz(i,j,k)*gupxx(i,j,k)*& +gupxy(i,j,k)*gxyx*gxzx-2.0*gupzz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-4.0*gupzz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxzy& +-2.0*gupzz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxzx*gyzy-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzx*gyzz-2.0*gupzz(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*gxzy*gyzx-2.0*gupzz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxzy-2.0*gupzz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*& +gxyy*gxzy-2.0*gupzz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-4.0*gupzz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxzz-2.0*& +gupzz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzz*gyzx) + MapleGenVar3 = gupxz(i,j,k)*gupxz(i,j,k)*gyzxz+2.0*gupxy(i,j,k)*gupxz(i,j,k)*gxyyz+gupxx(i,j,k)*gupyz(i,j,k)*gyzxy& +-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyyy+gupxx(i,j,k)*gupxx(i,j,k)*gxyxx+gupxy(i,j,k)*gupyz(i,j,k)*gyzyy-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gyzz-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gyyy+gupxy(i,j,k)*gupyy(i,j,k)*gyyyy+gupxz(i,j,k)*& +gupyz(i,j,k)*gyyzz+gupxy(i,j,k)*gupzz(i,j,k)*gyzyz+gupxx(i,j,k)*gupyz(i,j,k)*gyyxz+gupxy(i,j,k)*gupyz(i,j,k)*gyyyz-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxyx+gupxy(i,j,k)*gupxy(i,j,k)*gxyyy+gupxz(i,j,k)*gupyy(i,j,k)*gyyyz+gupxz(i,j,k)*gupxy(i,j,k)*gyyxz+& +gupxx(i,j,k)*gupxz(i,j,k)*gyzxx+gupxz(i,j,k)*gupxz(i,j,k)*gxyzz+2.0*gupxx(i,j,k)*gupxy(i,j,k)*gxyxy+2.0*gupxx(i,j,k)*gupxz(i,j,k)*gxyxz& ++gupxz(i,j,k)*gupzz(i,j,k)*gyzzz-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxyx+gupxy(i,j,k)*gupxy(i,j,k)*gyyxy+gupxz(i,j,k)*& +gupyz(i,j,k)*gyzyz + MapleGenVar4 = MapleGenVar3-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzz*gyzx-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*gxyy*gyyx+gupxx(i,j,k)*gupzz(i,j,k)*gyzxz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxyz*& +gyzx)+gupxx(i,j,k)*gupxy(i,j,k)*gyyxx-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gyzz+gyzy*gyyz)-4.0*gupxy(i,j,k)*& +gupxz(i,j,k)*gupyy(i,j,k)*gyyx*gyyz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzx+gxyx*gxzz)+gupxx(i,j,k)*gupyy(i,j,k)*& +gyyxy-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)+gupxy(i,j,k)*gupxz(i,j,k)*gyzxy-4.0*gupxx(i,j,k)*gupxz(i,j,k)& +*gupxy(i,j,k)*gxyx*gxyz + MapleGenVar2 = MapleGenVar4-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxzx-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupxy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxyx*gyyx-gupxx(i,j,k)*gupxx(i,j,k)*& +gupyz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxxy-4.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(& +gxxy*gyyx+gxyx*gxyy)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyyy+gxyy*gyyx)-gupxx(i,j,k)*gupxy(i,j,k)*& +gupyz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-2.0*& +gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxyy*gyzx) + MapleGenVar4 = MapleGenVar2-gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzy*gyzx)-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxxz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxyx*gxzz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyyz+gxyz*gyyx)-gupxx(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxzy-gupxx(i,j,k)*gupxz(i,j,k)*& +gupzz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxyy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*& +gupxy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*gupxx(i,j,k)*& +gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyzy+gxzx*gxyy) + MapleGenVar3 = MapleGenVar4-gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxxy*gxyy-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gxyy-2.0*gupxx(i,j,k)*gupyy(i,j,k)*& +gupxy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-gupxx(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(& +gxyy*gyzy+gxzy*gyyy)-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupxx(i,j,k)*gupyy(i,j,k)*& +gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyy*gxxz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyyz+gxyz*gyyy)-gupxx(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzy+gxyy*gxzz) + MapleGenVar4 = MapleGenVar3-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxyz*gyzy)-& +gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxxx*gxyz-2.0*& +gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxyz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-gupxx(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gyzz+gxzx*gxyz)-& +gupxx(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxxy*gxyz-2.0*& +gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)& +-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gyzz+gxzy*gxyz) + MapleGenVar1 = MapleGenVar4-gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+gxzy*gyzz)-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxxz*gxyz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxyz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*& +gupxy(i,j,k)*(gxxz*gyyz+gxyz*gxyz)-gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*gupxx(i,j,k)*& +gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-4.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gyyx-3.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gyyx*gyyx-gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyyy+gxyy*gyyx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-4.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gyyx*gyyy + MapleGenVar4 = MapleGenVar1-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyyx*gyzy-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzx+gxzy*gyyx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyx*gyzy+gyzx*gyyy)-& +gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyyz+gxyz*& +gyyx)-gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyz*gyyx& +-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyx*gyzz+& +gyzx*gyyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzx& ++gxzx*gyyy) + MapleGenVar3 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyyy-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-4.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-3.0*gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-gupxy(i,j,k)*& +gupyy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyyz+gxyz*gyyy)-& +gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyz*gyyy-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyyy*gyzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-2.0*& +gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxyy-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyy*gxzy + MapleGenVar4 = MapleGenVar3-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-4.0*gupxx(i,j,k)*& +gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxyz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxyy*gxzz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*& +gxzy*gxyz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxyz*gyyz-2.0*& +gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxyz*gyzz-4.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyyx*gyzx-2.0*gupxy(i,j,k)*gupxz(i,j,k)*& +gupyz(i,j,k)*gyyx*gyzz-4.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyyy*gyzy-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyyy*gyyz& +-gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzx*gyyz) + MapleGenVar2 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gyyz-2.0*gupxy(i,j,k)*& +gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-gupxy(i,j,k)& +*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gyyz-2.0*gupxy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyyz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-gupxy(i,j,k)*gupyz(i,j,k)*& +gupzz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxyz*gyyz-3.0*gupxy(i,j,k)*gupzz(i,j,k)*& +gupxz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyyz*gyyz-gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(& +gyyz*gzzz+gyzz*gyzz)-gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*& +(gyyx*gzzx+gyzx*gyzx) + MapleGenVar4 = MapleGenVar2-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxzx*gyzx-2.0*gupxz(i,j,k)*& +gupxx(i,j,k)*gupyz(i,j,k)*gyzx*gyzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyzy+gxyy*gyzx)-gupxz(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*(gxyx*gzzy+gxzy*gyzx)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gyyx*gyzy+gyzx*gyyy)-gupxz(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzy*gyzx-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gyzz+gxyz*gyzx)-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gyyx*gyzz+gyzx*gyyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)& +-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyzz + MapleGenVar3 = MapleGenVar4-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gyzx*gzzz-gupxz(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gyzy-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-2.0*gupxz(i,j,k)*gupyy(i,j,k)*& +gupyy(i,j,k)*gyyy*gyzy-gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*& +gxzy*gyzy-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gyzy-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gyzz+gxyz& +*gyzy)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gyyy*gyzz& ++gyzy*gyyz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gzzz+gyzy*gyzz) + MapleGenVar4 = MapleGenVar3-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzz*gyzy-4.0*gupxz(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)& +*(gyyz*gzzx+gyzx*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gyzz*gzzx-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*& +gzzy+gxzy*gyzz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*& +gxzy*gyzz-gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzz+& +gyzz*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzz*gyzz-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gyzz-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyyz + CAZxy = Gamxy - (MapleGenVar4-4.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyyz*gyzz-2.0*gupxz(i,j,k)*& +gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gyzx-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gyyx*gyzx-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*& +gyzx*gzzx-4.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyzy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzx*gzzy-2.0*& +gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzy*gzzx-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gyzy-2.0*gupxz(i,j,k)*gupyy(i,j,k)*& +gupzz(i,j,k)*gyzy*gzzy-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzy*gzzz-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gzzy& +-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gyzz-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyyz*gyzz-2.0*gupxz(i,j,k)*& +gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz) + MapleGenVar3 = gupxy(i,j,k)*gupxy(i,j,k)*gxyxy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gxyy+gupxx(i,j,k)*& +gupyz(i,j,k)*gxyxz-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gyyx*gyyx-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gyzz+& +gupxx(i,j,k)*gupyy(i,j,k)*gxyxy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyzy*gyzy+gupxy(i,j,k)*gupyz(i,j,k)*gyzxy+gupxz(i,j,k)*gupyy(i,j,k)& +*gxyyz+gupyz(i,j,k)*gupyz(i,j,k)*gyzyz+2.0*gupyy(i,j,k)*gupyz(i,j,k)*gyyyz+gupyy(i,j,k)*gupzz(i,j,k)*gyzyz+2.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gyyxy+gupxz(i,j,k)*gupxy(i,j,k)*gxyxz+gupxz(i,j,k)*gupyz(i,j,k)*gxyzz-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gxyx& ++gupxy(i,j,k)*gupxz(i,j,k)*gyzxx+gupyy(i,j,k)*gupxz(i,j,k)*gyzxy-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy+gupyz(i,j,k)*& +gupxz(i,j,k)*gyzxz+gupyy(i,j,k)*gupyz(i,j,k)*gyzyy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gyzx*gyzx+gupyz(i,j,k)*gupyz(i,j,k)*gyyzz& +-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz+gupyz(i,j,k)*gupzz(i,j,k)*gyzzz+gupxy(i,j,k)*gupyz(i,j,k)*gxyyz + MapleGenVar4 = MapleGenVar3+gupxy(i,j,k)*gupzz(i,j,k)*gyzxz+gupxx(i,j,k)*gupxy(i,j,k)*gxyxx-2.0*gupxy(i,j,k)& +*gupxy(i,j,k)*gupzz(i,j,k)*gxyz*gxyz+gupxy(i,j,k)*gupyy(i,j,k)*gxyyy-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyyy+gupxy(i,j,k)*& +gupxy(i,j,k)*gyyxx+gupyy(i,j,k)*gupyy(i,j,k)*gyyyy+2.0*gupxy(i,j,k)*gupyz(i,j,k)*gyyxz-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyyz*& +gyyz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxxz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxxz*gxyz-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxyx + MapleGenVar2 = MapleGenVar4-gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-gupxx(i,j,k)& +*gupxx(i,j,k)*gupyz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxxx*gxyy-gupxx(i,j,k)*gupxy(i,j,k)*& +gupyy(i,j,k)*(gxxx*gyyy+gxyx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxzx*gxyy)-gupxx(i,j,k)*gupxz(i,j,k)& +*gupyy(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxzx*gxyz)-2.0*gupxx(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxxy-gupxx(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)& +*(gxxy*gyzx+gxyx*gxzy)-gupxx(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-gupxx(i,j,k)*gupyy(i,j,k)*& +gupyz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-gupxx(i,j,k)*gupyz(i,j,k)& +*gupyz(i,j,k)*(gxxy*gyzz+gxzy*gxyz) + MapleGenVar4 = MapleGenVar2-gupxx(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-gupxx(i,j,k)& +*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-& +gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxyy*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxxz*gyyz+gxyz*gxyz)& +-gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gyyx+gxyx*gxyx& +)-gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gyzx+gxzx& +*gyyx)-gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyyy+& +gxyx*gxyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyx*gyyy + MapleGenVar3 = MapleGenVar4-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxyz-2.0*gupxx(i,j,k)*& +gupxz(i,j,k)*gupxy(i,j,k)*gxxx*gxyz-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxxy*gxyy-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*& +gxxy*gxyz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxxz-6.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxyx*gyyx-4.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxzx-2.0*gupxy(i,j,k)*gupxz(i,j,k)*& +gupyy(i,j,k)*gxyx*gyyz-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy& +*gyyx+gxyx*gxyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gyyx + MapleGenVar4 = MapleGenVar3-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzy*gyyx)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupyy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-6.0*& +gupxy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-gupxy(i,j,k)*& +gupyy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-4.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gxyz-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-gupxy(i,j,k)*gupxy(i,j,k)& +*gupxz(i,j,k)*(gxxz*gyyx+gxyx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-gupxy(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzz*gyyy) + MapleGenVar1 = MapleGenVar4-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxz*gyyz+gxyz*gxyz)-gupxy(i,j,k)& +*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-& +gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*& +gyyx)-gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyzy+gxzx& +*gxyy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyzz+& +gxzx*gxyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzx*& +gyzz-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzx+gxzy*& +gyyx)-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy) + MapleGenVar4 = MapleGenVar1-gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-gupxz(i,j,k)& +*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyzz+gxzy*gxyz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-2.0*& +gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzy*gyzz-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-gupxz(i,j,k)*gupxz(i,j,k)& +*gupyy(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-4.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*& +gupxz(i,j,k)*gxyy*gxzy-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gxyy*gyyz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxyz*gyyx& +-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gxyz*gyyy-6.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxyz*gyyz + MapleGenVar3 = MapleGenVar4-4.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxyz*gyzz-2.0*gupxy(i,j,k)*& +gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*& +gxzx*gyzy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxzy*gyzx-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzz*gyzx-gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzy+gxyy*gxzz)-gupxz(i,j,k)*gupyz(i,j,k)& +*gupyy(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxzz*gyzy-2.0*gupxz(i,j,k)*gupzz(i,j,k)*& +gupyy(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupxz(i,j,k)*& +gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz + MapleGenVar4 = MapleGenVar3-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxzy-4.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyyy+gxyy*gyyx)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-4.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxyy*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzy*gyzx)& +-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxyx*gxzz-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyyz+gxyz*gyyx)-& +gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxyz*& +gyzx)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxyy-& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzx+gxzx*gyzy) + + MapleGenVar2 = MapleGenVar4-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyyz+gxyz*gyyy)-& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxyz*& +gyzy)-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxyz-& +gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)& +-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+gxzy*gyzz& +)-gupyy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzy+gxzy*& +gyyx)-4.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gyyx*gyyy-4.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyx*gyzy+gyzx*& +gyyy)-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyx*gzzy+gyzx*gyzy) + MapleGenVar4 = MapleGenVar2-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-4.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gyyx*gyyz-4.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyx*gyzz+gyzx*gyyz)-gupyy(i,j,k)*& +gupxz(i,j,k)*gupzz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxyy*gxzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxyz-6.0*gupyy(i,j,k)*gupxx(i,j,k)*& +gupyz(i,j,k)*gyyx*gyzx-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyyx*gyzy-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyyx*gyzz& +-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-6.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyyy*gyzy + MapleGenVar3 = MapleGenVar4-gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-gupyy(i,j,k)& +*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-4.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyyy*gyyz-2.0*gupyy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyyy*gyzz-4.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gyzz+gyzy*gyyz)-gupyy(i,j,k)*gupyz(i,j,k)*& +gupzz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-gupyy(i,j,k)*gupxz(i,j,k)& +*gupzz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*gupyy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyyz-gupyy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-gupyy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)& +*(gyyz*gzzz+gyzz*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-gupyz(i,j,k)*gupxy(i,j,k)*& +gupxz(i,j,k)*(gxyx*gzzy+gxzy*gyzx) + MapleGenVar4 = MapleGenVar3-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-4.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyzx*gyzy-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-gupyz(i,j,k)*gupyz(i,j,k)& +*gupxz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gyzx*gyzz-gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*& +(gxyy*gzzx+gxzx*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)& +*(gyyy*gzzy+gyzy*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupyz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzy*gzzz-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(& +gxyz*gzzx+gxzx*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gyyz*gzzx+gyzx*gyzz) + CAZyy = Gamyy - (MapleGenVar4-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyyy-2.0*gupyy(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyyz-6.0*gupyy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyyz*gyzz-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*& +gyzx*gzzx-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzx*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gyzx*gzzz-2.0*& +gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzy*gzzx-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyzy*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupzz(i,j,k)*gyzz*gzzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzy+gxzy*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyz& +*gzzy+gyzy*gyzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gzzy-gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzz+& +gyzz*gyzz)-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz) + MapleGenVar3 = gupyz(i,j,k)*gupxx(i,j,k)*gxyxy+gupxz(i,j,k)*gupyy(i,j,k)*gyyxy+gupzz(i,j,k)*gupxy(i,j,k)*gyyxz+2.0*& +gupxz(i,j,k)*gupzz(i,j,k)*gyzxz+gupzz(i,j,k)*gupxy(i,j,k)*gxyyz+gupyz(i,j,k)*gupxy(i,j,k)*gxyyy+gupyz(i,j,k)*gupxy(i,j,k)*gyyxy+gupyz(i,j,k)*& +gupyy(i,j,k)*gyyyy+gupxz(i,j,k)*gupxz(i,j,k)*gyzxx+gupxz(i,j,k)*gupyz(i,j,k)*gyyxz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxyz& +-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyyy*gyzz+gupxz(i,j,k)*gupxy(i,j,k)*gxyxy+gupzz(i,j,k)*gupyy(i,j,k)*gyyyz+gupxz(i,j,k)*& +gupxy(i,j,k)*gyyxx-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gyzz+gupyz(i,j,k)*gupyz(i,j,k)*gyzyy+2.0*gupyz(i,j,k)*gupzz(i,j,k)*& +gyzyz+gupzz(i,j,k)*gupxx(i,j,k)*gxyxz+gupyz(i,j,k)*gupxz(i,j,k)*gxyyz+gupxz(i,j,k)*gupxx(i,j,k)*gxyxx+2.0*gupxz(i,j,k)*gupyz(i,j,k)*& +gyzxy-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyyy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyyz+gupzz(i,j,k)*& +gupzz(i,j,k)*gyzzz + MapleGenVar4 = MapleGenVar3+gupzz(i,j,k)*gupxz(i,j,k)*gxyzz-2.0*gupzz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzy*& +gyzx+gupyz(i,j,k)*gupyz(i,j,k)*gyyyz+gupxz(i,j,k)*gupxz(i,j,k)*gxyxz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxyx*gxzz-2.0*& +gupzz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz+gupzz(i,j,k)*gupyz(i,j,k)*gyyzz-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyz*gyyx& +-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxyx-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxyx-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupxx(i,j,k)*gxyx*gxzx-gupxz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*(gxxx*gyyx+gxyx*gxyx) + MapleGenVar2 = MapleGenVar4-3.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-& +gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*& +gyzx)-4.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxyy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxzy-gupxz(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyyy+gxyy*gyyx)& +-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxy*gyzx+gxyx*& +gxzy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxyy*gyzx)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*& +gzzy+gxzy*gyzx)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxyx*gxxz-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxyz& +-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyx+gxyx*gxyz) + MapleGenVar4 = MapleGenVar2-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyyz+gxyz*gyyx)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzx+gxyx*& +gxzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gyzz+gxyz*gyzx)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*& +gzzz+gxzz*gyzx)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gxyy-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyyy+& +gxyx*gxyy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*& +gyzy+gxzx*gxyy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-2.0*gupxz(i,j,k)*gupyy(i,j,k)*& +gupxy(i,j,k)*gxyy*gxyy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxyy*gxzy + MapleGenVar3 = MapleGenVar4-gupxz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-2.0*& +gupxz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gxyy*gyyy-3.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-gupxz(i,j,k)*& +gupxz(i,j,k)*gupyy(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxyy*gxzz-gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-2.0*& +gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyyz+gxyz*gyyy)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzz*& +gyyy)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxyy*gxzz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+& +gxyz*gyzy)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*& +gxxx*gxyz + MapleGenVar4 = MapleGenVar3-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyyz+gxyx*gxyz)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gyzz+gxzx*gxyz)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzy*gxyz-& +gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyyz+gxyy*gxyz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzy*& +gyyz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxzy*gxyz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+& +gxzy*gyzz)-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxyz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxyz*gxzz-& +gupxz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*(gxxz*gyyz+gxyz*gxyz) + MapleGenVar1 = MapleGenVar4-3.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-& +gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*& +gyzz)-gupyz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*(gxxx*gyyx+gxyx*gxyx)-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gyyx*gyyx& +-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gyyx*gyzx-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxyx*gyyx-2.0*gupxz(i,j,k)*& +gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gxxy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*& +gxxx*gxyy-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxyy-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-2.0*& +gupxz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxyy*gxxz-4.0*gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gxyz + MapleGenVar4 = MapleGenVar1-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxxy*gxyz-2.0*gupxz(i,j,k)*& +gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxyz-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gxyz*gyyz-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*& +gxyz*gyzz-4.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gyyx-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gyyx*gzzx+gyzx& +*gyzx)-gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxy*gyyx+gxyx*gxyy)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyyy& ++gxyy*gyyx)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyy*gyyx-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyyx*gyzy-& +gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzx+gxzy*gyyx) + MapleGenVar3 = MapleGenVar4-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gyyx*gyzy+gyzx*gyyy)& +-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-gupyz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxz*gyyx+gxyx*& +gxyz)-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gyyz+gxyz*gyyx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gyyx*& +gyzz-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gyyx*gyzz+& +gyzx*gyyz)-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*& +gyyy+gxyx*gxyy)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gyyy-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyzx*gyyy& +-gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzx+gyzx*& +gyzy) + MapleGenVar4 = MapleGenVar3-gupyz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*(gxxy*gyyy+gxyy*gxyy)-4.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyyy*gyzy-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-gupyz(i,j,k)*& +gupyz(i,j,k)*gupxx(i,j,k)*(gxxz*gyyy+gxyy*gxyz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gyyz+gxyz*gyyy)& +-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyz*gyyy-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyyy*gyyz-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxz(i,j,k)*(gxyz*gyzy+gxzz*gyyy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gyzz+gyzy*gyyz)-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-gupyz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gyyz+gxyx*gxyz)& +-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gyzx*gyyz + MapleGenVar2 = MapleGenVar4-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzx*gyyz)-2.0*& +gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*gyyz+gxyy*gxyz)& +-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gyyz-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gyzz+gxzy*gyyz)-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-gupyz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*(gxxz*gyyz+gxyz*gxyz)& +-2.0*gupyz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyyz*gyyz-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyyz*gyzz-2.0*gupyz(i,j,k)*& +gupzz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzz+gyzz*gyzz)-gupzz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupzz(i,j,k)& +*gupxx(i,j,k)*gupxy(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*gupzz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyzx*gyzx-2.0*gupzz(i,j,k)*& +gupzz(i,j,k)*gupxx(i,j,k)*gyzx*gzzx + MapleGenVar4 = MapleGenVar2-gupzz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxy*gyzx+gxyx*gxzy)-2.0*& +gupzz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyzy+gxyy*gyzx)-gupzz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyy*gyzx+gxzy*gyyx)& +-2.0*gupzz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gyyx*gyzy+gyzx*gyyy)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gyzx*gzzy-& +gupzz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxz*gyzx+gxyx*gxzz)-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gyzz+gxyz*& +gyzx)-gupzz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyz*gyzx+gxzz*gyyx)-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gyyx*gyzz+& +gyzx*gyyz)-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzz*gyzx-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gyzx*gzzz-& +gupzz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gyzy+gxzx*gxyy) + MapleGenVar3 = MapleGenVar4-gupzz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyzy+gxzx*gyyy)-4.0*& +gupyz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gyyx*gyyy-4.0*gupyz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gyyx*gyyz-4.0*gupyz(i,j,k)*gupyy(i,j,k)*& +gupxy(i,j,k)*gxyy*gyyy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gyyz-4.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gyyz& +-2.0*gupzz(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gyzx-2.0*gupzz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gyyx*gyzx-2.0*gupzz(i,j,k)*& +gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gyzx-4.0*gupzz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyzy-4.0*gupzz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*& +gyzx*gyzz-2.0*gupzz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gyzy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gyzy*gzzx + MapleGenVar4 = MapleGenVar3-gupzz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupzz(i,j,k)& +*gupyy(i,j,k)*gupxy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*gupzz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyzy-2.0*gupzz(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gyzy-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyzy*gzzy-gupzz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxz*& +gyzy+gxyy*gxzz)-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gyzz+gxyz*gyzy)-gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(& +gxyz*gyzy+gxzz*gyyy)-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gyyy*gyzz+gyzy*gyyz)-4.0*gupzz(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzy*gzzz-gupzz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*& +gyzz+gxzx*gxyz)-gupzz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gyzz+gxzx*gyyz) + CAZzy = Gamzy -(MapleGenVar4-2.0*gupzz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gyzz-2.0*gupzz(i,j,k)*& +gupzz(i,j,k)*gupxz(i,j,k)*gyzz*gzzx-gupzz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*gyzz+gxzy*gxyz)-gupzz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)& +*(gxyy*gyzz+gxzy*gyyz)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gzzy-gupzz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*(gxxz*& +gyzz+gxyz*gxzz)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gyzz-gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*(gxyz*gyzz+& +gxzz*gyyz)-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyyz*gyzz-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gyzz-2.0*& +gupzz(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gyzy-2.0*gupzz(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxzy*gyzy-2.0*gupzz(i,j,k)*gupyz(i,j,k)*& +gupxz(i,j,k)*gxzz*gyzy-2.0*gupzz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gyzz) + MapleGenVar3 = gupxx(i,j,k)*gupyy(i,j,k)*gyzxy-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gzzz+gupxz(i,j,k)*& +gupzz(i,j,k)*gzzzz+gupxy(i,j,k)*gupxy(i,j,k)*gxzyy+2.0*gupxx(i,j,k)*gupxy(i,j,k)*gxzxy+2.0*gupxy(i,j,k)*gupxz(i,j,k)*gxzyz-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gxzx+gupxz(i,j,k)*gupxy(i,j,k)*gyzxz+gupxx(i,j,k)*gupyz(i,j,k)*gzzxy+gupxy(i,j,k)*gupxy(i,j,k)*& +gyzxy+gupxz(i,j,k)*gupyz(i,j,k)*gzzyz+gupxy(i,j,k)*gupyy(i,j,k)*gyzyy+gupxz(i,j,k)*gupyy(i,j,k)*gyzyz+gupxz(i,j,k)*gupxz(i,j,k)*gzzxz& +-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyy*gyzx+2.0*gupxx(i,j,k)*gupxz(i,j,k)*gxzxz+gupxx(i,j,k)*gupxx(i,j,k)*gxzxx-2.0*& +gupxz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gzzz*gzzz+gupxx(i,j,k)*gupyz(i,j,k)*gyzxz+gupxz(i,j,k)*gupxz(i,j,k)*gxzzz-2.0*gupxx(i,j,k)*gupxx(i,j,k)& +*gupxx(i,j,k)*gxxx*gxzx+gupxy(i,j,k)*gupxz(i,j,k)*gzzxy+gupxx(i,j,k)*gupxy(i,j,k)*gyzxx+gupxy(i,j,k)*gupyz(i,j,k)*gyzyz-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gyzy + MapleGenVar4 = MapleGenVar3+gupxx(i,j,k)*gupxz(i,j,k)*gzzxx+gupxx(i,j,k)*gupzz(i,j,k)*gzzxz+gupxy(i,j,k)*& +gupyz(i,j,k)*gzzyy+gupxy(i,j,k)*gupzz(i,j,k)*gzzyz+gupxz(i,j,k)*gupyz(i,j,k)*gyzzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzz*gzzx& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gxzx-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-& +gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-2.0*& +gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gzzx+gxzx*gyzx) + + MapleGenVar2 = MapleGenVar4-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxzx*gzzx-2.0*gupxx(i,j,k)*& +gupxx(i,j,k)*gupxy(i,j,k)*gxzx*gxxy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxzx*gxyy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(& +gxxy*gyzx+gxzx*gxyy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*& +gupyz(i,j,k)*(gxzx*gyzy+gxzy*gyzx)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-gupxx(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxzx*gzzy+gxzy*gzzx)& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gxxz-4.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz-2.0*gupxx(i,j,k)*& +gupxz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-2.0*& +gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxzx*gyzz+gxzz*gyzx) + MapleGenVar4 = MapleGenVar2-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-& +gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxzx*gzzz+gxzz*& +gzzx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxxx*gxzy-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxzy-2.0*gupxx(i,j,k)& +*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-2.0*& +gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gzzy+gxzy*gyzx)& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gxxy*gxzy-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxzy*gxzy-2.0*gupxx(i,j,k)*& +gupyy(i,j,k)*gupxy(i,j,k)*(gxxy*gyzy+gxyy*gxzy) + MapleGenVar3 = MapleGenVar4-gupxx(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*& +gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-gupxx(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzy*gxxz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-& +gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxzy*gyzz+gxzz*& +gyzy)-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzy+& +gxzy*gyzz)-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxzy*gzzz+gxzz*gzzy)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*& +gxxx*gxzz-4.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxzy-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gxyz + MapleGenVar4 = MapleGenVar3-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gxzy-2.0*gupxx(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gxzy*gzzy-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*& +gxzy*gxyz-4.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxzz-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyx*gxzz-2.0*& +gupxx(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyzz+gxzz*gyyx)& +-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gzzz+gxzz*& +gyzx)-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxxy*gxzz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxxy*gyzz+gxyy*& +gxzz) + MapleGenVar1 = MapleGenVar4-gupxx(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-2.0*& +gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)& +-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxxz*gxzz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gxzz-2.0*gupxx(i,j,k)*& +gupzz(i,j,k)*gupxy(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*& +gupxx(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)& +-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gxzz*gzzz-gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gyzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyzx*gyzx-3.0*gupxy(i,j,k)*gupxx(i,j,k)*& +gupxz(i,j,k)*(gxyx*gzzx+gxzx*gyzx) + MapleGenVar4 = MapleGenVar1-gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupxy(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxzx*gyzy+gxzy*gyzx)& +-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gyzx*gyyy-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyzy-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyzx*gzzy+gyzy*gzzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyz*gyzx+gxzx*gyyz)& +-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxzx*gyzz+gxzz*gyzx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyz*gyzx + MapleGenVar3 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-& +gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyzx*gzzz+gyzz*& +gzzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gyyx*gyzy& +-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyx*gzzy+gyzx*& +gyzy)-gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gyzy& +-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyzy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gyzy-3.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupxz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gyyy*gzzy+gyzy*gyzy) + MapleGenVar4 = MapleGenVar3-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxzy*gyzz+gxzz*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyz*gyzy-4.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-gupxy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyzy*gzzz+gyzz*gzzy)-& +gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gyzz-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gzzz+gxzx*gyzz)-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)& +-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzz*gyyy) + MapleGenVar2 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gyzz-2.0*gupxy(i,j,k)*& +gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupzz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxyz*gyzz-2.0*gupxy(i,j,k)*& +gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gyzz-3.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-gupxy(i,j,k)*gupzz(i,j,k)*& +gupyz(i,j,k)*(gyyz*gzzz+gyzz*gyzz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*gxyy*gxzz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gxzz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz& +-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gyzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*gyyx*gyzx + MapleGenVar4 = MapleGenVar2-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gyzx*gzzx-2.0*gupxy(i,j,k)*& +gupxz(i,j,k)*gupyy(i,j,k)*gyzx*gyyz-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyzz-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*& +gxzy*gyzy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyzy*gzzy-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyzy*gyyz-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gyyx*gyzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyyy*gyzz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*& +gupxz(i,j,k)*gxzz*gyzz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*gyyz*gyzz-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxzx*gzzx& +-gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gyyx*gzzx+gyzx*gyzx) + MapleGenVar3 = MapleGenVar4-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gzzx*gzzx-gupxz(i,j,k)*gupxy(i,j,k)*& +gupxy(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxzx*gzzy+gxzy*gzzx)-gupxz(i,j,k)*& +gupxy(i,j,k)*gupyy(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyzx*gzzy+gyzy*gzzx)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzy*gzzx-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxzx*gzzz+gxzz*gzzx)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gyyz*gzzx+gyzx*gyzz)& +-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyzx*gzzz+gyzz*gzzx)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzz*gzzx& +-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gzzx*gzzz-gupxz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gzzy+gxzy*gyzx) + MapleGenVar4 = MapleGenVar3-gupxz(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-2.0*& +gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gzzy-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxzy*gzzy-gupxz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(& +gyyy*gzzy+gyzy*gyzy)-2.0*gupxz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gzzy*gzzy-gupxz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gxyz*& +gzzy+gxzy*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxzy*gzzz+gxzz*gzzy)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(& +gyyz*gzzy+gyzy*gyzz)-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyzy*gzzz+gyzz*gzzy)-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gxzz*gzzy-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzz*gzzy-gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*& +gzzz+gxzz*gyzx)-gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gyyx*gzzz+gyzx*gyzz) + CAZxz = Gamxz - (MapleGenVar4-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gzzz-gupxz(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-gupxz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-2.0*gupxz(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gxzy*gzzz-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gzzz-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*& +gxzz*gzzz-gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gyyz*gzzz+gyzz*gyzz)-4.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyzx*& +gzzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzy*gzzx-4.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gzzx*gzzy-2.0*gupxz(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gzzy-4.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gzzy-4.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*& +gzzy*gzzz-4.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gzzz) + MapleGenVar3 = gupyz(i,j,k)*gupyz(i,j,k)*gzzyz+gupyy(i,j,k)*gupyy(i,j,k)*gyzyy+gupyz(i,j,k)*gupzz(i,j,k)*gzzzz-2.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*gyyy*gyzy+2.0*gupyy(i,j,k)*gupyz(i,j,k)*gyzyz+gupxy(i,j,k)*gupyz(i,j,k)*gzzxy-2.0*gupyy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gyzy+gupyy(i,j,k)*gupxx(i,j,k)*gxzxy+gupyz(i,j,k)*gupyz(i,j,k)*gyzzz+gupxy(i,j,k)*gupxz(i,j,k)*gxzxz+2.0& +*gupxy(i,j,k)*gupyz(i,j,k)*gyzxz+gupxy(i,j,k)*gupxx(i,j,k)*gxzxx+gupyy(i,j,k)*gupxz(i,j,k)*gzzxy+gupyy(i,j,k)*gupxz(i,j,k)*gxzyz+gupxy(i,j,k)*& +gupzz(i,j,k)*gzzxz-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxzx*gxyy+gupyz(i,j,k)*gupxy(i,j,k)*gxzyz-2.0*gupyz(i,j,k)*gupzz(i,j,k)*& +gupzz(i,j,k)*gzzz*gzzz+gupxy(i,j,k)*gupxz(i,j,k)*gzzxx-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gzzz-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyzz*gzzy-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxxx*gxzy+2.0*gupxy(i,j,k)*gupyy(i,j,k)*gyzxy+& +gupyz(i,j,k)*gupxz(i,j,k)*gxzzz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxzx*gzzz+gxzz*gzzx) + MapleGenVar4 = MapleGenVar3+gupxy(i,j,k)*gupxy(i,j,k)*gyzxx+gupxy(i,j,k)*gupxy(i,j,k)*gxzxy+gupyy(i,j,k)*& +gupyz(i,j,k)*gzzyy+gupyz(i,j,k)*gupxz(i,j,k)*gzzxz+gupyz(i,j,k)*gupxx(i,j,k)*gxzxz+gupyy(i,j,k)*gupzz(i,j,k)*gzzyz-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxy(i,j,k)*gxyx*gxzy-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyy*gyzz+gupyy(i,j,k)*gupxy(i,j,k)*gxzyy-2.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*gxxx*gxzx-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxyx*gxzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*& +gupxz(i,j,k)*gxzx*gxzx + MapleGenVar2 = MapleGenVar4-gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*& +gupxy(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*gyyx)-gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)& +-3.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*gxzx*gxxy& +-4.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxzy-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxzx*gyzy+gxzy*& +gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzx+& +gxzx*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxzx*gzzy+gxzy*gzzx)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*& +gxzx*gxyz-4.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz + MapleGenVar4 = MapleGenVar2-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzx+gxzx*gyyz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxzx*gyzz+gxzz*& +gyzx)-gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzx+& +gxzx*gyzz)-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxzx*gzzx-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxzx*gxxz-gupxy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupyy(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gzzy+gxzy*gyzx) + MapleGenVar3 = MapleGenVar4-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*gxyy*gxzy-2.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupxz(i,j,k)*gxzy*gxzy-gupxy(i,j,k)*gupxy(i,j,k)*gupyy(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*& +gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-3.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxzy*gxyz-gupxy(i,j,k)*gupxy(i,j,k)*& +gupyz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxzy*gyzz+gxzz*gyzy)-gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)& +-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzy+gxzy*gyzz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxzy*gzzz+& +gxzz*gzzy) + MapleGenVar4 = MapleGenVar3-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxzz-gupxy(i,j,k)*gupxy(i,j,k)*& +gupxz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-gupxy(i,j,k)*& +gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)& +-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gxzz-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)& +-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxyz*gxzz& +-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gxzz + MapleGenVar1 = MapleGenVar4-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-2.0*& +gupxy(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)& +-3.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gxzz*gzzz-& +gupyy(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gyyx*gyzx-2.0*& +gupyy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyzx*gyzx-gupyy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-2.0*gupyy(i,j,k)*& +gupxx(i,j,k)*gupyz(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-gupyy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*& +gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxzx*gyzy+gxzy*gyzx)-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*gxyy*gyzx-2.0*& +gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gyzx*gyyy + MapleGenVar4 = MapleGenVar1-gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-2.0*& +gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyy*gzzx+gyzx*gyzy)-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyzx*gzzy+gyzy*& +gzzx)-gupyy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxzx*gyzz+& +gxzz*gyzx)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gyzx*gyyz-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzx+gxzz*& +gyzx)-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyzx*& +gzzz+gyzz*gzzx)-gupyy(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gyzy+gxyx*gxzy)-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*& +gxyx*gyzy + MapleGenVar3 = MapleGenVar4-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxy(i,j,k)*gyyx*gyzy-gupyy(i,j,k)*gupxy(i,j,k)*& +gupxz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-gupyy(i,j,k)*& +gupyy(i,j,k)*gupxx(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxzy*gyzy-2.0*gupyy(i,j,k)*& +gupyy(i,j,k)*gupxy(i,j,k)*gxyy*gyzy-gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*& +gupyz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyzy*gzzy-gupyy(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(& +gxxz*gyzy+gxzy*gxyz)-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxzy*gyzz+gxzz*gyzy)-2.0*gupyy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gyzy*gyyz-4.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz + MapleGenVar4 = MapleGenVar3-gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-2.0*& +gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzy+gyzy*gyzz)-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyzy*gzzz+gyzz*& +gzzy)-gupyy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*gxxy*gxzy& +-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gxzy*gzzy-2.0*gupxy(i,j,k)*& +gupyz(i,j,k)*gupxx(i,j,k)*gxzy*gxxz-4.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxzz-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*& +gxxx*gxzz-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gxxy*gxzz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gxxz*gxzz + MapleGenVar2 = MapleGenVar4-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz-2.0*gupyy(i,j,k)*& +gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gyzx-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupxy(i,j,k)*gxyx*gyzx-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*& +gyzx*gzzx-4.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyzy-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxyz*gyzx-4.0*& +gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyzz-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gxyz*gyzy-2.0*gupyy(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*gxyx*gyzz-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gyyx*gyzz-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gzzz+& +gxzx*gyzz)-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-gupyy(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*& +gyzz+gxyy*gxzz)-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyyy*gyzz + MapleGenVar4 = MapleGenVar2-gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-2.0*& +gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-gupyy(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*(gxxz*gyzz+gxyz*gxzz)& +-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyyz*gyzz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyzz*gyzz-gupyy(i,j,k)*gupzz(i,j,k)*& +gupxz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gyyz*gzzz+gyzz*gyzz)-2.0*& +gupyy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz-gupyz(i,j,k)*gupxx(i,j,k)*gupxx(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-4.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupxx(i,j,k)*gyzx*gzzx-2.0*gupyz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gzzx*gzzx-gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxy*& +gzzx+gxzx*gxzy) + MapleGenVar3 = MapleGenVar4-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxzx*gzzy+gxzy*gzzx)-& +gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*(gyzx*gzzy+gyzy*& +gzzx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyzy*gzzx-gupyz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(gxxz*gzzx+gxzx*gxzz)& +-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxzx*gzzz+gxzz*gzzx)-gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyz*gzzx+gxzz*& +gyzx)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gyzx*gzzz+gyzz*gzzx)-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzz*& +gzzx-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gyzz*gzzx-gupyz(i,j,k)*gupxy(i,j,k)*gupxx(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-& +gupyz(i,j,k)*gupxy(i,j,k)*gupxy(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyzx*gzzy + MapleGenVar4 = MapleGenVar3-gupyz(i,j,k)*gupyy(i,j,k)*gupxx(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-4.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyzy*gzzy-2.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gzzy*gzzy-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(& +gxxz*gzzy+gxzy*gxzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxzy*gzzz+gxzz*gzzy)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxy(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyzy*gzzz+gyzz*gzzy)-2.0*& +gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzz*gzzy-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gzzy*gzzz-gupyz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*(& +gxxx*gzzz+gxzx*gxzz)-gupyz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxyx*gzzz+gxzx*gyzz)-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupxz(i,j,k)*gxzx*gzzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gyzx*gzzz + CAZyz = Gamyz - (MapleGenVar4-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-gupyz(i,j,k)*& +gupyz(i,j,k)*gupxy(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gzzz-gupyz(i,j,k)*gupzz(i,j,k)*& +gupxx(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*& +gupxz(i,j,k)*gxzz*gyzz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gxyz*gyzz-4.0*gupyz(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxzx*gzzx& +-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzy*gzzx-4.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gzzx*gzzy-4.0*gupyz(i,j,k)*& +gupxz(i,j,k)*gupzz(i,j,k)*gzzx*gzzz-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gzzy-4.0*gupyz(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*& +gxzy*gzzy-4.0*gupyz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxzz*gzzz) + MapleGenVar3 = -4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*& +gxzz*gxzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gyzz-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*gyzy*gyzy+gupxz(i,j,k)& +*gupzz(i,j,k)*gxzzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxx(i,j,k)*gxzx*gxzx+gupxy(i,j,k)*gupyz(i,j,k)*gyzxy+gupyz(i,j,k)*gupyz(i,j,k)*& +gyzyz+gupxx(i,j,k)*gupyz(i,j,k)*gxzxy+gupxy(i,j,k)*gupzz(i,j,k)*gxzyz+gupyy(i,j,k)*gupzz(i,j,k)*gyzyz+2.0*gupxz(i,j,k)*gupzz(i,j,k)*& +gzzxz+gupxy(i,j,k)*gupxz(i,j,k)*gyzxx+gupyy(i,j,k)*gupxz(i,j,k)*gyzxy+gupyz(i,j,k)*gupxz(i,j,k)*gyzxz+gupyy(i,j,k)*gupyz(i,j,k)*gyzyy& +-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*gyzx*gyzx+gupxx(i,j,k)*gupxz(i,j,k)*gxzxx-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxx(i,j,k)*gzzx*& +gzzx-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyy(i,j,k)*gxzy*gxzy-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyzz+gupxx(i,j,k)*& +gupzz(i,j,k)*gxzxz+gupxz(i,j,k)*gupyz(i,j,k)*gxzyz+gupyz(i,j,k)*gupzz(i,j,k)*gyzzz+gupxz(i,j,k)*gupxz(i,j,k)*gzzxx+gupxy(i,j,k)*gupyz(i,j,k)*& +gxzyy + MapleGenVar4 = MapleGenVar3+gupzz(i,j,k)*gupzz(i,j,k)*gzzzz+gupxy(i,j,k)*gupzz(i,j,k)*gyzxz+2.0*gupyz(i,j,k)& +*gupzz(i,j,k)*gzzyz+gupyz(i,j,k)*gupyz(i,j,k)*gzzyy+gupxy(i,j,k)*gupxz(i,j,k)*gxzxy+gupxz(i,j,k)*gupxz(i,j,k)*gxzxz-2.0*gupzz(i,j,k)*& +gupzz(i,j,k)*gupyy(i,j,k)*gzzy*gzzy+2.0*gupxz(i,j,k)*gupyz(i,j,k)*gzzxy-2.0*gupxx(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxxx*gxzx-& +gupxx(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupxx(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxxx*gzzx+gxzx*gxzx)& +-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxx*gyzy+gxyx*gxzy) + MapleGenVar2 = MapleGenVar4-gupxx(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-2.0*& +gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxxx*gxzz-gupxx(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-gupxx(i,j,k)*gupxz(i,j,k)& +*gupzz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-gupxx(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-gupxx(i,j,k)*& +gupxy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-gupxx(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupxx(i,j,k)& +*gupyy(i,j,k)*gupzz(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-gupxx(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-& +gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-2.0*gupxx(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxxz-gupxx(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxx(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-gupxx(i,j,k)& +*gupyz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzy+gxzy*gxyz) + MapleGenVar4 = MapleGenVar2-gupxx(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-gupxx(i,j,k)& +*gupzz(i,j,k)*gupyz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxx(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-& +gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*(gxxx*gyzx+gxyx*gxzx)-gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gyzx+gxzx*gyyx)& +-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxxx*gyzy+gxyx*& +gxzy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyx*gyzy-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)-& +gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gyzz+gxyx*gxzz)-2.0*gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxxx*gxzy-2.0*& +gupxx(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxxy + MapleGenVar3 = MapleGenVar4-2.0*gupxx(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxxy*gxzy-2.0*gupxx(i,j,k)*& +gupyz(i,j,k)*gupxz(i,j,k)*gxxy*gxzz-2.0*gupxx(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxxz-2.0*gupxx(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*& +gxxz*gxzz-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxyx*gyzx-2.0*gupxy(i,j,k)*gupxx(i,j,k)*gupxz(i,j,k)*gxyx*gxzx-2.0*& +gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxyx*gyzz-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+gxzx*gyzz)-gupxy(i,j,k)*gupxy(i,j,k)& +*gupxz(i,j,k)*(gxxy*gyzx+gxzx*gxyy)-2.0*gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gxyy*gyzx-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*& +(gxyy*gzzx+gxzy*gyzx)-gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*(gxxy*gyzy+gxyy*gxzy)-gupxy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)& +*(gxyy*gyzy+gxzy*gyyy)-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*(gxyy*gzzy+gxzy*gyzy) + MapleGenVar4 = MapleGenVar3-gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxxy*gyzz+gxyy*gxzz)-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxyy*gyzz-gupxy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gxyy*gzzz+gxzy*gyzz)-gupxy(i,j,k)*gupxz(i,j,k)& +*gupxz(i,j,k)*(gxxz*gyzx+gxzx*gxyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-gupxy(i,j,k)*& +gupyz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzy+gxzy*gxyz)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gxyz*gyzy-gupxy(i,j,k)*gupyz(i,j,k)*& +gupzz(i,j,k)*(gxyz*gzzy+gxzz*gyzy)-gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*(gxxz*gyzz+gxyz*gxzz)-gupxy(i,j,k)*gupzz(i,j,k)& +*gupyz(i,j,k)*(gxyz*gyzz+gxzz*gyyz)-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-gupxz(i,j,k)*& +gupxz(i,j,k)*gupxx(i,j,k)*(gxxx*gzzx+gxzx*gxzx)-gupxz(i,j,k)*gupxx(i,j,k)*gupyy(i,j,k)*(gxyx*gyzx+gxzx*gyyx) + MapleGenVar1 = MapleGenVar4-2.0*gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*(gxyx*gzzx+gxzx*gyzx)-& +gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*(gxxx*gzzy+gxzx*gxzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gzzy+gxzx*gyzy)& +-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupxy(i,j,k)*gxzx*gxzy-gupxz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxxx*gzzz+gxzx*gxzz)-gupxz(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*(gxyx*gzzz+gxzx*gyzz)-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gxzx*gzzz-gupxz(i,j,k)*gupxz(i,j,k)*& +gupxy(i,j,k)*(gxxy*gzzx+gxzx*gxzy)-gupxz(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzx+gxzy*gyzx)-gupxz(i,j,k)*gupxz(i,j,k)& +*gupyy(i,j,k)*(gxxy*gzzy+gxzy*gxzy)-gupxz(i,j,k)*gupyy(i,j,k)*gupyy(i,j,k)*(gxyy*gyzy+gxzy*gyyy)-2.0*gupxz(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*(gxyy*gzzy+gxzy*gyzy)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxy*gzzz+gxzy*gxzz)-gupxz(i,j,k)& +*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gzzz+gxzy*gyzz) + MapleGenVar4 = MapleGenVar1-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gxzy*gxzz-gupxz(i,j,k)*gupxz(i,j,k)*& +gupxz(i,j,k)*(gxxz*gzzx+gxzx*gxzz)-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzx+gxzz*gyzx)-2.0*gupxy(i,j,k)*& +gupyy(i,j,k)*gupyz(i,j,k)*gxyy*gyzy-2.0*gupxy(i,j,k)*gupyy(i,j,k)*gupxz(i,j,k)*gxyy*gxzy-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*& +gxyz*gyzx-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxyz*gyzz-2.0*gupxy(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gxyz*gxzz-4.0*& +gupxz(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gxzx*gyzx-6.0*gupxz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*gxzx*gzzx-2.0*gupxz(i,j,k)*gupxy(i,j,k)*& +gupzz(i,j,k)*gxzx*gzzy-2.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gxzy*gzzx + MapleGenVar3 = MapleGenVar4-4.0*gupxz(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gxzy*gyzy-6.0*gupxz(i,j,k)*& +gupyy(i,j,k)*gupzz(i,j,k)*gxzy*gzzy-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzy*gzzz-2.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*& +gxzz*gzzx-gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxxz*gzzy+gxzy*gxzz)-gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzy+& +gxzz*gyzy)-gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxxz*gzzz+gxzz*gxzz)-gupxz(i,j,k)*gupzz(i,j,k)*gupyy(i,j,k)*(gxyz*gyzz& ++gxzz*gyyz)-2.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*(gxyz*gzzz+gxzz*gyzz)-6.0*gupxz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*& +gxzz*gzzz-2.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gxzz*gzzy-4.0*gupxz(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gxzz*gyzz-2.0*& +gupxy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*gxyx*gxzy + MapleGenVar4 = MapleGenVar3-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-gupxy(i,j,k)& +*gupxy(i,j,k)*gupzz(i,j,k)*(gxyx*gzzy+gxzy*gyzx)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxyx*gxzz-gupxy(i,j,k)*gupxz(i,j,k)*& +gupyz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-2.0*gupxy(i,j,k)*& +gupxy(i,j,k)*gupxz(i,j,k)*gxzx*gxyy-gupxy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-gupxy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)& +*(gxyy*gzzx+gxzx*gyzy)-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-gupxy(i,j,k)*gupyz(i,j,k)*& +gupzz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-2.0*gupxy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*gxzx*gxyz-gupxy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(& +gxyz*gyzx+gxzx*gyyz)-gupxy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzx+gxzx*gyzz) + MapleGenVar2 = MapleGenVar4-gupxy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-gupxy(i,j,k)& +*gupyz(i,j,k)*gupzz(i,j,k)*(gxyz*gzzy+gxzy*gyzz)-gupyy(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*(gyyx*gzzx+gyzx*gyzx)-& +gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gyzy+gxzy*gyyx)-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyx*gzzy+gyzx*gyzy)& +-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyx*gyzz+gxzz*gyyx)-gupyy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyx*gzzz+gyzx*gyzz& +)-gupyy(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gyzx+gxzx*gyyy)-2.0*gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxyy*gxzz-2.0*& +gupxy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*gxzy*gxyz-2.0*gupyy(i,j,k)*gupxx(i,j,k)*gupyz(i,j,k)*gyyx*gyzx-2.0*gupyy(i,j,k)*gupxy(i,j,k)*& +gupyz(i,j,k)*gyyx*gyzy-2.0*gupyy(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*gyyx*gyzz-gupyy(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyyy*gzzx+& +gyzx*gyzy) + MapleGenVar4 = MapleGenVar2-2.0*gupyy(i,j,k)*gupyy(i,j,k)*gupyz(i,j,k)*gyyy*gyzy-gupyy(i,j,k)*gupyy(i,j,k)*& +gupzz(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-gupyy(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyy*gyzz+gxzz*gyyy)-2.0*gupyy(i,j,k)*& +gupyz(i,j,k)*gupyz(i,j,k)*gyyy*gyzz-gupyy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-gupyy(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)& +*(gxyz*gyzx+gxzx*gyyz)-gupyy(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzx+gyzx*gyzz)-gupyy(i,j,k)*gupyz(i,j,k)*& +gupxz(i,j,k)*(gxyz*gyzy+gxzy*gyyz)-2.0*gupyy(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*gyzy*gyyz-gupyy(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(& +gyyz*gzzy+gyzy*gyzz)-gupyy(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzz+gyzz*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxx(i,j,k)*& +(gyyx*gzzx+gyzx*gyzx) + MapleGenVar3 = MapleGenVar4-gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyx*gzzy+gxzy*gyzx)-gupyz(i,j,k)& +*gupyz(i,j,k)*gupxy(i,j,k)*(gyyx*gzzy+gyzx*gyzy)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)*gyzx*gyzy-gupyz(i,j,k)*gupxz(i,j,k)*& +gupxz(i,j,k)*(gxyx*gzzz+gxzz*gyzx)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gyyx*gzzz+gyzx*gyzz)-4.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupxz(i,j,k)*gyzx*gyzz-gupyz(i,j,k)*gupxy(i,j,k)*gupxz(i,j,k)*(gxyy*gzzx+gxzx*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupxy(i,j,k)& +*(gyyy*gzzx+gyzx*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupyy(i,j,k)*(gyyy*gzzy+gyzy*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*& +gupxz(i,j,k)*(gxyy*gzzz+gxzz*gyzy)-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyy*gzzz+gyzy*gyzz)-2.0*gupyz(i,j,k)*& +gupyz(i,j,k)*gupzz(i,j,k)*gyzy*gzzz-gupyz(i,j,k)*gupxz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzx+gxzx*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)& +*(gyyz*gzzx+gyzx*gyzz) + MapleGenVar4 = MapleGenVar3-2.0*gupyy(i,j,k)*gupxy(i,j,k)*gupyz(i,j,k)*gyzx*gyyy-2.0*gupyy(i,j,k)*& +gupxz(i,j,k)*gupyz(i,j,k)*gyzx*gyyz-2.0*gupyy(i,j,k)*gupzz(i,j,k)*gupyz(i,j,k)*gyyz*gyzz-6.0*gupyz(i,j,k)*gupxx(i,j,k)*gupzz(i,j,k)*& +gyzx*gzzx-2.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzx*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*gyzx*gzzz-2.0*& +gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*gyzy*gzzx-6.0*gupyz(i,j,k)*gupyy(i,j,k)*gupzz(i,j,k)*gyzy*gzzy-2.0*gupyz(i,j,k)*gupxz(i,j,k)*& +gupzz(i,j,k)*gyzz*gzzx-gupyz(i,j,k)*gupyz(i,j,k)*gupxz(i,j,k)*(gxyz*gzzy+gxzy*gyzz)-gupyz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gyyz& +*gzzy+gyzy*gyzz)-2.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*gyzz*gzzy-gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyyz*gzzz+& +gyzz*gyzz) + CAZzz = Gamzz - (MapleGenVar4-6.0*gupyz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gyzz*gzzz-4.0*gupxz(i,j,k)*& +gupxy(i,j,k)*gupyz(i,j,k)*(gxzx*gyzy+gxzy*gyzx)-4.0*gupxz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gxzx*gzzy+gxzy*gzzx)& +-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupyz(i,j,k)*(gxzx*gyzz+gxzz*gyzx)-4.0*gupxz(i,j,k)*gupxz(i,j,k)*gupzz(i,j,k)*(gxzx*gzzz+& +gxzz*gzzx)-4.0*gupxz(i,j,k)*gupyz(i,j,k)*gupyz(i,j,k)*(gxzy*gyzz+gxzz*gyzy)-4.0*gupxz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(& +gxzy*gzzz+gxzz*gzzy)-4.0*gupyz(i,j,k)*gupxy(i,j,k)*gupzz(i,j,k)*(gyzx*gzzy+gyzy*gzzx)-4.0*gupyz(i,j,k)*& +gupxz(i,j,k)*gupzz(i,j,k)*(gyzx*gzzz+gyzz*gzzx)-4.0*gupyz(i,j,k)*gupyz(i,j,k)*gupzz(i,j,k)*(gyzy*gzzz+gyzz*gzzy)& +-4.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxy(i,j,k)*gzzx*gzzy-4.0*gupzz(i,j,k)*gupzz(i,j,k)*gupxz(i,j,k)*gzzx*gzzz-4.0*gupzz(i,j,k)*& +gupzz(i,j,k)*gupyz(i,j,k)*gzzy*gzzz-2.0*gupzz(i,j,k)*gupzz(i,j,k)*gupzz(i,j,k)*gzzz*gzzz) + +! second kind of connection + Gamxxx =HALF*( gupxx(i,j,k)*gxxx + gupxy(i,j,k)*(TWO*gxyx - gxxy ) + gupxz(i,j,k)*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy(i,j,k)*gxxx + gupyy(i,j,k)*(TWO*gxyx - gxxy ) + gupyz(i,j,k)*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz(i,j,k)*gxxx + gupyz(i,j,k)*(TWO*gxyx - gxxy ) + gupzz(i,j,k)*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx(i,j,k)*(TWO*gxyy - gyyx ) + gupxy(i,j,k)*gyyy + gupxz(i,j,k)*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy(i,j,k)*(TWO*gxyy - gyyx ) + gupyy(i,j,k)*gyyy + gupyz(i,j,k)*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz(i,j,k)*(TWO*gxyy - gyyx ) + gupyz(i,j,k)*gyyy + gupzz(i,j,k)*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx(i,j,k)*(TWO*gxzz - gzzx ) + gupxy(i,j,k)*(TWO*gyzz - gzzy ) + gupxz(i,j,k)*gzzz) + Gamyzz =HALF*( gupxy(i,j,k)*(TWO*gxzz - gzzx ) + gupyy(i,j,k)*(TWO*gyzz - gzzy ) + gupyz(i,j,k)*gzzz) + Gamzzz =HALF*( gupxz(i,j,k)*(TWO*gxzz - gzzx ) + gupyz(i,j,k)*(TWO*gyzz - gzzy ) + gupzz(i,j,k)*gzzz) + + Gamxxy =HALF*( gupxx(i,j,k)*gxxy + gupxy(i,j,k)*gyyx + gupxz(i,j,k)*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy(i,j,k)*gxxy + gupyy(i,j,k)*gyyx + gupyz(i,j,k)*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz(i,j,k)*gxxy + gupyz(i,j,k)*gyyx + gupzz(i,j,k)*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx(i,j,k)*gxxz + gupxy(i,j,k)*( gxyz + gyzx - gxzy ) + gupxz(i,j,k)*gzzx ) + Gamyxz =HALF*( gupxy(i,j,k)*gxxz + gupyy(i,j,k)*( gxyz + gyzx - gxzy ) + gupyz(i,j,k)*gzzx ) + Gamzxz =HALF*( gupxz(i,j,k)*gxxz + gupyz(i,j,k)*( gxyz + gyzx - gxzy ) + gupzz(i,j,k)*gzzx ) + + Gamxyz =HALF*( gupxx(i,j,k)*( gxyz + gxzy - gyzx ) + gupxy(i,j,k)*gyyz + gupxz(i,j,k)*gzzy ) + Gamyyz =HALF*( gupxy(i,j,k)*( gxyz + gxzy - gyzx ) + gupyy(i,j,k)*gyyz + gupyz(i,j,k)*gzzy ) + Gamzyz =HALF*( gupxz(i,j,k)*( gxyz + gxzy - gyzx ) + gupyz(i,j,k)*gyyz + gupzz(i,j,k)*gzzy ) + + Gamxa = gupxx(i,j,k) * Gamxxx + gupyy(i,j,k) * Gamxyy + gupzz(i,j,k) * Gamxzz + & + TWO*( gupxy(i,j,k) * Gamxxy + gupxz(i,j,k) * Gamxxz + gupyz(i,j,k) * Gamxyz ) + Gamya = gupxx(i,j,k) * Gamyxx + gupyy(i,j,k) * Gamyyy + gupzz(i,j,k) * Gamyzz + & + TWO*( gupxy(i,j,k) * Gamyxy + gupxz(i,j,k) * Gamyxz + gupyz(i,j,k) * Gamyyz ) + Gamza = gupxx(i,j,k) * Gamzxx + gupyy(i,j,k) * Gamzyy + gupzz(i,j,k) * Gamzzz + & + TWO*( gupxy(i,j,k) * Gamzxy + gupxz(i,j,k) * Gamzxz + gupyz(i,j,k) * Gamzyz ) + + call point_fdderivs_shc(ex,Lap,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betax,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betay,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,betaz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + + AAxx = gupxx(i,j,k) * Axx(i,j,k) * Axx(i,j,k) + gupyy(i,j,k) * Axy(i,j,k) * Axy(i,j,k) + gupzz(i,j,k) * Axz(i,j,k) * Axz(i,j,k) + & + TWO * (gupxy(i,j,k) * Axx(i,j,k) * Axy(i,j,k) + gupxz(i,j,k) * Axx(i,j,k) * Axz(i,j,k) + gupyz(i,j,k) * Axy(i,j,k) * Axz(i,j,k)) + AAyy = gupxx(i,j,k) * Axy(i,j,k) * Axy(i,j,k) + gupyy(i,j,k) * Ayy(i,j,k) * Ayy(i,j,k) + gupzz(i,j,k) * Ayz(i,j,k) * Ayz(i,j,k) + & + TWO * (gupxy(i,j,k) * Axy(i,j,k) * Ayy(i,j,k) + gupxz(i,j,k) * Axy(i,j,k) * Ayz(i,j,k) + gupyz(i,j,k) * Ayy(i,j,k) * Ayz(i,j,k)) + AAzz = gupxx(i,j,k) * Axz(i,j,k) * Axz(i,j,k) + gupyy(i,j,k) * Ayz(i,j,k) * Ayz(i,j,k) + gupzz(i,j,k) * Azz(i,j,k) * Azz(i,j,k) + & + TWO * (gupxy(i,j,k) * Axz(i,j,k) * Ayz(i,j,k) + gupxz(i,j,k) * Axz(i,j,k) * Azz(i,j,k) + gupyz(i,j,k) * Ayz(i,j,k) * Azz(i,j,k)) + AAxy = gupxx(i,j,k) * Axx(i,j,k) * Axy(i,j,k) + gupyy(i,j,k) * Axy(i,j,k) * Ayy(i,j,k) + gupzz(i,j,k) * Axz(i,j,k) * Ayz(i,j,k) + & + gupxy(i,j,k) *(Axx(i,j,k) * Ayy(i,j,k) + Axy(i,j,k) * Axy(i,j,k)) + & + gupxz(i,j,k) *(Axx(i,j,k) * Ayz(i,j,k) + Axz(i,j,k) * Axy(i,j,k)) + & + gupyz(i,j,k) *(Axy(i,j,k) * Ayz(i,j,k) + Axz(i,j,k) * Ayy(i,j,k)) + AAxz = gupxx(i,j,k) * Axx(i,j,k) * Axz(i,j,k) + gupyy(i,j,k) * Axy(i,j,k) * Ayz(i,j,k) + gupzz(i,j,k) * Axz(i,j,k) * Azz(i,j,k) + & + gupxy(i,j,k) *(Axx(i,j,k) * Ayz(i,j,k) + Axy(i,j,k) * Axz(i,j,k)) + & + gupxz(i,j,k) *(Axx(i,j,k) * Azz(i,j,k) + Axz(i,j,k) * Axz(i,j,k)) + & + gupyz(i,j,k) *(Axy(i,j,k) * Azz(i,j,k) + Axz(i,j,k) * Ayz(i,j,k)) + AAyz = gupxx(i,j,k) * Axy(i,j,k) * Axz(i,j,k) + gupyy(i,j,k) * Ayy(i,j,k) * Ayz(i,j,k) + gupzz(i,j,k) * Ayz(i,j,k) * Azz(i,j,k) + & + gupxy(i,j,k) *(Axy(i,j,k) * Ayz(i,j,k) + Ayy(i,j,k) * Axz(i,j,k)) + & + gupxz(i,j,k) *(Axy(i,j,k) * Azz(i,j,k) + Ayz(i,j,k) * Axz(i,j,k)) + & + gupyz(i,j,k) *(Ayy(i,j,k) * Azz(i,j,k) + Ayz(i,j,k) * Ayz(i,j,k)) + + betas = betax(i,j,k)*slx(i,j,k)+betay(i,j,k)*sly(i,j,k)+betaz(i,j,k)*slz(i,j,k) + fxx = trK(i,j,k)+TWO*TZ(i,j,k) + fxy = fxx*Axy(i,j,k)-TWO*AAxy + fxz = fxx*Axz(i,j,k)-TWO*AAxz + fyy = fxx*Ayy(i,j,k)-TWO*AAyy + fyz = fxx*Ayz(i,j,k)-TWO*AAyz + fzz = fxx*Azz(i,j,k)-TWO*AAzz + fxx = fxx*Axx(i,j,k)-TWO*AAxx + + muL = 2.d0/alpn1(i,j,k) + tmuSL = chin1(i,j,k)*2.d0/dsqrt(3.d0)/alpn1(i,j,k)**2 + tmuST = chin1(i,j,k)/alpn1(i,j,k)**2 +! Eq.(17) + totrK_rhs = (betax(i,j,k)*Kx+betay(i,j,k)*Ky+betaz(i,j,k)*Kz) & + -dsqrt(muL)*alpn1(i,j,k)*(vx(i,j,k)*Kx+vy(i,j,k)*Ky+vz(i,j,k)*Kz+trK(i,j,k)/R(k)) +#if 0 + -0.5d0*(qupxx(i,j,k)*Lapxx+qupyy(i,j,k)*Lapyy+qupzz(i,j,k)*Lapzz+ & + TWO*(qupxy(i,j,k)*Lapxy+qupxz(i,j,k)*Lapxz+qupyz(i,j,k)*Lapyz)) & + -trK(i,j,k)/R(k)*betas & + -0.5d0*alpn1(i,j,k)*(gupxx(i,j,k)*AAxx+gupyy(i,j,k)*AAyy+gupzz(i,j,k)*AAzz+ & + TWO*(gupxy(i,j,k)*AAxy+gupxz(i,j,k)*AAxz+gupyz(i,j,k)*AAyz)+(trK(i,j,k)+TWO*TZ(i,j,k))**2/3.d0 & + +kappa1*(ONE-kappa2)*TZ(i,j,k))+(ONE+betas/dsqrt(muL)/alpn1(i,j,k))/R(k)*(vx(i,j,k)*Lapx+vy(i,j,k)*Lapy+vz(i,j,k)*Lapz) & + +ha/R(k)**4-kappa3*alpn1(i,j,k)*trK(i,j,k) +#endif + +! Eq.(18) + toGams_rhs = -alpn1(i,j,k)*dsqrt(tmuSL)*(Gamxx+Gamyy+Gamzz) + ( & + slx(i,j,k)*(qupxx(i,j,k)*sfxxx+qupyy(i,j,k)*sfxyy+qupzz(i,j,k)*sfxzz+TWO*(qupxy(i,j,k)*sfxxy+qupxz(i,j,k)*sfxxz+qupyz(i,j,k)*sfxyz)) & + +sly(i,j,k)*(qupxx(i,j,k)*sfyxx+qupyy(i,j,k)*sfyyy+qupzz(i,j,k)*sfyzz+TWO*(qupxy(i,j,k)*sfyxy+qupxz(i,j,k)*sfyxz+qupyz(i,j,k)*sfyyz)) & + +slz(i,j,k)*(qupxx(i,j,k)*sfzxx+qupyy(i,j,k)*sfzyy+qupzz(i,j,k)*sfzzz+TWO*(qupxy(i,j,k)*sfzxy+qupxz(i,j,k)*sfzxz+qupyz(i,j,k)*sfzyz)) ) & + /chin1(i,j,k) - ( & + vx(i,j,k)*(qulxx(i,j,k)*sfxxx+qulxy(i,j,k)*sfxxy+qulxz(i,j,k)*sfxxz+ & + qulxy(i,j,k)*sfyxx+qulyy(i,j,k)*sfyxy+qulyz(i,j,k)*sfyxz+ & + qulxz(i,j,k)*sfzxx+qulyz(i,j,k)*sfzxy+qulzz(i,j,k)*sfzxz) & + +vy(i,j,k)*(qulxx(i,j,k)*sfxxy+qulxy(i,j,k)*sfxyy+qulxz(i,j,k)*sfxyz+ & + qulxy(i,j,k)*sfyxy+qulyy(i,j,k)*sfyyy+qulyz(i,j,k)*sfyyz+ & + qulxz(i,j,k)*sfzxy+qulyz(i,j,k)*sfzyy+qulzz(i,j,k)*sfzyz) & + +vz(i,j,k)*(qulxx(i,j,k)*sfxxz+qulxy(i,j,k)*sfxyz+qulxz(i,j,k)*sfxzz+ & + qulxy(i,j,k)*sfyxz+qulyy(i,j,k)*sfyyz+qulyz(i,j,k)*sfyzz+ & + qulxz(i,j,k)*sfzxz+qulyz(i,j,k)*sfzyz+qulzz(i,j,k)*sfzzz) )/chin1(i,j,k) & + -4.d0*alpn1(i,j,k)*dsqrt(muL)/3.d0/(dsqrt(tmuSL)+dsqrt(muL))/chin1(i,j,k)*(vx(i,j,k)*Kx+vy(i,j,k)*Ky+vz(i,j,k)*Kz) & + -2.d0*alpn1(i,j,k)/3.d0/(dsqrt(tmuSL)+ONE)/chin1(i,j,k)*(vx(i,j,k)*TZx+vy(i,j,k)*TZy+vz(i,j,k)*TZz) & + +thbs-kappa3*alpn1(i,j,k)*(slx(i,j,k)*Gamx(i,j,k)+sly(i,j,k)*Gamy(i,j,k)+slz(i,j,k)*Gamz(i,j,k)) & + +(slx(i,j,k)*(betax(i,j,k)*Gamxx+betay(i,j,k)*Gamxy+betaz(i,j,k)*Gamxz) & + +sly(i,j,k)*(betax(i,j,k)*Gamyx+betay(i,j,k)*Gamyy+betaz(i,j,k)*Gamyz) & + +slz(i,j,k)*(betax(i,j,k)*Gamzx+betay(i,j,k)*Gamzy+betaz(i,j,k)*Gamzz)) + + toTZ_rhs = -alpn1(i,j,k)*(vx(i,j,k)*TZx+vy(i,j,k)*TZy+vz(i,j,k)*TZz)+(betax(i,j,k)*TZx+betay(i,j,k)*TZy+betaz(i,j,k)*TZz) + + toAss_rhs = -alpn1(i,j,k)*chin1(i,j,k)*( & + TWO*((gupxx(i,j,k)*(Axxx-(Gamxxx*Axx(i,j,k)+Gamyxx*Axy(i,j,k)+Gamzxx*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxx*Axy(i,j,k)+Gamyxx*Ayy(i,j,k)+Gamzxx*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxx*Axz(i,j,k)+Gamyxx*Ayz(i,j,k)+Gamzxx*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + - (Gamxa*Axx(i,j,k)+Gamya*Axy(i,j,k)+Gamza*Axz(i,j,k)) )*vx(i,j,k) & + + (gupxx(i,j,k)*(Axyx-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxyy*Axx(i,j,k)+Gamyyy*Axy(i,j,k)+Gamzyy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayyy-(Gamxyy*Axy(i,j,k)+Gamyyy*Ayy(i,j,k)+Gamzyy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyy*Axz(i,j,k)+Gamyyy*Ayz(i,j,k)+Gamzyy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + - (Gamxa*Axy(i,j,k)+Gamya*Ayy(i,j,k)+Gamza*Ayz(i,j,k)) )*vy(i,j,k) & + + (gupxx(i,j,k)*(Axzx-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayzy-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxzz*Axx(i,j,k)+Gamyzz*Axy(i,j,k)+Gamzzz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxzz*Axy(i,j,k)+Gamyzz*Ayy(i,j,k)+Gamzzz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Azzz-(Gamxzz*Axz(i,j,k)+Gamyzz*Ayz(i,j,k)+Gamzzz*Azz(i,j,k))) & + - (Gamxa*Axz(i,j,k)+Gamya*Ayz(i,j,k)+Gamza*Azz(i,j,k)) )*vz(i,j,k) ) & + -2.d0/3.d0*chin1(i,j,k)*(vx(i,j,k)*(TWO*Kx+TZx)+vy(i,j,k)*(TWO*Ky+TZy)+vz(i,j,k)*(TWO*Kz+TZz)) & + -2.d0/3.d0*(Rxx(i,j,k)*vx(i,j,k)*vx(i,j,k)+Ryy(i,j,k)*vy(i,j,k)*vy(i,j,k)+Rzz(i,j,k)*vz(i,j,k)*vz(i,j,k) & + +TWO*(Rxy(i,j,k)*vx(i,j,k)*vy(i,j,k)+Rxz(i,j,k)*vx(i,j,k)*vz(i,j,k)+Ryz(i,j,k)*vy(i,j,k)*vz(i,j,k))) & + + ONE/3.d0*(Rxx(i,j,k)*qupxx(i,j,k)+Ryy(i,j,k)*qupyy(i,j,k)+Rzz(i,j,k)*qupzz(i,j,k) & + +TWO*(Rxy(i,j,k)*qupxy(i,j,k)+Rxz(i,j,k)*qupxz(i,j,k)+Ryz(i,j,k)*qupyz(i,j,k))) & + +2.d0/3.d0*chin1(i,j,k)*(slx(i,j,k)*vx(i,j,k)*CAZxx+slx(i,j,k)*vy(i,j,k)*CAZxy+slx(i,j,k)*vz(i,j,k)*CAZxz & + +sly(i,j,k)*vx(i,j,k)*CAZyx+sly(i,j,k)*vy(i,j,k)*CAZyy+sly(i,j,k)*vz(i,j,k)*CAZyz & + +slz(i,j,k)*vx(i,j,k)*CAZzx+slz(i,j,k)*vy(i,j,k)*CAZzy+slz(i,j,k)*vz(i,j,k)*CAZzz) & + -ONE/3.d0*chin1(i,j,k)*(qulxx(i,j,k)*CAZxx+qulyx(i,j,k)*CAZxy+qulzx(i,j,k)*CAZxz & + +qulxy(i,j,k)*CAZyx+qulyy(i,j,k)*CAZyy+qulzy(i,j,k)*CAZyz & + +qulxz(i,j,k)*CAZzx+qulyz(i,j,k)*CAZzy+qulzz(i,j,k)*CAZzz) & + -3.d0/chin1(i,j,k)*(vx(i,j,k)*(gupxx(i,j,k)*chix*Axx(i,j,k)+gupxy(i,j,k)*chix*Axy(i,j,k)+gupxz(i,j,k)*chix*Axz(i,j,k) & + +gupxy(i,j,k)*chiy*Axx(i,j,k)+gupyy(i,j,k)*chiy*Axy(i,j,k)+gupyz(i,j,k)*chiy*Axz(i,j,k) & + +gupxz(i,j,k)*chiz*Axx(i,j,k)+gupyz(i,j,k)*chiz*Axy(i,j,k)+gupzz(i,j,k)*chiz*Axz(i,j,k)) & + +vy(i,j,k)*(gupxx(i,j,k)*chix*Axy(i,j,k)+gupxy(i,j,k)*chix*Ayy(i,j,k)+gupxz(i,j,k)*chix*Ayz(i,j,k) & + +gupxy(i,j,k)*chiy*Axy(i,j,k)+gupyy(i,j,k)*chiy*Ayy(i,j,k)+gupyz(i,j,k)*chiy*Ayz(i,j,k) & + +gupxz(i,j,k)*chiz*Axy(i,j,k)+gupyz(i,j,k)*chiz*Ayy(i,j,k)+gupzz(i,j,k)*chiz*Ayz(i,j,k)) & + +vz(i,j,k)*(gupxx(i,j,k)*chix*Axz(i,j,k)+gupxy(i,j,k)*chix*Ayz(i,j,k)+gupxz(i,j,k)*chix*Azz(i,j,k) & + +gupxy(i,j,k)*chiy*Axz(i,j,k)+gupyy(i,j,k)*chiy*Ayz(i,j,k)+gupyz(i,j,k)*chiy*Azz(i,j,k) & + +gupxz(i,j,k)*chiz*Axz(i,j,k)+gupyz(i,j,k)*chiz*Ayz(i,j,k)+gupzz(i,j,k)*chiz*Azz(i,j,k)) ) & + -kappa1*(vx(i,j,k)*Gmxcon(i,j,k)+vy(i,j,k)*Gmycon(i,j,k)+vz(i,j,k)*Gmzcon(i,j,k)) ) & + +alpn1(i,j,k)*(fxx*vx(i,j,k)*vx(i,j,k)+fyy*vy(i,j,k)*vy(i,j,k)+fzz*vz(i,j,k)*vz(i,j,k) & + +TWO*(fxy*vx(i,j,k)*vy(i,j,k)+fxz*vx(i,j,k)*vz(i,j,k)+fyz*vy(i,j,k)*vz(i,j,k))) + +! Eq.(22) + toAs1_rhs = alpn1(i,j,k)*(fxx*vx(i,j,k)*ux(i,j,k)+fxy*vy(i,j,k)*ux(i,j,k)+fxz*vz(i,j,k)*ux(i,j,k) & + +fxy*vx(i,j,k)*uy(i,j,k)+fyy*vy(i,j,k)*uy(i,j,k)+fyz*vz(i,j,k)*uy(i,j,k) & + +fxz*vx(i,j,k)*uz(i,j,k)+fyz*vy(i,j,k)*uz(i,j,k)+fzz*vz(i,j,k)*uz(i,j,k)) + + toAs2_rhs = alpn1(i,j,k)*(fxx*vx(i,j,k)*wx(i,j,k)+fxy*vy(i,j,k)*wx(i,j,k)+fxz*vz(i,j,k)*wx(i,j,k) & + +fxy*vx(i,j,k)*wy(i,j,k)+fyy*vy(i,j,k)*wy(i,j,k)+fyz*vz(i,j,k)*wy(i,j,k) & + +fxz*vx(i,j,k)*wz(i,j,k)+fyz*vy(i,j,k)*wz(i,j,k)+fzz*vz(i,j,k)*wz(i,j,k)) + + fxx = Lapxx - (Gamxxx-((chix+chix)/chin1(i,j,k)-gxx(i,j,k)*gxxx)*HALF)*Lapx - (Gamyxx+gxx(i,j,k)*gxxy*HALF)*Lapy - (Gamzxx+gxx(i,j,k)*gxxz*HALF)*Lapz + fyy = Lapyy - (Gamxyy+gyy(i,j,k)*gxxx*HALF)*Lapx - (Gamyyy-((chiy+chiy)/chin1(i,j,k)-gyy(i,j,k)*gxxy)*HALF)*Lapy - (Gamzyy+gyy(i,j,k)*gxxz*HALF)*Lapz + fzz = Lapzz - (Gamxzz+gzz(i,j,k)*gxxx*HALF)*Lapx - (Gamyzz+gzz(i,j,k)*gxxy*HALF)*Lapy - (Gamzzz-((chiz+chiz)/chin1(i,j,k)-gzz(i,j,k)*gxxz)*HALF)*Lapz + fxy = Lapxy - (Gamxxy-(chiy/chin1(i,j,k)-gxy(i,j,k)*gxxx)*HALF)*Lapx - (Gamyxy-(chix/chin1(i,j,k)-gxy(i,j,k)*gxxy)*HALF)*Lapy& + - (Gamzxy+gxy(i,j,k)*gxxz*HALF)*Lapz + fxz = Lapxz - (Gamxxz-(chiz/chin1(i,j,k)-gxz(i,j,k)*gxxx)*HALF)*Lapx - (Gamyxz+gxz(i,j,k)*gxxy*HALF)*Lapy& + - (Gamzxz-(chix/chin1(i,j,k)-gxz(i,j,k)*gxxz)*HALF)*Lapz + fyz = Lapyz - (Gamxyz+gyz(i,j,k)*gxxx*HALF)*Lapx - (Gamyyz-(chiz/chin1(i,j,k)-gyz(i,j,k)*gxxy)*HALF)*Lapy& + - (Gamzyz-(chiy/chin1(i,j,k)-gyz(i,j,k)*gxxz)*HALF)*Lapz + + TFxx = -chin1(i,j,k)*fxx + TFxy = -chin1(i,j,k)*fxy + TFxz = -chin1(i,j,k)*fxz + TFyy = -chin1(i,j,k)*fyy + TFyz = -chin1(i,j,k)*fyz + TFzz = -chin1(i,j,k)*fzz + toAss_rhs = toAss_rhs -2.d0/3.d0*chin1(i,j,k)*(fxx*vx(i,j,k)*vx(i,j,k)+fyy*vy(i,j,k)*vy(i,j,k)+fzz*vz(i,j,k)*vz(i,j,k) & + +TWO*(fxy*vx(i,j,k)*vy(i,j,k)+fxz*vx(i,j,k)*vz(i,j,k)+fyz*vy(i,j,k)*vz(i,j,k))) & + +ONE/3.d0*chin1(i,j,k)*(fxx*qupxx(i,j,k)+fyy*qupyy(i,j,k)+fzz*qupzz(i,j,k) & + +TWO*(fxy*qupxy(i,j,k)+fxz*qupxz(i,j,k)+fyz*qupyz(i,j,k))) + toAs1_rhs = toAs1_rhs -chin1(i,j,k)*(fxx*vx(i,j,k)*ux(i,j,k)+fxy*vy(i,j,k)*ux(i,j,k)+fxz*vz(i,j,k)*ux(i,j,k) & + +fxy*vx(i,j,k)*uy(i,j,k)+fyy*vy(i,j,k)*uy(i,j,k)+fyz*vz(i,j,k)*uy(i,j,k) & + +fxz*vx(i,j,k)*uz(i,j,k)+fyz*vy(i,j,k)*uz(i,j,k)+fzz*vz(i,j,k)*uz(i,j,k)) + toAs2_rhs = toAs2_rhs -chin1(i,j,k)*(fxx*vx(i,j,k)*wx(i,j,k)+fxy*vy(i,j,k)*wx(i,j,k)+fxz*vz(i,j,k)*wx(i,j,k) & + +fxy*vx(i,j,k)*wy(i,j,k)+fyy*vy(i,j,k)*wy(i,j,k)+fyz*vz(i,j,k)*wy(i,j,k) & + +fxz*vx(i,j,k)*wz(i,j,k)+fyz*vy(i,j,k)*wz(i,j,k)+fzz*vz(i,j,k)*wz(i,j,k)) + + fxx = (betax(i,j,k)*Axxx+betay(i,j,k)*Axxy+betaz(i,j,k)*Axxz)-TWO*(Axx(i,j,k)*sfxx+Axy(i,j,k)*sfyx+Axz(i,j,k)*sfzx) + fxy = (betax(i,j,k)*Axyx+betay(i,j,k)*Axyy+betaz(i,j,k)*Axyz)- & + (Axx(i,j,k)*sfxy+Axy(i,j,k)*sfyy+Axz(i,j,k)*sfzy)-(Axy(i,j,k)*sfxx+Ayy(i,j,k)*sfyx+Ayz(i,j,k)*sfzx) + fxz = (betax(i,j,k)*Axzx+betay(i,j,k)*Axzy+betaz(i,j,k)*Axzz)- & + (Axx(i,j,k)*sfxz+Axy(i,j,k)*sfyz+Axz(i,j,k)*sfzz)-(Axz(i,j,k)*sfxx+Ayz(i,j,k)*sfyx+Azz(i,j,k)*sfzx) + fyy = (betax(i,j,k)*Ayyx+betay(i,j,k)*Ayyy+betaz(i,j,k)*Ayyz)-TWO*(Axy(i,j,k)*sfxy+Ayy(i,j,k)*sfyy+Ayz(i,j,k)*sfzy) + fyz = (betax(i,j,k)*Ayzx+betay(i,j,k)*Ayzy+betaz(i,j,k)*Ayzz)- & + (Axy(i,j,k)*sfxz+Ayy(i,j,k)*sfyz+Ayz(i,j,k)*sfzz)-(Axz(i,j,k)*sfxy+Ayz(i,j,k)*sfyy+Azz(i,j,k)*sfzy) + fzz = (betax(i,j,k)*Azzx+betay(i,j,k)*Azzy+betaz(i,j,k)*Azzz)-TWO*(Axz(i,j,k)*sfxz+Ayz(i,j,k)*sfyz+Azz(i,j,k)*sfzz) + TFxx = TFxx+fxx + TFxy = TFxy+fxy + TFxz = TFxz+fxz + TFyy = TFyy+fyy + TFyz = TFyz+fyz + TFzz = TFzz+fzz + + toAss_rhs = toAss_rhs + (fxx*vx(i,j,k)*vx(i,j,k)+fyy*vy(i,j,k)*vy(i,j,k)+fzz*vz(i,j,k)*vz(i,j,k) & + +TWO*(fxy*vx(i,j,k)*vy(i,j,k)+fxz*vx(i,j,k)*vz(i,j,k)+fyz*vy(i,j,k)*vz(i,j,k))) + toAs1_rhs = toAs1_rhs +(fxx*vx(i,j,k)*ux(i,j,k)+fxy*vy(i,j,k)*ux(i,j,k)+fxz*vz(i,j,k)*ux(i,j,k) & + + fxy*vx(i,j,k)*uy(i,j,k)+fyy*vy(i,j,k)*uy(i,j,k)+fyz*vz(i,j,k)*uy(i,j,k) & + + fxz*vx(i,j,k)*uz(i,j,k)+fyz*vy(i,j,k)*uz(i,j,k)+fzz*vz(i,j,k)*uz(i,j,k)) + toAs2_rhs = toAs2_rhs +(fxx*vx(i,j,k)*wx(i,j,k)+fxy*vy(i,j,k)*wx(i,j,k)+fxz*vz(i,j,k)*wx(i,j,k) & + + fxy*vx(i,j,k)*wy(i,j,k)+fyy*vy(i,j,k)*wy(i,j,k)+fyz*vz(i,j,k)*wy(i,j,k) & + + fxz*vx(i,j,k)*wz(i,j,k)+fyz*vy(i,j,k)*wz(i,j,k)+fzz*vz(i,j,k)*wz(i,j,k)) + toAs1_rhs = toAs1_rhs-alpn1(i,j,k)*chin1(i,j,k)*( & + (gupxx(i,j,k)*(Axxx-(Gamxxx*Axx(i,j,k)+Gamyxx*Axy(i,j,k)+Gamzxx*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxx*Axy(i,j,k)+Gamyxx*Ayy(i,j,k)+Gamzxx*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxx*Axz(i,j,k)+Gamyxx*Ayz(i,j,k)+Gamzxx*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + - (Gamxa*Axx(i,j,k)+Gamya*Axy(i,j,k)+Gamza*Axz(i,j,k)) )*ux(i,j,k) & + + (gupxx(i,j,k)*(Axyx-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxyy*Axx(i,j,k)+Gamyyy*Axy(i,j,k)+Gamzyy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayyy-(Gamxyy*Axy(i,j,k)+Gamyyy*Ayy(i,j,k)+Gamzyy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyy*Axz(i,j,k)+Gamyyy*Ayz(i,j,k)+Gamzyy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + - (Gamxa*Axy(i,j,k)+Gamya*Ayy(i,j,k)+Gamza*Ayz(i,j,k)) )*uy(i,j,k) & + + (gupxx(i,j,k)*(Axzx-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayzy-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxzz*Axx(i,j,k)+Gamyzz*Axy(i,j,k)+Gamzzz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxzz*Axy(i,j,k)+Gamyzz*Ayy(i,j,k)+Gamzzz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Azzz-(Gamxzz*Axz(i,j,k)+Gamyzz*Ayz(i,j,k)+Gamzzz*Azz(i,j,k))) & + - (Gamxa*Axz(i,j,k)+Gamya*Ayz(i,j,k)+Gamza*Azz(i,j,k)) )*uz(i,j,k) & + -2.d0/3.d0*(Kx*ux(i,j,k)+Ky*uy(i,j,k)+Kz*uz(i,j,k)) & + -ONE/3.d0* (TZx*ux(i,j,k)+TZy*uy(i,j,k)+TZz*uz(i,j,k)) & + -1.5d0/chin1(i,j,k)* & + (ux(i,j,k)*(gupxx(i,j,k)*chix*Axx(i,j,k)+gupxy(i,j,k)*chix*Axy(i,j,k)+gupxz(i,j,k)*chix*Axz(i,j,k) & + +gupxy(i,j,k)*chiy*Axx(i,j,k)+gupyy(i,j,k)*chiy*Axy(i,j,k)+gupyz(i,j,k)*chiy*Axz(i,j,k) & + +gupxz(i,j,k)*chiz*Axx(i,j,k)+gupyz(i,j,k)*chiz*Axy(i,j,k)+gupzz(i,j,k)*chiz*Axz(i,j,k)) & + +uy(i,j,k)*(gupxx(i,j,k)*chix*Axy(i,j,k)+gupxy(i,j,k)*chix*Ayy(i,j,k)+gupxz(i,j,k)*chix*Ayz(i,j,k) & + +gupxy(i,j,k)*chiy*Axy(i,j,k)+gupyy(i,j,k)*chiy*Ayy(i,j,k)+gupyz(i,j,k)*chiy*Ayz(i,j,k) & + +gupxz(i,j,k)*chiz*Axy(i,j,k)+gupyz(i,j,k)*chiz*Ayy(i,j,k)+gupzz(i,j,k)*chiz*Ayz(i,j,k)) & + +uz(i,j,k)*(gupxx(i,j,k)*chix*Axz(i,j,k)+gupxy(i,j,k)*chix*Ayz(i,j,k)+gupxz(i,j,k)*chix*Azz(i,j,k) & + +gupxy(i,j,k)*chiy*Axz(i,j,k)+gupyy(i,j,k)*chiy*Ayz(i,j,k)+gupyz(i,j,k)*chiy*Azz(i,j,k) & + +gupxz(i,j,k)*chiz*Axz(i,j,k)+gupyz(i,j,k)*chiz*Ayz(i,j,k)+gupzz(i,j,k)*chiz*Azz(i,j,k)) ) & + -0.5d0*kappa1*(Gmxcon(i,j,k)*ulx(i,j,k)+Gmycon(i,j,k)*uly(i,j,k)+Gmzcon(i,j,k)*ulz(i,j,k)) & + -(Rxx(i,j,k)*vx(i,j,k)*ux(i,j,k)+Rxy(i,j,k)*vy(i,j,k)*ux(i,j,k)+Rxz(i,j,k)*vz(i,j,k)*ux(i,j,k) & + +Rxy(i,j,k)*vx(i,j,k)*uy(i,j,k)+Ryy(i,j,k)*vy(i,j,k)*uy(i,j,k)+Ryz(i,j,k)*vz(i,j,k)*uy(i,j,k) & + +Rxz(i,j,k)*vx(i,j,k)*uz(i,j,k)+Ryz(i,j,k)*vy(i,j,k)*uz(i,j,k)+Rzz(i,j,k)*vz(i,j,k)*uz(i,j,k)) & + +0.5d0*chin1(i,j,k)*(ulx(i,j,k)*vx(i,j,k)*CAZxx+ulx(i,j,k)*vy(i,j,k)*CAZxy+ulx(i,j,k)*vz(i,j,k)*CAZxz & + +uly(i,j,k)*vx(i,j,k)*CAZyx+uly(i,j,k)*vy(i,j,k)*CAZyy+uly(i,j,k)*vz(i,j,k)*CAZyz & + +ulz(i,j,k)*vx(i,j,k)*CAZzx+ulz(i,j,k)*vy(i,j,k)*CAZzy+ulz(i,j,k)*vz(i,j,k)*CAZzz)) + toAs2_rhs = toAs2_rhs-alpn1(i,j,k)*chin1(i,j,k)*( & + (gupxx(i,j,k)*(Axxx-(Gamxxx*Axx(i,j,k)+Gamyxx*Axy(i,j,k)+Gamzxx*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxx*Axy(i,j,k)+Gamyxx*Ayy(i,j,k)+Gamzxx*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxx*Axz(i,j,k)+Gamyxx*Ayz(i,j,k)+Gamzxx*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axxy-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axxz-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Axyz-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + - (Gamxa*Axx(i,j,k)+Gamya*Axy(i,j,k)+Gamza*Axz(i,j,k)) )*wx(i,j,k) & + + (gupxx(i,j,k)*(Axyx-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axyy-(Gamxyy*Axx(i,j,k)+Gamyyy*Axy(i,j,k)+Gamzyy*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayyy-(Gamxyy*Axy(i,j,k)+Gamyyy*Ayy(i,j,k)+Gamzyy*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyy*Axz(i,j,k)+Gamyyy*Ayz(i,j,k)+Gamzyy*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axyz-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayyz-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + - (Gamxa*Axy(i,j,k)+Gamya*Ayy(i,j,k)+Gamza*Ayz(i,j,k)) )*wy(i,j,k) & + + (gupxx(i,j,k)*(Axzx-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k))) & + + gupxy(i,j,k)*(Axzy-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k))) & + + gupyy(i,j,k)*(Ayzy-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k))) & + + gupxz(i,j,k)*(Axzz-(Gamxzz*Axx(i,j,k)+Gamyzz*Axy(i,j,k)+Gamzzz*Axz(i,j,k))) & + + gupyz(i,j,k)*(Ayzz-(Gamxzz*Axy(i,j,k)+Gamyzz*Ayy(i,j,k)+Gamzzz*Ayz(i,j,k))) & + + gupzz(i,j,k)*(Azzz-(Gamxzz*Axz(i,j,k)+Gamyzz*Ayz(i,j,k)+Gamzzz*Azz(i,j,k))) & + - (Gamxa*Axz(i,j,k)+Gamya*Ayz(i,j,k)+Gamza*Azz(i,j,k)) )*wz(i,j,k) & + -2.d0/3.d0*(Kx*wx(i,j,k)+ky*wy(i,j,k)+Kz*wz(i,j,k)) & + -ONE/3.d0* (TZx*wx(i,j,k)+TZy*wy(i,j,k)+TZz*wz(i,j,k)) & + -1.5d0/chin1(i,j,k)* & + (wx(i,j,k)*(gupxx(i,j,k)*chix*Axx(i,j,k)+gupxy(i,j,k)*chix*Axy(i,j,k)+gupxz(i,j,k)*chix*Axz(i,j,k) & + +gupxy(i,j,k)*chiy*Axx(i,j,k)+gupyy(i,j,k)*chiy*Axy(i,j,k)+gupyz(i,j,k)*chiy*Axz(i,j,k) & + +gupxz(i,j,k)*chiz*Axx(i,j,k)+gupyz(i,j,k)*chiz*Axy(i,j,k)+gupzz(i,j,k)*chiz*Axz(i,j,k)) & + +wy(i,j,k)*(gupxx(i,j,k)*chix*Axy(i,j,k)+gupxy(i,j,k)*chix*Ayy(i,j,k)+gupxz(i,j,k)*chix*Ayz(i,j,k) & + +gupxy(i,j,k)*chiy*Axy(i,j,k)+gupyy(i,j,k)*chiy*Ayy(i,j,k)+gupyz(i,j,k)*chiy*Ayz(i,j,k) & + +gupxz(i,j,k)*chiz*Axy(i,j,k)+gupyz(i,j,k)*chiz*Ayy(i,j,k)+gupzz(i,j,k)*chiz*Ayz(i,j,k)) & + +wz(i,j,k)*(gupxx(i,j,k)*chix*Axz(i,j,k)+gupxy(i,j,k)*chix*Ayz(i,j,k)+gupxz(i,j,k)*chix*Azz(i,j,k) & + +gupxy(i,j,k)*chiy*Axz(i,j,k)+gupyy(i,j,k)*chiy*Ayz(i,j,k)+gupyz(i,j,k)*chiy*Azz(i,j,k) & + +gupxz(i,j,k)*chiz*Axz(i,j,k)+gupyz(i,j,k)*chiz*Ayz(i,j,k)+gupzz(i,j,k)*chiz*Azz(i,j,k)) ) & + -0.5d0*kappa1*(Gmxcon(i,j,k)*wlx(i,j,k)+Gmycon(i,j,k)*wly(i,j,k)+Gmzcon(i,j,k)*wlz(i,j,k)) & + -(Rxx(i,j,k)*vx(i,j,k)*wx(i,j,k)+Rxy(i,j,k)*vy(i,j,k)*wx(i,j,k)+Rxz(i,j,k)*vz(i,j,k)*wx(i,j,k) & + +Rxy(i,j,k)*vx(i,j,k)*wy(i,j,k)+Ryy(i,j,k)*vy(i,j,k)*wy(i,j,k)+Ryz(i,j,k)*vz(i,j,k)*wy(i,j,k) & + +Rxz(i,j,k)*vx(i,j,k)*wz(i,j,k)+Ryz(i,j,k)*vy(i,j,k)*wz(i,j,k)+Rzz(i,j,k)*vz(i,j,k)*wz(i,j,k)) & + +0.5d0*chin1(i,j,k)*(wlx(i,j,k)*vx(i,j,k)*CAZxx+wlx(i,j,k)*vy(i,j,k)*CAZxy+wlx(i,j,k)*vz(i,j,k)*CAZxz & + +wly(i,j,k)*vx(i,j,k)*CAZyx+wly(i,j,k)*vy(i,j,k)*CAZyy+wly(i,j,k)*vz(i,j,k)*CAZyz & + +wlz(i,j,k)*vx(i,j,k)*CAZzx+wlz(i,j,k)*vy(i,j,k)*CAZzy+wlz(i,j,k)*vz(i,j,k)*CAZzz)) + + toGam1_rhs = -alpn1(i,j,k)*dsqrt(tmuST)*((Gamxx*vx(i,j,k)*ulx(i,j,k)+Gamxy*vy(i,j,k)*ulx(i,j,k)+Gamxz*vz(i,j,k)*ulx(i,j,k) & + +Gamyx*vx(i,j,k)*uly(i,j,k)+Gamyy*vy(i,j,k)*uly(i,j,k)+Gamyz*vz(i,j,k)*uly(i,j,k) & + +Gamzx*vx(i,j,k)*ulz(i,j,k)+Gamzy*vy(i,j,k)*ulz(i,j,k)+Gamzz*vz(i,j,k)*ulz(i,j,k)) & + -(Gamxx*ux(i,j,k)*slx(i,j,k)+Gamxy*uy(i,j,k)*slx(i,j,k)+Gamxz*uz(i,j,k)*slx(i,j,k) & + +Gamyx*ux(i,j,k)*sly(i,j,k)+Gamyy*uy(i,j,k)*sly(i,j,k)+Gamyz*uz(i,j,k)*sly(i,j,k) & + +Gamzx*ux(i,j,k)*slz(i,j,k)+Gamzy*uy(i,j,k)*slz(i,j,k)+Gamzz*uz(i,j,k)*slz(i,j,k))/chin1(i,j,k) ) & + +((qupxx(i,j,k)*sfxxx+qupxx(i,j,k)*sfxxx+qupxx(i,j,k)*sfxxx & + +TWO*(qupxy(i,j,k)*sfxxy+qupxz(i,j,k)*sfxxz+qupyz(i,j,k)*sfxyz))*ulx(i,j,k) & + +(qupxx(i,j,k)*sfyxx+qupxx(i,j,k)*sfyxx+qupxx(i,j,k)*sfyxx & + +TWO*(qupxy(i,j,k)*sfyxy+qupxz(i,j,k)*sfyxz+qupyz(i,j,k)*sfyyz))*uly(i,j,k) & + +(qupxx(i,j,k)*sfzxx+qupxx(i,j,k)*sfzxx+qupxx(i,j,k)*sfzxx & + +TWO*(qupxy(i,j,k)*sfzxy+qupxz(i,j,k)*sfzxz+qupyz(i,j,k)*sfzyz))*ulz(i,j,k) & + )/chin1(i,j,k) & + +4.d0/3.d0/chin1(i,j,k)*(ux(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxx+vx(i,j,k)*sly(i,j,k)*sfyxx+vx(i,j,k)*slz(i,j,k)*sfzxx & + +vy(i,j,k)*slx(i,j,k)*sfxxy+vy(i,j,k)*sly(i,j,k)*sfyxy+vy(i,j,k)*slz(i,j,k)*sfzxy & + +vz(i,j,k)*slx(i,j,k)*sfxxz+vz(i,j,k)*sly(i,j,k)*sfyxz+vz(i,j,k)*slz(i,j,k)*sfzxz) & + +uy(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxy+vx(i,j,k)*sly(i,j,k)*sfyxy+vx(i,j,k)*slz(i,j,k)*sfzxy & + +vy(i,j,k)*slx(i,j,k)*sfxyy+vy(i,j,k)*sly(i,j,k)*sfyyy+vy(i,j,k)*slz(i,j,k)*sfzyy & + +vz(i,j,k)*slx(i,j,k)*sfxyz+vz(i,j,k)*sly(i,j,k)*sfyyz+vz(i,j,k)*slz(i,j,k)*sfzyz) & + +uz(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxz+vx(i,j,k)*sly(i,j,k)*sfyxz+vx(i,j,k)*slz(i,j,k)*sfzxz & + +vy(i,j,k)*slx(i,j,k)*sfxyz+vy(i,j,k)*sly(i,j,k)*sfyyz+vy(i,j,k)*slz(i,j,k)*sfzyz & + +vz(i,j,k)*slx(i,j,k)*sfxzz+vz(i,j,k)*sly(i,j,k)*sfyzz+vz(i,j,k)*slz(i,j,k)*sfzzz)) & + +ONE/3.d0/chin1(i,j,k)* (ux(i,j,k)*(qulxx(i,j,k)*sfxxx+qulxy(i,j,k)*sfyxx+qulxz(i,j,k)*sfzxx & + +qulyx(i,j,k)*sfxxy+qulyy(i,j,k)*sfyxy+qulyz(i,j,k)*sfzxy & + +qulzx(i,j,k)*sfxxz+qulzy(i,j,k)*sfyxz+qulzz(i,j,k)*sfzxz) & + +uy(i,j,k)*(qulxx(i,j,k)*sfxxy+qulxy(i,j,k)*sfyxy+qulxz(i,j,k)*sfzxy & + +qulyx(i,j,k)*sfxyy+qulyy(i,j,k)*sfyyy+qulyz(i,j,k)*sfzyy & + +qulzx(i,j,k)*sfxyz+qulzy(i,j,k)*sfyyz+qulzz(i,j,k)*sfzyz) & + +uz(i,j,k)*(qulxx(i,j,k)*sfxxz+qulxy(i,j,k)*sfyxz+qulxz(i,j,k)*sfzxz & + +qulyx(i,j,k)*sfxyz+qulyy(i,j,k)*sfyyz+qulyz(i,j,k)*sfzyz & + +qulzx(i,j,k)*sfxzz+qulzy(i,j,k)*sfyzz+qulzz(i,j,k)*sfzzz)) & + -2.d0/3.d0*alpn1(i,j,k)/chin1(i,j,k)*(ux(i,j,k)*(TWO*Kx+TZx)+uy(i,j,k)*(TWO*Ky+TZy)+uz(i,j,k)*(TWO*Kz+TZz)) & + +hu-kappa3*alpn1(i,j,k)*(Gamx(i,j,k)*ulx(i,j,k)+Gamx(i,j,k)*uly(i,j,k)+Gamz(i,j,k)*ulz(i,j,k)) & + +(betax(i,j,k)*Gamxx+betay(i,j,k)*Gamxy+betaz(i,j,k)*Gamxz)*ulx(i,j,k) & + +(betax(i,j,k)*Gamyx+betay(i,j,k)*Gamyy+betaz(i,j,k)*Gamyz)*uly(i,j,k) & + +(betax(i,j,k)*Gamzx+betay(i,j,k)*Gamzy+betaz(i,j,k)*Gamzz)*ulz(i,j,k) + + toGam2_rhs = -alpn1(i,j,k)*dsqrt(tmuST)*((Gamxx*vx(i,j,k)*wlx(i,j,k)+Gamxy*vy(i,j,k)*wlx(i,j,k)+Gamxz*vz(i,j,k)*wlx(i,j,k) & + +Gamyx*vx(i,j,k)*wly(i,j,k)+Gamyy*vy(i,j,k)*wly(i,j,k)+Gamyz*vz(i,j,k)*wly(i,j,k) & + +Gamzx*vx(i,j,k)*wlz(i,j,k)+Gamzy*vy(i,j,k)*wlz(i,j,k)+Gamzz*vz(i,j,k)*wlz(i,j,k)) & + -(Gamxx*wx(i,j,k)*slx(i,j,k)+Gamxy*wy(i,j,k)*slx(i,j,k)+Gamxz*wz(i,j,k)*slx(i,j,k) & + +Gamyx*wx(i,j,k)*sly(i,j,k)+Gamyy*wy(i,j,k)*sly(i,j,k)+Gamyz*wz(i,j,k)*sly(i,j,k) & + +Gamzx*wx(i,j,k)*slz(i,j,k)+Gamzy*wy(i,j,k)*slz(i,j,k)+Gamzz*wz(i,j,k)*slz(i,j,k))/chin1(i,j,k) ) & + +((qupxx(i,j,k)*sfxxx+qupxx(i,j,k)*sfxxx+qupxx(i,j,k)*sfxxx & + +TWO*(qupxy(i,j,k)*sfxxy+qupxz(i,j,k)*sfxxz+qupyz(i,j,k)*sfxyz))*wlx(i,j,k) & + +(qupxx(i,j,k)*sfyxx+qupxx(i,j,k)*sfyxx+qupxx(i,j,k)*sfyxx & + +TWO*(qupxy(i,j,k)*sfyxy+qupxz(i,j,k)*sfyxz+qupyz(i,j,k)*sfyyz))*wly(i,j,k) & + +(qupxx(i,j,k)*sfzxx+qupxx(i,j,k)*sfzxx+qupxx(i,j,k)*sfzxx & + +TWO*(qupxy(i,j,k)*sfzxy+qupxz(i,j,k)*sfzxz+qupyz(i,j,k)*sfzyz))*wlz(i,j,k) & + )/chin1(i,j,k) & + +4.d0/3.d0/chin1(i,j,k)*(wx(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxx+vx(i,j,k)*sly(i,j,k)*sfyxx+vx(i,j,k)*slz(i,j,k)*sfzxx & + +vy(i,j,k)*slx(i,j,k)*sfxxy+vy(i,j,k)*sly(i,j,k)*sfyxy+vy(i,j,k)*slz(i,j,k)*sfzxy & + +vz(i,j,k)*slx(i,j,k)*sfxxz+vz(i,j,k)*sly(i,j,k)*sfyxz+vz(i,j,k)*slz(i,j,k)*sfzxz) & + +wy(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxy+vx(i,j,k)*sly(i,j,k)*sfyxy+vx(i,j,k)*slz(i,j,k)*sfzxy & + +vy(i,j,k)*slx(i,j,k)*sfxyy+vy(i,j,k)*sly(i,j,k)*sfyyy+vy(i,j,k)*slz(i,j,k)*sfzyy & + +vz(i,j,k)*slx(i,j,k)*sfxyz+vz(i,j,k)*sly(i,j,k)*sfyyz+vz(i,j,k)*slz(i,j,k)*sfzyz) & + +wz(i,j,k)*(vx(i,j,k)*slx(i,j,k)*sfxxz+vx(i,j,k)*sly(i,j,k)*sfyxz+vx(i,j,k)*slz(i,j,k)*sfzxz & + +vy(i,j,k)*slx(i,j,k)*sfxyz+vy(i,j,k)*sly(i,j,k)*sfyyz+vy(i,j,k)*slz(i,j,k)*sfzyz & + +vz(i,j,k)*slx(i,j,k)*sfxzz+vz(i,j,k)*sly(i,j,k)*sfyzz+vz(i,j,k)*slz(i,j,k)*sfzzz)) & + +ONE/3.d0/chin1(i,j,k)* (wx(i,j,k)*(qulxx(i,j,k)*sfxxx+qulxy(i,j,k)*sfyxx+qulxz(i,j,k)*sfzxx & + +qulyx(i,j,k)*sfxxy+qulyy(i,j,k)*sfyxy+qulyz(i,j,k)*sfzxy & + +qulzx(i,j,k)*sfxxz+qulzy(i,j,k)*sfyxz+qulzz(i,j,k)*sfzxz) & + +wy(i,j,k)*(qulxx(i,j,k)*sfxxy+qulxy(i,j,k)*sfyxy+qulxz(i,j,k)*sfzxy & + +qulyx(i,j,k)*sfxyy+qulyy(i,j,k)*sfyyy+qulyz(i,j,k)*sfzyy & + +qulzx(i,j,k)*sfxyz+qulzy(i,j,k)*sfyyz+qulzz(i,j,k)*sfzyz) & + +wz(i,j,k)*(qulxx(i,j,k)*sfxxz+qulxy(i,j,k)*sfyxz+qulxz(i,j,k)*sfzxz & + +qulyx(i,j,k)*sfxyz+qulyy(i,j,k)*sfyyz+qulyz(i,j,k)*sfzyz & + +qulzx(i,j,k)*sfxzz+qulzy(i,j,k)*sfyzz+qulzz(i,j,k)*sfzzz)) & + -2.d0/3.d0*alpn1(i,j,k)/chin1(i,j,k)*(wx(i,j,k)*(TWO*Kx+TZx)+wy(i,j,k)*(TWO*Ky+TZy)+wz(i,j,k)*(TWO*Kz+TZz)) & + +hw-kappa3*alpn1(i,j,k)*(Gamx(i,j,k)*wlx(i,j,k)+Gamx(i,j,k)*wly(i,j,k)+Gamz(i,j,k)*wlz(i,j,k)) & + +(betax(i,j,k)*Gamxx+betay(i,j,k)*Gamxy+betaz(i,j,k)*Gamxz)*wlx(i,j,k) & + +(betax(i,j,k)*Gamyx+betay(i,j,k)*Gamyy+betaz(i,j,k)*Gamyz)*wly(i,j,k) & + +(betax(i,j,k)*Gamzx+betay(i,j,k)*Gamzy+betaz(i,j,k)*Gamzz)*wlz(i,j,k) + +! \tilde{D} A_ij + gxxx = Axxx-TWO*(Gamxxx*Axx(i,j,k)+Gamyxx*Axy(i,j,k)+Gamzxx*Axz(i,j,k)) + gxxy = Axxy-TWO*(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k)) + gxxz = Axxz-TWO*(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k)) + gyyx = Ayyx-TWO*(Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k)) + gyyy = Ayyy-TWO*(Gamxyy*Axy(i,j,k)+Gamyyy*Ayy(i,j,k)+Gamzyy*Ayz(i,j,k)) + gyyz = Ayyz-TWO*(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k)) + gzzx = Azzx-TWO*(Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k)) + gzzy = Azzy-TWO*(Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k)) + gzzz = Azzz-TWO*(Gamxzz*Axz(i,j,k)+Gamyzz*Ayz(i,j,k)+Gamzzz*Azz(i,j,k)) + gxyx = Axyx-(Gamxxy*Axx(i,j,k)+Gamyxy*Axy(i,j,k)+Gamzxy*Axz(i,j,k)+Gamxxx*Axy(i,j,k)+Gamyxx*Ayy(i,j,k)+Gamzxx*Ayz(i,j,k)) + gxyy = Axyy-(Gamxyy*Axx(i,j,k)+Gamyyy*Axy(i,j,k)+Gamzyy*Axz(i,j,k)+Gamxxy*Axy(i,j,k)+Gamyxy*Ayy(i,j,k)+Gamzxy*Ayz(i,j,k)) + gxyz = Axyz-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k)+Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k)) + gxzx = Axzx-(Gamxxz*Axx(i,j,k)+Gamyxz*Axy(i,j,k)+Gamzxz*Axz(i,j,k)+Gamxxx*Axz(i,j,k)+Gamyxx*Ayz(i,j,k)+Gamzxx*Azz(i,j,k)) + gxzy = Axzy-(Gamxyz*Axx(i,j,k)+Gamyyz*Axy(i,j,k)+Gamzyz*Axz(i,j,k)+Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k)) + gxzz = Axzz-(Gamxzz*Axx(i,j,k)+Gamyzz*Axy(i,j,k)+Gamzzz*Axz(i,j,k)+Gamxxz*Axz(i,j,k)+Gamyxz*Ayz(i,j,k)+Gamzxz*Azz(i,j,k)) + gyzx = Ayzx-(Gamxxz*Axy(i,j,k)+Gamyxz*Ayy(i,j,k)+Gamzxz*Ayz(i,j,k)+Gamxxy*Axz(i,j,k)+Gamyxy*Ayz(i,j,k)+Gamzxy*Azz(i,j,k)) + gyzy = Ayzy-(Gamxyz*Axy(i,j,k)+Gamyyz*Ayy(i,j,k)+Gamzyz*Ayz(i,j,k)+Gamxyy*Axz(i,j,k)+Gamyyy*Ayz(i,j,k)+Gamzyy*Azz(i,j,k)) + gyzz = Ayzz-(Gamxzz*Axy(i,j,k)+Gamyzz*Ayy(i,j,k)+Gamzzz*Ayz(i,j,k)+Gamxyz*Axz(i,j,k)+Gamyyz*Ayz(i,j,k)+Gamzyz*Azz(i,j,k)) + + f = (trK(i,j,k)+TWO*TZ(i,j,k))*TWO/3.d0 + fxx = (vx(i,j,k)*gxxx + vy(i,j,k)*gxxy + vz(i,j,k)*gxxz & + -(vx(i,j,k)*gxxx + vy(i,j,k)*gxyx + vz(i,j,k)*gxzx)) & + +AAxx-f*Axx(i,j,k) + fyy = (vx(i,j,k)*gyyx + vy(i,j,k)*gyyy + vz(i,j,k)*gyyz & + -(vx(i,j,k)*gxyy + vy(i,j,k)*gyyy + vz(i,j,k)*gyzy)) & + +AAyy-f*Ayy(i,j,k) + fzz = (vx(i,j,k)*gzzx + vy(i,j,k)*gzzy + vz(i,j,k)*gzzz & + -(vx(i,j,k)*gxzz + vy(i,j,k)*gyzz + vz(i,j,k)*gzzz)) & + +AAzz-f*Azz(i,j,k) + fxy = (vx(i,j,k)*gxyx + vy(i,j,k)*gxyy + vz(i,j,k)*gxyz & + -(vx(i,j,k)*gxxy + vy(i,j,k)*gxyy + vz(i,j,k)*gxzy + vx(i,j,k)*gxyx + vy(i,j,k)*gyyx + vz(i,j,k)*gyzx)/TWO) & + +AAxy-f*Axy(i,j,k) + fxz = (vx(i,j,k)*gxzx + vy(i,j,k)*gxzy + vz(i,j,k)*gxzz & + -(vx(i,j,k)*gxxz + vy(i,j,k)*gxyz + vz(i,j,k)*gxzz + vx(i,j,k)*gyzx + vy(i,j,k)*gyzx + vz(i,j,k)*gzzx)/TWO) & + +AAxz-f*Axz(i,j,k) + fyz = (vx(i,j,k)*gyzx + vy(i,j,k)*gyzy + vz(i,j,k)*gyzz & + -(vx(i,j,k)*gxyz + vy(i,j,k)*gyyz + vz(i,j,k)*gyzz + vx(i,j,k)*gyzy + vy(i,j,k)*gyzy + vz(i,j,k)*gzzy)/TWO) & + +AAyz-f*Ayz(i,j,k) + +! 1/2 A_ij D_k(ln chi) + gxxx = Axx(i,j,k)*chix/TWO/chin1(i,j,k) + gxxy = Axx(i,j,k)*chiy/TWO/chin1(i,j,k) + gxxz = Axx(i,j,k)*chiz/TWO/chin1(i,j,k) + gxyx = Axy(i,j,k)*chix/TWO/chin1(i,j,k) + gxyy = Axy(i,j,k)*chiy/TWO/chin1(i,j,k) + gxyz = Axy(i,j,k)*chiz/TWO/chin1(i,j,k) + gxzx = Axz(i,j,k)*chix/TWO/chin1(i,j,k) + gxzy = Axz(i,j,k)*chiy/TWO/chin1(i,j,k) + gxzz = Axz(i,j,k)*chiz/TWO/chin1(i,j,k) + gyyx = Ayy(i,j,k)*chix/TWO/chin1(i,j,k) + gyyy = Ayy(i,j,k)*chiy/TWO/chin1(i,j,k) + gyyz = Ayy(i,j,k)*chiz/TWO/chin1(i,j,k) + gyzx = Ayz(i,j,k)*chix/TWO/chin1(i,j,k) + gyzy = Ayz(i,j,k)*chiy/TWO/chin1(i,j,k) + gyzz = Ayz(i,j,k)*chiz/TWO/chin1(i,j,k) + gzzx = Azz(i,j,k)*chix/TWO/chin1(i,j,k) + gzzy = Azz(i,j,k)*chiy/TWO/chin1(i,j,k) + gzzz = Azz(i,j,k)*chiz/TWO/chin1(i,j,k) + + fxx = fxx - (vx(i,j,k)*gxxx + vy(i,j,k)*gxxy + vz(i,j,k)*gxxz & + -(vx(i,j,k)*gxxx + vy(i,j,k)*gxyx + vz(i,j,k)*gxzx)) + fyy = fyy - (vx(i,j,k)*gyyx + vy(i,j,k)*gyyy + vz(i,j,k)*gyyz & + -(vx(i,j,k)*gxyy + vy(i,j,k)*gyyy + vz(i,j,k)*gyzy)) + fzz = fzz - (vx(i,j,k)*gzzx + vy(i,j,k)*gzzy + vz(i,j,k)*gzzz & + -(vx(i,j,k)*gxzz + vy(i,j,k)*gyzz + vz(i,j,k)*gzzz)) + fxy = fxy - (vx(i,j,k)*gxyx + vy(i,j,k)*gxyy + vz(i,j,k)*gxyz & + -(vx(i,j,k)*gxxy + vy(i,j,k)*gxyy + vz(i,j,k)*gxzy + vx(i,j,k)*gxyx + vy(i,j,k)*gyyx + vz(i,j,k)*gyzx)/TWO) + fxz = fxz - (vx(i,j,k)*gxzx + vy(i,j,k)*gxzy + vz(i,j,k)*gxzz & + -(vx(i,j,k)*gxxz + vy(i,j,k)*gxyz + vz(i,j,k)*gxzz + vx(i,j,k)*gyzx + vy(i,j,k)*gyzx + vz(i,j,k)*gzzx)/TWO) + fyz = fyz - (vx(i,j,k)*gyzx + vy(i,j,k)*gyzy + vz(i,j,k)*gyzz & + -(vx(i,j,k)*gxyz + vy(i,j,k)*gyyz + vz(i,j,k)*gyzz + vx(i,j,k)*gyzy + vy(i,j,k)*gyzy + vz(i,j,k)*gzzy)/TWO) + + TFxx = TFxx-alpn1(i,j,k)*fxx + TFxy = TFxy-alpn1(i,j,k)*fxy + TFxz = TFxz-alpn1(i,j,k)*fxz + TFyy = TFyy-alpn1(i,j,k)*fyy + TFyz = TFyz-alpn1(i,j,k)*fyz + TFzz = TFzz-alpn1(i,j,k)*fzz + + f = 0.5d0*(qupxx(i,j,k)*TFxx+qupyy(i,j,k)*TFyy+qupzz(i,j,k)*TFzz & + +TWO*(qupxy(i,j,k)*TFxy+qupxz(i,j,k)*TFxz+qupyz(i,j,k)*TFyz)) + + toA11_rhs = ux(i,j,k)*ux(i,j,k)*TFxx+uy(i,j,k)*uy(i,j,k)*TFyy+uz(i,j,k)*uz(i,j,k)*TFzz+ & + TWO*(ux(i,j,k)*uy(i,j,k)*TFxy+ux(i,j,k)*uz(i,j,k)*TFxz+uy(i,j,k)*uz(i,j,k)*TFyz)-f + toA22_rhs = wx(i,j,k)*wx(i,j,k)*TFxx+wy(i,j,k)*wy(i,j,k)*TFyy+wz(i,j,k)*wz(i,j,k)*TFzz+ & + TWO*(wx(i,j,k)*wy(i,j,k)*TFxy+wx(i,j,k)*wz(i,j,k)*TFxz+wy(i,j,k)*wz(i,j,k)*TFyz)-f + toA12_rhs = ux(i,j,k)*wx(i,j,k)*TFxx+ux(i,j,k)*wy(i,j,k)*TFxy+ux(i,j,k)*wz(i,j,k)*TFxz & + +uy(i,j,k)*wx(i,j,k)*TFxy+uy(i,j,k)*wy(i,j,k)*TFyy+uy(i,j,k)*wz(i,j,k)*TFyz & + +uz(i,j,k)*wx(i,j,k)*TFxz+uz(i,j,k)*wy(i,j,k)*TFyz+uz(i,j,k)*wz(i,j,k)*TFzz + + toA11_rhs = toA11_rhs +alpn1(i,j,k)*chin1(i,j,k)*Rhpsi0 + toA22_rhs = toA22_rhs -alpn1(i,j,k)*chin1(i,j,k)*Rhpsi0 + toA12_rhs = toA12_rhs +alpn1(i,j,k)*chin1(i,j,k)*Ihpsi0 + +#if 0 + toAqq_rhs = qupxx(i,j,k)*Axx_rhs(i,j,k)+qupyy(i,j,k)*Ayy_rhs(i,j,k)+qupzz(i,j,k)*Azz_rhs(i,j,k) & + +TWO*(qupxy(i,j,k)*Axy_rhs(i,j,k)+qupxz(i,j,k)*Axz_rhs(i,j,k)+qupyz(i,j,k)*Ayz_rhs(i,j,k)) +#else + Ainvxx = gupxx(i,j,k)*gupxx(i,j,k)*Axx(i,j,k)+2.0*gupxx(i,j,k)*gupxy(i,j,k)*Axy(i,j,k)+ & + 2.0*gupxx(i,j,k)*gupxz(i,j,k)*Axz(i,j,k)+gupxy(i,j,k)*gupxy(i,j,k)*Ayy(i,j,k)+ & + 2.0*gupxy(i,j,k)*gupxz(i,j,k)*Ayz(i,j,k)+gupxz(i,j,k)*gupxz(i,j,k)*Azz(i,j,k) + + Ainvxy = gupxx(i,j,k)*gupxy(i,j,k)*Axx(i,j,k)+gupxx(i,j,k)*gupyy(i,j,k)*Axy(i,j,k)+ & + gupxx(i,j,k)*gupyz(i,j,k)*Axz(i,j,k)+gupxy(i,j,k)*gupxy(i,j,k)*Axy(i,j,k)+ & + gupxy(i,j,k)*gupyy(i,j,k)*Ayy(i,j,k)+gupxy(i,j,k)*gupyz(i,j,k)*Ayz(i,j,k)+ & + gupxz(i,j,k)*gupxy(i,j,k)*Axz(i,j,k)+gupxz(i,j,k)*gupyy(i,j,k)*Ayz(i,j,k)+gupxz(i,j,k)*gupyz(i,j,k)*Azz(i,j,k) + + Ainvxz = gupxx(i,j,k)*gupxz(i,j,k)*Axx(i,j,k)+gupxx(i,j,k)*gupyz(i,j,k)*Axy(i,j,k)+ & + gupxx(i,j,k)*gupzz(i,j,k)*Axz(i,j,k)+gupxy(i,j,k)*gupxz(i,j,k)*Axy(i,j,k)+ & + gupxy(i,j,k)*gupyz(i,j,k)*Ayy(i,j,k)+gupxy(i,j,k)*gupzz(i,j,k)*Ayz(i,j,k)+ & + gupxz(i,j,k)*gupxz(i,j,k)*Axz(i,j,k)+gupxz(i,j,k)*gupyz(i,j,k)*Ayz(i,j,k)+gupxz(i,j,k)*gupzz(i,j,k)*Azz(i,j,k) + Ainvyy = gupxy(i,j,k)*gupxy(i,j,k)*Axx(i,j,k)+2.0*gupxy(i,j,k)*gupyy(i,j,k)*Axy(i,j,k)+ & + 2.0*gupxy(i,j,k)*gupyz(i,j,k)*Axz(i,j,k)+gupyy(i,j,k)*gupyy(i,j,k)*Ayy(i,j,k)+ & + 2.0*gupyy(i,j,k)*gupyz(i,j,k)*Ayz(i,j,k)+gupyz(i,j,k)*gupyz(i,j,k)*Azz(i,j,k) + + Ainvyz = gupxy(i,j,k)*gupxz(i,j,k)*Axx(i,j,k)+gupxy(i,j,k)*gupyz(i,j,k)*Axy(i,j,k)+ & + gupxy(i,j,k)*gupzz(i,j,k)*Axz(i,j,k)+gupyy(i,j,k)*gupxz(i,j,k)*Axy(i,j,k)+ & + gupyy(i,j,k)*gupyz(i,j,k)*Ayy(i,j,k)+gupyy(i,j,k)*gupzz(i,j,k)*Ayz(i,j,k)+ & + gupyz(i,j,k)*gupxz(i,j,k)*Axz(i,j,k)+gupyz(i,j,k)*gupyz(i,j,k)*Ayz(i,j,k)+gupyz(i,j,k)*gupzz(i,j,k)*Azz(i,j,k) + Ainvzz = gupxz(i,j,k)*gupxz(i,j,k)*Axx(i,j,k)+2.0*gupxz(i,j,k)*gupyz(i,j,k)*Axy(i,j,k)+ & + 2.0*gupxz(i,j,k)*gupzz(i,j,k)*Axz(i,j,k)+gupyz(i,j,k)*gupyz(i,j,k)*Ayy(i,j,k)+ & + 2.0*gupyz(i,j,k)*gupzz(i,j,k)*Ayz(i,j,k)+gupzz(i,j,k)*gupzz(i,j,k)*Azz(i,j,k) + + toAqq_rhs = -TWO*alpn1(i,j,k)*chin1(i,j,k)*(gupxx(i,j,k)*AAxx+gupyy(i,j,k)*AAyy+gupzz(i,j,k)*AAzz & + +TWO*(gupxy(i,j,k)*AAxy+gupxz(i,j,k)*AAxz+gupyz(i,j,k)*AAyz))+chin1(i,j,k)*(Ainvxx+liegxx+Ainvyy*liegyy+Ainvzz*liegzz & + +TWO*(Ainvxy*liegxy+Ainvxz*liegxz+Ainvyz*liegyz))-toAss_rhs +#endif +! reconstruct rhs for dynamical variables + trK_rhs(i,j,k) = totrK_rhs + TZ_rhs(i,j,k) = toTZ_rhs + Gamx_rhs(i,j,k) = toGams_rhs*vx(i,j,k)+toGam1_rhs*ux(i,j,k)+toGam2_rhs*wx(i,j,k) + Gamy_rhs(i,j,k) = toGams_rhs*vy(i,j,k)+toGam1_rhs*uy(i,j,k)+toGam2_rhs*wy(i,j,k) + Gamz_rhs(i,j,k) = toGams_rhs*vz(i,j,k)+toGam1_rhs*uz(i,j,k)+toGam2_rhs*wz(i,j,k) + Axx_rhs(i,j,k) = (ulx(i,j,k)*ulx(i,j,k)-0.5d0*qxx(i,j,k))*toA11_rhs+(wlx(i,j,k)*wlx(i,j,k)-0.5d0*qxx(i,j,k))*toA22_rhs+ulx(i,j,k)*wlx(i,j,k)*toA12_rhs & + + ulx(i,j,k)*slx(i,j,k)*toAs1_rhs+wlx(i,j,k)*slx(i,j,k)*toAs2_rhs+slx(i,j,k)*slx(i,j,k)*toAss_rhs & + + 0.5d0*qxx(i,j,k)*toAqq_rhs + Ayy_rhs(i,j,k) = (uly(i,j,k)*uly(i,j,k)-0.5d0*qyy(i,j,k))*toA11_rhs+(wly(i,j,k)*wly(i,j,k)-0.5d0*qyy(i,j,k))*toA22_rhs+uly(i,j,k)*wly(i,j,k)*toA12_rhs & + + uly(i,j,k)*sly(i,j,k)*toAs1_rhs+wly(i,j,k)*sly(i,j,k)*toAs2_rhs+sly(i,j,k)*sly(i,j,k)*toAss_rhs & + + 0.5d0*qyy(i,j,k)*toAqq_rhs + Azz_rhs(i,j,k) = (ulz(i,j,k)*ulz(i,j,k)-0.5d0*qzz(i,j,k))*toA11_rhs+(wlz(i,j,k)*wlz(i,j,k)-0.5d0*qzz(i,j,k))*toA22_rhs+ulz(i,j,k)*wlz(i,j,k)*toA12_rhs & + + ulz(i,j,k)*slz(i,j,k)*toAs1_rhs+wlz(i,j,k)*slz(i,j,k)*toAs2_rhs+slz(i,j,k)*slz(i,j,k)*toAss_rhs & + + 0.5d0*qzz(i,j,k)*toAqq_rhs + Axy_rhs(i,j,k) = (ulx(i,j,k)*uly(i,j,k)-0.5d0*qxy(i,j,k))*toA11_rhs+(wlx(i,j,k)*wly(i,j,k)-0.5d0*qxy(i,j,k))*toA22_rhs+ & + (ulx(i,j,k)*wly(i,j,k)+uly(i,j,k)*wlx(i,j,k))/TWO*toA12_rhs & + +(ulx(i,j,k)*sly(i,j,k)+uly(i,j,k)*slx(i,j,k))/TWO*toAs1_rhs & + +(wlx(i,j,k)*sly(i,j,k)+wly(i,j,k)*slx(i,j,k))/TWO*toAs2_rhs & + +(slx(i,j,k)*sly(i,j,k)+sly(i,j,k)*slx(i,j,k))/TWO*toAss_rhs & + + 0.5d0*qxy(i,j,k)*toAqq_rhs + Axz_rhs(i,j,k) = (ulx(i,j,k)*ulz(i,j,k)-0.5d0*qxz(i,j,k))*toA11_rhs+(wlx(i,j,k)*wlz(i,j,k)-0.5d0*qxz(i,j,k))*toA22_rhs+ & + (ulx(i,j,k)*wlz(i,j,k)+ulz(i,j,k)*wlx(i,j,k))/TWO*toA12_rhs & + +(ulx(i,j,k)*slz(i,j,k)+ulz(i,j,k)*slx(i,j,k))/TWO*toAs1_rhs & + +(wlx(i,j,k)*slz(i,j,k)+wlz(i,j,k)*slx(i,j,k))/TWO*toAs2_rhs & + +(slx(i,j,k)*slz(i,j,k)+slz(i,j,k)*slx(i,j,k))/TWO*toAss_rhs & + + 0.5d0*qxz(i,j,k)*toAqq_rhs + Ayz_rhs(i,j,k) = (uly(i,j,k)*ulz(i,j,k)-0.5d0*qyz(i,j,k))*toA11_rhs+(wlz(i,j,k)*wlz(i,j,k)-0.5d0*qyz(i,j,k))*toA22_rhs+ & + (uly(i,j,k)*wlz(i,j,k)+ulz(i,j,k)*wly(i,j,k))/TWO*toA12_rhs & + +(uly(i,j,k)*slz(i,j,k)+ulz(i,j,k)*sly(i,j,k))/TWO*toAs1_rhs & + +(wly(i,j,k)*slz(i,j,k)+wlz(i,j,k)*sly(i,j,k))/TWO*toAs2_rhs & + +(sly(i,j,k)*slz(i,j,k)+slz(i,j,k)*sly(i,j,k))/TWO*toAss_rhs & + + 0.5d0*qyz(i,j,k)*toAqq_rhs + enddo + enddo + enddo + + endif + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + if(eps>0)then +! usual Kreiss-Oliger dissipation + call kodis_sh(ex,crho,sigma,R,chi,chi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,trK,trK_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dxx,gxx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxy,gxy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gxz,gxz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dyy,gyy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,gyz,gyz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dzz,gzz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axx,Axx_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axy,Axy_rhs,AAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Axz,Axz_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayy,Ayy_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Ayz,Ayz_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Azz,Azz_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamx,Gamx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamy,Gamy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Gamz,Gamz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,Lap,Lap_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betax,betax_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betay,betay_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,betaz,betaz_rhs,SSA,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfx,dtSfx_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfy,dtSfy_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,dtSfz,dtSfz_rhs,SSA,Symmetry,eps,sst) + + call kodis_sh(ex,crho,sigma,R,TZ,TZ_rhs,SSS,Symmetry,eps,sst) + endif + + return + + end subroutine david_milton_cpbc_ss +#endif +! repopulate the buffer points of outer boundary through extroplation +! need CPBC_ghost_width + subroutine repo_extro_ss(ex,x,y,z,f,zmin,zmax,tpp) + implicit none + integer,intent(in ):: ex(1:3) + double precision,intent(in),dimension(ex(1))::x + double precision,intent(in),dimension(ex(2))::y + double precision,intent(in),dimension(ex(3))::z + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: f + real*8, intent(in):: zmin,zmax +! extraplate type +! 0: Lagange polynomial; 1: D+^n f = 0 + integer,intent(in) :: tpp +!~~~~~~~~~~~> local variables + logical :: gont + real*8 :: dZ + integer :: i, j, k + integer :: layer(1:6,1:6),gp + real*8 :: extroplate_lag,extroplate_cg + + integer :: NP + +!sanity check + if(ex(3) .le. CPBC_ghost_width +(ghost_width*2+1))then + write(*,*) "repo_extro_ss has assumed ex(3) > CPBC_ghost_width +(ghost_width*2+1) but ex(3) = ",ex(3),"CPBC_ghost_width = ",CPBC_ghost_width + stop + endif + + dZ = Z(2) - Z(1) + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(Z(ex(3))-zmax) < dZ)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) - CPBC_ghost_width + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) - CPBC_ghost_width +endif +! extroplate point by point + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + +!!! fixme: note the assumption points requirement is enough or not + select case (tpp) + case (0) + NP = ghost_width*2+1 +! NP = ghost_width*2-1 + + do k = layer(3,gp) + 1,ex(3) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + f(i,j,k) = extroplate_lag(NP,f(i,j,k-NP:k-1)) + enddo + enddo + enddo + + case (1) +! NP = (ghost_width-1)*2 + NP = ghost_width*2 + + do k = layer(3,gp) + 1,ex(3) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + f(i,j,k) = extroplate_cg(NP,f(i,j,k-NP:k-1)) + enddo + enddo + enddo + + case (2) + NP = ghost_width*2+1 +! NP = ghost_width*2-1 + + NP = NP + CPBC_ghost_width + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + call extroplate_lag2(NP,f(i,j,ex(3)-NP+1:ex(3))) + enddo + enddo + + case default + write(*,*) "repo_extro_ss: not recognized extraplation type = ",tpp + return + end select + + + endif + + return + + end subroutine repo_extro_ss +! extroplate for unigrid with Lagange polynomial + function extroplate_lag(N,f) result(gont) + implicit none + integer,intent(in ) :: N + real*8,dimension(N),intent(in) :: f + + real*8 :: gont + + real*8,parameter :: THR=3.d0 + real*8,parameter :: FIV=5.d0,TEN=1.d1,NIN=9.d0 + real*8,parameter :: SEV=7.d0,TYO=2.1d1,F35=3.5d1 + real*8,parameter :: F36=3.6d1,F84=8.4d1,F126=1.26d2 + real*8,parameter :: F11=1.1d1,F55=5.5d1,F165=1.65d2,F330=3.3d2,F462=4.62d2 + +! Lagange polynomial + select case (N) +! for 2nd order code + case (3) + gont = THR*f(3)-THR*f(2)+f(1) +! for 2nd order code + case (5) + gont = FIV*f(5)-TEN*f(4)+TEN*f(3)-FIV*f(2)+f(1) +! for 4th order code + case (7) + gont = SEV*f(7)-TYO*f(6)+F35*f(5)-F35*f(4)+TYO*f(3)-SEV*f(2)+f(1) +! for 6th order code + case (9) + gont = NIN*f(9)-F36*f(8)+F84*f(7)-F126*f(6)+F126*f(5)-F84*f(4)+F36*f(3)-NIN*f(2)+f(1) +! for 8th order code + case (11) + gont = F11*f(11)-F55*f(10)+F165*f(9)-F330*f(8)+F462*f(7)-F462*f(6)+F330*f(5)-F165*f(4)+F55*f(3)-F11*f(2)+f(1) + end select + + return + + end function extroplate_lag +! extroplate for unigrid with Lagange polynomial +! but using inner N-ghost_width points for all of the outer ghost_width points + subroutine extroplate_lag2(N,f) + implicit none + integer,intent(in ) :: N + real*8,dimension(N),intent(inout) :: f + + integer :: NI,i + real*8 :: s1,s2 + + NI = N - CPBC_ghost_width + + do i=1,CPBC_ghost_width + +! Lagange polynomial + select case (NI) +! for 2nd order code + case (3) + f(NI+i) = i**2*f(1)/2+i*f(1)/2-i**2*f(2)-2*i*f(2)+f(3)*i**2/2+3.D0/2.D0*f(3)*i+f(3) +! for 2nd order code + case (5) + f(NI+i) = i**4*f(1)/24+i**3*f(1)/4+11.D0/24.D0*i**2*f(1)+i*f(1)/4-i**4*f(2)/6 & + -7.D0/6.D0*i**3*f(2)-7.D0/3.D0*i**2*f(2)-4.D0/3.D0*i*f(2)+f(3)*i**4/4 & + +2*f(3)*i**3+19.D0/4.D0*f(3)*i**2+3*f(3)*i-i**4*f(4)/6 & + -3.D0/2.D0*i**3*f(4)-13.D0/3.D0*i**2*f(4)-4*i*f(4) & + +f(5)*i**4/24+5.D0/12.D0*f(5)*i**3+35.D0/24.D0*f(5)*i**2 & + +25.D0/12.D0*f(5)*i+f(5) +! for 4th order code + case (7) + s1 = 33.D0/4.D0*f(3)*i**2+15.D0/2.D0*f(5)*i+117.D0/8.D0*f(5)*i**2 & + -121.D0/36.D0*i**4*f(4)+i**5*f(1)/48-i**6*f(2)/120-20.D0/3.D0*i*f(4) & + +35.D0/144.D0*f(7)*i**4+137.D0/48.D0*f(5)*i**4+107.D0/48.D0*f(3)*i**4 & + +203.D0/90.D0*f(7)*i**2-31.D0/3.D0*i**3*f(4)-27.D0/10.D0*i**2*f(2) & + +f(5)*i**6/48+15.D0/4.D0*f(3)*i+17.D0/144.D0*i**4*f(1)-i**5*f(4)/2 & + -i**5*f(6)/6-13.D0/6.D0*i**3*f(2)+137.D0/360.D0*i**2*f(1) & + +49.D0/48.D0*f(7)*i**3 + f(NI+i) = s1-19.D0/24.D0*i**4*f(2)+7.D0/240.D0*f(7)*i**5+f(7)*i**6/720 & + +461.D0/48.D0*f(5)*i**3-6*i*f(6)-87.D0/10.D0*i**2*f(6) & + +i**6*f(1)/720-127.D0/9.D0*i**2*f(4)+19.D0/48.D0*f(5)*i**5 & + +5.D0/16.D0*i**3*f(1)-i**6*f(6)/120+49.D0/20.D0*f(7)*i & + -29.D0/6.D0*i**3*f(6)-31.D0/24.D0*i**4*f(6)-6.D0/5.D0*i*f(2) & + +i*f(1)/6-2.D0/15.D0*i**5*f(2)-i**6*f(4)/36 & + +307.D0/48.D0*f(3)*i**3+17.D0/48.D0*f(3)*i**5+f(3)*i**6/48+f(7) +! for 6th order code + case (9) + s1 = -8*i*f(8)-527.D0/180.D0*i**3*f(2)+2803.D0/480.D0*f(3)*i**4 & + -i**8*f(8)/5040+18353.D0/720.D0*f(7)*i**3-391.D0/720.D0*i**6*f(4) & + +1457.D0/36.D0*f(5)*i**3+9.D0/80.D0*f(9)*i**5+23.D0/2880.D0*i**6*f(1) & + +17.D0/720.D0*f(7)*i**7-56.D0/3.D0*i*f(6)+761.D0/280.D0*f(9)*i & + -67.D0/45.D0*i**4*f(2)+14*f(7)*i+f(3)*i**7/48-268.D0/15.D0*i**4*f(6) & + -2003.D0/45.D0*i**2*f(6)+13.D0/960.D0*f(9)*i**6-73.D0/720.D0*i**6*f(8) & + +f(7)*i**8/1440+363.D0/1120.D0*i**2*f(1)-797.D0/20.D0*i**3*f(6) & + -11.D0/240.D0*i**7*f(6)-329.D0/90.D0*i**4*f(8)+179.D0/36.D0*f(5)*i**5 & + +967.D0/5760.D0*i**4*f(1)-103.D0/35.D0*i**2*f(2)-481.D0/35.D0*i**2*f(8) & + +179.D0/72.D0*f(7)*i**5-349.D0/36.D0*i**3*f(8)+61.D0/240.D0*f(3)*i**6 & + -115.D0/144.D0*i**5*f(8)+f(5)*i**8/576-56.D0/5.D0*i*f(4) & + +187.D0/16.D0*f(3)*i**3-149.D0/240.D0*i**6*f(6) + f(NI+i) = s1+i**8*f(1)/40320+2143.D0/180.D0*f(3)*i**2+469.D0/1440.D0*i**3*f(1) & + +f(5)*i**7/18+621.D0/20.D0*f(7)*i**2+f(9)+267.D0/160.D0*f(9)*i**3 & + +7.D0/144.D0*i**5*f(1)-i**7*f(8)/144+1069.D0/1920.D0*f(9)*i**4 & + -141.D0/5.D0*i**2*f(4)-29.D0/5040.D0*i**7*f(2)-i**8*f(4)/720 & + +691.D0/16.D0*f(5)*i**2+f(9)*i**7/1120-2581.D0/720.D0*i**5*f(4) & + -i**8*f(2)/5040+10993.D0/576.D0*f(5)*i**4+14.D0/3.D0*f(3)*i & + -i**8*f(6)/720-4891.D0/180.D0*i**3*f(4)+13.D0/8.D0*f(3)*i**5 & + +239.D0/720.D0*f(7)*i**6+15289.D0/1440.D0*f(7)*i**4+f(3)*i**8/1440 & + -49.D0/720.D0*i**6*f(2)+35.D0/2.D0*f(5)*i-71.D0/16.D0*i**5*f(6) & + +f(9)*i**8/40320+29531.D0/10080.D0*f(9)*i**2+209.D0/288.D0*f(5)*i**6 & + -1193.D0/90.D0*i**4*f(4)+i*f(1)/8-61.D0/144.D0*i**5*f(2)+i**7*f(1)/1440 & + -31.D0/720.D0*i**7*f(4)-8.D0/7.D0*i*f(2) +! for 8th order code + case (11) + s2 = -433739.D0/7560.D0*i**4*f(8)+7129.D0/25200.D0*i**2*f(1) & + -6947.D0/8640.D0*i**5*f(2)+3013.D0/172800.D0*i**6*f(1) & + -107.D0/1440.D0*i**8*f(6)-119.D0/4320.D0*i**7*f(2)+i*f(1)/10 & + +f(7)*i**10/17280+i**10*f(1)/3628800+59.D0/5040.D0*f(3)*i**8 & + -67.D0/1440.D0*i**7*f(10)+105.D0/2.D0*f(7)*i & + +84095.D0/36288.D0*f(11)*i**3-62549.D0/720.D0*i**4*f(6) & + -263.D0/84.D0*i**2*f(2)-5419.D0/1440.D0*i**6*f(8) & + +11.D0/30240.D0*f(11)*i**8+757.D0/5760.D0*f(3)*i**7 & + +39867.D0/2240.D0*f(3)*i**3-i**10*f(8)/30240-8.D0/9.D0*i**7*f(6) & + -10*i*f(10)+6961.D0/72.D0*f(5)*i**2-i**10*f(10)/362880 & + +i**9*f(1)/80640+728587.D0/8640.D0*f(7)*i**4-41.D0/1260.D0*i**8*f(4) + s1 = s2-6709.D0/17280.D0*i**6*f(10)+47.D0/80640.D0*f(3)*i**9 & + +49.D0/17280.D0*f(5)*i**9-1253.D0/480.D0*i**6*f(4) & + +6751.D0/48.D0*f(7)*i**2+10427.D0/11520.D0*f(3)*i**6-10.D0/9.D0*i*f(2) & + -23.D0/181440.D0*i**9*f(2)-i**9*f(10)/6720+45449.D0/11520.D0*f(3)*i**5 & + +2281.D0/2880.D0*f(7)*i**7-252.D0/5.D0*i*f(6)+f(9)*i**10/80640 & + +29.D0/120960.D0*i**8*f(1)-6541.D0/63.D0*i**2*f(8) & + +461789.D0/4320.D0*f(5)*i**3-161353.D0/45360.D0*i**3*f(2) & + +435893.D0/40320.D0*f(3)*i**4-97.D0/2520.D0*i**8*f(8) & + +1123.D0/5760.D0*f(9)*i**7-i**10*f(4)/30240-1003.D0/21.D0*i**2*f(4) & + -4861.D0/252.D0*i**2*f(10)-40*i*f(8)-i**9*f(6)/288-i**10*f(6)/14400 & + -13.D0/7560.D0*i**9*f(8)+1303.D0/4032.D0*i**3*f(1) + s2 = s1-151.D0/60480.D0*i**8*f(2)+19.D0/256.D0*i**5*f(1) & + +71689.D0/480.D0*f(7)*i**3-6877.D0/50.D0*i**2*f(6)+34343.D0/5760.D0*f(7)*i**6 & + -211.D0/60480.D0*i**8*f(10)+129067.D0/5760.D0*f(5)*i**5+35*f(5)*i & + -8321.D0/720.D0*i**5*f(4)+i**7*f(1)/384-1197.D0/8.D0*i**3*f(6) & + +3533.D0/224.D0*f(3)*i**2+18047.D0/11520.D0*f(9)*i**6 & + +163313.D0/5760.D0*f(7)*i**5+f(5)*i**10/17280+f(11)*i**10/3628800 & + +11.D0/725760.D0*f(11)*i**9-120.D0/7.D0*i*f(4)-i**9*f(4)/630 & + +177133.D0/50400.D0*f(11)*i**2-93773.D0/14400.D0*i**6*f(6) & + +121.D0/24192.D0*f(11)*i**7+28603.D0/5760.D0*f(5)*i**6 & + -197741.D0/90720.D0*i**4*f(2)+f(3)*i**10/80640+7381.D0/2520.D0*f(11)*i-3229.D0/17280.D0*i**6*f(2) + f(NI+i) = s2+17.D0/5760.D0*f(7)*i**9-22439.D0/420.D0*i**3*f(4) & + -1877.D0/5040.D0*i**7*f(4)-i**10*f(2)/362880-43319.D0/1440.D0*i**5*f(6) & + +31.D0/480.D0*f(7)*i**8+1999.D0/2880.D0*f(5)*i**7+45.D0/8.D0*f(3)*i & + +19.D0/320.D0*f(5)*i**8-349.D0/720.D0*i**7*f(8) & + +273431.D0/4320.D0*f(5)*i**4-242639.D0/7560.D0*i**4*f(4) & + +4523.D0/22680.D0*i**4*f(1)+607.D0/40320.D0*f(9)*i**8 & + +92771.D0/11520.D0*f(9)*i**5+264767.D0/10080.D0*f(9)*i**4 & + +115923.D0/2240.D0*f(9)*i**3+6121.D0/112.D0*f(9)*i**2+45.D0/2.D0*f(9)*i & + +53.D0/80640.D0*f(9)*i**9-6041.D0/2880.D0*i**5*f(10) & + -663941.D0/90720.D0*i**4*f(10)-79913.D0/5040.D0*i**3*f(10) & + +7513.D0/172800.D0*f(11)*i**6+8591.D0/34560.D0*f(11)*i**5 & + +341693.D0/362880.D0*f(11)*i**4-13349.D0/720.D0*i**5*f(8) & + -400579.D0/3780.D0*i**3*f(8)+f(11) + + end select + + enddo + + return + + end subroutine extroplate_lag2 +! extroplate for unigrid with Calabrese Gundlach type, Eq.(16) of CQG 23 S343 (2006) + function extroplate_cg(N,f) result(gont) + implicit none + integer,intent(in ) :: N + real*8,dimension(N),intent(in) :: f + + real*8 :: gont + +! Eq.(16) of CQG 23 S343 (2006) + select case (N) +! for 2nd order code + case (2) + gont = 2.d0*f(2)-f(1) +! for 4th order code + case (4) + gont = 4.d0*f(4)-6.d0*f(3)+4.d0*f(2)-f(1) +! for 6th order code + case (6) +! Eq.(C7) of PRD 83, 024025 + gont = 6.d0*f(6)-1.5d1*f(5)+2.d1*f(4)-1.5d1*f(3)+6.d0*f(2)-f(1) +! for 8th order code + case (8) + gont = 8.d0*f(8)-2.8d1*f(7)+5.6d1*f(6)-7.d1*f(5)+5.6d1*f(4)-2.8d1*f(3)+8.d0*f(2)-f(1) + end select + + return + + end function extroplate_cg +! need CPBC_ghost_width + subroutine david_milton_extroplate_ss(ex,crho,sigma,R, & + TZ,chi,trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gmx,Gmy,Gmz, & + Lap , betax , betay , betaz , & + dtSfx , dtSfy , dtSfz,zmin,zmax) + +! NOTE: we need Kreiss-Oliger dissipation here instead of rhs calculation routine + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3) + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: TZ,chi,dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: dtSfx, dtSfy, dtSfz + real*8, intent(in):: zmin,zmax + +#define tptype 1 +#if (tptype == 0) +! default we always use hp (tpp=0) + + call repo_extro_ss(ex,crho,sigma,R,TZ,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,chi,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dxx,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dyy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dzz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,gxy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,gxz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,gyz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,trK,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Axx,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Ayy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Azz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Axy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Axz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Ayz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Gmx,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Gmy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Gmz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,Lap,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betax,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betay,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betaz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dtSfx,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dtSfy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dtSfz,zmin,zmax,0) +#elif (tptype == 1) +! all D+ f = 0 (tpp=1) + + call repo_extro_ss(ex,crho,sigma,R,TZ,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,chi,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dxx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dyy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dzz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,gxy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,gxz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,gyz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,trK,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Ayy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Azz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Ayz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Lap,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,betax,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,betay,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,betaz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dtSfx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dtSfy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dtSfz,zmin,zmax,1) +#elif (tptype == 2) +! Lagange polynomial but all used inner points (tpp=2) + + call repo_extro_ss(ex,crho,sigma,R,TZ,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,chi,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dxx,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dyy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dzz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,gxy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,gxz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,gyz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,trK,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Axx,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Ayy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Azz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Axy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Axz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Ayz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Gmx,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Gmy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Gmz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,Lap,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,betax,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,betay,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,betaz,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dtSfx,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dtSfy,zmin,zmax,2) + call repo_extro_ss(ex,crho,sigma,R,dtSfz,zmin,zmax,2) + +#elif (tptype == 3) +! thumb of rule: D+ f = 0 (tpp=1) for outgoing ones; hp (tpp=0) for ingoing ones + + call repo_extro_ss(ex,crho,sigma,R,TZ,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,chi,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dxx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dyy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dzz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,gxy,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,gxz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,gyz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,trK,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Ayy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Azz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Axz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Ayz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Gmz,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,Lap,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betax,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betay,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,betaz,zmin,zmax,0) + call repo_extro_ss(ex,crho,sigma,R,dtSfx,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dtSfy,zmin,zmax,1) + call repo_extro_ss(ex,crho,sigma,R,dtSfz,zmin,zmax,1) + +#else +#error "not recognized tptype" +#endif + +#undef tptype + + return + + end subroutine david_milton_extroplate_ss +!construct rACqq rhs + subroutine cpbcrACqq(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,rACqq,& + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,Sfx,Sfy,Sfz,Axx,Axy,Axz,Ayy,Ayz,Azz,rACss,Symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz,Axx,Axy,Axz,Ayy,Ayz,Azz,rACss + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rACqq +!~~~~~~> Other variables: + real*8 :: chin1,alpha,gxx,gyy,gzz + real*8 :: sfxx,sfxy,sfxz,sfyx,sfyy,sfyz,sfzx,sfzy,sfzz + real*8 :: gxxx,gxxy,gxxz + real*8 :: gxyx,gxyy,gxyz + real*8 :: gxzx,gxzy,gxzz + real*8 :: gyyx,gyyy,gyyz + real*8 :: gyzx,gyzy,gyzz + real*8 :: gzzx,gzzy,gzzz + logical :: gont + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + real*8 :: dR + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dR = R(2)-R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +! consider buffer points near boundary + layer(3,3) = ex(3) - CPBC_ghost_width + layer(6,3) = ex(3) - CPBC_ghost_width +endif + + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + alpha = Lap(i,j,k)+1.d0 + chin1 = chi(i,j,k)+1.d0 + gxx = dxx(i,j,k)+1.d0 + gyy = dyy(i,j,k)+1.d0 + gzz = dzz(i,j,k)+1.d0 + call point_fderivs_shc(ex,Sfx,sfxx,sfxy,sfxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfy,sfyx,sfyy,sfyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfz,sfzx,sfzy,sfzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call racqq_point(Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + alpha,Sfx(i,j,k),Sfy(i,j,k),Sfz(i,j,k),chin1, & + sfxx,sfyx,sfzx,sfxy,sfyy,sfzy,sfxz,sfyz,sfzz, & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + gxx,gxy(i,j,k),gxz(i,j,k),gyy,gyz(i,j,k),gzz, & + rACqq(i,j,k),rACss(i,j,k)) + enddo + enddo + enddo + endif + + return + + end subroutine cpbcrACqq +!construct rtrK rhs + subroutine cpbcrtrK(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,rtrK,& + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,Sfx,Sfy,Sfz,TZ,Symmetry,sst,kappa1,kappa2) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz,TZ + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax,kappa1,kappa2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rtrK +!~~~~~~> Other variables: + real*8 :: chin1,alpha,gxx,gyy,gzz + real*8 :: Kx,Ky,Kz,TZx,TZy,TZz + logical :: gont + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + real*8 :: dR + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dR = R(2)-R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +! consider buffer points near boundary + layer(3,3) = ex(3) - CPBC_ghost_width + layer(6,3) = ex(3) - CPBC_ghost_width +endif + + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + alpha = Lap(i,j,k)+1.d0 + chin1 = chi(i,j,k)+1.d0 + gxx = dxx(i,j,k)+1.d0 + gyy = dyy(i,j,k)+1.d0 + gzz = dzz(i,j,k)+1.d0 + call point_fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call rkhat_point(alpha,Sfx(i,j,k),Sfy(i,j,k),Sfz(i,j,k),chin1, & + Kx,Ky,Kz,TZx,TZy,TZz, & + gxx,gxy(i,j,k),gxz(i,j,k),gyy,gyz(i,j,k),gzz,kappa1,kappa2, & + trK(i,j,k),R(k),rtrK(i,j,k),TZ(i,j,k),x(i,j,k),y(i,j,k),z(i,j,k)) + enddo + enddo + enddo + endif + + return + + end subroutine cpbcrtrK +!construct rTZ rhs + subroutine cpbcrtheta(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,rTheta,& + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,Sfx,Sfy,Sfz,TZ,Symmetry,sst,kappa1,kappa2) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz,TZ + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax,kappa1,kappa2 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rTheta +!~~~~~~> Other variables: + real*8 :: alpha,chin1,gxx,gyy,gzz + real*8 :: TZx,TZy,TZz + logical :: gont + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + real*8 :: dR + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dR = R(2)-R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +! consider buffer points near boundary + layer(3,3) = ex(3) - CPBC_ghost_width + layer(6,3) = ex(3) - CPBC_ghost_width +endif + + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + alpha = Lap(i,j,k)+1.d0 + chin1 = chi(i,j,k)+1.d0 + gxx = dxx(i,j,k)+1.d0 + gyy = dyy(i,j,k)+1.d0 + gzz = dzz(i,j,k)+1.d0 + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call rtheta_point(alpha,Sfx(i,j,k),Sfy(i,j,k),Sfz(i,j,k),chin1, & + TZx,TZy,TZz, & + gxx,gxy(i,j,k),gxz(i,j,k),gyy,gyz(i,j,k),gzz,kappa1,kappa2, & + R(k),rTheta(i,j,k),TZ(i,j,k),x(i,j,k),y(i,j,k),z(i,j,k)) + enddo + enddo + enddo + endif + + return + + end subroutine cpbcrtheta +!construct rGam rhs + subroutine cpbcrgam(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax,rGamAx,rGamAy,rGamAz,rGams,& + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Lap,Sfx,Sfy,Sfz,TZ,Gamx,Gamy,Gamz,Symmetry,sst,eta) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK,chi,dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz,TZ,Gamx,Gamy,Gamz + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax,eta + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rGamAx,rGamAy,rGamAz,rGams +!~~~~~~> Other variables: + real*8 :: alpha,chin1,gxx,gyy,gzz + real*8 :: sfxx,sfyx,sfzx + real*8 :: sfxy,sfyy,sfzy + real*8 :: sfxz,sfyz,sfzz + real*8 :: sfxxx,sfyxx,sfzxx + real*8 :: sfxxy,sfyxy,sfzxy + real*8 :: sfxxz,sfyxz,sfzxz + real*8 :: sfxyy,sfyyy,sfzyy + real*8 :: sfxyz,sfyyz,sfzyz + real*8 :: sfxzz,sfyzz,sfzzz + real*8 :: Gamxx,Gamyx,Gamzx + real*8 :: Gamxy,Gamyy,Gamzy + real*8 :: Gamxz,Gamyz,Gamzz + real*8 :: Kx,Ky,Kz,TZx,TZy,TZz + logical :: gont + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + real*8 :: dR + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dR = R(2)-R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +! consider buffer points near boundary + layer(3,3) = ex(3) - CPBC_ghost_width + layer(6,3) = ex(3) - CPBC_ghost_width +endif + + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + alpha = Lap(i,j,k)+1.d0 + chin1 = chi(i,j,k)+1.d0 + gxx = dxx(i,j,k)+1.d0 + gyy = dyy(i,j,k)+1.d0 + gzz = dzz(i,j,k)+1.d0 + call point_fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfx,sfxx,sfxy,sfxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfy,sfyx,sfyy,sfyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfz,sfzx,sfzy,sfzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fdderivs_shc(ex,Sfx,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,crho,sigma,R,ANTI,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,Sfy,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,crho,sigma,R,SYM ,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,Sfz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call rgam_point(alpha,Sfx(i,j,k),Sfy(i,j,k),Sfz(i,j,k),chin1, & + sfxx,sfyx,sfzx, & + sfxy,sfyy,sfzy, & + sfxz,sfyz,sfzz, & + sfxxx,sfyxx,sfzxx, & + sfxxy,sfyxy,sfzxy, & + sfxxz,sfyxz,sfzxz, & + sfxyy,sfyyy,sfzyy, & + sfxyz,sfyyz,sfzyz, & + sfxzz,sfyzz,sfzzz, & + Gamxx,Gamyx,Gamzx, & + Gamxy,Gamyy,Gamzy, & + Gamxz,Gamyz,Gamzz, & + Kx,Ky,Kz,TZx,TZy,TZz, & + gxx,gxy(i,j,k),gxz(i,j,k),gyy,gyz(i,j,k),gzz,& + R(k),rGamAx(i,j,k),rGamAy(i,j,k),rGamAz(i,j,k),rGams(i,j,k), & + eta,x(i,j,k),y(i,j,k),z(i,j,k)) + enddo + enddo + enddo + endif + + return + + end subroutine cpbcrgam +!construct rA rhs + subroutine cpbcra(ex,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + xmin,ymin,zmin,xmax,ymax,zmax, & + rACABTFxx,rACABTFxy,rACABTFxz,rACABTFyy,rACABTFyz,rACABTFzz,& + rACsAx,rACsAy,rACsAz,rACss, & + chi,trK,dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Lap,Sfx,Sfy,Sfz,TZ,Gamx,Gamy,Gamz,Symmetry,sst,kappa1) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK,chi,dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz,TZ,Gamx,Gamy,Gamz,Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax,kappa1 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rACABTFxx,rACABTFxy,rACABTFxz,rACABTFyy,rACABTFyz,rACABTFzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::rACsAx,rACsAy,rACsAz,rACss +!~~~~~~> Other variables: + real*8 :: alpha,chin1,gxx,gyy,gzz + real*8 :: sfxx,sfyx,sfzx + real*8 :: sfxy,sfyy,sfzy + real*8 :: sfxz,sfyz,sfzz + real*8 :: sfxxx,sfyxx,sfzxx + real*8 :: sfxxy,sfyxy,sfzxy + real*8 :: sfxxz,sfyxz,sfzxz + real*8 :: sfxyy,sfyyy,sfzyy + real*8 :: sfxyz,sfyyz,sfzyz + real*8 :: sfxzz,sfyzz,sfzzz + real*8 :: Gamxx,Gamyx,Gamzx + real*8 :: Gamxy,Gamyy,Gamzy + real*8 :: Gamxz,Gamyz,Gamzz + real*8 :: Kx,Ky,Kz,TZx,TZy,TZz + real*8 :: Lapx,Lapy,Lapz,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz + real*8 :: chix,chiy,chiz + real*8 :: chixx,chixy,chixz,chiyy,chiyz,chizz + real*8 :: Axxx,Axxy,Axxz + real*8 :: Axyx,Axyy,Axyz + real*8 :: Axzx,Axzy,Axzz + real*8 :: Ayyx,Ayyy,Ayyz + real*8 :: Ayzx,Ayzy,Ayzz + real*8 :: Azzx,Azzy,Azzz + real*8 :: gxxx,gxxy,gxxz + real*8 :: gxyx,gxyy,gxyz + real*8 :: gxzx,gxzy,gxzz + real*8 :: gyyx,gyyy,gyyz + real*8 :: gyzx,gyzy,gyzz + real*8 :: gzzx,gzzy,gzzz + real*8 :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8 :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8 :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8 :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8 :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8 :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + logical :: gont + integer :: i, j, k + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + real*8 :: dR + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dR = R(2)-R(1) + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(R(ex(3))-zmax) < dR)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +! consider buffer points near boundary + layer(3,3) = ex(3) - CPBC_ghost_width + layer(6,3) = ex(3) - CPBC_ghost_width +endif + + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) + alpha = Lap(i,j,k)+1.d0 + chin1 = chi(i,j,k)+1.d0 + gxx = dxx(i,j,k)+1.d0 + gyy = dyy(i,j,k)+1.d0 + gzz = dzz(i,j,k)+1.d0 + call point_fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,TZ,TZx,TZy,TZz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfx,sfxx,sfxy,sfxz,crho,sigma,R,ANTI,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfy,sfyx,sfyy,sfyz,crho,sigma,R,SYM,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Sfz,sfzx,sfzy,sfzz,crho,sigma,R,SYM,SYM,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fdderivs_shc(ex,Sfx,sfxxx,sfxxy,sfxxz,sfxyy,sfxyz,sfxzz,crho,sigma,R,ANTI,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,Sfy,sfyxx,sfyxy,sfyxz,sfyyy,sfyyz,sfyzz,crho,sigma,R,SYM ,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,Sfz,sfzxx,sfzxy,sfzxz,sfzyy,sfzyz,sfzzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + + call point_fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fderivs_shc(ex,Lap,Lapx,Lapy,Lapz,crho,sigma,R,SYM,SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + call point_fdderivs_shc(ex,Lap,Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,chi,chixx,chixy,chixz,chiyy,chiyz,chizz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call point_fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + call ra_point(Axx(i,j,k),Axy(i,j,k),Axz(i,j,k),Ayy(i,j,k),Ayz(i,j,k),Azz(i,j,k), & + alpha,Sfx(i,j,k),Sfy(i,j,k),Sfz(i,j,k),chin1, & + Lapx,Axxx,Axyx,Axzx,Ayyx,Ayzx,Azzx, & + Lapy,Axxy,Axyy,Axzy,Ayyy,Ayzy,Azzy, & + Lapz,Axxz,Axyz,Axzz,Ayyz,Ayzz,Azzz, & + sfxx,sfyx,sfzx, & + sfxy,sfyy,sfzy, & + sfxz,sfyz,sfzz, & + chix,chiy,chiz, & + Lapxx,Lapxy,Lapxz,Lapyy,Lapyz,Lapzz, & + sfxxx,sfyxx,sfzxx, & + sfxxy,sfyxy,sfzxy, & + sfxxz,sfyxz,sfzxz, & + sfxyy,sfyyy,sfzyy, & + sfxyz,sfyyz,sfzyz, & + sfxzz,sfyzz,sfzzz, & + chixx,chixy,chixz,chiyy,chiyz,chizz, & + gxxxx,gxyxx,gxzxx,gyyxx,gyzxx,gzzxx, & + gxxxy,gxyxy,gxzxy,gyyxy,gyzxy,gzzxy, & + gxxxz,gxyxz,gxzxz,gyyxz,gyzxz,gzzxz, & + gxxyy,gxyyy,gxzyy,gyyyy,gyzyy,gzzyy, & + gxxyz,gxyyz,gxzyz,gyyyz,gyzyz,gzzyz, & + gxxzz,gxyzz,gxzzz,gyyzz,gyzzz,gzzzz, & + Gamxx,gxxx,gxyx,gxzx, & + Gamyx,gyyx,gyzx, & + Gamzx,gzzx, & + Gamxy,gxxy,gxyy,gxzy, & + Gamyy,gyyy,gyzy, & + Gamzy,gzzy, & + Gamxz,gxxz,gxyz,gxzz, & + Gamyz,gyyz,gyzz, & + Gamzz,gzzz, & + Kx,Ky,Kz,TZx,TZy,TZz, & + Gamx(i,j,k),gxx,gxy(i,j,k),gxz(i,j,k), & + Gamy(i,j,k),gyy,gyz(i,j,k), & + Gamz(i,j,k),gzz, & + kappa1,trK(i,j,k), & + R(k),rACABTFxx(i,j,k),rACABTFxy(i,j,k),rACABTFxz(i,j,k), & + rACABTFyy(i,j,k),rACABTFyz(i,j,k),rACABTFzz(i,j,k), & + rACsAx(i,j,k),rACsAy(i,j,k),rACsAz(i,j,k), & + rACss(i,j,k),TZ(i,j,k), & + x(i,j,k),y(i,j,k),z(i,j,k)) + enddo + enddo + enddo + endif + + return + + end subroutine cpbcra diff --git a/AMSS_NCKU_source/cpbc.h b/AMSS_NCKU_source/cpbc.h new file mode 100644 index 0000000..0da495c --- /dev/null +++ b/AMSS_NCKU_source/cpbc.h @@ -0,0 +1,56 @@ + +#ifndef CPBC_H +#define CPBC_H + +#ifdef fortran1 +#define f_david_milton_extroplate_ss david_milton_extroplate_ss +#define f_david_milton_cpbc_ss david_milton_cpbc_ss +#endif +#ifdef fortran2 +#define f_david_milton_extroplate_ss DAVID_MILTON_EXTROPLATE_SS +#define f_david_milton_cpbc_ss DAVID_MILTON_CPBC_SS +#endif +#ifdef fortran3 +#define f_david_milton_extroplate_ss david_milton_extroplate_ss_ +#define f_david_milton_cpbc_ss david_milton_cpbc_ss_ +#endif +extern "C" +{ + int f_david_milton_extroplate_ss(int *, double *, double *, double *, // ex,crho,sigma,R + double *, double *, double *, // TZ, chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double &, double &); +} // zmin,zmax + +extern "C" +{ + int f_david_milton_cpbc_ss(int *, double *, double *, double *, // ex,crho,sigma,R + double *, double *, double *, // x,y,z + double *, double *, double *, // drhodx,drhody,drhodz + double *, double *, double *, // dsigmadx,dsigmady,dsigmadz + double *, double *, double *, // dRdx,dRdy,dRdz + double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double &, double &, double &, double &, double &, double &, // xmin,ymin,zmin,xmax,ymax,zmax + double *, double *, double *, // TZ,chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, double *, // TZ, chi, trK + double *, double *, double *, double *, double *, double *, // gij + double *, double *, double *, double *, double *, double *, // Aij + double *, double *, double *, // Gam + double *, double *, double *, double *, double *, double *, double *, // Gauge + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Christoffel + double *, double *, double *, double *, double *, double *, // Ricci + double *, double *, double *, // Gama constraint + int &, double &, int &); +} // Symmetry, eps, sst +#endif /* CPBC_H */ diff --git a/AMSS_NCKU_source/cpbc_util.C b/AMSS_NCKU_source/cpbc_util.C new file mode 100644 index 0000000..d4d3237 --- /dev/null +++ b/AMSS_NCKU_source/cpbc_util.C @@ -0,0 +1,13026 @@ + + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + + +#define Power(x,y) (pow((double) (x), (double) (y))) +#define Sqrt(x) sqrt(x) +#define Log(x) log((double) (x)) +#define pow2(x) ((x)*(x)) +#define pow3(x) ((x)*(x)*(x)) +#define pow4(x) ((x)*(x)*(x)*(x)) +#define pow2inv(x) (1.0/((x)*(x))) + +#define Cal(x,y,z) ((x)?(y):(z)) + +#define Tan(x) tan(x) +#define ArcTan(x) atan(x) +#define Sin(x) sin(x) +#define Cos(x) cos(x) +#define Csc(x) (1./sin(x)) +#define Abs(x) (fabs(x)) +#define sqrt2 (sqrt(2)) +#define Tanh(x) tanh(x) +#define Sech(x) (1/cosh(x)) + + +extern "C" { + +#ifdef fortran1 +void cpbc_point +#endif +#ifdef fortran2 +void CPBC_POINT +#endif +#ifdef fortran3 +void cpbc_point_ +#endif +(double & r,double & xp,double & yp,double & zp, + double & Theta,double & chi,double & Khat, + double & g11,double & g12,double & g13,double & g22,double & g23,double & g33, + double & A11,double & A12,double & A13,double & A22,double & A23,double & A33, + double & G1,double & G2,double & G3, + double & alpha,double & beta1,double & beta2,double & beta3, + double & da1,double & da2,double & da3, + double & dda11,double & dda12,double & dda13,double & dda22,double & dda23,double & dda33, + double & db11,double & db21,double & db31, + double & db12,double & db22,double & db32, + double & db13,double & db23,double & db33, + double & ddb111,double & ddb121,double & ddb131,double & ddb221,double & ddb231,double & ddb331, + double & ddb112,double & ddb122,double & ddb132,double & ddb222,double & ddb232,double & ddb332, + double & ddb113,double & ddb123,double & ddb133,double & ddb223,double & ddb233,double & ddb333, + double & dchi1,double & dchi2,double & dchi3, + double & ddchi11,double & ddchi12,double & ddchi13,double & ddchi22,double & ddchi23,double & ddchi33, + double & dg111,double & dg112,double & dg113,double & dg122,double & dg123,double & dg133, + double & dg211,double & dg212,double & dg213,double & dg222,double & dg223,double & dg233, + double & dg311,double & dg312,double & dg313,double & dg322,double & dg323,double & dg333, + double & ddg1111,double & ddg1211,double & ddg1311,double & ddg2211,double & ddg2311,double & ddg3311, + double & ddg1112,double & ddg1212,double & ddg1312,double & ddg2212,double & ddg2312,double & ddg3312, + double & ddg1113,double & ddg1213,double & ddg1313,double & ddg2213,double & ddg2313,double & ddg3313, + double & ddg1122,double & ddg1222,double & ddg1322,double & ddg2222,double & ddg2322,double & ddg3322, + double & ddg1123,double & ddg1223,double & ddg1323,double & ddg2223,double & ddg2323,double & ddg3323, + double & ddg1133,double & ddg1233,double & ddg1333,double & ddg2233,double & ddg2333,double & ddg3333, + double & dKhat1,double & dKhat2,double & dKhat3, + double & dA111,double & dA112,double & dA113,double & dA122,double & dA123,double & dA133, + double & dA211,double & dA212,double & dA213,double & dA222,double & dA223,double & dA233, + double & dA311,double & dA312,double & dA313,double & dA322,double & dA323,double & dA333, + double & dG11,double & dG21,double & dG31, + double & dG12,double & dG22,double & dG32, + double & dG13,double & dG23,double & dG33, + double & dTheta1,double & dTheta2,double & dTheta3, + double & rKhat,double & rTheta, + double & rA11,double & rA12,double & rA13,double & rA22,double & rA23,double & rA33, + double & rG1,double & rG2,double & rG3, + double &kappa1,double &kappa2,double &shiftdriver) +{ + +double AA11; +double AA12; +double AA13; +double AA21; +double AA22; +double AA23; +double AA31; +double AA32; +double AA33; +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double Ainv11; +double Ainv12; +double Ainv13; +double Ainv22; +double Ainv23; +double Ainv33; +double betaA1; +double betaA2; +double betaA3; +double betas; +double cdA111; +double cdA112; +double cdA113; +double cdA122; +double cdA123; +double cdA133; +double cdA211; +double cdA212; +double cdA213; +double cdA222; +double cdA223; +double cdA233; +double cdA311; +double cdA312; +double cdA313; +double cdA322; +double cdA323; +double cdA333; +double cdda11; +double cdda12; +double cdda13; +double cdda22; +double cdda23; +double cdda33; +double cddf11; +double cddf12; +double cddf13; +double cddf22; +double cddf23; +double cddf33; +const double chipsipower = -4; +double Dalpha; +double DbetaA1; +double DbetaA2; +double DbetaA3; +double Dbetas; +double ddf11; +double ddf12; +double ddf13; +double ddf22; +double ddf23; +double ddf33; +double detginv; +double df1; +double df2; +double df3; +double DGamA1; +double DGamA2; +double DGamA3; +double DGams; +double dGfromgdu11; +double dGfromgdu12; +double dGfromgdu13; +double dGfromgdu21; +double dGfromgdu22; +double dGfromgdu23; +double dGfromgdu31; +double dGfromgdu32; +double dGfromgdu33; +double dginv111; +double dginv112; +double dginv113; +double dginv122; +double dginv123; +double dginv133; +double dginv211; +double dginv212; +double dginv213; +double dginv222; +double dginv223; +double dginv233; +double dginv311; +double dginv312; +double dginv313; +double dginv322; +double dginv323; +double dginv333; +double divbeta; +double DK; +double dK1; +double dK2; +double dK3; +double DKhat; +double DTheta; +double f; +double ff; +double gADM11; +double gADM12; +double gADM13; +double gADM21; +double gADM22; +double gADM23; +double gADM31; +double gADM32; +double gADM33; +double GamA1; +double GamA2; +double GamA3; +double gamma111; +double gamma112; +double gamma113; +double gamma122; +double gamma123; +double gamma133; +double gamma211; +double gamma212; +double gamma213; +double gamma222; +double gamma223; +double gamma233; +double gamma311; +double gamma312; +double gamma313; +double gamma322; +double gamma323; +double gamma333; +double gammado111; +double gammado112; +double gammado113; +double gammado122; +double gammado123; +double gammado133; +double gammado211; +double gammado212; +double gammado213; +double gammado222; +double gammado223; +double gammado233; +double gammado311; +double gammado312; +double gammado313; +double gammado322; +double gammado323; +double gammado333; +double Gams; +double Gfromg1; +double Gfromg2; +double Gfromg3; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +const bool givehPsi0 = false; +const double hPsi0para = 0; +const double hPsi0parb = 0; +const double hPsi0parc = 0; +double ImhPsi0; +double K; +double lieA11; +double lieA12; +double lieA13; +double lieA22; +double lieA23; +double lieA33; +double lieg11; +double lieg12; +double lieg13; +double lieg22; +double lieg23; +double lieg33; +double lienK; +double lienKhat; +double lienTheta; +double modshatARG; +double muL; +double muStilde; +double oochipsipower; +double oomodshat; +double psim4; +double qdd11; +double qdd12; +double qdd13; +double qdd22; +double qdd23; +double qdd33; +double qPhysuudd1111; +double qPhysuudd1112; +double qPhysuudd1113; +double qPhysuudd1122; +double qPhysuudd1123; +double qPhysuudd1133; +double qPhysuudd1211; +double qPhysuudd1212; +double qPhysuudd1213; +double qPhysuudd1222; +double qPhysuudd1223; +double qPhysuudd1233; +double qPhysuudd1311; +double qPhysuudd1312; +double qPhysuudd1313; +double qPhysuudd1322; +double qPhysuudd1323; +double qPhysuudd1333; +double qPhysuudd2211; +double qPhysuudd2212; +double qPhysuudd2213; +double qPhysuudd2222; +double qPhysuudd2223; +double qPhysuudd2233; +double qPhysuudd2311; +double qPhysuudd2312; +double qPhysuudd2313; +double qPhysuudd2322; +double qPhysuudd2323; +double qPhysuudd2333; +double qPhysuudd3311; +double qPhysuudd3312; +double qPhysuudd3313; +double qPhysuudd3322; +double qPhysuudd3323; +double qPhysuudd3333; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double quu11; +double quu12; +double quu13; +double quu22; +double quu23; +double quu33; +double R11; +double R12; +double R13; +double R22; +double R23; +double R33; +double rACABTF11; +double rACABTF12; +double rACABTF13; +double rACABTF22; +double rACABTF23; +double rACABTF33; +double rACqq; +double rACsA1; +double rACsA2; +double rACsA3; +double rACss; +double RehPsi0; +double Rf11; +double Rf12; +double Rf13; +double Rf22; +double Rf23; +double Rf33; +double rGamA1; +double rGamA2; +double rGamA3; +double rGams; +double Rhat; +double Rphi11; +double Rphi12; +double Rphi13; +double Rphi22; +double Rphi23; +double Rphi33; +double sdotv; +double sdotw; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; +const double time = 0; +double totdivbeta; +double trcdda; +double trcddf; +double vbetaA; +double vbetas; +double vd1; +double vd2; +double vd3; +double vdotv; +double vdotw; +double vu1; +double vu2; +double vu3; +double wd1; +double wd2; +double wd3; +double wdotw; +double wu1; +double wu2; +double wu3; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +#if 0 +// my code +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +g12/chi - sdown1*sdown2 +; + +qdd13 += +g13/chi - sdown1*sdown3 +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +g23/chi - sdown2*sdown3 +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +qPhysuudd1111 += +-0.5*qdd11*quu11 + pow2(qud11) +; + +qPhysuudd1112 += +qud11*qud12 - 0.5*qdd12*quu11 +; + +qPhysuudd1113 += +qud11*qud13 - 0.5*qdd13*quu11 +; + +qPhysuudd1122 += +-0.5*qdd22*quu11 + pow2(qud12) +; + +qPhysuudd1123 += +qud12*qud13 - 0.5*qdd23*quu11 +; + +qPhysuudd1133 += +-0.5*qdd33*quu11 + pow2(qud13) +; + +qPhysuudd1211 += +qud11*qud21 - 0.5*qdd11*quu12 +; + +qPhysuudd1212 += +0.5*(qud12*qud21 + qud11*qud22 - qdd12*quu12) +; + +qPhysuudd1213 += +0.5*(qud13*qud21 + qud11*qud23 - qdd13*quu12) +; + +qPhysuudd1222 += +qud12*qud22 - 0.5*qdd22*quu12 +; + +qPhysuudd1223 += +0.5*(qud13*qud22 + qud12*qud23 - qdd23*quu12) +; + +qPhysuudd1233 += +qud13*qud23 - 0.5*qdd33*quu12 +; + +qPhysuudd1311 += +qud11*qud31 - 0.5*qdd11*quu13 +; + +qPhysuudd1312 += +0.5*(qud12*qud31 + qud11*qud32 - qdd12*quu13) +; + +qPhysuudd1313 += +0.5*(qud13*qud31 + qud11*qud33 - qdd13*quu13) +; + +qPhysuudd1322 += +qud12*qud32 - 0.5*qdd22*quu13 +; + +qPhysuudd1323 += +0.5*(qud13*qud32 + qud12*qud33 - qdd23*quu13) +; + +qPhysuudd1333 += +qud13*qud33 - 0.5*qdd33*quu13 +; + +qPhysuudd2211 += +-0.5*qdd11*quu22 + pow2(qud21) +; + +qPhysuudd2212 += +qud21*qud22 - 0.5*qdd12*quu22 +; + +qPhysuudd2213 += +qud21*qud23 - 0.5*qdd13*quu22 +; + +qPhysuudd2222 += +-0.5*qdd22*quu22 + pow2(qud22) +; + +qPhysuudd2223 += +qud22*qud23 - 0.5*qdd23*quu22 +; + +qPhysuudd2233 += +-0.5*qdd33*quu22 + pow2(qud23) +; + +qPhysuudd2311 += +qud21*qud31 - 0.5*qdd11*quu23 +; + +qPhysuudd2312 += +0.5*(qud22*qud31 + qud21*qud32 - qdd12*quu23) +; + +qPhysuudd2313 += +0.5*(qud23*qud31 + qud21*qud33 - qdd13*quu23) +; + +qPhysuudd2322 += +qud22*qud32 - 0.5*qdd22*quu23 +; + +qPhysuudd2323 += +0.5*(qud23*qud32 + qud22*qud33 - qdd23*quu23) +; + +qPhysuudd2333 += +qud23*qud33 - 0.5*qdd33*quu23 +; + +qPhysuudd3311 += +-0.5*qdd11*quu33 + pow2(qud31) +; + +qPhysuudd3312 += +qud31*qud32 - 0.5*qdd12*quu33 +; + +qPhysuudd3313 += +qud31*qud33 - 0.5*qdd13*quu33 +; + +qPhysuudd3322 += +-0.5*qdd22*quu33 + pow2(qud32) +; + +qPhysuudd3323 += +qud32*qud33 - 0.5*qdd23*quu33 +; + +qPhysuudd3333 += +-0.5*qdd33*quu33 + pow2(qud33) +; + +muL += +2./alpha +; + +muStilde += +1/chi +; + +vbetas += +2.*sqrt(0.33333333333333333333*muStilde) +; + +vbetaA += +sqrt(muStilde) +; + +K += +Khat + 2.*Theta +; + +dK1 += +dKhat1 + 2.*dTheta1 +; + +dK2 += +dKhat2 + 2.*dTheta2 +; + +dK3 += +dKhat3 + 2.*dTheta3 +; + +dginv111 += +-2.*(dg123*ginv12*ginv13 + ginv11*(dg112*ginv12 + dg113*ginv13)) - + dg111*pow2(ginv11) - dg122*pow2(ginv12) - dg133*pow2(ginv13) +; + +dginv112 += +-(ginv11*(dg111*ginv12 + dg112*ginv22 + dg113*ginv23)) - + ginv12*(dg113*ginv13 + dg122*ginv22 + dg123*ginv23) - + ginv13*(dg123*ginv22 + dg133*ginv23) - dg112*pow2(ginv12) +; + +dginv113 += +-(ginv11*(dg111*ginv13 + dg112*ginv23 + dg113*ginv33)) - + ginv12*(dg112*ginv13 + dg122*ginv23 + dg123*ginv33) - + ginv13*(dg123*ginv23 + dg133*ginv33) - dg113*pow2(ginv13) +; + +dginv122 += +-2.*(dg123*ginv22*ginv23 + ginv12*(dg112*ginv22 + dg113*ginv23)) - + dg111*pow2(ginv12) - dg122*pow2(ginv22) - dg133*pow2(ginv23) +; + +dginv123 += +-(ginv13*(dg112*ginv22 + dg113*ginv23)) - dg133*ginv23*ginv33 - + ginv12*(dg111*ginv13 + dg112*ginv23 + dg113*ginv33) - + ginv22*(dg122*ginv23 + dg123*ginv33) - dg123*pow2(ginv23) +; + +dginv133 += +-2.*(dg123*ginv23*ginv33 + ginv13*(dg112*ginv23 + dg113*ginv33)) - + dg111*pow2(ginv13) - dg122*pow2(ginv23) - dg133*pow2(ginv33) +; + +dginv211 += +-2.*(dg223*ginv12*ginv13 + ginv11*(dg212*ginv12 + dg213*ginv13)) - + dg211*pow2(ginv11) - dg222*pow2(ginv12) - dg233*pow2(ginv13) +; + +dginv212 += +-(ginv11*(dg211*ginv12 + dg212*ginv22 + dg213*ginv23)) - + ginv12*(dg213*ginv13 + dg222*ginv22 + dg223*ginv23) - + ginv13*(dg223*ginv22 + dg233*ginv23) - dg212*pow2(ginv12) +; + +dginv213 += +-(ginv11*(dg211*ginv13 + dg212*ginv23 + dg213*ginv33)) - + ginv12*(dg212*ginv13 + dg222*ginv23 + dg223*ginv33) - + ginv13*(dg223*ginv23 + dg233*ginv33) - dg213*pow2(ginv13) +; + +dginv222 += +-2.*(dg223*ginv22*ginv23 + ginv12*(dg212*ginv22 + dg213*ginv23)) - + dg211*pow2(ginv12) - dg222*pow2(ginv22) - dg233*pow2(ginv23) +; + +dginv223 += +-(ginv13*(dg212*ginv22 + dg213*ginv23)) - dg233*ginv23*ginv33 - + ginv12*(dg211*ginv13 + dg212*ginv23 + dg213*ginv33) - + ginv22*(dg222*ginv23 + dg223*ginv33) - dg223*pow2(ginv23) +; + +dginv233 += +-2.*(dg223*ginv23*ginv33 + ginv13*(dg212*ginv23 + dg213*ginv33)) - + dg211*pow2(ginv13) - dg222*pow2(ginv23) - dg233*pow2(ginv33) +; + +dginv311 += +-2.*(dg323*ginv12*ginv13 + ginv11*(dg312*ginv12 + dg313*ginv13)) - + dg311*pow2(ginv11) - dg322*pow2(ginv12) - dg333*pow2(ginv13) +; + +dginv312 += +-(ginv11*(dg311*ginv12 + dg312*ginv22 + dg313*ginv23)) - + ginv12*(dg313*ginv13 + dg322*ginv22 + dg323*ginv23) - + ginv13*(dg323*ginv22 + dg333*ginv23) - dg312*pow2(ginv12) +; + +dginv313 += +-(ginv11*(dg311*ginv13 + dg312*ginv23 + dg313*ginv33)) - + ginv12*(dg312*ginv13 + dg322*ginv23 + dg323*ginv33) - + ginv13*(dg323*ginv23 + dg333*ginv33) - dg313*pow2(ginv13) +; + +dginv322 += +-2.*(dg323*ginv22*ginv23 + ginv12*(dg312*ginv22 + dg313*ginv23)) - + dg311*pow2(ginv12) - dg322*pow2(ginv22) - dg333*pow2(ginv23) +; + +dginv323 += +-(ginv13*(dg312*ginv22 + dg313*ginv23)) - dg333*ginv23*ginv33 - + ginv12*(dg311*ginv13 + dg312*ginv23 + dg313*ginv33) - + ginv22*(dg322*ginv23 + dg323*ginv33) - dg323*pow2(ginv23) +; + +dginv333 += +-2.*(dg323*ginv23*ginv33 + ginv13*(dg312*ginv23 + dg313*ginv33)) - + dg311*pow2(ginv13) - dg322*pow2(ginv23) - dg333*pow2(ginv33) +; + +gammado111 += +0.5*dg111 +; + +gammado112 += +0.5*dg211 +; + +gammado113 += +0.5*dg311 +; + +gammado122 += +-0.5*dg122 + dg212 +; + +gammado123 += +0.5*(-dg123 + dg213 + dg312) +; + +gammado133 += +-0.5*dg133 + dg313 +; + +gammado211 += +dg112 - 0.5*dg211 +; + +gammado212 += +0.5*dg122 +; + +gammado213 += +0.5*(dg123 - dg213 + dg312) +; + +gammado222 += +0.5*dg222 +; + +gammado223 += +0.5*dg322 +; + +gammado233 += +-0.5*dg233 + dg323 +; + +gammado311 += +dg113 - 0.5*dg311 +; + +gammado312 += +0.5*(dg123 + dg213 - dg312) +; + +gammado313 += +0.5*dg133 +; + +gammado322 += +dg223 - 0.5*dg322 +; + +gammado323 += +0.5*dg233 +; + +gammado333 += +0.5*dg333 +; + +gamma111 += +gammado111*ginv11 + gammado211*ginv12 + gammado311*ginv13 +; + +gamma112 += +gammado112*ginv11 + gammado212*ginv12 + gammado312*ginv13 +; + +gamma113 += +gammado113*ginv11 + gammado213*ginv12 + gammado313*ginv13 +; + +gamma122 += +gammado122*ginv11 + gammado222*ginv12 + gammado322*ginv13 +; + +gamma123 += +gammado123*ginv11 + gammado223*ginv12 + gammado323*ginv13 +; + +gamma133 += +gammado133*ginv11 + gammado233*ginv12 + gammado333*ginv13 +; + +gamma211 += +gammado111*ginv12 + gammado211*ginv22 + gammado311*ginv23 +; + +gamma212 += +gammado112*ginv12 + gammado212*ginv22 + gammado312*ginv23 +; + +gamma213 += +gammado113*ginv12 + gammado213*ginv22 + gammado313*ginv23 +; + +gamma222 += +gammado122*ginv12 + gammado222*ginv22 + gammado322*ginv23 +; + +gamma223 += +gammado123*ginv12 + gammado223*ginv22 + gammado323*ginv23 +; + +gamma233 += +gammado133*ginv12 + gammado233*ginv22 + gammado333*ginv23 +; + +gamma311 += +gammado111*ginv13 + gammado211*ginv23 + gammado311*ginv33 +; + +gamma312 += +gammado112*ginv13 + gammado212*ginv23 + gammado312*ginv33 +; + +gamma313 += +gammado113*ginv13 + gammado213*ginv23 + gammado313*ginv33 +; + +gamma322 += +gammado122*ginv13 + gammado222*ginv23 + gammado322*ginv33 +; + +gamma323 += +gammado123*ginv13 + gammado223*ginv23 + gammado323*ginv33 +; + +gamma333 += +gammado133*ginv13 + gammado233*ginv23 + gammado333*ginv33 +; + +Gfromg1 += +gamma111*ginv11 + gamma122*ginv22 + + 2.*(gamma112*ginv12 + gamma113*ginv13 + gamma123*ginv23) + gamma133*ginv33 +; + +Gfromg2 += +gamma211*ginv11 + gamma222*ginv22 + + 2.*(gamma212*ginv12 + gamma213*ginv13 + gamma223*ginv23) + gamma233*ginv33 +; + +Gfromg3 += +gamma311*ginv11 + gamma322*ginv22 + + 2.*(gamma312*ginv12 + gamma313*ginv13 + gamma323*ginv23) + gamma333*ginv33 +; + +dGfromgdu11 += +-((dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)* + Power(ginv12,3)) - (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + + dg111*dg333)*Power(ginv13,3) - 2.*Power(ginv11,3)*pow2(dg111) + + (ddg1111 - dg111*((8.*dg112 + 2.*dg211)*ginv12 + + (8.*dg113 + 2.*dg311)*ginv13) - + (dg113*(4.*dg112 + dg211) + dg112*dg311 + dg111*(dg213 + dg312))* + ginv23 - ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(dg113*dg311 + dg111*dg313 + 2.*pow2(dg113)))*pow2(ginv11) + + (ddg1122 + ddg1212 - (dg123*(8.*dg112 + 2.*dg211) + + dg113*(4.*dg122 + 2.*dg212) + dg122*dg311 + + 2.*(dg111*dg223 + dg112*(dg213 + dg312)) + dg111*dg322)*ginv13 - + (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + ginv23 - ginv22*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122)) - + ginv33*(dg123*(dg213 + dg312) + dg122*dg313 + dg113*(dg223 + dg322) + + dg112*dg323 + 2.*pow2(dg123)))*pow2(ginv12) + + (ddg1133 + ddg1313 - (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*ginv23 - + ginv22*(dg133*dg212 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*(dg233 + dg323) + 2.*pow2(dg123)) - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133)))*pow2(ginv13) \ ++ ginv13*(ddg1333*ginv33 + ginv22* + (ddg1223 - (dg133*dg222 + dg123*(4.*dg223 + dg322) + + dg122*(dg233 + dg323))*ginv23 - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*ginv33) + + ginv23*(ddg1233 + ddg1323 - + (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)*ginv33) - + (dg123*dg222 + dg122*dg223)*pow2(ginv22) - + (dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + + dg122*dg333)*pow2(ginv23) - 2.*dg133*dg333*pow2(ginv33)) + + ginv11*(ddg1313*ginv33 + ginv12* + (2.*ddg1112 + ddg1211 - + (dg113*(12.*dg112 + 3.*dg211) + 3.*dg112*dg311 + + dg111*(8.*dg123 + 3.*(dg213 + dg312)))*ginv13 - + (dg122*(4.*dg112 + dg211) + 6.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*dg211 + dg122*dg311 + + 4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213 + dg312)) + + dg111*(dg223 + dg322))*ginv23 - + (dg123*dg311 + dg113*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*dg112*dg313 + dg111*dg323)*ginv33) + + ginv22*(ddg1212 - (dg113*dg222 + 2.*(dg123*dg212 + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv23 - + (dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323)*ginv33) + + ginv13*(2.*ddg1113 + ddg1311 - + (dg123*(4.*dg112 + dg211) + dg111*dg223 + + 2.*(dg113*dg212 + dg112*(dg213 + dg312)))*ginv22 - + (dg133*dg211 + dg123*dg311 + + 4.*(dg113*(dg123 + dg213 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + dg323))*ginv23 - + (dg133*(4.*dg113 + dg311) + 6.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1213 + ddg1312 - + (dg133*(dg213 + dg312) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323) + dg112*dg333)*ginv33) - + (3.*dg112*dg211 + dg111*(4.*dg122 + 3.*dg212) + 6.*pow2(dg112))* + pow2(ginv12) - (3.*dg113*dg311 + dg111*(4.*dg133 + 3.*dg313) + + 6.*pow2(dg113))*pow2(ginv13) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (dg133*dg212 + dg123*(dg213 + dg312) + dg122*dg313 + + dg113*(dg223 + dg322) + dg112*(dg233 + dg323))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv12*(ddg1323*ginv33 + ginv22* + (ddg1222 - (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)*ginv23 - + (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33) + + ginv23*(ddg1223 + ddg1322 - + (dg133*(dg223 + dg322) + dg123*(dg233 + 4.*dg323) + dg122*dg333)* + ginv33) + ginv13*(2.*ddg1123 + ddg1213 + ddg1312 - + (dg113*dg222 + 4.*(dg123*(dg122 + dg212) + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv22 - + (dg133*(4.*dg123 + dg213 + dg312) + 4.*dg123*dg313 + + dg113*(dg233 + 4.*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg122*dg313 + + dg113*dg322) + 4.* + (dg122*dg133 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*dg323 + pow2(dg123)))) - + (dg133*(4.*dg112 + dg211) + dg113*(8.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + pow2(ginv13) - 2.*dg122*dg222*pow2(ginv22) - + (dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + pow2(ginv23) - (dg133*dg323 + dg123*dg333)*pow2(ginv33)) +; + +dGfromgdu12 += +-((dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + dg122*dg333)* + Power(ginv23,3)) - 2.*(dg122*dg222*Power(ginv22,3) + + Power(ginv12,3)*(dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112)) + + (dg111*(dg112*ginv22 + dg113*ginv23) + ginv12*pow2(dg111))*pow2(ginv11)\ +) + (ddg1112 + ddg1211 - (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))*ginv13 - + (dg122*(6.*dg112 + 2.*dg211) + 6.*dg112*dg212 + 2.*dg111*dg222)* + ginv22 - (4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213)) + + dg122*dg311 + 2.*(dg123*dg211 + dg111*dg223 + dg112*dg312) + + dg111*dg322)*ginv23 - + (dg123*dg311 + dg113*(2.*(dg123 + dg213) + dg312) + dg112*dg313 + + dg111*dg323)*ginv33)*pow2(ginv12) - + ((2.*(dg113*dg123 + dg112*dg133) + dg123*dg311 + dg113*dg312 + + dg112*dg313 + dg111*dg323)*ginv22 + + (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + dg111*dg333)*ginv23)* + pow2(ginv13) + (ddg1222 - (4.*(dg123*dg222 + dg122*dg223) + + 2.*dg122*dg322)*ginv23 - + (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33)*pow2(ginv22) + + (ddg1233 + ddg1323 - (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)* + ginv33)*pow2(ginv23) + ginv11* + (ginv23*(ddg1113 - 2.*dg113*(dg133 + dg313)*ginv33) + + ginv22*(ddg1112 - (dg112*(4.*dg123 + 2.*dg213) + + 2.*(dg113*(dg122 + dg212) + dg112*dg312))*ginv23 - + (dg113*(2.*dg123 + dg312) + dg112*dg313)*ginv33) + + ginv12*(ddg1111 - dg111*(6.*dg113 + 2.*dg311)*ginv13 - + (dg113*(8.*dg112 + 2.*dg211) + dg112*dg311 + + dg111*(2.*(dg123 + dg213) + dg312))*ginv23 - + ginv22*(2.*(dg112*dg211 + dg111*(dg122 + dg212)) + + 6.*pow2(dg112)) - ginv33* + (dg113*dg311 + dg111*dg313 + 2.*pow2(dg113))) - + ginv13*((dg112*(4.*dg113 + dg311) + dg111*(2.*dg123 + dg312))* + ginv22 + ginv23*(dg113*dg311 + dg111*(2.*dg133 + dg313) + + 4.*pow2(dg113))) - dg111*(6.*dg112 + 2.*dg211)*pow2(ginv12) - + 2.*dg112*(dg122 + dg212)*pow2(ginv22) - + (2.*(dg112*dg133 + dg113*(dg123 + dg213)) + dg113*dg312 + dg112*dg313)* + pow2(ginv23)) + ginv13*(ginv22* + (ddg1123 + ddg1312 - (dg133*(2.*dg123 + dg312) + + 2.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg113*dg223 + + dg112*dg233) + dg122*dg313 + dg113*dg322 + + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg123)))) + + ginv23*(ddg1133 + ddg1313 - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))) - + (2.*(dg123*(dg122 + dg212) + dg112*dg223) + dg122*dg312 + + dg112*dg322)*pow2(ginv22) - + (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*pow2(ginv23)\ +) + ginv23*(ddg1333*ginv33 - 2.*dg133*dg333*pow2(ginv33)) + + ginv12*(ddg1313*ginv33 + ginv13* + (ddg1113 + ddg1311 - (2.* + (dg123*dg211 + dg113*(dg122 + dg212) + dg111*dg223) + + dg122*dg311 + dg112*(8.*dg123 + 2.*dg213 + 4.*dg312) + + dg111*dg322)*ginv22 - + (dg133*(4.*dg112 + 2.*dg211) + + dg113*(8.*dg123 + 4.*(dg213 + dg312)) + 4.*dg112*dg313 + + 2.*(dg123*dg311 + dg111*(dg233 + dg323)))*ginv23 - + (dg133*(2.*dg113 + dg311) + 4.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1123 + 2.*ddg1213 + ddg1312 - + (2.*(dg133*(dg123 + dg213) + dg113*dg233) + dg133*dg312 + + 4.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33) + + ginv22*(ddg1122 + 2.*ddg1212 - + (4.*(dg122*dg213 + dg113*dg222) + + 6.*(dg123*(dg122 + dg212) + dg112*dg223) + + 3.*(dg122*dg312 + dg112*dg322))*ginv23 - + ginv33*(dg122*dg313 + dg113*dg322 + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323 + + pow2(dg123)))) - + 2.*(dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113))*pow2(ginv13) - + (4.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))*pow2(ginv22) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*(dg133*(dg122 + dg212) + dg123*dg312 + dg122*dg313 + + dg113*dg322 + dg112*(dg233 + dg323) + pow2(dg123)))*pow2(ginv23) \ +- (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv22*(ddg1323*ginv33 + ginv23* + (2.*ddg1223 + ddg1322 - (2.*(dg133*dg223 + dg123*dg233) + + dg133*dg322 + 6.*dg123*dg323 + dg122*dg333)*ginv33) - + (2.*(dg133*dg222 + dg122*dg233) + dg123*(6.*dg223 + 3.*dg322) + + 3.*dg122*dg323)*pow2(ginv23) - + (dg133*dg323 + dg123*dg333)*pow2(ginv33)) +; + +dGfromgdu13 += +-((dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + Power(ginv23,3)) - 2.*(dg133*dg333*Power(ginv33,3) + + Power(ginv13,3)*(dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113)) + + (dg111*(dg112*ginv23 + dg113*ginv33) + ginv13*pow2(dg111))*pow2(ginv11)\ +) - ((dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)*ginv23 + + (2.*(dg113*dg122 + dg112*dg123) + dg123*dg211 + dg113*dg212 + + dg112*dg213 + dg111*dg223)*ginv33 + + 2.*ginv13*(dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112)))* + pow2(ginv12) + (ddg1113 + ddg1311 - + (dg123*(2.*dg112 + dg211) + dg113*dg212 + dg111*dg223 + + dg112*(dg213 + 2.*dg312))*ginv22 - + (dg133*dg211 + 2.*(dg113*dg213 + dg123*dg311) + + 4.*(dg113*(dg123 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + 2.*dg323))*ginv23 - + (dg133*(6.*dg113 + 2.*dg311) + 6.*dg113*dg313 + 2.*dg111*dg333)*ginv33\ +)*pow2(ginv13) - (2.*dg122*dg222*ginv23 + + (dg123*dg222 + dg122*dg223)*ginv33)*pow2(ginv22) + + (ddg1223 + ddg1322 - (3.*(dg133*dg223 + dg123*dg233) + 6.*dg123*dg323 + + 2.*(dg133*dg322 + dg122*dg333))*ginv33)*pow2(ginv23) + + ddg1333*pow2(ginv33) + ginv11* + (ddg1113*ginv33 - ginv22*(2.*dg112*(dg122 + dg212)*ginv23 + + (dg113*dg212 + dg112*(2.*dg123 + dg213))*ginv33) + + ginv23*(ddg1112 - (dg113*(4.*dg123 + 2.*dg213) + + 2.*(dg113*dg312 + dg112*(dg133 + dg313)))*ginv33) - + ginv12*(dg111*(6.*dg112 + 2.*dg211)*ginv13 + + (dg113*(4.*dg112 + dg211) + dg111*(2.*dg123 + dg213))*ginv33 + + ginv23*(dg112*dg211 + dg111*(2.*dg122 + dg212) + 4.*pow2(dg112))) + + ginv13*(ddg1111 - (dg113*(8.*dg112 + dg211) + 2.*dg112*dg311 + + dg111*(dg213 + 2.*(dg123 + dg312)))*ginv23 - + ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(2.*(dg113*dg311 + dg111*(dg133 + dg313)) + 6.*pow2(dg113))) \ +- dg111*(6.*dg113 + 2.*dg311)*pow2(ginv13) - + (dg113*dg212 + dg112*dg213 + + 2.*(dg113*dg122 + dg112*(dg123 + dg312)))*pow2(ginv23) - + 2.*dg113*(dg133 + dg313)*pow2(ginv33)) + + ginv12*((ddg1123 + ddg1213)*ginv33 + + ginv13*(ddg1112 + ddg1211 - + (dg122*(2.*dg112 + dg211) + 4.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*(8.*dg112 + 2.*dg211) + + 4.*(dg113*(dg122 + dg212) + dg112*(dg213 + dg312)) + + 2.*(dg122*dg311 + dg111*(dg223 + dg322)))*ginv23 - + (dg133*(2.*dg112 + dg211) + + dg113*(8.*dg123 + 4.*dg213 + 2.*dg312) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + ginv33) - ginv22*((dg122*dg213 + dg113*dg222 + + 2.*(dg123*(dg122 + dg212) + dg112*dg223))*ginv33 + + ginv23*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))) + + ginv23*(ddg1122 + ddg1212 - + ginv33*(dg133*(2.*dg122 + dg212) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322) + + dg112*(dg233 + 2.*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg123)))) - + (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))* + pow2(ginv13) - (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + pow2(ginv23) - (dg133*(2.*dg123 + dg213) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv22*(ddg1223*ginv33 + ginv23* + (ddg1222 - (dg133*dg222 + dg123*(6.*dg223 + 2.*dg322) + + dg122*(dg233 + 2.*dg323))*ginv33) - + (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)*pow2(ginv23) - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv23*((ddg1233 + 2.*ddg1323)*ginv33 - + (dg133*(2.*dg233 + 4.*dg323) + 4.*dg123*dg333)*pow2(ginv33)) + + ginv13*((ddg1133 + 2.*ddg1313)*ginv33 + + ginv23*(ddg1123 + ddg1213 + 2.*ddg1312 - + (dg133*(6.*dg123 + 3.*dg213 + 4.*dg312) + 6.*dg123*dg313 + + dg113*(3.*dg233 + 6.*dg323) + 4.*dg112*dg333)*ginv33) + + ginv22*(ddg1212 - (dg123*(2.*dg122 + 4.*dg212) + dg113*dg222 + + dg122*(dg213 + 2.*dg312) + dg112*(4.*dg223 + 2.*dg322))*ginv23 - + ginv33*(dg133*dg212 + dg112*(dg233 + 2.*dg323) + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + pow2(dg123)))) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg112*dg233 + + dg122*dg313 + dg113*(dg223 + dg322) + pow2(dg123)))*pow2(ginv23) \ +- (4.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))*pow2(ginv33)) +; + +dGfromgdu21 += +-((dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + dg211*dg333)* + Power(ginv13,3)) - 2.*(dg111*dg211*Power(ginv11,3) + + Power(ginv12,3)*(dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212))) + + (ddg1211 - (4.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + 2.*(dg112 + dg211)*dg212*ginv22 - + (2.*(dg113*dg212 + (dg112 + dg211)*dg213) + dg212*dg311 + + dg211*dg312)*ginv23 - + (dg213*(2.*dg113 + dg311) + dg211*dg313)*ginv33 - + ginv12*(4.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211)))*pow2(ginv11) \ ++ (ddg1222 + ddg2212 - (4.*(dg212*(dg123 + dg213) + + (dg112 + dg211)*dg223) + dg222*dg311 + + 2.*(dg122*dg213 + dg113*dg222 + dg212*dg312) + dg211*dg322)*ginv13 \ +- (2.*dg122 + 6.*dg212)*dg222*ginv22 - + ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(2.*(dg123 + dg213) + dg312) + dg222*dg313 + dg213*dg322 + + dg212*dg323)*ginv33)*pow2(ginv12) + + (ddg1233 + ddg2313 - (2.*((dg123 + dg213)*dg223 + dg212*dg233) + + dg223*dg312 + dg212*dg323)*ginv22 - + (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*ginv23 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33)*pow2(ginv13) + + ginv11*(ddg2313*ginv33 + ginv22* + (ddg2212 - (dg222*(2.*dg213 + dg312) + dg212*(4.*dg223 + dg322))* + ginv23 - (dg223*(2.*dg213 + dg312) + dg212*dg323)*ginv33) + + ginv23*(ddg2213 + ddg2312 - + (dg233*(2.*dg213 + dg312) + 2.*(dg223*dg313 + dg213*dg323) + + dg212*dg333)*ginv33) + + ginv13*(2.*ddg1213 + ddg2311 - + (2.*(dg112 + dg211)*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv22 - + (2.*(dg133*dg213 + dg113*dg233) + dg233*dg311 + 6.*dg213*dg313 + + dg211*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg123*dg213 + dg113*dg223 + + (dg112 + dg211)*dg233) + dg223*dg311 + dg211*dg323 + + 4.*(dg213*dg312 + dg212*dg313 + pow2(dg213)))) + + ginv12*(2.*ddg1212 + ddg2211 - + (6.*(dg113*dg212 + dg112*dg213) + 4.*dg111*dg223 + + 3.*dg212*dg311 + dg211*(4.*dg123 + 6.*dg213 + 3.*dg312))*ginv13 \ +- (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + + (dg112 + dg211)*dg223) + dg222*dg311 + + dg212*(8.*dg213 + 4.*dg312) + dg211*dg322)*ginv23 - + ginv22*(2.*(dg122*dg212 + (dg112 + dg211)*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*dg311 + dg211*dg323 + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313 + + pow2(dg213)))) - + (6.*dg112*dg212 + dg211*(2.*dg122 + 6.*dg212) + 2.*dg111*dg222)* + pow2(ginv12) - (2.*(dg133*dg211 + dg111*dg233) + + dg213*(6.*dg113 + 3.*dg311) + 3.*dg211*dg313)*pow2(ginv13) - + 2.*dg212*dg222*pow2(ginv22) - + (2.*(dg213*dg223 + dg212*dg233) + dg223*dg312 + dg222*dg313 + + dg213*dg322 + dg212*dg323)*pow2(ginv23) - + (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv12*(ddg2323*ginv33 + ginv13* + (2.*ddg1223 + ddg2213 + ddg2312 - + (2.*((dg123 + dg213)*dg222 + dg122*dg223) + dg222*dg312 + + dg212*(8.*dg223 + dg322))*ginv22 - + (dg223*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322) + + 4.*dg212*(dg233 + dg323))*ginv23 - + (2.*(dg133*dg223 + (dg123 + dg213)*dg233) + dg233*dg312 + + 4.*(dg223*dg313 + dg213*dg323) + dg212*dg333)*ginv33) + + ginv23*(ddg2223 + ddg2322 - + (dg233*(2.*dg223 + dg322) + 4.*dg223*dg323 + dg222*dg333)*ginv33) + + ginv22*(ddg2222 - dg222*(6.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223))) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*((dg112 + dg211)*dg233 + dg223*dg311 + dg213*dg312 + + dg212*(dg133 + dg313) + dg211*dg323 + pow2(dg213)))*pow2(ginv13) \ +- 2.*(pow2(dg222)*pow2(ginv22) + + (dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223))*pow2(ginv23)) - + (dg233*dg323 + dg223*dg333)*pow2(ginv33)) + + ginv13*(ddg2333*ginv33 + ginv22* + (ddg2223 - 2.*dg223*(dg233 + dg323)*ginv33 - + ginv23*(dg223*dg322 + dg222*(2.*dg233 + dg323) + 4.*pow2(dg223))) + + ginv23*(ddg2233 + ddg2323 - + ginv33*(3.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))) - + (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg223*pow2(ginv22) + dg233*dg333*pow2(ginv33))\ +) +; + +dGfromgdu22 += +-((2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)* + Power(ginv12,3)) - (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + + dg222*dg333)*Power(ginv23,3) - 2.*Power(ginv22,3)*pow2(dg222) - + (2.*dg111*dg211*ginv12 + (dg112*dg211 + dg111*dg212)*ginv22 + + (dg113*dg211 + dg111*dg213)*ginv23)*pow2(ginv11) + + (ddg1212 + ddg2211 - (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))*ginv13 - + (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + dg112*dg223) + + dg222*dg311 + dg212*(8.*dg213 + 2.*dg312) + + dg211*(4.*dg223 + dg322))*ginv23 - + ginv22*(4.*dg211*dg222 + 3.*(dg122*dg212 + dg112*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + dg212*dg313 + + dg211*dg323 + 2.*pow2(dg213)))*pow2(ginv12) - + ((dg112*dg233 + dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + dg211*dg323)*ginv22 + + (dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + + dg211*dg333)*ginv23)*pow2(ginv13) + + (ddg2222 - dg222*(8.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223)))*pow2(ginv22) + + (ddg2233 + ddg2323 - ginv33* + (3.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233)))*pow2(ginv23) + + ginv13*(ginv22*(ddg1223 + ddg2312 - + (dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322 + + 4.*(dg223*(dg123 + dg213 + dg312) + dg212*(dg233 + dg323)))* + ginv23 - (dg233*(dg123 + dg312) + dg223*(dg133 + 2.*dg313) + + 2.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv23*(ddg1233 + ddg2313 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33) - + ((dg122 + 4.*dg212)*dg223 + dg222*(dg123 + dg312) + dg212*dg322)* + pow2(ginv22) - (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*pow2(ginv23)) + + ginv11*(-(ginv13*((2.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + + dg212*dg311 + dg211*(dg123 + dg312))*ginv22 + + (dg111*dg233 + dg213*(4.*dg113 + dg311) + dg211*(dg133 + dg313))* + ginv23)) + ginv12*(ddg1211 - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + (6.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + dg212*dg311 + + dg211*(dg123 + 4.*dg213 + dg312))*ginv23 - + (dg213*(2.*dg113 + dg311) + dg211*dg313)*ginv33) + + ginv22*(ddg1212 - (dg122*dg213 + dg113*dg222 + 2.*dg112*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv23 - + (dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313)*ginv33) + + ginv23*(ddg1213 - (dg113*dg233 + dg213*(dg133 + 2.*dg313))*ginv33) - + (3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))*pow2(ginv12) - + (dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))*pow2(ginv22) - + (dg113*dg223 + dg112*dg233 + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + 2.*pow2(dg213))*pow2(ginv23)) + + ginv23*(ddg2333*ginv33 - 2.*dg233*dg333*pow2(ginv33)) + + ginv12*(ddg2313*ginv33 + ginv22* + (ddg1222 + 2.*ddg2212 - + ((3.*dg122 + 12.*dg212)*dg223 + + dg222*(8.*dg213 + 3.*(dg123 + dg312)) + 3.*dg212*dg322)*ginv23 \ +- (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + dg222*dg313 + dg213*dg322 + + 2.*dg212*dg323)*ginv33) + + ginv23*(ddg1223 + 2.*ddg2213 + ddg2312 - + (dg233*(dg123 + 4.*dg213 + dg312) + dg223*(dg133 + 4.*dg313) + + 4.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv13*(ddg1213 + ddg2311 - + (dg122*dg213 + dg222*(dg113 + dg311) + + 4.*((dg112 + dg211)*dg223 + dg212*(dg123 + dg213 + dg312)) + + dg211*dg322)*ginv22 - + (dg233*(dg113 + dg311) + dg213*(dg133 + 4.*dg313) + dg211*dg333)* + ginv33 - ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg223*dg311 + + dg211*dg323) + 4.* + (dg113*dg223 + dg211*dg233 + dg213*(dg123 + dg312) + + dg212*dg313 + pow2(dg213)))) - + (dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + pow2(ginv13) - (2.*dg122 + 8.*dg212)*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(8.*dg213 + 2.*(dg123 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + pow2(ginv23) - (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (2.*ddg2223 + ddg2322 - (dg233*(4.*dg223 + dg322) + 6.*dg223*dg323 + + dg222*dg333)*ginv33) - + (3.*dg223*dg322 + dg222*(4.*dg233 + 3.*dg323) + 6.*pow2(dg223))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333)*pow2(ginv33)) +; + +dGfromgdu23 += +-((dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + Power(ginv13,3)) - (2.*dg111*dg211*ginv13 + + (dg112*dg211 + dg111*dg212)*ginv23 + + (dg113*dg211 + dg111*dg213)*ginv33)*pow2(ginv11) - + ((2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv13 + + (dg122*dg213 + dg212*(dg123 + 2.*dg213) + dg113*dg222 + + (dg112 + 2.*dg211)*dg223)*ginv33 + + 2.*ginv23*(dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212)))* + pow2(ginv12) + (ddg1213 + ddg2311 - + ((dg112 + 2.*dg211)*dg223 + dg212*(dg123 + 2.*(dg213 + dg312)))* + ginv22 - (3.*(dg133*dg213 + dg113*dg233) + 6.*dg213*dg313 + + 2.*(dg233*dg311 + dg211*dg333))*ginv33 - + ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg133*dg212 + dg123*dg213 + (dg112 + dg211)*dg233 + + dg223*(dg113 + dg311) + dg211*dg323 + pow2(dg213))))*pow2(ginv13) \ +- 2.*(dg233*dg333*Power(ginv33,3) + + Power(ginv23,3)*(dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223)) + + (dg222*dg223*ginv33 + ginv23*pow2(dg222))*pow2(ginv22)) + + (ddg2223 + ddg2322 - (dg233*(6.*dg223 + 2.*dg322) + 6.*dg223*dg323 + + 2.*dg222*dg333)*ginv33)*pow2(ginv23) + ddg2333*pow2(ginv33) + + ginv11*(ddg1213*ginv33 + ginv13* + (ddg1211 - 2.*(dg112 + dg211)*dg212*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + 2.*dg212*dg311 + + dg211*(dg123 + 2.*(dg213 + dg312)))*ginv23 - + (dg111*dg233 + dg213*(6.*dg113 + 2.*dg311) + + dg211*(dg133 + 2.*dg313))*ginv33) - + ginv12*((4.*dg112*dg212 + dg211*(dg122 + 2.*dg212) + dg111*dg222)* + ginv23 + (dg211*(dg123 + 2.*dg213) + + 2.*(dg113*dg212 + dg112*dg213) + dg111*dg223)*ginv33 + + ginv13*(3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))) - + ginv22*((dg212*(dg123 + 2.*dg213) + dg112*dg223)*ginv33 + + ginv23*(dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))) + + ginv23*(ddg1212 - ginv33* + (dg112*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + pow2(dg213)))) - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*pow2(ginv13) - + (dg122*dg213 + dg113*dg222 + dg112*dg223 + + dg212*(dg123 + 2.*(dg213 + dg312)))*pow2(ginv23) - + (dg113*dg233 + dg213*(dg133 + 2.*dg313))*pow2(ginv33)) + + ginv22*(ddg2223*ginv33 + ginv23* + (ddg2222 - ginv33*(2.*(dg223*dg322 + dg222*(dg233 + dg323)) + + 6.*pow2(dg223))) - dg222*(6.*dg223 + 2.*dg322)*pow2(ginv23) - + 2.*dg223*(dg233 + dg323)*pow2(ginv33)) + + ginv12*((ddg1223 + ddg2213)*ginv33 - + ginv22*((2.*dg122 + 6.*dg212)*dg222*ginv23 + + ((dg123 + 2.*dg213)*dg222 + (dg122 + 4.*dg212)*dg223)*ginv33) + + ginv23*(ddg1222 + ddg2212 - + ((dg122 + 2.*dg212)*dg233 + + dg223*(4.*dg123 + 8.*dg213 + 2.*dg312) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + ginv33) + ginv13*(ddg1212 + ddg2211 - + (4.*(dg112 + dg211)*dg223 + + dg212*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg213 + dg222*(dg113 + dg311) + dg211*dg322))*ginv23 \ +- ginv22*(dg122*dg212 + (dg112 + 2.*dg211)*dg222 + 4.*pow2(dg212)) - + ginv33*((dg112 + 2.*dg211)*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg223*dg311 + dg213*dg312 + dg211*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg213)))) - + (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))* + pow2(ginv13) - ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)* + pow2(ginv23) - ((dg123 + 2.*dg213)*dg233 + + dg223*(dg133 + 2.*dg313) + 2.*dg213*dg323)*pow2(ginv33)) + + ginv13*((ddg1233 + 2.*ddg2313)*ginv33 + + ginv22*(ddg2212 - ((dg122 + 8.*dg212)*dg223 + + dg222*(dg123 + 2.*(dg213 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*(dg233 + dg323))* + ginv33) + ginv23*(ddg1223 + ddg2213 + 2.*ddg2312 - + (3.*(dg133*dg223 + dg123*dg233) + dg233*(6.*dg213 + 4.*dg312) + + 6.*(dg223*dg313 + dg213*dg323) + 4.*dg212*dg333)*ginv33) - + 2.*dg212*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(2.*dg123 + 4.*(dg213 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*dg213*dg322 + 4.*dg212*dg323)* + pow2(ginv23) - (dg233*(2.*dg133 + 4.*dg313) + 4.*dg213*dg333)* + pow2(ginv33)) + ginv23*((ddg2233 + 2.*ddg2323)*ginv33 - + (4.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))*pow2(ginv33)) +; + +dGfromgdu31 += +-((dg222*dg311 + dg211*dg322 + 2.*((dg122 + dg212)*dg312 + dg112*dg322))* + Power(ginv12,3)) - 2.*(dg111*dg311*Power(ginv11,3) + + Power(ginv13,3)*(dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313))) + + (ddg1311 - ((4.*dg112 + 2.*dg211)*dg311 + 4.*dg111*dg312)*ginv12 - + (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + (dg311*(dg213 + 2.*dg312) + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313))*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(4.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311)))*pow2(ginv11) \ ++ (ddg1322 + ddg2312 - (2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))* + ginv22 - ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*ginv23 - + (dg313*(dg223 + 2.*dg322) + (dg213 + 2.*(dg123 + dg312))*dg323)* + ginv33 - ginv13*(4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg213*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + dg211*dg323 + pow2(dg312))))*pow2(ginv12) \ ++ (ddg1333 + ddg3313 - (dg233*dg312 + dg223*dg313 + + (dg213 + 2.*(dg123 + dg312))*dg323 + dg212*dg333)*ginv22 - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*ginv23 - + (2.*dg133 + 6.*dg313)*dg333*ginv33)*pow2(ginv13) + + ginv11*(ddg3313*ginv33 + ginv22* + (ddg2312 - (dg222*dg313 + dg213*dg322 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + (dg223*dg313 + (dg213 + 2.*dg312)*dg323)*ginv33) + + ginv23*(ddg2313 + ddg3312 - + (dg313*(dg233 + 4.*dg323) + (dg213 + 2.*dg312)*dg333)*ginv33) + + ginv12*(2.*ddg1312 + ddg2311 - + (dg311*(4.*dg123 + 3.*dg213 + 6.*dg312) + 3.*dg211*dg313 + + 6.*(dg113*dg312 + dg112*dg313) + 4.*dg111*dg323)*ginv13 - + (dg222*dg311 + (2.*dg122 + 6.*dg212)*dg312 + + (2.*dg112 + dg211)*dg322)*ginv22 - + (4.*dg312*dg313 + 2.*((dg123 + dg213)*dg313 + + (dg113 + dg311)*dg323))*ginv33 - + ginv23*((2.*dg123 + 4.*dg213)*dg312 + dg311*(dg223 + 2.*dg322) + + dg211*dg323 + 2.*(dg122*dg313 + dg113*dg322 + dg112*dg323) + + 4.*(dg212*dg313 + pow2(dg312)))) + + ginv13*(2.*ddg1313 + ddg3311 - + ((4.*dg213 + 8.*dg312)*dg313 + dg311*(dg233 + 2.*dg323) + + dg211*dg333 + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + + dg112*dg333))*ginv23 - + ginv22*(dg223*dg311 + dg211*dg323 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312))) - + ginv33*(2.*(dg133*dg313 + (dg113 + dg311)*dg333) + 6.*pow2(dg313))) \ +- ((2.*dg122 + 3.*dg212)*dg311 + (6.*dg112 + 3.*dg211)*dg312 + + 2.*dg111*dg322)*pow2(ginv12) - + (6.*dg113*dg313 + dg311*(2.*dg133 + 6.*dg313) + 2.*dg111*dg333)* + pow2(ginv13) - (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + (dg313*(dg223 + 2.*dg322) + dg213*dg323 + dg312*(dg233 + 2.*dg323) + + dg212*dg333)*pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv12*(ddg3323*ginv33 + ginv13* + (2.*ddg1323 + ddg2313 + ddg3312 - + (dg222*dg313 + (2.*dg123 + dg213)*dg322 + + dg312*(4.*dg223 + 2.*dg322) + (2.*dg122 + 4.*dg212)*dg323)* + ginv22 - ((4.*dg213 + 8.*dg312)*dg323 + + 4.*(dg313*(dg223 + dg322) + dg123*dg323) + + 2.*(dg233*dg312 + dg133*dg322 + (dg122 + dg212)*dg333))*ginv23 \ +- (dg313*(dg233 + 8.*dg323) + (dg213 + 2.*dg312)*dg333 + + 2.*(dg133*dg323 + dg123*dg333))*ginv33) + + ginv22*(ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))) + + ginv23*(ddg2323 + ddg3322 - + ginv33*(dg233*dg323 + (dg223 + 2.*dg322)*dg333 + 4.*pow2(dg323))) - + (dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg312)*dg313 + dg113*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg213*dg313 + dg112*dg333))*pow2(ginv13) - + (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg322*pow2(ginv22) + + dg323*dg333*pow2(ginv33))) + + ginv13*(ddg3333*ginv33 + ginv23* + (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33) + + ginv22*(ddg2323 - (4.*dg223*dg323 + dg322*(dg233 + 2.*dg323) + + dg222*dg333)*ginv23 - + ginv33*(dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))) - + (dg223*dg322 + dg222*dg323)*pow2(ginv22) - + 2.*((dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))*pow2(ginv23) + + pow2(dg333)*pow2(ginv33))) +; + +dGfromgdu32 += +-(((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + Power(ginv12,3)) - 2.*(dg222*dg322*Power(ginv22,3) + + Power(ginv23,3)*(dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))) - + (2.*dg111*dg311*ginv12 + (dg112*dg311 + dg111*dg312)*ginv22 + + (dg113*dg311 + dg111*dg313)*ginv23)*pow2(ginv11) + + (ddg1312 + ddg2311 - (4.*dg311*dg312 + + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*ginv13 - + ((3.*dg122 + 6.*dg212)*dg312 + 3.*dg112*dg322 + + 2.*(dg222*dg311 + dg211*dg322))*ginv22 - + ((dg123 + 2.*(dg213 + dg312))*dg313 + (dg113 + 2.*dg311)*dg323)* + ginv33 - ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + (dg112 + dg211)*dg323 + pow2(dg312))))* + pow2(ginv12) - ((dg123*dg313 + dg312*(dg133 + 2.*dg313) + + (dg113 + 2.*dg311)*dg323 + dg112*dg333)*ginv22 + + 2.*ginv23*(dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313)))* + pow2(ginv13) + (ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(4.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322)))*pow2(ginv22) \ ++ (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33)*pow2(ginv23) + + ginv11*(-(ginv13*((dg311*(dg123 + 2.*dg312) + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv22 + + (4.*dg113*dg313 + dg311*(dg133 + 2.*dg313) + dg111*dg333)*ginv23)\ +) + ginv12*(ddg1311 - ((dg122 + 2.*dg212)*dg311 + + (6.*dg112 + 2.*dg211)*dg312 + dg111*dg322)*ginv22 - + (dg311*(dg123 + 2.*(dg213 + dg312)) + 2.*dg211*dg313 + + 4.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))) + + ginv22*(ddg1312 - ((dg123 + 2.*dg312)*dg313 + dg113*dg323)*ginv33 - + ginv23*(dg122*dg313 + dg113*dg322 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312)))) + + ginv23*(ddg1313 - ginv33* + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))) - + ((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*pow2(ginv12) - + ((dg122 + 2.*dg212)*dg312 + dg112*dg322)*pow2(ginv22) - + (dg133*dg312 + (dg123 + 2.*(dg213 + dg312))*dg313 + dg113*dg323 + + dg112*dg333)*pow2(ginv23)) + + ginv13*(ginv23*(ddg1333 + ddg3313 - (2.*dg133 + 6.*dg313)*dg333*ginv33) + + ginv22*(ddg1323 + ddg3312 - + (dg133*dg322 + (4.*dg123 + 2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg313*(dg223 + dg322) + + dg212*dg333))*ginv23 - + ((dg133 + 4.*dg313)*dg323 + (dg123 + 2.*dg312)*dg333)*ginv33) - + (dg123*dg322 + dg122*dg323 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*pow2(ginv22) - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*pow2(ginv23)) + + ginv12*(ddg3313*ginv33 + ginv22* + (ddg1322 + 2.*ddg2312 - + (4.*(dg222*dg313 + dg213*dg322) + + 3.*(dg123*dg322 + dg122*dg323) + + 6.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + ((2.*dg213 + 4.*dg312)*dg323 + + 2.*(dg313*(dg223 + dg322) + dg123*dg323))*ginv33) + + ginv23*(ddg1323 + 2.*ddg2313 + ddg3312 - + (dg133*dg323 + dg313*(2.*dg233 + 8.*dg323) + + (dg123 + 2.*(dg213 + dg312))*dg333)*ginv33) + + ginv13*(ddg1313 + ddg3311 - + (8.*dg312*dg313 + 4.* + ((dg123 + dg213)*dg313 + (dg113 + dg311)*dg323) + + 2.*(dg233*dg311 + dg133*dg312 + (dg112 + dg211)*dg333))*ginv23 \ +- ginv22*(dg122*dg313 + dg113*dg322 + + 2.*(dg213*dg312 + dg212*dg313 + dg311*(dg223 + dg322) + + dg211*dg323) + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg312))) \ +- ginv33*(dg133*dg313 + (dg113 + 2.*dg311)*dg333 + 4.*pow2(dg313))) - + (2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)* + pow2(ginv13) - (2.*dg122*dg322 + 4.*(dg222*dg312 + dg212*dg322))* + pow2(ginv22) - (dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg213 + dg312)*dg323) + + dg122*dg333 + 2.*(dg233*dg312 + dg123*dg323 + dg212*dg333))* + pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv22*(ddg3323*ginv33 + ginv23* + (2.*ddg2323 + ddg3322 - + ginv33*(2.*(dg233*dg323 + (dg223 + dg322)*dg333) + 6.*pow2(dg323))) \ +- (6.*dg223*dg323 + dg322*(2.*dg233 + 6.*dg323) + 2.*dg222*dg333)* + pow2(ginv23) - 2.*dg323*dg333*pow2(ginv33)) + + ginv23*(ddg3333*ginv33 - 2.*pow2(dg333)*pow2(ginv33)) +; + +dGfromgdu33 += +-((2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)* + Power(ginv13,3)) - (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + + dg222*dg333)*Power(ginv23,3) - 2.*Power(ginv33,3)*pow2(dg333) - + (2.*dg111*dg311*ginv13 + (dg112*dg311 + dg111*dg312)*ginv23 + + (dg113*dg311 + dg111*dg313)*ginv33)*pow2(ginv11) - + (((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + ginv13 + (dg222*dg311 + dg211*dg322 + + 2.*((dg122 + dg212)*dg312 + dg112*dg322))*ginv23 + + (dg223*dg311 + (dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + + dg113*dg322 + (dg112 + dg211)*dg323)*ginv33)*pow2(ginv12) + + (ddg1313 + ddg3311 - ((2.*dg213 + 8.*dg312)*dg313 + + dg311*(dg233 + 4.*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + dg112*dg333))*ginv23 \ +- ginv22*(dg223*dg311 + (dg123 + dg213)*dg312 + dg212*dg313 + + (dg112 + dg211)*dg323 + 2.*pow2(dg312)) - + ginv33*(4.*dg311*dg333 + 3.*(dg133*dg313 + dg113*dg333) + + 6.*pow2(dg313)))*pow2(ginv13) - + (2.*dg222*dg322*ginv23 + (dg223*dg322 + dg222*dg323)*ginv33)* + pow2(ginv22) + (ddg2323 + ddg3322 - + ginv33*(4.*dg322*dg333 + 3.*(dg233*dg323 + dg223*dg333) + + 6.*pow2(dg323)))*pow2(ginv23) + ddg3333*pow2(ginv33) + + ginv13*((ddg1333 + 2.*ddg3313)*ginv33 + + ginv22*(ddg2312 - (dg222*dg313 + (dg123 + dg213)*dg322 + + dg122*dg323 + 4.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 \ +- (dg312*(dg233 + 4.*dg323) + 2.*(dg223*dg313 + (dg123 + dg213)*dg323) + + dg212*dg333)*ginv33) + + ginv23*(ddg1323 + ddg2313 + 2.*ddg3312 - + (12.*dg313*dg323 + (3.*dg213 + 8.*dg312)*dg333 + + 3.*(dg233*dg313 + dg133*dg323 + dg123*dg333))*ginv33) - + (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + ((dg133 + 4.*dg313)*dg322 + (2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg223*dg313 + dg123*dg323 + + dg212*dg333))*pow2(ginv23) - + (2.*dg133 + 8.*dg313)*dg333*pow2(ginv33)) + + ginv23*((ddg2333 + 2.*ddg3323)*ginv33 - + (2.*dg233 + 8.*dg323)*dg333*pow2(ginv33)) + + ginv12*((ddg1323 + ddg2313)*ginv33 - + ginv22*((2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))*ginv23 + + (dg222*dg313 + (dg123 + dg213)*dg322 + dg122*dg323 + + 2.*(dg223*dg312 + dg212*dg323))*ginv33) + + ginv23*(ddg1322 + ddg2312 - + (dg233*dg312 + dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg123 + dg213 + dg312)*dg323) + + (dg122 + dg212)*dg333)*ginv33) + + ginv13*(ddg1312 + ddg2311 - + (dg222*dg311 + (dg122 + 4.*dg212)*dg312 + (dg112 + dg211)*dg322)* + ginv22 - (dg133*dg312 + dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg213 + dg312)*dg313 + dg113*dg323) + + (dg112 + dg211)*dg333)*ginv33 - + ginv23*(2.*(dg223*dg311 + dg122*dg313 + dg113*dg322 + + dg211*dg323) + 4.* + ((dg123 + dg213)*dg312 + dg212*dg313 + dg311*dg322 + + dg112*dg323 + pow2(dg312)))) - + (4.*dg311*dg312 + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*pow2(ginv13) - + ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*pow2(ginv23) - + (dg133*dg323 + dg313*(dg233 + 4.*dg323) + (dg123 + dg213)*dg333)* + pow2(ginv33)) + ginv11*(ddg1313*ginv33 - + ginv12*(((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*ginv13 + + ((dg122 + dg212)*dg311 + (4.*dg112 + dg211)*dg312 + dg111*dg322)* + ginv23 + ((dg123 + dg213)*dg311 + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv33) - + ginv22*(((dg122 + 2.*dg212)*dg312 + dg112*dg322)*ginv23 + + ((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323)*ginv33) + + ginv13*(ddg1311 - (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + ((dg123 + dg213)*dg311 + 4.*(dg113 + dg311)*dg312 + + (4.*dg112 + dg211)*dg313 + dg111*dg323)*ginv23 - + (6.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)*ginv33) + + ginv23*(ddg1312 - (dg312*(dg133 + 4.*dg313) + + 2.*((dg123 + dg213)*dg313 + dg113*dg323) + dg112*dg333)*ginv33) \ +- (3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))*pow2(ginv13) - + ((dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg112*dg323 + 2.*pow2(dg312))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (ddg2322 - (6.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + ginv33) - (3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))* + pow2(ginv33)) +; + +R11 += +dG11*g11 + dG12*g12 + dG13*g13 + gammado111*Gfromg1 + gammado112*Gfromg2 + + gammado113*Gfromg3 + (-0.5*ddg1111 + 3.*gamma111*gammado111 + + 2.*(gamma211*gammado112 + gamma311*gammado113) + + gamma211*gammado211 + gamma311*gammado311)*ginv11 + + (-ddg1211 + 3.*(gamma112*gammado111 + gamma111*gammado112) + + 2.*(gamma212*gammado112 + gamma312*gammado113 + + gamma211*gammado122 + gamma311*gammado123) + gamma212*gammado211 + + gamma211*gammado212 + gamma312*gammado311 + gamma311*gammado312)*ginv12 \ ++ (-ddg1311 + 3.*(gamma113*gammado111 + gamma111*gammado113) + + 2.*(gamma213*gammado112 + gamma313*gammado113 + + gamma211*gammado123 + gamma311*gammado133) + gamma213*gammado211 + + gamma211*gammado213 + gamma313*gammado311 + gamma311*gammado313)*ginv13 \ ++ (-0.5*ddg2211 + 3.*gamma112*gammado112 + + 2.*(gamma212*gammado122 + gamma312*gammado123) + + gamma212*gammado212 + gamma312*gammado312)*ginv22 + + (-ddg2311 + 3.*(gamma113*gammado112 + gamma112*gammado113) + + 2.*(gamma213*gammado122 + (gamma212 + gamma313)*gammado123 + + gamma312*gammado133) + gamma213*gammado212 + gamma212*gammado213 + + gamma313*gammado312 + gamma312*gammado313)*ginv23 + + (-0.5*ddg3311 + 3.*gamma113*gammado113 + + 2.*(gamma213*gammado123 + gamma313*gammado133) + gamma213*gammado213 + + gamma313*gammado313)*ginv33 +; + +R12 += +0.5*(dG21*g11 + (dG11 + dG22)*g12 + dG23*g13 + dG12*g22 + dG13*g23 + + (gammado112 + gammado211)*Gfromg1 + + (gammado122 + gammado212)*Gfromg2 + (gammado123 + gammado213)*Gfromg3) \ ++ (-0.5*ddg1112 + gamma112*gammado111 + (gamma111 + gamma212)*gammado112 + + gamma312*gammado113 + gamma111*gammado211 + 2.*gamma211*gammado212 + + gamma311*(gammado213 + gammado312))*ginv11 + + (-ddg1212 + gamma122*gammado111 + (2.*gamma112 + gamma222)*gammado112 + + gamma322*gammado113 + (gamma111 + gamma212)*gammado122 + + gamma112*gammado211 + (gamma111 + 2.*gamma212)*gammado212 + + 2.*gamma211*gammado222 + + gamma312*(gammado123 + gammado213 + gammado312) + + gamma311*(gammado223 + gammado322))*ginv12 + + (-ddg1312 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + (gamma111 + gamma212)*gammado123 + + gamma312*gammado133 + gamma113*gammado211 + + (gamma111 + gamma313)*gammado213 + + 2.*(gamma213*gammado212 + gamma211*gammado223) + + gamma313*gammado312 + gamma311*(gammado233 + gammado323))*ginv13 + + (-0.5*ddg2212 + gamma122*gammado112 + (gamma112 + gamma222)*gammado122 + + gamma322*gammado123 + gamma112*gammado212 + 2.*gamma212*gammado222 + + gamma312*(gammado223 + gammado322))*ginv22 + + (-ddg2312 + gamma123*gammado112 + gamma122*gammado113 + + (gamma113 + gamma223)*gammado122 + + (gamma112 + gamma222 + gamma323)*gammado123 + gamma322*gammado133 + + gamma113*gammado212 + gamma112*gammado213 + + 2.*(gamma213*gammado222 + gamma212*gammado223) + + gamma313*(gammado223 + gammado322) + + gamma312*(gammado233 + gammado323))*ginv23 + + (-0.5*ddg3312 + gamma123*gammado113 + (gamma113 + gamma223)*gammado123 + + gamma323*gammado133 + gamma113*gammado213 + 2.*gamma213*gammado223 + + gamma313*(gammado233 + gammado323))*ginv33 +; + +R13 += +0.5*(dG31*g11 + dG32*g12 + (dG11 + dG33)*g13 + dG12*g23 + dG13*g33 + + (gammado113 + gammado311)*Gfromg1 + + (gammado123 + gammado312)*Gfromg2 + (gammado133 + gammado313)*Gfromg3) \ ++ (-0.5*ddg1113 + gamma113*gammado111 + gamma213*gammado112 + + (gamma111 + gamma313)*gammado113 + gamma111*gammado311 + + gamma211*(gammado213 + gammado312) + 2.*gamma311*gammado313)*ginv11 + + (-ddg1213 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + gamma213*gammado122 + + (gamma111 + gamma313)*gammado123 + gamma112*gammado311 + + gamma111*gammado312 + gamma212*(gammado213 + gammado312) + + gamma211*(gammado223 + gammado322) + + 2.*(gamma312*gammado313 + gamma311*gammado323))*ginv12 + + (-ddg1313 + gamma133*gammado111 + gamma233*gammado112 + + (2.*gamma113 + gamma333)*gammado113 + + (gamma111 + gamma313)*gammado133 + gamma113*gammado311 + + gamma213*(gammado123 + gammado213 + gammado312) + + (gamma111 + 2.*gamma313)*gammado313 + + gamma211*(gammado233 + gammado323) + 2.*gamma311*gammado333)*ginv13 + + (-0.5*ddg2213 + gamma123*gammado112 + gamma223*gammado122 + + (gamma112 + gamma323)*gammado123 + gamma112*gammado312 + + gamma212*(gammado223 + gammado322) + 2.*gamma312*gammado323)*ginv22 + + (-ddg2313 + gamma133*gammado112 + gamma123*gammado113 + + gamma233*gammado122 + (gamma113 + gamma223 + gamma333)*gammado123 + + (gamma112 + gamma323)*gammado133 + gamma113*gammado312 + + gamma112*gammado313 + gamma213*(gammado223 + gammado322) + + gamma212*(gammado233 + gammado323) + + 2.*(gamma313*gammado323 + gamma312*gammado333))*ginv23 + + (-0.5*ddg3313 + gamma133*gammado113 + gamma233*gammado123 + + (gamma113 + gamma333)*gammado133 + gamma113*gammado313 + + gamma213*(gammado233 + gammado323) + 2.*gamma313*gammado333)*ginv33 +; + +R22 += +dG21*g12 + dG22*g22 + dG23*g23 + gammado212*Gfromg1 + gammado222*Gfromg2 + + gammado223*Gfromg3 + (-0.5*ddg1122 + + gamma112*(gammado112 + 2.*gammado211) + 3.*gamma212*gammado212 + + gamma312*(2.*gammado213 + gammado312))*ginv11 + + (-ddg1222 + gamma122*(gammado112 + 2.*gammado211) + + gamma112*(gammado122 + 2.*gammado212) + + 3.*(gamma222*gammado212 + gamma212*gammado222) + + 2.*(gamma322*gammado213 + gamma312*gammado223) + + gamma322*gammado312 + gamma312*gammado322)*ginv12 + + (-ddg1322 + gamma123*(gammado112 + 2.*gammado211) + + gamma112*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado212 + gamma212*gammado223) + + 2.*(gamma323*gammado213 + gamma312*gammado233) + + gamma323*gammado312 + gamma312*gammado323)*ginv13 + + (-0.5*ddg2222 + gamma122*(gammado122 + 2.*gammado212) + + 3.*gamma222*gammado222 + gamma322*(2.*gammado223 + gammado322))*ginv22 \ ++ (-ddg2322 + gamma123*(gammado122 + 2.*gammado212) + + gamma122*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado222 + gamma222*gammado223) + + 2.*(gamma323*gammado223 + gamma322*gammado233) + + gamma323*gammado322 + gamma322*gammado323)*ginv23 + + (-0.5*ddg3322 + gamma123*(gammado123 + 2.*gammado213) + + 3.*gamma223*gammado223 + gamma323*(2.*gammado233 + gammado323))*ginv33 +; + +R23 += +0.5*(dG31*g12 + dG21*g13 + dG32*g22 + (dG22 + dG33)*g23 + dG23*g33 + + (gammado213 + gammado312)*Gfromg1 + + (gammado223 + gammado322)*Gfromg2 + (gammado233 + gammado323)*Gfromg3) \ ++ (-0.5*ddg1123 + gamma113*gammado211 + gamma213*gammado212 + + (gamma212 + gamma313)*gammado213 + + gamma112*(gammado113 + gammado311) + gamma212*gammado312 + + 2.*gamma312*gammado313)*ginv11 + + (-ddg1223 + gamma123*gammado211 + (gamma113 + gamma223)*gammado212 + + (gamma222 + gamma323)*gammado213 + gamma213*gammado222 + + (gamma212 + gamma313)*gammado223 + + gamma122*(gammado113 + gammado311) + gamma222*gammado312 + + gamma112*(gammado123 + gammado312) + gamma212*gammado322 + + 2.*(gamma322*gammado313 + gamma312*gammado323))*ginv12 + + (-ddg1323 + gamma133*gammado211 + gamma233*gammado212 + + (gamma113 + gamma223 + gamma333)*gammado213 + gamma213*gammado223 + + (gamma212 + gamma313)*gammado233 + + gamma123*(gammado113 + gammado311) + gamma223*gammado312 + + gamma112*(gammado133 + gammado313) + gamma212*gammado323 + + 2.*(gamma323*gammado313 + gamma312*gammado333))*ginv13 + + (-0.5*ddg2223 + gamma123*gammado212 + gamma223*gammado222 + + (gamma222 + gamma323)*gammado223 + + gamma122*(gammado123 + gammado312) + gamma222*gammado322 + + 2.*gamma322*gammado323)*ginv22 + + (-ddg2323 + gamma133*gammado212 + gamma233*gammado222 + + (2.*gamma223 + gamma333)*gammado223 + + (gamma222 + gamma323)*gammado233 + + gamma123*(gammado123 + gammado213 + gammado312) + + gamma122*(gammado133 + gammado313) + gamma223*gammado322 + + (gamma222 + 2.*gamma323)*gammado323 + 2.*gamma322*gammado333)*ginv23 + + (-0.5*ddg3323 + gamma133*gammado213 + gamma233*gammado223 + + (gamma223 + gamma333)*gammado233 + + gamma123*(gammado133 + gammado313) + gamma223*gammado323 + + 2.*gamma323*gammado333)*ginv33 +; + +R33 += +dG31*g13 + dG32*g23 + dG33*g33 + gammado313*Gfromg1 + gammado323*Gfromg2 + + gammado333*Gfromg3 + (-0.5*ddg1133 + + gamma113*(gammado113 + 2.*gammado311) + + gamma213*(gammado213 + 2.*gammado312) + 3.*gamma313*gammado313)*ginv11 \ ++ (-ddg1233 + gamma123*(gammado113 + 2.*gammado311) + + gamma113*(gammado123 + 2.*gammado312) + + gamma223*(gammado213 + 2.*gammado312) + + gamma213*(gammado223 + 2.*gammado322) + + 3.*(gamma323*gammado313 + gamma313*gammado323))*ginv12 + + (-ddg1333 + gamma133*(gammado113 + 2.*gammado311) + + gamma233*(gammado213 + 2.*gammado312) + + gamma113*(gammado133 + 2.*gammado313) + + gamma213*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado313 + gamma313*gammado333))*ginv13 + + (-0.5*ddg2233 + gamma123*(gammado123 + 2.*gammado312) + + gamma223*(gammado223 + 2.*gammado322) + 3.*gamma323*gammado323)*ginv22 \ ++ (-ddg2333 + gamma133*(gammado123 + 2.*gammado312) + + gamma123*(gammado133 + 2.*gammado313) + + gamma233*(gammado223 + 2.*gammado322) + + gamma223*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado323 + gamma323*gammado333))*ginv23 + + (-0.5*ddg3333 + gamma133*(gammado133 + 2.*gammado313) + + gamma233*(gammado233 + 2.*gammado323) + 3.*gamma333*gammado333)*ginv33 +; + +ff += +chi +; + +oochipsipower += +1/chipsipower +; + +f += +oochipsipower*log(ff) +; + +psim4 += +exp(-4.*f) +; + +df1 += +(dchi1*oochipsipower)/chi +; + +df2 += +(dchi2*oochipsipower)/chi +; + +df3 += +(dchi3*oochipsipower)/chi +; + +ddf11 += +(ddchi11*oochipsipower)/chi - chipsipower*pow2(df1) +; + +ddf12 += +-(chipsipower*df1*df2) + (ddchi12*oochipsipower)/chi +; + +ddf13 += +-(chipsipower*df1*df3) + (ddchi13*oochipsipower)/chi +; + +ddf22 += +(ddchi22*oochipsipower)/chi - chipsipower*pow2(df2) +; + +ddf23 += +-(chipsipower*df2*df3) + (ddchi23*oochipsipower)/chi +; + +ddf33 += +(ddchi33*oochipsipower)/chi - chipsipower*pow2(df3) +; + +cddf11 += +ddf11 - df1*gamma111 - df2*gamma211 - df3*gamma311 +; + +cddf12 += +ddf12 - df1*gamma112 - df2*gamma212 - df3*gamma312 +; + +cddf13 += +ddf13 - df1*gamma113 - df2*gamma213 - df3*gamma313 +; + +cddf22 += +ddf22 - df1*gamma122 - df2*gamma222 - df3*gamma322 +; + +cddf23 += +ddf23 - df1*gamma123 - df2*gamma223 - df3*gamma323 +; + +cddf33 += +ddf33 - df1*gamma133 - df2*gamma233 - df3*gamma333 +; + +trcddf += +cddf11*ginv11 + cddf22*ginv22 + + 2.*(cddf12*ginv12 + cddf13*ginv13 + cddf23*ginv23) + cddf33*ginv33 +; + +Rphi11 += +-2.*(cddf11 + g11*trcddf) + (4. - 4.*g11*ginv11)*pow2(df1) - + g11*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi12 += +df1*df2*(4. - 8.*g12*ginv12) - 2.*(cddf12 + g12*trcddf) - + g12*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi13 += +df1*(4.*df3 - 8.*df2*g13*ginv12) - 2.*(cddf13 + g13*trcddf) - + g13*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi22 += +-2.*(cddf22 + g22*trcddf) + (4. - 4.*g22*ginv22)*pow2(df2) - + g22*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv33*pow2(df3))) +; + +Rphi23 += +df2*(-8.*df1*g23*ginv12 + df3*(4. - 8.*g23*ginv23)) - + 2.*(cddf23 + g23*trcddf) - g23* + (8.*df1*df3*ginv13 + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + + ginv33*pow2(df3))) +; + +Rphi33 += +-2.*(cddf33 + g33*trcddf) - g33* + (8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2))) + + (4. - 4.*g33*ginv33)*pow2(df3) +; + +Rf11 += +R11 + Rphi11 +; + +Rf12 += +R12 + Rphi12 +; + +Rf13 += +R13 + Rphi13 +; + +Rf22 += +R22 + Rphi22 +; + +Rf23 += +R23 + Rphi23 +; + +Rf33 += +R33 + Rphi33 +; + +Rhat += +psim4*(ginv11*Rf11 + ginv22*Rf22 + + 2.*(ginv12*Rf12 + ginv13*Rf13 + ginv23*Rf23) + ginv33*Rf33) +; + +cdda11 += +dda11 - da2*gamma211 - da3*gamma311 + + da1*(-gamma111 + df1*(-4. + 2.*g11*ginv11)) + + 2.*g11*((da2*df1 + da1*df2)*ginv12 + (da3*df1 + da1*df3)*ginv13 + + da2*df2*ginv22 + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +cdda12 += +dda12 - da1*gamma112 - da2*gamma212 - da3*gamma312 + + 2.*(-(da2*df1) - da1*df2 + g12* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda13 += +dda13 - da1*gamma113 - da2*gamma213 - da3*gamma313 + + 2.*(-(da3*df1) - da1*df3 + g13* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda22 += +dda22 - da1*gamma122 - da2*(4.*df2 + gamma222) - da3*gamma322 + + 2.*g22*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +cdda23 += +dda23 - da1*gamma123 - da2*gamma223 - da3*gamma323 + + 2.*(-(da3*df2) - da2*df3 + g23* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda33 += +dda33 - da1*gamma133 - da2*gamma233 - da3*(4.*df3 + gamma333) + + 2.*g33*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +trcdda += +(cdda11*ginv11 + cdda22*ginv22 + + 2.*(cdda12*ginv12 + cdda13*ginv13 + cdda23*ginv23) + cdda33*ginv33)*psim4 +; + +AA11 += +2.*(A11*(A12*ginv12 + A13*ginv13) + A12*A13*ginv23) + ginv11*pow2(A11) + + ginv22*pow2(A12) + ginv33*pow2(A13) +; + +AA12 += +(A12*A13 + A11*A23)*ginv13 + A12*(A11*ginv11 + A22*ginv22) + + (A13*A22 + A12*A23)*ginv23 + A13*A23*ginv33 + ginv12*(A11*A22 + pow2(A12)) +; + +AA13 += +(A12*A13 + A11*A23)*ginv12 + A12*A23*ginv22 + (A13*A23 + A12*A33)*ginv23 + + A13*(A11*ginv11 + A33*ginv33) + ginv13*(A11*A33 + pow2(A13)) +; + +AA21 += +(A12*A13 + A11*A23)*ginv13 + A12*(A11*ginv11 + A22*ginv22) + + (A13*A22 + A12*A23)*ginv23 + A13*A23*ginv33 + ginv12*(A11*A22 + pow2(A12)) +; + +AA22 += +2.*(A12*(A22*ginv12 + A23*ginv13) + A22*A23*ginv23) + ginv11*pow2(A12) + + ginv22*pow2(A22) + ginv33*pow2(A23) +; + +AA23 += +A12*A13*ginv11 + (A13*A22 + A12*A23)*ginv12 + (A13*A23 + A12*A33)*ginv13 + + A23*(A22*ginv22 + A33*ginv33) + ginv23*(A22*A33 + pow2(A23)) +; + +AA31 += +(A12*A13 + A11*A23)*ginv12 + A12*A23*ginv22 + (A13*A23 + A12*A33)*ginv23 + + A13*(A11*ginv11 + A33*ginv33) + ginv13*(A11*A33 + pow2(A13)) +; + +AA32 += +A12*A13*ginv11 + (A13*A22 + A12*A23)*ginv12 + (A13*A23 + A12*A33)*ginv13 + + A23*(A22*ginv22 + A33*ginv33) + ginv23*(A22*A33 + pow2(A23)) +; + +AA33 += +2.*(A13*(A23*ginv12 + A33*ginv13) + A23*A33*ginv23) + ginv11*pow2(A13) + + ginv22*pow2(A23) + ginv33*pow2(A33) +; + +Ainv11 += +2.*(A23*ginv12*ginv13 + ginv11*(A12*ginv12 + A13*ginv13)) + + A11*pow2(ginv11) + A22*pow2(ginv12) + A33*pow2(ginv13) +; + +Ainv12 += +ginv11*(A11*ginv12 + A12*ginv22 + A13*ginv23) + + ginv12*(A13*ginv13 + A22*ginv22 + A23*ginv23) + + ginv13*(A23*ginv22 + A33*ginv23) + A12*pow2(ginv12) +; + +Ainv13 += +ginv11*(A11*ginv13 + A12*ginv23 + A13*ginv33) + + ginv12*(A12*ginv13 + A22*ginv23 + A23*ginv33) + + ginv13*(A23*ginv23 + A33*ginv33) + A13*pow2(ginv13) +; + +Ainv22 += +2.*(A23*ginv22*ginv23 + ginv12*(A12*ginv22 + A13*ginv23)) + + A11*pow2(ginv12) + A22*pow2(ginv22) + A33*pow2(ginv23) +; + +Ainv23 += +ginv13*(A12*ginv22 + A13*ginv23) + A33*ginv23*ginv33 + + ginv12*(A11*ginv13 + A12*ginv23 + A13*ginv33) + + ginv22*(A22*ginv23 + A23*ginv33) + A23*pow2(ginv23) +; + +Ainv33 += +2.*(A23*ginv23*ginv33 + ginv13*(A12*ginv23 + A13*ginv33)) + + A11*pow2(ginv13) + A22*pow2(ginv23) + A33*pow2(ginv33) +; + +cdA111 += +dA111 - 2.*(A11*gamma111 + A12*gamma211 + A13*gamma311) +; + +cdA112 += +dA112 - A11*gamma112 - A22*gamma211 - A12*(gamma111 + gamma212) - + A23*gamma311 - A13*gamma312 +; + +cdA113 += +dA113 - A11*gamma113 - A23*gamma211 - A12*gamma213 - A33*gamma311 - + A13*(gamma111 + gamma313) +; + +cdA122 += +dA122 - 2.*(A12*gamma112 + A22*gamma212 + A23*gamma312) +; + +cdA123 += +dA123 - A13*gamma112 - A12*gamma113 - A22*gamma213 - A33*gamma312 - + A23*(gamma212 + gamma313) +; + +cdA133 += +dA133 - 2.*(A13*gamma113 + A23*gamma213 + A33*gamma313) +; + +cdA211 += +dA211 - 2.*(A11*gamma112 + A12*gamma212 + A13*gamma312) +; + +cdA212 += +dA212 - A11*gamma122 - A22*gamma212 - A12*(gamma112 + gamma222) - + A23*gamma312 - A13*gamma322 +; + +cdA213 += +dA213 - A11*gamma123 - A23*gamma212 - A12*gamma223 - A33*gamma312 - + A13*(gamma112 + gamma323) +; + +cdA222 += +dA222 - 2.*(A12*gamma122 + A22*gamma222 + A23*gamma322) +; + +cdA223 += +dA223 - A13*gamma122 - A12*gamma123 - A22*gamma223 - A33*gamma322 - + A23*(gamma222 + gamma323) +; + +cdA233 += +dA233 - 2.*(A13*gamma123 + A23*gamma223 + A33*gamma323) +; + +cdA311 += +dA311 - 2.*(A11*gamma113 + A12*gamma213 + A13*gamma313) +; + +cdA312 += +dA312 - A11*gamma123 - A22*gamma213 - A12*(gamma113 + gamma223) - + A23*gamma313 - A13*gamma323 +; + +cdA313 += +dA313 - A11*gamma133 - A23*gamma213 - A12*gamma233 - A33*gamma313 - + A13*(gamma113 + gamma333) +; + +cdA322 += +dA322 - 2.*(A12*gamma123 + A22*gamma223 + A23*gamma323) +; + +cdA323 += +dA323 - A13*gamma123 - A12*gamma133 - A22*gamma233 - A33*gamma323 - + A23*(gamma223 + gamma333) +; + +cdA333 += +dA333 - 2.*(A13*gamma133 + A23*gamma233 + A33*gamma333) +; + +divbeta += +db11 + db22 + db33 +; + +totdivbeta += +0.66666666666666666667*divbeta +; + +lieg11 += +beta1*dg111 + beta2*dg211 + beta3*dg311 + + 2.*(db11*g11 + db12*g12 + db13*g13) - g11*totdivbeta +; + +lieg12 += +beta1*dg112 + beta2*dg212 + beta3*dg312 + db21*g11 + db23*g13 + db12*g22 + + db13*g23 + g12*(db11 + db22 - totdivbeta) +; + +lieg13 += +beta1*dg113 + beta2*dg213 + beta3*dg313 + db31*g11 + db32*g12 + db12*g23 + + db13*g33 + g13*(db11 + db33 - totdivbeta) +; + +lieg22 += +beta1*dg122 + beta2*dg222 + beta3*dg322 + + 2.*(db21*g12 + db22*g22 + db23*g23) - g22*totdivbeta +; + +lieg23 += +beta1*dg123 + beta2*dg223 + beta3*dg323 + db31*g12 + db21*g13 + db32*g22 + + db23*g33 + g23*(db22 + db33 - totdivbeta) +; + +lieg33 += +beta1*dg133 + beta2*dg233 + beta3*dg333 + + 2.*(db31*g13 + db32*g23 + db33*g33) - g33*totdivbeta +; + +lieA11 += +beta1*dA111 + beta2*dA211 + beta3*dA311 + + 2.*(A11*db11 + A12*db12 + A13*db13) - A11*totdivbeta +; + +lieA12 += +beta1*dA112 + beta2*dA212 + beta3*dA312 + A22*db12 + A23*db13 + A11*db21 + + A13*db23 + A12*(db11 + db22 - totdivbeta) +; + +lieA13 += +beta1*dA113 + beta2*dA213 + beta3*dA313 + A23*db12 + A33*db13 + A11*db31 + + A12*db32 + A13*(db11 + db33 - totdivbeta) +; + +lieA22 += +beta1*dA122 + beta2*dA222 + beta3*dA322 + + 2.*(A12*db21 + A22*db22 + A23*db23) - A22*totdivbeta +; + +lieA23 += +beta1*dA123 + beta2*dA223 + beta3*dA323 + A13*db21 + A33*db23 + A12*db31 + + A22*db32 + A23*(db22 + db33 - totdivbeta) +; + +lieA33 += +beta1*dA133 + beta2*dA233 + beta3*dA333 + + 2.*(A13*db31 + A23*db32 + A33*db33) - A33*totdivbeta +; + +betas += +beta1*sdown1 + beta2*sdown2 + beta3*sdown3 +; + +Dbetas += +(db11*sdown1 + db12*sdown2 + db13*sdown3)*sup1 + + (db21*sdown1 + db22*sdown2 + db23*sdown3)*sup2 + + (db31*sdown1 + db32*sdown2 + db33*sdown3)*sup3 +; + +Dalpha += +da1*sup1 + da2*sup2 + da3*sup3 +; + +DKhat += +dKhat1*sup1 + dKhat2*sup2 + dKhat3*sup3 +; + +DK += +dK1*sup1 + dK2*sup2 + dK3*sup3 +; + +DTheta += +dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3 +; + +Gams += +G1*sdown1 + G2*sdown2 + G3*sdown3 +; + +DGams += +(dG11*sdown1 + dG12*sdown2 + dG13*sdown3)*sup1 + + (dG21*sdown1 + dG22*sdown2 + dG23*sdown3)*sup2 + + (dG31*sdown1 + dG32*sdown2 + dG33*sdown3)*sup3 +; + +GamA1 += +G1*qud11 + G2*qud12 + G3*qud13 +; + +GamA2 += +G1*qud21 + G2*qud22 + G3*qud23 +; + +GamA3 += +G1*qud31 + G2*qud32 + G3*qud33 +; + +DGamA1 += +(dG11*qud11 + dG12*qud12 + dG13*qud13)*sup1 + + (dG21*qud11 + dG22*qud12 + dG23*qud13)*sup2 + + (dG31*qud11 + dG32*qud12 + dG33*qud13)*sup3 +; + +DGamA2 += +(dG11*qud21 + dG12*qud22 + dG13*qud23)*sup1 + + (dG21*qud21 + dG22*qud22 + dG23*qud23)*sup2 + + (dG31*qud21 + dG32*qud22 + dG33*qud23)*sup3 +; + +DGamA3 += +(dG11*qud31 + dG12*qud32 + dG13*qud33)*sup1 + + (dG21*qud31 + dG22*qud32 + dG23*qud33)*sup2 + + (dG31*qud31 + dG32*qud32 + dG33*qud33)*sup3 +; + +betaA1 += +beta1*qud11 + beta2*qud12 + beta3*qud13 +; + +betaA2 += +beta1*qud21 + beta2*qud22 + beta3*qud23 +; + +betaA3 += +beta1*qud31 + beta2*qud32 + beta3*qud33 +; + +DbetaA1 += +(db11*qud11 + db12*qud12 + db13*qud13)*sup1 + + (db21*qud11 + db22*qud12 + db23*qud13)*sup2 + + (db31*qud11 + db32*qud12 + db33*qud13)*sup3 +; + +DbetaA2 += +(db11*qud21 + db12*qud22 + db13*qud23)*sup1 + + (db21*qud21 + db22*qud22 + db23*qud23)*sup2 + + (db31*qud21 + db32*qud22 + db33*qud23)*sup3 +; + +DbetaA3 += +(db11*qud31 + db12*qud32 + db13*qud33)*sup1 + + (db21*qud31 + db22*qud32 + db23*qud33)*sup2 + + (db31*qud31 + db32*qud32 + db33*qud33)*sup3 +; + +lienKhat += +-((DKhat + Khat/r)*sqrt(muL)) +; + +lienTheta += +-DTheta - (kappa1*(2. + kappa2) + 1/r)*Theta +; + +lienK += +lienKhat + 2.*lienTheta +; + +rKhat += +beta1*dKhat1 + beta2*dKhat2 + beta3*dKhat3 + alpha*lienKhat +; + +#if 0 +// David's new version +rGams += +(beta1*dG11 + beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + ddb221*quu22 + + 2.*(ddb121*quu12 + ddb131*quu13 + ddb231*quu23) + ddb331*quu33)/chi\ +)*sdown1 + (beta1*dG12 + beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + ddb222*quu22 + + 2.*(ddb122*quu12 + ddb132*quu13 + ddb232*quu23) + ddb332*quu33)/chi\ +)*sdown2 + (beta1*dG13 + beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + ddb223*quu22 + + 2.*(ddb123*quu12 + ddb133*quu13 + ddb233*quu23) + ddb333*quu33)/chi\ +)*sdown3 - ((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + ddb121*qud21 + + ddb122*qud22 + ddb123*qud23 + ddb131*qud31 + ddb132*qud32 + + ddb133*qud33)*sup1 + (ddb121*qud11 + ddb122*qud12 + + ddb123*qud13 + ddb221*qud21 + ddb222*qud22 + ddb223*qud23 + + ddb231*qud31 + ddb232*qud32 + ddb233*qud33)*sup2 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb231*qud21 + + ddb232*qud22 + ddb233*qud23 + ddb331*qud31 + ddb332*qud32 + + ddb333*qud33)*sup3)/chi - (dG11 + dG22 + dG33)*vbetas + + 2.*((0.33333333333333333333*alpha* + (dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3))/(chi + chi*vbetas) + + ((db11 + db22 + db33)*shiftdriver)/(vbetaA*sqrt(3.))) + + (1.3333333333333333333*alpha*(dKhat1*sup1 + dKhat2*sup2 + dKhat3*sup3)* + sqrt(muL))/(chi*(vbetas + sqrt(muL))) +; +#else +//David's old version +rGams += +shiftdriver*((beta1*db11 + beta2*db21)*(db12*sdown2 + db13*sdown3) + + 2.*beta1*((beta2*ddb121 + beta3*ddb131)*sdown1 + + (beta2*ddb122 + beta3*ddb132)*sdown2 + + (beta2*ddb123 + beta3*ddb133)*sdown3) + + sdown1*(db21*(beta1*db12 + beta2*(db11 + db22) + beta3*db32) + + db31*(beta1*db13 + beta2*db23 + beta3*(db11 + db33)) + + beta2*(2.*beta3*ddb231 + dG21) + beta3*dG31 + ddb111*pow2(beta1) + + ddb221*pow2(beta2) + ddb331*pow2(beta3) + beta1*(dG11 + pow2(db11))\ +) + sdown2*(db12*(beta1*db22 + beta3*db31) + + db32*(beta1*db13 + beta2*db23 + beta3*(db22 + db33)) + beta1*dG12 + + beta3*dG32 + ddb112*pow2(beta1) + ddb222*pow2(beta2) + + ddb332*pow2(beta3) + beta2*(2.*beta3*ddb232 + dG22 + pow2(db22)))) - + ((beta1*db11 + beta2*db21 + beta3*db31)*sdown1 + + (beta2*db22 + beta3*db32)*sdown2 + beta2*db23*sdown3 + + beta1*(db12*sdown2 + db13*sdown3))*pow2(shiftdriver) + + sdown3*(shiftdriver*((beta1*db12 + beta2*db22)*db23 + beta1*dG13 + + beta2*dG23 + ddb113*pow2(beta1) + ddb223*pow2(beta2) + + ddb333*pow2(beta3) + beta3* + (db13*db31 + db23*db32 + 2.*beta2*ddb233 + dG33 + pow2(db33))) + + db33*((beta1*db13 + beta2*db23)*shiftdriver - beta3*pow2(shiftdriver))) +; +#endif + +rTheta += +beta1*dTheta1 + beta2*dTheta2 + beta3*dTheta3 + alpha*lienTheta +; + +rACss += +2.*((A23*alpha*K + lieA23)*sup2*sup3 + + sup1*((A12*alpha*K + lieA12)*sup2 + A13*alpha*K*sup3) + + psim4*((-cdda23 + alpha*Rf23)*sup2*sup3 + + sup1*((-cdda12 + alpha*Rf12)*sup2 - cdda13*sup3))) + + 0.66666666666666666667*(g13*sup1 + g23*sup2)*sup3*trcdda + + sup1*(2.*(-(AA31*alpha) + lieA13)*sup3 + + 0.66666666666666666667*g12*sup2*trcdda) + + (lieA11 + psim4*(-cdda11 + alpha*Rf11) + + 0.33333333333333333333*g11*(-(alpha*Rhat) + trcdda))*pow2(sup1) + + (lieA22 - cdda22*psim4 + alpha* + (A22*K + psim4*Rf22 - 0.33333333333333333333*g22*Rhat) + + 0.33333333333333333333*g22*trcdda)*pow2(sup2) + + (lieA33 - cdda33*psim4 + alpha* + (A33*K + psim4*Rf33 - 0.33333333333333333333*g33*Rhat) + + 0.33333333333333333333*g33*trcdda)*pow2(sup3) + + alpha*(ginv11*((-2.*cdA111*chi + 3.*A11*dchi1)*sup1 + + (-2.*cdA112*chi + 3.*A12*dchi1)*sup2 + + (-2.*cdA113*chi + 3.*A13*dchi1)*sup3) + + ginv22*((-2.*cdA212*chi + 3.*A12*dchi2)*sup1 + + (-2.*cdA222*chi + 3.*A22*dchi2)*sup2 + + (-2.*cdA223*chi + 3.*A23*dchi2)*sup3) + + ginv33*((-2.*cdA313*chi + 3.*A13*dchi3)*sup1 + + (-2.*cdA323*chi + 3.*A23*dchi3)*sup2 + + (-2.*cdA333*chi + 3.*A33*dchi3)*sup3) + + chi*(-2.*DTheta + 1.3333333333333333333* + (dK1*sup1 + dK2*sup2 + dK3*sup3)) + + ginv12*((-2.*cdA212*chi + 3.*A12*dchi2)*sup2 + + (-2.*cdA213*chi + 3.*A13*dchi2)*sup3 - + 2.*chi*((cdA112 + cdA211)*sup1 + cdA122*sup2 + cdA123*sup3) + + 3.*((A12*dchi1 + A11*dchi2)*sup1 + dchi1*(A22*sup2 + A23*sup3))) + + ginv13*((-2.*cdA312*chi + 3.*A12*dchi3)*sup2 + + (-2.*cdA313*chi + 3.*A13*dchi3)*sup3 - + 2.*chi*((cdA113 + cdA311)*sup1 + cdA123*sup2 + cdA133*sup3) + + 3.*((A13*dchi1 + A11*dchi3)*sup1 + dchi1*(A23*sup2 + A33*sup3))) + + ginv23*((-2.*cdA322*chi + 3.*A22*dchi3)*sup2 + + (-2.*cdA323*chi + 3.*A23*dchi3)*sup3 - + 2.*chi*((cdA213 + cdA312)*sup1 + cdA223*sup2 + cdA233*sup3) + + 3.*((A13*dchi2 + A12*dchi3)*sup1 + dchi2*(A23*sup2 + A33*sup3))) + + (0.33333333333333333333*((dG11 - dGfromgdu11)*qud11 + + (dG12 - dGfromgdu12)*qud12 + (dG13 - dGfromgdu13)*qud13 + + (dG21 - dGfromgdu21)*qud21 + (dG22 - dGfromgdu22)*qud22 + + (dG23 - dGfromgdu23)*qud23 + (dG31 - dGfromgdu31)*qud31 + + (dG32 - dGfromgdu32)*qud32 + (dG33 - dGfromgdu33)*qud33) + + kappa1*((G1 - Gfromg1)*sdown1 + (G2 - Gfromg2)*sdown2 + + (G3 - Gfromg3)*sdown3) + + 0.66666666666666666667* + ((dGfromgdu21*sdown1 + dGfromgdu22*sdown2)*sup2 + + sdown3*((-dG13 + dGfromgdu13)*sup1 - dG23*sup2 - dG33*sup3) + + sdown1*((-dG11 + dGfromgdu11)*sup1 - dG21*sup2 - dG31*sup3 + + dGfromgdu31*sup3) + + sdown2*((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3 + + dGfromgdu32*sup3)))*pow2(chi) + + 0.66666666666666666667*sup2* + (-(Rhat*(g12*sup1 + g23*sup3)) + dGfromgdu23*sdown3*pow2(chi)) + + sup3*((2.*psim4*Rf13 - 0.66666666666666666667*g13*Rhat)*sup1 + + 0.66666666666666666667*dGfromgdu33*sdown3*pow2(chi)) + + (-2.*AA11 + A11*K)*pow2(sup1) - + 2.*((AA23 + AA32)*sup2*sup3 + sup1*((AA12 + AA21)*sup2 + AA13*sup3) + + AA22*pow2(sup2) + AA33*pow2(sup3))) +; + +rACqq += +chi*(-((4.*(A12*Ainv12 + A13*Ainv13 + A23*Ainv23) + + 2.*(A11*Ainv11 + A22*Ainv22 + A33*Ainv33))*alpha) + + Ainv11*lieg11 + Ainv22*lieg22 + + 2.*(Ainv12*lieg12 + Ainv13*lieg13 + Ainv23*lieg23) + Ainv33*lieg33) - + rACss +; + +rGamA1 += +-(((dG21*qud11 + dG22*qud12 + dG23*qud13)*sup2 + + (dG31*qud11 + dG32*qud12 + dG33*qud13)*sup3)*vbetaA) + + qud11*(beta2*dG21 + beta3*dG31 + + (1.3333333333333333333*ddb111*quu11 + + 2.3333333333333333333*(ddb121*quu12 + ddb131*quu13) + + ddb221*quu22 + ddb331*quu33 + + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud12*(beta2*dG22 + beta3*dG32 + + (1.3333333333333333333*ddb112*quu11 + + 2.3333333333333333333*(ddb122*quu12 + ddb132*quu13) + + ddb222*quu22 + 2.*ddb232*quu23 + ddb332*quu33 + + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/vbetaA)/chi + + dG12*(beta1 - sup1*vbetaA)) + + qud13*(beta2*dG23 + beta3*dG33 + + (1.3333333333333333333*ddb113*quu11 + + 2.3333333333333333333*(ddb123*quu12 + ddb133*quu13) + + ddb223*quu22 + 2.*ddb233*quu23 + ddb333*quu33 + + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/vbetaA)/chi + + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb121*qud21 + ddb122*qud22 + ddb123*qud23 + + ddb131*qud31 + ddb132*qud32 + ddb133*qud33)*quu11 + + (ddb221*qud21 + ddb223*qud23 + ddb231*qud31 + ddb232*qud32 + + ddb233*qud33)*quu12 + + (ddb231*qud21 + ddb232*qud22 + ddb233*qud23 + ddb331*qud31 + + ddb332*qud32)*quu13) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu11 + + 1.3333333333333333333*(dKhat2*quu12 + dKhat3*quu13)) + + 1.3333333333333333333*((ddb132*quu13*sdown2 + ddb113*quu11*sdown3)* + sup1 + (quu13*(ddb231*sdown1 + ddb232*sdown2) + + quu12*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu12*(ddb232*sdown2 + ddb233*sdown3) + + quu13*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu12 + ddb131*quu13)*sup1 + ddb221*quu12*sup2 + + ddb131*quu11*sup3) + + sdown2*((ddb112*quu11 + ddb122*quu12)*sup1 + + quu11*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu12 + ddb133*quu13)*sup1 + + quu11*(ddb123*sup2 + ddb133*sup3))) + + qud11*(2.*ddb231*quu23 + (db21*shiftdriver*sup2)/vbetaA) - + (((db11*quu11 + db21*quu12)*sdown1 + + (db12*quu11 + db22*quu12 + db32*quu13)*sdown2 + + (db13*quu11 + db23*quu12 + db33*quu13)*sdown3)*shiftdriver)/ + vbetaA + ((dG22*quu12 + dG32*quu13)*sdown2 + + (dG13*quu11 + dG23*quu12)*sdown3)*vbetaA + + quu11*(1.3333333333333333333*sdown1*(ddb111*sup1 + ddb121*sup2) + + (dG11*sdown1 + dG12*sdown2)*vbetaA) + + quu12*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb222*qud22 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)) + + quu13*(-0.66666666666666666667*alpha*dTheta3 + + 0.33333333333333333333*ddb333*qud33 - + (db31*sdown1*shiftdriver)/vbetaA + dG31*sdown1*vbetaA + + sdown3*(1.3333333333333333333*ddb233*sup2 + dG33*vbetaA)))/chi +; + +rGamA2 += +-(((dG21*qud21 + dG22*qud22 + dG23*qud23)*sup2 + + (dG31*qud21 + dG32*qud22 + dG33*qud23)*sup3)*vbetaA) + + qud21*(beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + 2.*ddb131*quu13 + + 1.3333333333333333333*ddb221*quu22 + + 2.3333333333333333333*(ddb121*quu12 + ddb231*quu23) + + ddb331*quu33 + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud22*(beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + 2.*ddb132*quu13 + + 1.3333333333333333333*ddb222*quu22 + + 2.3333333333333333333*(ddb122*quu12 + ddb232*quu23) + + ddb332*quu33 + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/ + vbetaA)/chi + dG12*(beta1 - sup1*vbetaA)) + + qud23*(beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + 2.*ddb133*quu13 + + 1.3333333333333333333*ddb223*quu22 + + 2.3333333333333333333*(ddb123*quu12 + ddb233*quu23) + + ddb333*quu33 + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/ + vbetaA)/chi + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + + ddb131*qud31 + ddb132*qud32 + ddb133*qud33)*quu12 + + (ddb121*qud11 + ddb123*qud13 + ddb231*qud31 + ddb232*qud32 + + ddb233*qud33)*quu22 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb331*qud31 + + ddb332*qud32)*quu23) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu12 + + 1.3333333333333333333*(dKhat2*quu22 + dKhat3*quu23)) + + 1.3333333333333333333*((ddb132*quu23*sdown2 + ddb113*quu12*sdown3)* + sup1 + (quu23*(ddb231*sdown1 + ddb232*sdown2) + + quu22*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu22*(ddb232*sdown2 + ddb233*sdown3) + + quu23*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu22 + ddb131*quu23)*sup1 + ddb221*quu22*sup2 + + ddb131*quu12*sup3) + + sdown2*((ddb112*quu12 + ddb122*quu22)*sup1 + + quu12*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu22 + ddb133*quu23)*sup1 + + quu12*(ddb123*sup2 + ddb133*sup3))) - + (((db11*quu12 + db21*quu22)*sdown1 + + (db12*quu12 + db22*quu22 + db32*quu23)*sdown2 + + (db13*quu12 + db23*quu22 + db33*quu23)*sdown3)*shiftdriver)/ + vbetaA + (db21*qud21*shiftdriver*sup2)/vbetaA + + ((dG22*quu22 + dG32*quu23)*sdown2 + (dG13*quu12 + dG23*quu22)*sdown3)* + vbetaA + quu12*(1.3333333333333333333*sdown1* + (ddb111*sup1 + ddb121*sup2) + (dG11*sdown1 + dG12*sdown2)*vbetaA) \ ++ quu22*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb122*qud12 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)) + + quu23*(-0.66666666666666666667*alpha*dTheta3 + + 0.33333333333333333333*ddb333*qud33 - + (db31*sdown1*shiftdriver)/vbetaA + dG31*sdown1*vbetaA + + sdown3*(1.3333333333333333333*ddb233*sup2 + dG33*vbetaA)))/chi +; + +rGamA3 += +-(((dG21*qud31 + dG22*qud32 + dG23*qud33)*sup2 + + (dG31*qud31 + dG32*qud32 + dG33*qud33)*sup3)*vbetaA) + + qud31*(beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + 2.*ddb121*quu12 + ddb221*quu22 + + 2.3333333333333333333*(ddb131*quu13 + ddb231*quu23) + + 1.3333333333333333333*ddb331*quu33 + + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud32*(beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + 2.*ddb122*quu12 + ddb222*quu22 + + 2.3333333333333333333*(ddb132*quu13 + ddb232*quu23) + + 1.3333333333333333333*ddb332*quu33 + + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/vbetaA)/chi + + dG12*(beta1 - sup1*vbetaA)) + + qud33*(beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + 2.*ddb123*quu12 + ddb223*quu22 + + 2.3333333333333333333*(ddb133*quu13 + ddb233*quu23) + + 1.3333333333333333333*ddb333*quu33 + + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/vbetaA)/chi + + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + + ddb121*qud21 + ddb122*qud22 + ddb123*qud23)*quu13 + + (ddb121*qud11 + ddb123*qud13 + ddb221*qud21 + ddb222*qud22 + + ddb223*qud23)*quu23 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb231*qud21 + + ddb232*qud22)*quu33) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu13 + + 1.3333333333333333333*(dKhat2*quu23 + dKhat3*quu33)) + + 1.3333333333333333333*((ddb132*quu33*sdown2 + ddb113*quu13*sdown3)* + sup1 + (quu33*(ddb231*sdown1 + ddb232*sdown2) + + quu23*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu23*(ddb232*sdown2 + ddb233*sdown3) + + quu33*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu23 + ddb131*quu33)*sup1 + ddb221*quu23*sup2 + + ddb131*quu13*sup3) + + sdown2*((ddb112*quu13 + ddb122*quu23)*sup1 + + quu13*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu23 + ddb133*quu33)*sup1 + + quu13*(ddb123*sup2 + ddb133*sup3))) - + (((db11*quu13 + db21*quu23)*sdown1 + + (db12*quu13 + db22*quu23 + db32*quu33)*sdown2 + + (db13*quu13 + db23*quu23 + db33*quu33)*sdown3)*shiftdriver)/ + vbetaA + (db21*qud31*shiftdriver*sup2)/vbetaA + + ((dG22*quu23 + dG32*quu33)*sdown2 + (dG13*quu13 + dG23*quu23)*sdown3)* + vbetaA + quu13*(1.3333333333333333333*sdown1* + (ddb111*sup1 + ddb121*sup2) + (dG11*sdown1 + dG12*sdown2)*vbetaA) \ ++ quu33*(-0.66666666666666666667*alpha*dTheta3 + + ddb233*(0.33333333333333333333*qud23 + + 1.3333333333333333333*sdown3*sup2) - + (db31*sdown1*shiftdriver)/vbetaA + + (dG31*sdown1 + dG33*sdown3)*vbetaA) + + quu23*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb122*qud12 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)))/chi +; + +rACsA1 += +(qud11*(lieA11 + alpha*chi*Rf11) + + qud21*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud31*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud11*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud21*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud31*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud11 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud21 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud31) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud11 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud21 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud31) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud11 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud21 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud31) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud11 + + (0.66666666666666666667*dK2 - dTheta2)*qud21 + + (0.66666666666666666667*dK3 - dTheta3)*qud31) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud21 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud31 - + chi*((cdA112 + cdA211)*qud11 + cdA122*qud21 + cdA123*qud31) + + 1.5*((A12*dchi1 + A11*dchi2)*qud11 + dchi1*(A22*qud21 + A23*qud31))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud21 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud31 - + chi*((cdA113 + cdA311)*qud11 + cdA123*qud21 + cdA133*qud31) + + 1.5*((A13*dchi1 + A11*dchi3)*qud11 + dchi1*(A23*qud21 + A33*qud31))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud21 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud31 - + chi*((cdA213 + cdA312)*qud11 + cdA223*qud21 + cdA233*qud31) + + 1.5*((A13*dchi2 + A12*dchi3)*qud11 + dchi2*(A23*qud21 + A33*qud31))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd11 + (G2 - Gfromg2)*qdd12 + + (G3 - Gfromg3)*qdd13) - dG13*qdd13*sup1 - dG21*qdd11*sup2 + + (dGfromgdu22*qdd12 - dG23*qdd13)*sup2 + + (dGfromgdu31*qdd11 + dGfromgdu32*qdd12 - dG33*qdd13)*sup3 + + qdd11*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd12* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud11 + 0.5*dGfromgdu13*qdd13*pow2(chi))) + + sup2*(chi*(-(cdda12*qud11) - cdda22*qud21 - cdda23*qud31 + + alpha*qud21*Rf22) + alpha* + (chi*(qud11*Rf12 + qud31*Rf23) + 0.5*dGfromgdu23*qdd13*pow2(chi))) + + sup3*(chi*(-(cdda13*qud11) - cdda23*qud21 - cdda33*qud31 + + alpha*qud21*Rf23) + alpha* + (chi*(qud11*Rf13 + qud31*Rf33) + 0.5*dGfromgdu33*qdd13*pow2(chi))) +; + +rACsA2 += +(qud12*(lieA11 + alpha*chi*Rf11) + + qud22*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud32*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud12*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud22*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud32*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud12 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud22 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud32) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud12 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud22 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud32) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud12 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud22 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud32) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud12 + + (0.66666666666666666667*dK2 - dTheta2)*qud22 + + (0.66666666666666666667*dK3 - dTheta3)*qud32) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud22 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud32 - + chi*((cdA112 + cdA211)*qud12 + cdA122*qud22 + cdA123*qud32) + + 1.5*((A12*dchi1 + A11*dchi2)*qud12 + dchi1*(A22*qud22 + A23*qud32))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud22 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud32 - + chi*((cdA113 + cdA311)*qud12 + cdA123*qud22 + cdA133*qud32) + + 1.5*((A13*dchi1 + A11*dchi3)*qud12 + dchi1*(A23*qud22 + A33*qud32))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud22 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud32 - + chi*((cdA213 + cdA312)*qud12 + cdA223*qud22 + cdA233*qud32) + + 1.5*((A13*dchi2 + A12*dchi3)*qud12 + dchi2*(A23*qud22 + A33*qud32))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd12 + (G2 - Gfromg2)*qdd22 + + (G3 - Gfromg3)*qdd23) - dG13*qdd23*sup1 - dG21*qdd12*sup2 + + (dGfromgdu22*qdd22 - dG23*qdd23)*sup2 + + (dGfromgdu31*qdd12 + dGfromgdu32*qdd22 - dG33*qdd23)*sup3 + + qdd12*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd22* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud12 + 0.5*dGfromgdu13*qdd23*pow2(chi))) + + sup2*(chi*(-(cdda12*qud12) - cdda22*qud22 - cdda23*qud32 + + alpha*qud22*Rf22) + alpha* + (chi*(qud12*Rf12 + qud32*Rf23) + 0.5*dGfromgdu23*qdd23*pow2(chi))) + + sup3*(chi*(-(cdda13*qud12) - cdda23*qud22 - cdda33*qud32 + + alpha*qud22*Rf23) + alpha* + (chi*(qud12*Rf13 + qud32*Rf33) + 0.5*dGfromgdu33*qdd23*pow2(chi))) +; + +rACsA3 += +(qud13*(lieA11 + alpha*chi*Rf11) + + qud23*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud33*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud13*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud23*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud33*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud13 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud23 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud33) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud13 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud23 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud33) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud13 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud23 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud33) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud13 + + (0.66666666666666666667*dK2 - dTheta2)*qud23 + + (0.66666666666666666667*dK3 - dTheta3)*qud33) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud23 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud33 - + chi*((cdA112 + cdA211)*qud13 + cdA122*qud23 + cdA123*qud33) + + 1.5*((A12*dchi1 + A11*dchi2)*qud13 + dchi1*(A22*qud23 + A23*qud33))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud23 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud33 - + chi*((cdA113 + cdA311)*qud13 + cdA123*qud23 + cdA133*qud33) + + 1.5*((A13*dchi1 + A11*dchi3)*qud13 + dchi1*(A23*qud23 + A33*qud33))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud23 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud33 - + chi*((cdA213 + cdA312)*qud13 + cdA223*qud23 + cdA233*qud33) + + 1.5*((A13*dchi2 + A12*dchi3)*qud13 + dchi2*(A23*qud23 + A33*qud33))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd13 + (G2 - Gfromg2)*qdd23 + + (G3 - Gfromg3)*qdd33) - dG13*qdd33*sup1 - dG21*qdd13*sup2 + + (dGfromgdu22*qdd23 - dG23*qdd33)*sup2 + + (dGfromgdu31*qdd13 + dGfromgdu32*qdd23 - dG33*qdd33)*sup3 + + qdd13*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd23* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud13 + 0.5*dGfromgdu13*qdd33*pow2(chi))) + + sup2*(chi*(-(cdda12*qud13) - cdda22*qud23 - cdda23*qud33 + + alpha*qud23*Rf22) + alpha* + (chi*(qud13*Rf12 + qud33*Rf23) + 0.5*dGfromgdu23*qdd33*pow2(chi))) + + sup3*(chi*(-(cdda13*qud13) - cdda23*qud23 - cdda33*qud33 + + alpha*qud23*Rf23) + alpha* + (chi*(qud13*Rf13 + qud33*Rf33) + 0.5*dGfromgdu33*qdd33*pow2(chi))) +; + +rACABTF11 += +-(qPhysuudd1211*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3311*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1111*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1211* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1311*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2211*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2311*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1311 + AA22*qPhysuudd2211 + AA23*qPhysuudd2311 + + AA33*qPhysuudd3311 + qPhysuudd1111*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1311 + + (0.5*(A12*dchi1*qPhysuudd1111 + A23*dchi3*qPhysuudd3311))/chi)* + sup2) - qPhysuudd3311*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1211*sup3 + + qPhysuudd1211*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1311*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2211* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2311*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2311*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1211 + A13*dchi2*qPhysuudd1311)*sup2 + + (A12*dchi3*qPhysuudd1211 - + 0.5*dchi1*(A13*qPhysuudd1111 + A23*qPhysuudd1211))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1211 - + dchi3*(A11*qPhysuudd1311 + A12*qPhysuudd2311) + + dchi1*(A22*qPhysuudd2211 + A33*qPhysuudd3311))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1311) - + A22*dchi3*qPhysuudd2311 + + dchi2*(A11*qPhysuudd1111 + A33*qPhysuudd3311))*sup2 + + (-(A33*dchi1*qPhysuudd1311) + + A13*(-(dchi2*qPhysuudd1211) + dchi3*qPhysuudd1311) + + dchi3*(A11*qPhysuudd1111 + A22*qPhysuudd2211) + + A23*(-(dchi2*qPhysuudd2211) + dchi3*qPhysuudd2311))*sup3))/chi) +; + +rACABTF12 += +-(qPhysuudd1212*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3312*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1112*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1212* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1312*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2212*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2312*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1312 + AA22*qPhysuudd2212 + AA23*qPhysuudd2312 + + AA33*qPhysuudd3312 + qPhysuudd1112*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1312 + + (0.5*(A12*dchi1*qPhysuudd1112 + A23*dchi3*qPhysuudd3312))/chi)* + sup2) - qPhysuudd3312*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1212*sup3 + + qPhysuudd1212*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1312*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2212* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2312*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2312*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1212 + A13*dchi2*qPhysuudd1312)*sup2 + + (A12*dchi3*qPhysuudd1212 - + 0.5*dchi1*(A13*qPhysuudd1112 + A23*qPhysuudd1212))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1212 - + dchi3*(A11*qPhysuudd1312 + A12*qPhysuudd2312) + + dchi1*(A22*qPhysuudd2212 + A33*qPhysuudd3312))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1312) - + A22*dchi3*qPhysuudd2312 + + dchi2*(A11*qPhysuudd1112 + A33*qPhysuudd3312))*sup2 + + (-(A33*dchi1*qPhysuudd1312) + + A13*(-(dchi2*qPhysuudd1212) + dchi3*qPhysuudd1312) + + dchi3*(A11*qPhysuudd1112 + A22*qPhysuudd2212) + + A23*(-(dchi2*qPhysuudd2212) + dchi3*qPhysuudd2312))*sup3))/chi) +; + +rACABTF13 += +-(qPhysuudd1213*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3313*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1113*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1213* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1313*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2213*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2313*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1313 + AA22*qPhysuudd2213 + AA23*qPhysuudd2313 + + AA33*qPhysuudd3313 + qPhysuudd1113*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1313 + + (0.5*(A12*dchi1*qPhysuudd1113 + A23*dchi3*qPhysuudd3313))/chi)* + sup2) - qPhysuudd3313*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1213*sup3 + + qPhysuudd1213*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1313*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2213* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2313*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2313*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1213 + A13*dchi2*qPhysuudd1313)*sup2 + + (A12*dchi3*qPhysuudd1213 - + 0.5*dchi1*(A13*qPhysuudd1113 + A23*qPhysuudd1213))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1213 - + dchi3*(A11*qPhysuudd1313 + A12*qPhysuudd2313) + + dchi1*(A22*qPhysuudd2213 + A33*qPhysuudd3313))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1313) - + A22*dchi3*qPhysuudd2313 + + dchi2*(A11*qPhysuudd1113 + A33*qPhysuudd3313))*sup2 + + (-(A33*dchi1*qPhysuudd1313) + + A13*(-(dchi2*qPhysuudd1213) + dchi3*qPhysuudd1313) + + dchi3*(A11*qPhysuudd1113 + A22*qPhysuudd2213) + + A23*(-(dchi2*qPhysuudd2213) + dchi3*qPhysuudd2313))*sup3))/chi) +; + +rACABTF22 += +-(qPhysuudd1222*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3322*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1122*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1222* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1322*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2222*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2322*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1322 + AA22*qPhysuudd2222 + AA23*qPhysuudd2322 + + AA33*qPhysuudd3322 + qPhysuudd1122*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1322 + + (0.5*(A12*dchi1*qPhysuudd1122 + A23*dchi3*qPhysuudd3322))/chi)* + sup2) - qPhysuudd3322*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1222*sup3 + + qPhysuudd1222*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1322*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2222* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2322*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2322*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1222 + A13*dchi2*qPhysuudd1322)*sup2 + + (A12*dchi3*qPhysuudd1222 - + 0.5*dchi1*(A13*qPhysuudd1122 + A23*qPhysuudd1222))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1222 - + dchi3*(A11*qPhysuudd1322 + A12*qPhysuudd2322) + + dchi1*(A22*qPhysuudd2222 + A33*qPhysuudd3322))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1322) - + A22*dchi3*qPhysuudd2322 + + dchi2*(A11*qPhysuudd1122 + A33*qPhysuudd3322))*sup2 + + (-(A33*dchi1*qPhysuudd1322) + + A13*(-(dchi2*qPhysuudd1222) + dchi3*qPhysuudd1322) + + dchi3*(A11*qPhysuudd1122 + A22*qPhysuudd2222) + + A23*(-(dchi2*qPhysuudd2222) + dchi3*qPhysuudd2322))*sup3))/chi) +; + +rACABTF23 += +-(qPhysuudd1223*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3323*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1123*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1223* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1323*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2223*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2323*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1323 + AA22*qPhysuudd2223 + AA23*qPhysuudd2323 + + AA33*qPhysuudd3323 + qPhysuudd1123*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1323 + + (0.5*(A12*dchi1*qPhysuudd1123 + A23*dchi3*qPhysuudd3323))/chi)* + sup2) - qPhysuudd3323*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1223*sup3 + + qPhysuudd1223*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1323*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2223* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2323*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2323*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1223 + A13*dchi2*qPhysuudd1323)*sup2 + + (A12*dchi3*qPhysuudd1223 - + 0.5*dchi1*(A13*qPhysuudd1123 + A23*qPhysuudd1223))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1223 - + dchi3*(A11*qPhysuudd1323 + A12*qPhysuudd2323) + + dchi1*(A22*qPhysuudd2223 + A33*qPhysuudd3323))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1323) - + A22*dchi3*qPhysuudd2323 + + dchi2*(A11*qPhysuudd1123 + A33*qPhysuudd3323))*sup2 + + (-(A33*dchi1*qPhysuudd1323) + + A13*(-(dchi2*qPhysuudd1223) + dchi3*qPhysuudd1323) + + dchi3*(A11*qPhysuudd1123 + A22*qPhysuudd2223) + + A23*(-(dchi2*qPhysuudd2223) + dchi3*qPhysuudd2323))*sup3))/chi) +; + +rACABTF33 += +-(qPhysuudd1233*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3333*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1133*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1233* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1333*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2233*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2333*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1333 + AA22*qPhysuudd2233 + AA23*qPhysuudd2333 + + AA33*qPhysuudd3333 + qPhysuudd1133*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1333 + + (0.5*(A12*dchi1*qPhysuudd1133 + A23*dchi3*qPhysuudd3333))/chi)* + sup2) - qPhysuudd3333*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1233*sup3 + + qPhysuudd1233*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1333*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2233* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2333*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2333*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1233 + A13*dchi2*qPhysuudd1333)*sup2 + + (A12*dchi3*qPhysuudd1233 - + 0.5*dchi1*(A13*qPhysuudd1133 + A23*qPhysuudd1233))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1233 - + dchi3*(A11*qPhysuudd1333 + A12*qPhysuudd2333) + + dchi1*(A22*qPhysuudd2233 + A33*qPhysuudd3333))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1333) - + A22*dchi3*qPhysuudd2333 + + dchi2*(A11*qPhysuudd1133 + A33*qPhysuudd3333))*sup2 + + (-(A33*dchi1*qPhysuudd1333) + + A13*(-(dchi2*qPhysuudd1233) + dchi3*qPhysuudd1333) + + dchi3*(A11*qPhysuudd1133 + A22*qPhysuudd2233) + + A23*(-(dchi2*qPhysuudd2233) + dchi3*qPhysuudd2333))*sup3))/chi) +; + + +if (givehPsi0) { + +gADM11 += +g11/chi +; + +gADM12 += +g12/chi +; + +gADM13 += +g13/chi +; + +gADM21 += +g12/chi +; + +gADM22 += +g22/chi +; + +gADM23 += +g23/chi +; + +gADM31 += +g13/chi +; + +gADM32 += +g23/chi +; + +gADM33 += +g33/chi +; + +vu1 += +-yp +; + +vu2 += +xp +; + +vu3 += +0 +; + +wu1 += +((-(ADMginv13*sup2) + ADMginv12*sup3)*vu1 + + (ADMginv13*sup1 - ADMginv11*sup3)*vu2 + + (-(ADMginv12*sup1) + ADMginv11*sup2)*vu3)/Power(chi,1.5) +; + +wu2 += +((-(ADMginv23*sup2) + ADMginv22*sup3)*vu1 + + (ADMginv23*sup1 - ADMginv12*sup3)*vu2 + + (-(ADMginv22*sup1) + ADMginv12*sup2)*vu3)/Power(chi,1.5) +; + +wu3 += +((-(ADMginv33*sup2) + ADMginv23*sup3)*vu1 + + (ADMginv33*sup1 - ADMginv13*sup3)*vu2 + + (-(ADMginv23*sup1) + ADMginv13*sup2)*vu3)/Power(chi,1.5) +; + +sdotv += +(gADM11*sup1 + gADM21*sup2 + gADM31*sup3)*vu1 + + (gADM12*sup1 + gADM22*sup2 + gADM32*sup3)*vu2 + + (gADM13*sup1 + gADM23*sup2 + gADM33*sup3)*vu3 +; + +vu1 += +-(sdotv*sup1) + vu1 +; + +vu2 += +-(sdotv*sup2) + vu2 +; + +vu3 += +-(sdotv*sup3) + vu3 +; + +vdotv += +(gADM31*vu1 + (gADM23 + gADM32)*vu2)*vu3 + + vu1*((gADM12 + gADM21)*vu2 + gADM13*vu3) + gADM11*pow2(vu1) + + gADM22*pow2(vu2) + gADM33*pow2(vu3) +; + +vu1 += +vu1/Sqrt(vdotv) +; + +vu2 += +vu2/Sqrt(vdotv) +; + +vu3 += +vu3/Sqrt(vdotv) +; + +sdotw += +(gADM11*sup1 + gADM21*sup2 + gADM31*sup3)*wu1 + + (gADM12*sup1 + gADM22*sup2 + gADM32*sup3)*wu2 + + (gADM13*sup1 + gADM23*sup2 + gADM33*sup3)*wu3 +; + +vdotw += +(gADM11*vu1 + gADM21*vu2 + gADM31*vu3)*wu1 + + (gADM12*vu1 + gADM22*vu2 + gADM32*vu3)*wu2 + + (gADM13*vu1 + gADM23*vu2 + gADM33*vu3)*wu3 +; + +wu1 += +-(sdotw*sup1) - vdotw*vu1 + wu1 +; + +wu2 += +-(sdotw*sup2) - vdotw*vu2 + wu2 +; + +wu3 += +-(sdotw*sup3) - vdotw*vu3 + wu3 +; + +wdotw += +(gADM31*wu1 + (gADM23 + gADM32)*wu2)*wu3 + + wu1*((gADM12 + gADM21)*wu2 + gADM13*wu3) + gADM11*pow2(wu1) + + gADM22*pow2(wu2) + gADM33*pow2(wu3) +; + +wu1 += +wu1/Sqrt(wdotw) +; + +wu2 += +wu2/Sqrt(wdotw) +; + +wu3 += +wu3/Sqrt(wdotw) +; + +vd1 += +gADM11*vu1 + gADM12*vu2 + gADM13*vu3 +; + +vd2 += +gADM21*vu1 + gADM22*vu2 + gADM23*vu3 +; + +vd3 += +gADM31*vu1 + gADM32*vu2 + gADM33*vu3 +; + +wd1 += +gADM11*wu1 + gADM12*wu2 + gADM13*wu3 +; + +wd2 += +gADM21*wu1 + gADM22*wu2 + gADM23*wu3 +; + +wd3 += +gADM31*wu1 + gADM32*wu2 + gADM33*wu3 +; + +RehPsi0 += +Power(2.7182818284590452354,pow2(hPsi0parb)* + (2.*hPsi0parc*time - pow2(hPsi0parc) - pow2(time)))*hPsi0para +; + +ImhPsi0 += +0 +; + +rACABTF11 += +rACABTF11 + alpha*chi*(2.*ImhPsi0*vd1*wd1 + RehPsi0*(pow2(vd1) - pow2(wd1))) +; + +rACABTF12 += +rACABTF12 + alpha*chi*(vd2*(RehPsi0*vd1 + ImhPsi0*wd1) + + (ImhPsi0*vd1 - RehPsi0*wd1)*wd2) +; + +rACABTF13 += +rACABTF13 + alpha*chi*(vd3*(RehPsi0*vd1 + ImhPsi0*wd1) + + (ImhPsi0*vd1 - RehPsi0*wd1)*wd3) +; + +rACABTF22 += +rACABTF22 + alpha*chi*(2.*ImhPsi0*vd2*wd2 + RehPsi0*(pow2(vd2) - pow2(wd2))) +; + +rACABTF23 += +rACABTF23 + alpha*chi*(vd3*(RehPsi0*vd2 + ImhPsi0*wd2) + + (ImhPsi0*vd2 - RehPsi0*wd2)*wd3) +; + +rACABTF33 += +rACABTF33 + alpha*chi*(2.*ImhPsi0*vd3*wd3 + RehPsi0*(pow2(vd3) - pow2(wd3))) +; + + + } + +rA11 += +rACABTF11 + 0.5*qdd11*rACqq + 2.* + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)*sdown1 + rACss*pow2(sdown1) +; + +rA12 += +rACABTF12 + 0.5*qdd12*rACqq + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)* + sdown2 + sdown1*(qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3 + + rACss*sdown2) +; + +rA13 += +rACABTF13 + 0.5*qdd13*rACqq + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)* + sdown3 + sdown1*(qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3 + + rACss*sdown3) +; + +rA22 += +rACABTF22 + 0.5*qdd22*rACqq + 2.* + (qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3)*sdown2 + rACss*pow2(sdown2) +; + +rA23 += +rACABTF23 + 0.5*qdd23*rACqq + (qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3)* + sdown3 + sdown2*(qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3 + + rACss*sdown3) +; + +rA33 += +rACABTF33 + 0.5*qdd33*rACqq + 2.* + (qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3)*sdown3 + rACss*pow2(sdown3) +; + +rG1 += +qud11*rGamA1 + qud12*rGamA2 + qud13*rGamA3 + rGams*sup1 +; + +rG2 += +qud21*rGamA1 + qud22*rGamA2 + qud23*rGamA3 + rGams*sup2 +; + +rG3 += +qud31*rGamA1 + qud32*rGamA2 + qud33*rGamA3 + rGams*sup3 +; +#else +// code adapted from David 2012-8-18 + +detginv += +1/(2.*g12*g13*g23 + g11*g22*g33 - + g33*pow2(g12) - g22*pow2(g13) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +ginv11*chi +; + +ADMginv12 += +ginv12*chi +; + +ADMginv13 += +ginv13*chi +; + +ADMginv22 += +ginv22*chi +; + +ADMginv23 += +ginv23*chi +; + +ADMginv33 += +ginv33*chi +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +-(sdown1*sdown2) + g12/chi +; + +qdd13 += +-(sdown1*sdown3) + g13/chi +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +-(sdown2*sdown3) + g23/chi +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +qPhysuudd1111 += +-0.5*qdd11*quu11 + pow2(qud11) +; + +qPhysuudd1112 += +qud11*qud12 - 0.5*qdd12*quu11 +; + +qPhysuudd1113 += +qud11*qud13 - 0.5*qdd13*quu11 +; + +qPhysuudd1122 += +-0.5*qdd22*quu11 + pow2(qud12) +; + +qPhysuudd1123 += +qud12*qud13 - 0.5*qdd23*quu11 +; + +qPhysuudd1133 += +-0.5*qdd33*quu11 + pow2(qud13) +; + +qPhysuudd1211 += +qud11*qud21 - 0.5*qdd11*quu12 +; + +qPhysuudd1212 += +0.5*(qud12*qud21 + qud11*qud22 - qdd12*quu12) +; + +qPhysuudd1213 += +0.5*(qud13*qud21 + qud11*qud23 - qdd13*quu12) +; + +qPhysuudd1222 += +qud12*qud22 - 0.5*qdd22*quu12 +; + +qPhysuudd1223 += +0.5*(qud13*qud22 + qud12*qud23 - qdd23*quu12) +; + +qPhysuudd1233 += +qud13*qud23 - 0.5*qdd33*quu12 +; + +qPhysuudd1311 += +qud11*qud31 - 0.5*qdd11*quu13 +; + +qPhysuudd1312 += +0.5*(qud12*qud31 + qud11*qud32 - qdd12*quu13) +; + +qPhysuudd1313 += +0.5*(qud13*qud31 + qud11*qud33 - qdd13*quu13) +; + +qPhysuudd1322 += +qud12*qud32 - 0.5*qdd22*quu13 +; + +qPhysuudd1323 += +0.5*(qud13*qud32 + qud12*qud33 - qdd23*quu13) +; + +qPhysuudd1333 += +qud13*qud33 - 0.5*qdd33*quu13 +; + +qPhysuudd2211 += +-0.5*qdd11*quu22 + pow2(qud21) +; + +qPhysuudd2212 += +qud21*qud22 - 0.5*qdd12*quu22 +; + +qPhysuudd2213 += +qud21*qud23 - 0.5*qdd13*quu22 +; + +qPhysuudd2222 += +-0.5*qdd22*quu22 + pow2(qud22) +; + +qPhysuudd2223 += +qud22*qud23 - 0.5*qdd23*quu22 +; + +qPhysuudd2233 += +-0.5*qdd33*quu22 + pow2(qud23) +; + +qPhysuudd2311 += +qud21*qud31 - 0.5*qdd11*quu23 +; + +qPhysuudd2312 += +0.5*(qud22*qud31 + qud21*qud32 - qdd12*quu23) +; + +qPhysuudd2313 += +0.5*(qud23*qud31 + qud21*qud33 - qdd13*quu23) +; + +qPhysuudd2322 += +qud22*qud32 - 0.5*qdd22*quu23 +; + +qPhysuudd2323 += +0.5*(qud23*qud32 + qud22*qud33 - qdd23*quu23) +; + +qPhysuudd2333 += +qud23*qud33 - 0.5*qdd33*quu23 +; + +qPhysuudd3311 += +-0.5*qdd11*quu33 + pow2(qud31) +; + +qPhysuudd3312 += +qud31*qud32 - 0.5*qdd12*quu33 +; + +qPhysuudd3313 += +qud31*qud33 - 0.5*qdd13*quu33 +; + +qPhysuudd3322 += +-0.5*qdd22*quu33 + pow2(qud32) +; + +qPhysuudd3323 += +qud32*qud33 - 0.5*qdd23*quu33 +; + +qPhysuudd3333 += +-0.5*qdd33*quu33 + pow2(qud33) +; + +muL += +2./alpha +; + +muStilde += +1/chi +; + +vbetas += +2.*sqrt(0.33333333333333333333*muStilde) +; + +vbetaA += +sqrt(muStilde) +; + +K += +Khat + 2.*Theta +; + +dK1 += +dKhat1 + 2.*dTheta1 +; + +dK2 += +dKhat2 + 2.*dTheta2 +; + +dK3 += +dKhat3 + 2.*dTheta3 +; + +dginv111 += +-2.*(dg123*ginv12*ginv13 + ginv11*(dg112*ginv12 + dg113*ginv13)) - + dg111*pow2(ginv11) - dg122*pow2(ginv12) - dg133*pow2(ginv13) +; + +dginv112 += +-(ginv11*(dg111*ginv12 + dg112*ginv22 + dg113*ginv23)) - + ginv12*(dg113*ginv13 + dg122*ginv22 + dg123*ginv23) - + ginv13*(dg123*ginv22 + dg133*ginv23) - dg112*pow2(ginv12) +; + +dginv113 += +-(ginv11*(dg111*ginv13 + dg112*ginv23 + dg113*ginv33)) - + ginv12*(dg112*ginv13 + dg122*ginv23 + dg123*ginv33) - + ginv13*(dg123*ginv23 + dg133*ginv33) - dg113*pow2(ginv13) +; + +dginv122 += +-2.*(dg123*ginv22*ginv23 + ginv12*(dg112*ginv22 + dg113*ginv23)) - + dg111*pow2(ginv12) - dg122*pow2(ginv22) - dg133*pow2(ginv23) +; + +dginv123 += +-(ginv13*(dg112*ginv22 + dg113*ginv23)) - dg133*ginv23*ginv33 - + ginv12*(dg111*ginv13 + dg112*ginv23 + dg113*ginv33) - + ginv22*(dg122*ginv23 + dg123*ginv33) - dg123*pow2(ginv23) +; + +dginv133 += +-2.*(dg123*ginv23*ginv33 + ginv13*(dg112*ginv23 + dg113*ginv33)) - + dg111*pow2(ginv13) - dg122*pow2(ginv23) - dg133*pow2(ginv33) +; + +dginv211 += +-2.*(dg223*ginv12*ginv13 + ginv11*(dg212*ginv12 + dg213*ginv13)) - + dg211*pow2(ginv11) - dg222*pow2(ginv12) - dg233*pow2(ginv13) +; + +dginv212 += +-(ginv11*(dg211*ginv12 + dg212*ginv22 + dg213*ginv23)) - + ginv12*(dg213*ginv13 + dg222*ginv22 + dg223*ginv23) - + ginv13*(dg223*ginv22 + dg233*ginv23) - dg212*pow2(ginv12) +; + +dginv213 += +-(ginv11*(dg211*ginv13 + dg212*ginv23 + dg213*ginv33)) - + ginv12*(dg212*ginv13 + dg222*ginv23 + dg223*ginv33) - + ginv13*(dg223*ginv23 + dg233*ginv33) - dg213*pow2(ginv13) +; + +dginv222 += +-2.*(dg223*ginv22*ginv23 + ginv12*(dg212*ginv22 + dg213*ginv23)) - + dg211*pow2(ginv12) - dg222*pow2(ginv22) - dg233*pow2(ginv23) +; + +dginv223 += +-(ginv13*(dg212*ginv22 + dg213*ginv23)) - dg233*ginv23*ginv33 - + ginv12*(dg211*ginv13 + dg212*ginv23 + dg213*ginv33) - + ginv22*(dg222*ginv23 + dg223*ginv33) - dg223*pow2(ginv23) +; + +dginv233 += +-2.*(dg223*ginv23*ginv33 + ginv13*(dg212*ginv23 + dg213*ginv33)) - + dg211*pow2(ginv13) - dg222*pow2(ginv23) - dg233*pow2(ginv33) +; + +dginv311 += +-2.*(dg323*ginv12*ginv13 + ginv11*(dg312*ginv12 + dg313*ginv13)) - + dg311*pow2(ginv11) - dg322*pow2(ginv12) - dg333*pow2(ginv13) +; + +dginv312 += +-(ginv11*(dg311*ginv12 + dg312*ginv22 + dg313*ginv23)) - + ginv12*(dg313*ginv13 + dg322*ginv22 + dg323*ginv23) - + ginv13*(dg323*ginv22 + dg333*ginv23) - dg312*pow2(ginv12) +; + +dginv313 += +-(ginv11*(dg311*ginv13 + dg312*ginv23 + dg313*ginv33)) - + ginv12*(dg312*ginv13 + dg322*ginv23 + dg323*ginv33) - + ginv13*(dg323*ginv23 + dg333*ginv33) - dg313*pow2(ginv13) +; + +dginv322 += +-2.*(dg323*ginv22*ginv23 + ginv12*(dg312*ginv22 + dg313*ginv23)) - + dg311*pow2(ginv12) - dg322*pow2(ginv22) - dg333*pow2(ginv23) +; + +dginv323 += +-(ginv13*(dg312*ginv22 + dg313*ginv23)) - dg333*ginv23*ginv33 - + ginv12*(dg311*ginv13 + dg312*ginv23 + dg313*ginv33) - + ginv22*(dg322*ginv23 + dg323*ginv33) - dg323*pow2(ginv23) +; + +dginv333 += +-2.*(dg323*ginv23*ginv33 + ginv13*(dg312*ginv23 + dg313*ginv33)) - + dg311*pow2(ginv13) - dg322*pow2(ginv23) - dg333*pow2(ginv33) +; + +gammado111 += +0.5*dg111 +; + +gammado112 += +0.5*dg211 +; + +gammado113 += +0.5*dg311 +; + +gammado122 += +-0.5*dg122 + dg212 +; + +gammado123 += +0.5*(-dg123 + dg213 + dg312) +; + +gammado133 += +-0.5*dg133 + dg313 +; + +gammado211 += +dg112 - 0.5*dg211 +; + +gammado212 += +0.5*dg122 +; + +gammado213 += +0.5*(dg123 - dg213 + dg312) +; + +gammado222 += +0.5*dg222 +; + +gammado223 += +0.5*dg322 +; + +gammado233 += +-0.5*dg233 + dg323 +; + +gammado311 += +dg113 - 0.5*dg311 +; + +gammado312 += +0.5*(dg123 + dg213 - dg312) +; + +gammado313 += +0.5*dg133 +; + +gammado322 += +dg223 - 0.5*dg322 +; + +gammado323 += +0.5*dg233 +; + +gammado333 += +0.5*dg333 +; + +gamma111 += +gammado111*ginv11 + gammado211*ginv12 + gammado311*ginv13 +; + +gamma112 += +gammado112*ginv11 + gammado212*ginv12 + gammado312*ginv13 +; + +gamma113 += +gammado113*ginv11 + gammado213*ginv12 + gammado313*ginv13 +; + +gamma122 += +gammado122*ginv11 + gammado222*ginv12 + gammado322*ginv13 +; + +gamma123 += +gammado123*ginv11 + gammado223*ginv12 + gammado323*ginv13 +; + +gamma133 += +gammado133*ginv11 + gammado233*ginv12 + gammado333*ginv13 +; + +gamma211 += +gammado111*ginv12 + gammado211*ginv22 + gammado311*ginv23 +; + +gamma212 += +gammado112*ginv12 + gammado212*ginv22 + gammado312*ginv23 +; + +gamma213 += +gammado113*ginv12 + gammado213*ginv22 + gammado313*ginv23 +; + +gamma222 += +gammado122*ginv12 + gammado222*ginv22 + gammado322*ginv23 +; + +gamma223 += +gammado123*ginv12 + gammado223*ginv22 + gammado323*ginv23 +; + +gamma233 += +gammado133*ginv12 + gammado233*ginv22 + gammado333*ginv23 +; + +gamma311 += +gammado111*ginv13 + gammado211*ginv23 + gammado311*ginv33 +; + +gamma312 += +gammado112*ginv13 + gammado212*ginv23 + gammado312*ginv33 +; + +gamma313 += +gammado113*ginv13 + gammado213*ginv23 + gammado313*ginv33 +; + +gamma322 += +gammado122*ginv13 + gammado222*ginv23 + gammado322*ginv33 +; + +gamma323 += +gammado123*ginv13 + gammado223*ginv23 + gammado323*ginv33 +; + +gamma333 += +gammado133*ginv13 + gammado233*ginv23 + gammado333*ginv33 +; + +Gfromg1 += +gamma111*ginv11 + gamma122*ginv22 + + 2.*(gamma112*ginv12 + gamma113*ginv13 + gamma123*ginv23) + gamma133*ginv33 +; + +Gfromg2 += +gamma211*ginv11 + gamma222*ginv22 + + 2.*(gamma212*ginv12 + gamma213*ginv13 + gamma223*ginv23) + gamma233*ginv33 +; + +Gfromg3 += +gamma311*ginv11 + gamma322*ginv22 + + 2.*(gamma312*ginv12 + gamma313*ginv13 + gamma323*ginv23) + gamma333*ginv33 +; + +dGfromgdu11 += +(ddg1111 - dg111*((8.*dg112 + 2.*dg211)*ginv12 + + (8.*dg113 + 2.*dg311)*ginv13) - + (dg113*(4.*dg112 + dg211) + dg112*dg311 + dg111*(dg213 + dg312))* + ginv23 - ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(dg113*dg311 + dg111*dg313 + 2.*pow2(dg113)))*pow2(ginv11) + + (ddg1122 + ddg1212 - (dg123*(8.*dg112 + 2.*dg211) + + dg113*(4.*dg122 + 2.*dg212) + dg122*dg311 + + 2.*(dg111*dg223 + dg112*(dg213 + dg312)) + dg111*dg322)*ginv13 - + (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + ginv23 - ginv22*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122)) - + ginv33*(dg123*(dg213 + dg312) + dg122*dg313 + dg113*(dg223 + dg322) + + dg112*dg323 + 2.*pow2(dg123)))*pow2(ginv12) + + (ddg1133 + ddg1313 - (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*ginv23 - + ginv22*(dg133*dg212 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*(dg233 + dg323) + 2.*pow2(dg123)) - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133)))*pow2(ginv13) \ ++ ginv13*(ddg1333*ginv33 + ginv22* + (ddg1223 - (dg133*dg222 + dg123*(4.*dg223 + dg322) + + dg122*(dg233 + dg323))*ginv23 - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*ginv33) + + ginv23*(ddg1233 + ddg1323 - + (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)*ginv33) - + (dg123*dg222 + dg122*dg223)*pow2(ginv22) - + (dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + + dg122*dg333)*pow2(ginv23) - 2.*dg133*dg333*pow2(ginv33)) + + ginv11*(ddg1313*ginv33 + ginv12* + (2.*ddg1112 + ddg1211 - (dg113*(12.*dg112 + 3.*dg211) + + 3.*dg112*dg311 + dg111*(8.*dg123 + 3.*(dg213 + dg312)))*ginv13 \ +- (dg122*(4.*dg112 + dg211) + 6.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*dg211 + dg122*dg311 + + 4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213 + dg312)) + + dg111*(dg223 + dg322))*ginv23 - + (dg123*dg311 + dg113*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*dg112*dg313 + dg111*dg323)*ginv33) + + ginv22*(ddg1212 - (dg113*dg222 + 2.*(dg123*dg212 + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv23 - + (dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323)*ginv33) + + ginv13*(2.*ddg1113 + ddg1311 - + (dg123*(4.*dg112 + dg211) + dg111*dg223 + + 2.*(dg113*dg212 + dg112*(dg213 + dg312)))*ginv22 - + (dg133*dg211 + dg123*dg311 + + 4.*(dg113*(dg123 + dg213 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + dg323))*ginv23 - + (dg133*(4.*dg113 + dg311) + 6.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1213 + ddg1312 - + (dg133*(dg213 + dg312) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323) + dg112*dg333)*ginv33) - + (3.*dg112*dg211 + dg111*(4.*dg122 + 3.*dg212) + 6.*pow2(dg112))* + pow2(ginv12) - (3.*dg113*dg311 + dg111*(4.*dg133 + 3.*dg313) + + 6.*pow2(dg113))*pow2(ginv13) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (dg133*dg212 + dg123*(dg213 + dg312) + dg122*dg313 + + dg113*(dg223 + dg322) + dg112*(dg233 + dg323))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv12*(ddg1323*ginv33 + ginv22* + (ddg1222 - (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)* + ginv23 - (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33) + + ginv23*(ddg1223 + ddg1322 - + (dg133*(dg223 + dg322) + dg123*(dg233 + 4.*dg323) + dg122*dg333)* + ginv33) + ginv13*(2.*ddg1123 + ddg1213 + ddg1312 - + (dg113*dg222 + 4.*(dg123*(dg122 + dg212) + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv22 - + (dg133*(4.*dg123 + dg213 + dg312) + 4.*dg123*dg313 + + dg113*(dg233 + 4.*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg122*dg313 + + dg113*dg322) + 4.* + (dg122*dg133 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*dg323 + pow2(dg123)))) - + (dg133*(4.*dg112 + dg211) + dg113*(8.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + pow2(ginv13) - 2.*dg122*dg222*pow2(ginv22) - + (dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + pow2(ginv23) - (dg133*dg323 + dg123*dg333)*pow2(ginv33)) - + 2.*pow2(dg111)*pow3(ginv11) - + (dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)*pow3(ginv12) - + (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + dg111*dg333)*pow3(ginv13) +; + +dGfromgdu12 += +(ddg1112 + ddg1211 - (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))*ginv13 - + (dg122*(6.*dg112 + 2.*dg211) + 6.*dg112*dg212 + 2.*dg111*dg222)* + ginv22 - (4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213)) + + dg122*dg311 + 2.*(dg123*dg211 + dg111*dg223 + dg112*dg312) + + dg111*dg322)*ginv23 - (dg123*dg311 + + dg113*(2.*(dg123 + dg213) + dg312) + dg112*dg313 + dg111*dg323)* + ginv33)*pow2(ginv12) - ((2.*(dg113*dg123 + dg112*dg133) + + dg123*dg311 + dg113*dg312 + dg112*dg313 + dg111*dg323)*ginv22 + + (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + dg111*dg333)*ginv23)* + pow2(ginv13) + (ddg1222 - (4.*(dg123*dg222 + dg122*dg223) + + 2.*dg122*dg322)*ginv23 - + (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33)*pow2(ginv22) + + (ddg1233 + ddg1323 - (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)* + ginv33)*pow2(ginv23) + ginv11* + (ginv23*(ddg1113 - 2.*dg113*(dg133 + dg313)*ginv33) + + ginv22*(ddg1112 - (dg112*(4.*dg123 + 2.*dg213) + + 2.*(dg113*(dg122 + dg212) + dg112*dg312))*ginv23 - + (dg113*(2.*dg123 + dg312) + dg112*dg313)*ginv33) + + ginv12*(ddg1111 - dg111*(6.*dg113 + 2.*dg311)*ginv13 - + (dg113*(8.*dg112 + 2.*dg211) + dg112*dg311 + + dg111*(2.*(dg123 + dg213) + dg312))*ginv23 - + ginv22*(2.*(dg112*dg211 + dg111*(dg122 + dg212)) + + 6.*pow2(dg112)) - ginv33* + (dg113*dg311 + dg111*dg313 + 2.*pow2(dg113))) - + ginv13*((dg112*(4.*dg113 + dg311) + dg111*(2.*dg123 + dg312))* + ginv22 + ginv23*(dg113*dg311 + dg111*(2.*dg133 + dg313) + + 4.*pow2(dg113))) - dg111*(6.*dg112 + 2.*dg211)*pow2(ginv12) - + 2.*dg112*(dg122 + dg212)*pow2(ginv22) - + (2.*(dg112*dg133 + dg113*(dg123 + dg213)) + dg113*dg312 + dg112*dg313)* + pow2(ginv23)) + ginv13*(ginv22* + (ddg1123 + ddg1312 - (dg133*(2.*dg123 + dg312) + + 2.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg113*dg223 + + dg112*dg233) + dg122*dg313 + dg113*dg322 + + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg123)))) + + ginv23*(ddg1133 + ddg1313 - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))) - + (2.*(dg123*(dg122 + dg212) + dg112*dg223) + dg122*dg312 + + dg112*dg322)*pow2(ginv22) - + (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*pow2(ginv23)\ +) + ginv23*(ddg1333*ginv33 - 2.*dg133*dg333*pow2(ginv33)) + + ginv12*(ddg1313*ginv33 + ginv13* + (ddg1113 + ddg1311 - (2.* + (dg123*dg211 + dg113*(dg122 + dg212) + dg111*dg223) + + dg122*dg311 + dg112*(8.*dg123 + 2.*dg213 + 4.*dg312) + + dg111*dg322)*ginv22 - + (dg133*(4.*dg112 + 2.*dg211) + + dg113*(8.*dg123 + 4.*(dg213 + dg312)) + 4.*dg112*dg313 + + 2.*(dg123*dg311 + dg111*(dg233 + dg323)))*ginv23 - + (dg133*(2.*dg113 + dg311) + 4.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1123 + 2.*ddg1213 + ddg1312 - + (2.*(dg133*(dg123 + dg213) + dg113*dg233) + dg133*dg312 + + 4.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33) + + ginv22*(ddg1122 + 2.*ddg1212 - + (4.*(dg122*dg213 + dg113*dg222) + + 6.*(dg123*(dg122 + dg212) + dg112*dg223) + + 3.*(dg122*dg312 + dg112*dg322))*ginv23 - + ginv33*(dg122*dg313 + dg113*dg322 + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323 + + pow2(dg123)))) - + 2.*(dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113))*pow2(ginv13) - + (4.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))*pow2(ginv22) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*(dg133*(dg122 + dg212) + dg123*dg312 + dg122*dg313 + + dg113*dg322 + dg112*(dg233 + dg323) + pow2(dg123)))*pow2(ginv23) \ +- (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv22*(ddg1323*ginv33 + ginv23* + (2.*ddg1223 + ddg1322 - (2.*(dg133*dg223 + dg123*dg233) + + dg133*dg322 + 6.*dg123*dg323 + dg122*dg333)*ginv33) - + (2.*(dg133*dg222 + dg122*dg233) + dg123*(6.*dg223 + 3.*dg322) + + 3.*dg122*dg323)*pow2(ginv23) - + (dg133*dg323 + dg123*dg333)*pow2(ginv33)) - + 2.*((dg111*(dg112*ginv22 + dg113*ginv23) + ginv12*pow2(dg111))* + pow2(ginv11) + (dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112))* + pow3(ginv12) + dg122*dg222*pow3(ginv22)) - + (dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + dg122*dg333)* + pow3(ginv23) +; + +dGfromgdu13 += +-(((dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)*ginv23 + + (2.*(dg113*dg122 + dg112*dg123) + dg123*dg211 + dg113*dg212 + + dg112*dg213 + dg111*dg223)*ginv33 + + 2.*ginv13*(dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112)))* + pow2(ginv12)) + (ddg1113 + ddg1311 - + (dg123*(2.*dg112 + dg211) + dg113*dg212 + dg111*dg223 + + dg112*(dg213 + 2.*dg312))*ginv22 - + (dg133*dg211 + 2.*(dg113*dg213 + dg123*dg311) + + 4.*(dg113*(dg123 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + 2.*dg323))*ginv23 - + (dg133*(6.*dg113 + 2.*dg311) + 6.*dg113*dg313 + 2.*dg111*dg333)*ginv33\ +)*pow2(ginv13) - (2.*dg122*dg222*ginv23 + + (dg123*dg222 + dg122*dg223)*ginv33)*pow2(ginv22) + + (ddg1223 + ddg1322 - (3.*(dg133*dg223 + dg123*dg233) + 6.*dg123*dg323 + + 2.*(dg133*dg322 + dg122*dg333))*ginv33)*pow2(ginv23) + + ddg1333*pow2(ginv33) + ginv11* + (ddg1113*ginv33 - ginv22*(2.*dg112*(dg122 + dg212)*ginv23 + + (dg113*dg212 + dg112*(2.*dg123 + dg213))*ginv33) + + ginv23*(ddg1112 - (dg113*(4.*dg123 + 2.*dg213) + + 2.*(dg113*dg312 + dg112*(dg133 + dg313)))*ginv33) - + ginv12*(dg111*(6.*dg112 + 2.*dg211)*ginv13 + + (dg113*(4.*dg112 + dg211) + dg111*(2.*dg123 + dg213))*ginv33 + + ginv23*(dg112*dg211 + dg111*(2.*dg122 + dg212) + 4.*pow2(dg112))) + + ginv13*(ddg1111 - (dg113*(8.*dg112 + dg211) + 2.*dg112*dg311 + + dg111*(dg213 + 2.*(dg123 + dg312)))*ginv23 - + ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(2.*(dg113*dg311 + dg111*(dg133 + dg313)) + 6.*pow2(dg113))) \ +- dg111*(6.*dg113 + 2.*dg311)*pow2(ginv13) - + (dg113*dg212 + dg112*dg213 + + 2.*(dg113*dg122 + dg112*(dg123 + dg312)))*pow2(ginv23) - + 2.*dg113*(dg133 + dg313)*pow2(ginv33)) + + ginv12*((ddg1123 + ddg1213)*ginv33 + + ginv13*(ddg1112 + ddg1211 - + (dg122*(2.*dg112 + dg211) + 4.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*(8.*dg112 + 2.*dg211) + + 4.*(dg113*(dg122 + dg212) + dg112*(dg213 + dg312)) + + 2.*(dg122*dg311 + dg111*(dg223 + dg322)))*ginv23 - + (dg133*(2.*dg112 + dg211) + + dg113*(8.*dg123 + 4.*dg213 + 2.*dg312) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + ginv33) - ginv22*((dg122*dg213 + dg113*dg222 + + 2.*(dg123*(dg122 + dg212) + dg112*dg223))*ginv33 + + ginv23*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))) + + ginv23*(ddg1122 + ddg1212 - + ginv33*(dg133*(2.*dg122 + dg212) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322) + + dg112*(dg233 + 2.*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg123)))) - + (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))* + pow2(ginv13) - (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + pow2(ginv23) - (dg133*(2.*dg123 + dg213) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv22*(ddg1223*ginv33 + ginv23* + (ddg1222 - (dg133*dg222 + dg123*(6.*dg223 + 2.*dg322) + + dg122*(dg233 + 2.*dg323))*ginv33) - + (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)*pow2(ginv23) - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv23*((ddg1233 + 2.*ddg1323)*ginv33 - + (dg133*(2.*dg233 + 4.*dg323) + 4.*dg123*dg333)*pow2(ginv33)) + + ginv13*((ddg1133 + 2.*ddg1313)*ginv33 + + ginv23*(ddg1123 + ddg1213 + 2.*ddg1312 - + (dg133*(6.*dg123 + 3.*dg213 + 4.*dg312) + 6.*dg123*dg313 + + dg113*(3.*dg233 + 6.*dg323) + 4.*dg112*dg333)*ginv33) + + ginv22*(ddg1212 - (dg123*(2.*dg122 + 4.*dg212) + dg113*dg222 + + dg122*(dg213 + 2.*dg312) + dg112*(4.*dg223 + 2.*dg322))*ginv23 \ +- ginv33*(dg133*dg212 + dg112*(dg233 + 2.*dg323) + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + pow2(dg123)))) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg112*dg233 + + dg122*dg313 + dg113*(dg223 + dg322) + pow2(dg123)))*pow2(ginv23) \ +- (4.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))*pow2(ginv33)) - + (dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + pow3(ginv23) - 2.*((dg111*(dg112*ginv23 + dg113*ginv33) + + ginv13*pow2(dg111))*pow2(ginv11) + + (dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113))*pow3(ginv13) + + dg133*dg333*pow3(ginv33)) +; + +dGfromgdu21 += +(ddg1211 - (4.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + 2.*(dg112 + dg211)*dg212*ginv22 - + (2.*(dg113*dg212 + (dg112 + dg211)*dg213) + dg212*dg311 + + dg211*dg312)*ginv23 - (dg213*(2.*dg113 + dg311) + dg211*dg313)* + ginv33 - ginv12*(4.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211)))* + pow2(ginv11) + (ddg1222 + ddg2212 - + (4.*(dg212*(dg123 + dg213) + (dg112 + dg211)*dg223) + dg222*dg311 + + 2.*(dg122*dg213 + dg113*dg222 + dg212*dg312) + dg211*dg322)*ginv13 \ +- (2.*dg122 + 6.*dg212)*dg222*ginv22 - + ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(2.*(dg123 + dg213) + dg312) + dg222*dg313 + dg213*dg322 + + dg212*dg323)*ginv33)*pow2(ginv12) + + (ddg1233 + ddg2313 - (2.*((dg123 + dg213)*dg223 + dg212*dg233) + + dg223*dg312 + dg212*dg323)*ginv22 - + (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*ginv23 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33)*pow2(ginv13) + + ginv11*(ddg2313*ginv33 + ginv22* + (ddg2212 - (dg222*(2.*dg213 + dg312) + dg212*(4.*dg223 + dg322))* + ginv23 - (dg223*(2.*dg213 + dg312) + dg212*dg323)*ginv33) + + ginv23*(ddg2213 + ddg2312 - + (dg233*(2.*dg213 + dg312) + 2.*(dg223*dg313 + dg213*dg323) + + dg212*dg333)*ginv33) + + ginv13*(2.*ddg1213 + ddg2311 - + (2.*(dg112 + dg211)*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv22 - + (2.*(dg133*dg213 + dg113*dg233) + dg233*dg311 + 6.*dg213*dg313 + + dg211*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg123*dg213 + dg113*dg223 + + (dg112 + dg211)*dg233) + dg223*dg311 + dg211*dg323 + + 4.*(dg213*dg312 + dg212*dg313 + pow2(dg213)))) + + ginv12*(2.*ddg1212 + ddg2211 - + (6.*(dg113*dg212 + dg112*dg213) + 4.*dg111*dg223 + + 3.*dg212*dg311 + dg211*(4.*dg123 + 6.*dg213 + 3.*dg312))*ginv13 \ +- (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + + (dg112 + dg211)*dg223) + dg222*dg311 + + dg212*(8.*dg213 + 4.*dg312) + dg211*dg322)*ginv23 - + ginv22*(2.*(dg122*dg212 + (dg112 + dg211)*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*dg311 + dg211*dg323 + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313 + + pow2(dg213)))) - + (6.*dg112*dg212 + dg211*(2.*dg122 + 6.*dg212) + 2.*dg111*dg222)* + pow2(ginv12) - (2.*(dg133*dg211 + dg111*dg233) + + dg213*(6.*dg113 + 3.*dg311) + 3.*dg211*dg313)*pow2(ginv13) - + 2.*dg212*dg222*pow2(ginv22) - + (2.*(dg213*dg223 + dg212*dg233) + dg223*dg312 + dg222*dg313 + + dg213*dg322 + dg212*dg323)*pow2(ginv23) - + (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv12*(ddg2323*ginv33 + ginv13* + (2.*ddg1223 + ddg2213 + ddg2312 - + (2.*((dg123 + dg213)*dg222 + dg122*dg223) + dg222*dg312 + + dg212*(8.*dg223 + dg322))*ginv22 - + (dg223*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322) + + 4.*dg212*(dg233 + dg323))*ginv23 - + (2.*(dg133*dg223 + (dg123 + dg213)*dg233) + dg233*dg312 + + 4.*(dg223*dg313 + dg213*dg323) + dg212*dg333)*ginv33) + + ginv23*(ddg2223 + ddg2322 - + (dg233*(2.*dg223 + dg322) + 4.*dg223*dg323 + dg222*dg333)*ginv33) + + ginv22*(ddg2222 - dg222*(6.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223))) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*((dg112 + dg211)*dg233 + dg223*dg311 + dg213*dg312 + + dg212*(dg133 + dg313) + dg211*dg323 + pow2(dg213)))*pow2(ginv13) \ +- 2.*(pow2(dg222)*pow2(ginv22) + + (dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223))*pow2(ginv23)) - + (dg233*dg323 + dg223*dg333)*pow2(ginv33)) + + ginv13*(ddg2333*ginv33 + ginv22* + (ddg2223 - 2.*dg223*(dg233 + dg323)*ginv33 - + ginv23*(dg223*dg322 + dg222*(2.*dg233 + dg323) + 4.*pow2(dg223))) + + ginv23*(ddg2233 + ddg2323 - + ginv33*(3.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))) - + (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg223*pow2(ginv22) + + dg233*dg333*pow2(ginv33))) - + 2.*(dg111*dg211*pow3(ginv11) + + (dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212))*pow3(ginv12)) - + (dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + dg211*dg333)* + pow3(ginv13) +; + +dGfromgdu22 += +-((2.*dg111*dg211*ginv12 + (dg112*dg211 + dg111*dg212)*ginv22 + + (dg113*dg211 + dg111*dg213)*ginv23)*pow2(ginv11)) + + (ddg1212 + ddg2211 - (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))*ginv13 - + (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + dg112*dg223) + + dg222*dg311 + dg212*(8.*dg213 + 2.*dg312) + + dg211*(4.*dg223 + dg322))*ginv23 - + ginv22*(4.*dg211*dg222 + 3.*(dg122*dg212 + dg112*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + dg212*dg313 + + dg211*dg323 + 2.*pow2(dg213)))*pow2(ginv12) - + ((dg112*dg233 + dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + dg211*dg323)*ginv22 + + (dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + + dg211*dg333)*ginv23)*pow2(ginv13) + + (ddg2222 - dg222*(8.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223)))*pow2(ginv22) + + (ddg2233 + ddg2323 - ginv33*(3.*(dg233*dg323 + dg223*dg333) + + 2.*pow2(dg233)))*pow2(ginv23) + + ginv13*(ginv22*(ddg1223 + ddg2312 - + (dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322 + + 4.*(dg223*(dg123 + dg213 + dg312) + dg212*(dg233 + dg323)))* + ginv23 - (dg233*(dg123 + dg312) + dg223*(dg133 + 2.*dg313) + + 2.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv23*(ddg1233 + ddg2313 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33) - + ((dg122 + 4.*dg212)*dg223 + dg222*(dg123 + dg312) + dg212*dg322)* + pow2(ginv22) - (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*pow2(ginv23)) + + ginv11*(-(ginv13*((2.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + + dg212*dg311 + dg211*(dg123 + dg312))*ginv22 + + (dg111*dg233 + dg213*(4.*dg113 + dg311) + dg211*(dg133 + dg313))* + ginv23)) + ginv12*(ddg1211 - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + (6.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + dg212*dg311 + + dg211*(dg123 + 4.*dg213 + dg312))*ginv23 - + (dg213*(2.*dg113 + dg311) + dg211*dg313)*ginv33) + + ginv22*(ddg1212 - (dg122*dg213 + dg113*dg222 + 2.*dg112*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv23 - + (dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313)*ginv33) + + ginv23*(ddg1213 - (dg113*dg233 + dg213*(dg133 + 2.*dg313))*ginv33) - + (3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))*pow2(ginv12) - + (dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))*pow2(ginv22) - + (dg113*dg223 + dg112*dg233 + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + 2.*pow2(dg213))*pow2(ginv23)) + + ginv23*(ddg2333*ginv33 - 2.*dg233*dg333*pow2(ginv33)) + + ginv12*(ddg2313*ginv33 + ginv22* + (ddg1222 + 2.*ddg2212 - ((3.*dg122 + 12.*dg212)*dg223 + + dg222*(8.*dg213 + 3.*(dg123 + dg312)) + 3.*dg212*dg322)*ginv23 \ +- (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + dg222*dg313 + dg213*dg322 + + 2.*dg212*dg323)*ginv33) + + ginv23*(ddg1223 + 2.*ddg2213 + ddg2312 - + (dg233*(dg123 + 4.*dg213 + dg312) + dg223*(dg133 + 4.*dg313) + + 4.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv13*(ddg1213 + ddg2311 - + (dg122*dg213 + dg222*(dg113 + dg311) + + 4.*((dg112 + dg211)*dg223 + dg212*(dg123 + dg213 + dg312)) + + dg211*dg322)*ginv22 - + (dg233*(dg113 + dg311) + dg213*(dg133 + 4.*dg313) + dg211*dg333)* + ginv33 - ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg223*dg311 + + dg211*dg323) + 4.* + (dg113*dg223 + dg211*dg233 + dg213*(dg123 + dg312) + + dg212*dg313 + pow2(dg213)))) - + (dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + pow2(ginv13) - (2.*dg122 + 8.*dg212)*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(8.*dg213 + 2.*(dg123 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + pow2(ginv23) - (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (2.*ddg2223 + ddg2322 - (dg233*(4.*dg223 + dg322) + + 6.*dg223*dg323 + dg222*dg333)*ginv33) - + (3.*dg223*dg322 + dg222*(4.*dg233 + 3.*dg323) + 6.*pow2(dg223))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333)*pow2(ginv33)) - + (2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*pow3(ginv12) - + 2.*pow2(dg222)*pow3(ginv22) - + (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + dg222*dg333)*pow3(ginv23) +; + +dGfromgdu23 += +-((2.*dg111*dg211*ginv13 + (dg112*dg211 + dg111*dg212)*ginv23 + + (dg113*dg211 + dg111*dg213)*ginv33)*pow2(ginv11)) - + ((2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv13 + + (dg122*dg213 + dg212*(dg123 + 2.*dg213) + dg113*dg222 + + (dg112 + 2.*dg211)*dg223)*ginv33 + + 2.*ginv23*(dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212)))* + pow2(ginv12) + (ddg1213 + ddg2311 - + ((dg112 + 2.*dg211)*dg223 + dg212*(dg123 + 2.*(dg213 + dg312)))* + ginv22 - (3.*(dg133*dg213 + dg113*dg233) + 6.*dg213*dg313 + + 2.*(dg233*dg311 + dg211*dg333))*ginv33 - + ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg133*dg212 + dg123*dg213 + (dg112 + dg211)*dg233 + + dg223*(dg113 + dg311) + dg211*dg323 + pow2(dg213))))*pow2(ginv13) \ ++ (ddg2223 + ddg2322 - (dg233*(6.*dg223 + 2.*dg322) + 6.*dg223*dg323 + + 2.*dg222*dg333)*ginv33)*pow2(ginv23) + ddg2333*pow2(ginv33) + + ginv11*(ddg1213*ginv33 + ginv13* + (ddg1211 - 2.*(dg112 + dg211)*dg212*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + 2.*dg212*dg311 + + dg211*(dg123 + 2.*(dg213 + dg312)))*ginv23 - + (dg111*dg233 + dg213*(6.*dg113 + 2.*dg311) + + dg211*(dg133 + 2.*dg313))*ginv33) - + ginv12*((4.*dg112*dg212 + dg211*(dg122 + 2.*dg212) + dg111*dg222)* + ginv23 + (dg211*(dg123 + 2.*dg213) + + 2.*(dg113*dg212 + dg112*dg213) + dg111*dg223)*ginv33 + + ginv13*(3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))) - + ginv22*((dg212*(dg123 + 2.*dg213) + dg112*dg223)*ginv33 + + ginv23*(dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))) + + ginv23*(ddg1212 - ginv33*(dg112*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + pow2(dg213)))) - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*pow2(ginv13) - + (dg122*dg213 + dg113*dg222 + dg112*dg223 + + dg212*(dg123 + 2.*(dg213 + dg312)))*pow2(ginv23) - + (dg113*dg233 + dg213*(dg133 + 2.*dg313))*pow2(ginv33)) + + ginv22*(ddg2223*ginv33 + ginv23* + (ddg2222 - ginv33*(2.*(dg223*dg322 + dg222*(dg233 + dg323)) + + 6.*pow2(dg223))) - dg222*(6.*dg223 + 2.*dg322)*pow2(ginv23) - + 2.*dg223*(dg233 + dg323)*pow2(ginv33)) + + ginv12*((ddg1223 + ddg2213)*ginv33 - + ginv22*((2.*dg122 + 6.*dg212)*dg222*ginv23 + + ((dg123 + 2.*dg213)*dg222 + (dg122 + 4.*dg212)*dg223)*ginv33) + + ginv23*(ddg1222 + ddg2212 - + ((dg122 + 2.*dg212)*dg233 + + dg223*(4.*dg123 + 8.*dg213 + 2.*dg312) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + ginv33) + ginv13*(ddg1212 + ddg2211 - + (4.*(dg112 + dg211)*dg223 + + dg212*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg213 + dg222*(dg113 + dg311) + dg211*dg322))*ginv23 \ +- ginv22*(dg122*dg212 + (dg112 + 2.*dg211)*dg222 + 4.*pow2(dg212)) - + ginv33*((dg112 + 2.*dg211)*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg223*dg311 + dg213*dg312 + dg211*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg213)))) - + (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))* + pow2(ginv13) - ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)* + pow2(ginv23) - ((dg123 + 2.*dg213)*dg233 + + dg223*(dg133 + 2.*dg313) + 2.*dg213*dg323)*pow2(ginv33)) + + ginv13*((ddg1233 + 2.*ddg2313)*ginv33 + + ginv22*(ddg2212 - ((dg122 + 8.*dg212)*dg223 + + dg222*(dg123 + 2.*(dg213 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*(dg233 + dg323))* + ginv33) + ginv23*(ddg1223 + ddg2213 + 2.*ddg2312 - + (3.*(dg133*dg223 + dg123*dg233) + dg233*(6.*dg213 + 4.*dg312) + + 6.*(dg223*dg313 + dg213*dg323) + 4.*dg212*dg333)*ginv33) - + 2.*dg212*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(2.*dg123 + 4.*(dg213 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*dg213*dg322 + 4.*dg212*dg323)* + pow2(ginv23) - (dg233*(2.*dg133 + 4.*dg313) + 4.*dg213*dg333)* + pow2(ginv33)) + ginv23*((ddg2233 + 2.*ddg2323)*ginv33 - + (4.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))*pow2(ginv33)) - + (dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + pow3(ginv13) - 2.*((dg222*dg223*ginv33 + ginv23*pow2(dg222))* + pow2(ginv22) + (dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223))* + pow3(ginv23) + dg233*dg333*pow3(ginv33)) +; + +dGfromgdu31 += +(ddg1311 - ((4.*dg112 + 2.*dg211)*dg311 + 4.*dg111*dg312)*ginv12 - + (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + (dg311*(dg213 + 2.*dg312) + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313))*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(4.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311)))*pow2(ginv11) \ ++ (ddg1322 + ddg2312 - (2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))* + ginv22 - ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*ginv23 - + (dg313*(dg223 + 2.*dg322) + (dg213 + 2.*(dg123 + dg312))*dg323)* + ginv33 - ginv13*(4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg213*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + dg211*dg323 + pow2(dg312))))*pow2(ginv12) \ ++ (ddg1333 + ddg3313 - (dg233*dg312 + dg223*dg313 + + (dg213 + 2.*(dg123 + dg312))*dg323 + dg212*dg333)*ginv22 - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*ginv23 - + (2.*dg133 + 6.*dg313)*dg333*ginv33)*pow2(ginv13) + + ginv11*(ddg3313*ginv33 + ginv22* + (ddg2312 - (dg222*dg313 + dg213*dg322 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + (dg223*dg313 + (dg213 + 2.*dg312)*dg323)*ginv33) + + ginv23*(ddg2313 + ddg3312 - + (dg313*(dg233 + 4.*dg323) + (dg213 + 2.*dg312)*dg333)*ginv33) + + ginv12*(2.*ddg1312 + ddg2311 - + (dg311*(4.*dg123 + 3.*dg213 + 6.*dg312) + 3.*dg211*dg313 + + 6.*(dg113*dg312 + dg112*dg313) + 4.*dg111*dg323)*ginv13 - + (dg222*dg311 + (2.*dg122 + 6.*dg212)*dg312 + + (2.*dg112 + dg211)*dg322)*ginv22 - + (4.*dg312*dg313 + 2.*((dg123 + dg213)*dg313 + + (dg113 + dg311)*dg323))*ginv33 - + ginv23*((2.*dg123 + 4.*dg213)*dg312 + dg311*(dg223 + 2.*dg322) + + dg211*dg323 + 2.*(dg122*dg313 + dg113*dg322 + dg112*dg323) + + 4.*(dg212*dg313 + pow2(dg312)))) + + ginv13*(2.*ddg1313 + ddg3311 - + ((4.*dg213 + 8.*dg312)*dg313 + dg311*(dg233 + 2.*dg323) + + dg211*dg333 + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + + dg112*dg333))*ginv23 - + ginv22*(dg223*dg311 + dg211*dg323 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312))) - ginv33* + (2.*(dg133*dg313 + (dg113 + dg311)*dg333) + 6.*pow2(dg313))) - + ((2.*dg122 + 3.*dg212)*dg311 + (6.*dg112 + 3.*dg211)*dg312 + + 2.*dg111*dg322)*pow2(ginv12) - + (6.*dg113*dg313 + dg311*(2.*dg133 + 6.*dg313) + 2.*dg111*dg333)* + pow2(ginv13) - (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + (dg313*(dg223 + 2.*dg322) + dg213*dg323 + dg312*(dg233 + 2.*dg323) + + dg212*dg333)*pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv12*(ddg3323*ginv33 + ginv13* + (2.*ddg1323 + ddg2313 + ddg3312 - + (dg222*dg313 + (2.*dg123 + dg213)*dg322 + + dg312*(4.*dg223 + 2.*dg322) + (2.*dg122 + 4.*dg212)*dg323)* + ginv22 - ((4.*dg213 + 8.*dg312)*dg323 + + 4.*(dg313*(dg223 + dg322) + dg123*dg323) + + 2.*(dg233*dg312 + dg133*dg322 + (dg122 + dg212)*dg333))*ginv23 \ +- (dg313*(dg233 + 8.*dg323) + (dg213 + 2.*dg312)*dg333 + + 2.*(dg133*dg323 + dg123*dg333))*ginv33) + + ginv22*(ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))) + + ginv23*(ddg2323 + ddg3322 - + ginv33*(dg233*dg323 + (dg223 + 2.*dg322)*dg333 + 4.*pow2(dg323))) - + (dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg312)*dg313 + dg113*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg213*dg313 + dg112*dg333))*pow2(ginv13) - + (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg322*pow2(ginv22) + + dg323*dg333*pow2(ginv33))) + + ginv13*(ddg3333*ginv33 + ginv23* + (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33) + + ginv22*(ddg2323 - (4.*dg223*dg323 + dg322*(dg233 + 2.*dg323) + + dg222*dg333)*ginv23 - + ginv33*(dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))) - + (dg223*dg322 + dg222*dg323)*pow2(ginv22) - + 2.*((dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))*pow2(ginv23) + + pow2(dg333)*pow2(ginv33))) - + (dg222*dg311 + dg211*dg322 + 2.*((dg122 + dg212)*dg312 + dg112*dg322))* + pow3(ginv12) - 2.*(dg111*dg311*pow3(ginv11) + + (dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313))*pow3(ginv13)) +; + +dGfromgdu32 += +-((2.*dg111*dg311*ginv12 + (dg112*dg311 + dg111*dg312)*ginv22 + + (dg113*dg311 + dg111*dg313)*ginv23)*pow2(ginv11)) + + (ddg1312 + ddg2311 - (4.*dg311*dg312 + + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*ginv13 - + ((3.*dg122 + 6.*dg212)*dg312 + 3.*dg112*dg322 + + 2.*(dg222*dg311 + dg211*dg322))*ginv22 - + ((dg123 + 2.*(dg213 + dg312))*dg313 + (dg113 + 2.*dg311)*dg323)* + ginv33 - ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + (dg112 + dg211)*dg323 + pow2(dg312))))* + pow2(ginv12) - ((dg123*dg313 + dg312*(dg133 + 2.*dg313) + + (dg113 + 2.*dg311)*dg323 + dg112*dg333)*ginv22 + + 2.*ginv23*(dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313)))* + pow2(ginv13) + (ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(4.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322)))*pow2(ginv22) \ ++ (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33)*pow2(ginv23) + + ginv11*(-(ginv13*((dg311*(dg123 + 2.*dg312) + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv22 + + (4.*dg113*dg313 + dg311*(dg133 + 2.*dg313) + dg111*dg333)*ginv23)\ +) + ginv12*(ddg1311 - ((dg122 + 2.*dg212)*dg311 + + (6.*dg112 + 2.*dg211)*dg312 + dg111*dg322)*ginv22 - + (dg311*(dg123 + 2.*(dg213 + dg312)) + 2.*dg211*dg313 + + 4.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))) + + ginv22*(ddg1312 - ((dg123 + 2.*dg312)*dg313 + dg113*dg323)*ginv33 - + ginv23*(dg122*dg313 + dg113*dg322 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312)))) + + ginv23*(ddg1313 - ginv33* + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))) - + ((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*pow2(ginv12) - + ((dg122 + 2.*dg212)*dg312 + dg112*dg322)*pow2(ginv22) - + (dg133*dg312 + (dg123 + 2.*(dg213 + dg312))*dg313 + dg113*dg323 + + dg112*dg333)*pow2(ginv23)) + + ginv13*(ginv23*(ddg1333 + ddg3313 - (2.*dg133 + 6.*dg313)*dg333*ginv33) + + ginv22*(ddg1323 + ddg3312 - + (dg133*dg322 + (4.*dg123 + 2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg313*(dg223 + dg322) + + dg212*dg333))*ginv23 - + ((dg133 + 4.*dg313)*dg323 + (dg123 + 2.*dg312)*dg333)*ginv33) - + (dg123*dg322 + dg122*dg323 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*pow2(ginv22) - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*pow2(ginv23)) + + ginv12*(ddg3313*ginv33 + ginv22* + (ddg1322 + 2.*ddg2312 - (4.*(dg222*dg313 + dg213*dg322) + + 3.*(dg123*dg322 + dg122*dg323) + + 6.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + ((2.*dg213 + 4.*dg312)*dg323 + + 2.*(dg313*(dg223 + dg322) + dg123*dg323))*ginv33) + + ginv23*(ddg1323 + 2.*ddg2313 + ddg3312 - + (dg133*dg323 + dg313*(2.*dg233 + 8.*dg323) + + (dg123 + 2.*(dg213 + dg312))*dg333)*ginv33) + + ginv13*(ddg1313 + ddg3311 - + (8.*dg312*dg313 + 4.* + ((dg123 + dg213)*dg313 + (dg113 + dg311)*dg323) + + 2.*(dg233*dg311 + dg133*dg312 + (dg112 + dg211)*dg333))*ginv23 \ +- ginv22*(dg122*dg313 + dg113*dg322 + + 2.*(dg213*dg312 + dg212*dg313 + dg311*(dg223 + dg322) + + dg211*dg323) + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg312))) \ +- ginv33*(dg133*dg313 + (dg113 + 2.*dg311)*dg333 + 4.*pow2(dg313))) - + (2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)* + pow2(ginv13) - (2.*dg122*dg322 + 4.*(dg222*dg312 + dg212*dg322))* + pow2(ginv22) - (dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg213 + dg312)*dg323) + + dg122*dg333 + 2.*(dg233*dg312 + dg123*dg323 + dg212*dg333))* + pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv22*(ddg3323*ginv33 + ginv23* + (2.*ddg2323 + ddg3322 - ginv33* + (2.*(dg233*dg323 + (dg223 + dg322)*dg333) + 6.*pow2(dg323))) - + (6.*dg223*dg323 + dg322*(2.*dg233 + 6.*dg323) + 2.*dg222*dg333)* + pow2(ginv23) - 2.*dg323*dg333*pow2(ginv33)) + + ginv23*(ddg3333*ginv33 - 2.*pow2(dg333)*pow2(ginv33)) - + ((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + pow3(ginv12) - 2.*(dg222*dg322*pow3(ginv22) + + (dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))*pow3(ginv23)) +; + +dGfromgdu33 += +-((2.*dg111*dg311*ginv13 + (dg112*dg311 + dg111*dg312)*ginv23 + + (dg113*dg311 + dg111*dg313)*ginv33)*pow2(ginv11)) - + (((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + ginv13 + (dg222*dg311 + dg211*dg322 + + 2.*((dg122 + dg212)*dg312 + dg112*dg322))*ginv23 + + (dg223*dg311 + (dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + + dg113*dg322 + (dg112 + dg211)*dg323)*ginv33)*pow2(ginv12) + + (ddg1313 + ddg3311 - ((2.*dg213 + 8.*dg312)*dg313 + + dg311*(dg233 + 4.*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + dg112*dg333))*ginv23 \ +- ginv22*(dg223*dg311 + (dg123 + dg213)*dg312 + dg212*dg313 + + (dg112 + dg211)*dg323 + 2.*pow2(dg312)) - + ginv33*(4.*dg311*dg333 + 3.*(dg133*dg313 + dg113*dg333) + + 6.*pow2(dg313)))*pow2(ginv13) - + (2.*dg222*dg322*ginv23 + (dg223*dg322 + dg222*dg323)*ginv33)* + pow2(ginv22) + (ddg2323 + ddg3322 - + ginv33*(4.*dg322*dg333 + 3.*(dg233*dg323 + dg223*dg333) + + 6.*pow2(dg323)))*pow2(ginv23) + ddg3333*pow2(ginv33) + + ginv13*((ddg1333 + 2.*ddg3313)*ginv33 + + ginv22*(ddg2312 - (dg222*dg313 + (dg123 + dg213)*dg322 + + dg122*dg323 + 4.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 \ +- (dg312*(dg233 + 4.*dg323) + 2.*(dg223*dg313 + (dg123 + dg213)*dg323) + + dg212*dg333)*ginv33) + + ginv23*(ddg1323 + ddg2313 + 2.*ddg3312 - + (12.*dg313*dg323 + (3.*dg213 + 8.*dg312)*dg333 + + 3.*(dg233*dg313 + dg133*dg323 + dg123*dg333))*ginv33) - + (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + ((dg133 + 4.*dg313)*dg322 + (2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg223*dg313 + dg123*dg323 + + dg212*dg333))*pow2(ginv23) - + (2.*dg133 + 8.*dg313)*dg333*pow2(ginv33)) + + ginv23*((ddg2333 + 2.*ddg3323)*ginv33 - + (2.*dg233 + 8.*dg323)*dg333*pow2(ginv33)) + + ginv12*((ddg1323 + ddg2313)*ginv33 - + ginv22*((2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))*ginv23 + + (dg222*dg313 + (dg123 + dg213)*dg322 + dg122*dg323 + + 2.*(dg223*dg312 + dg212*dg323))*ginv33) + + ginv23*(ddg1322 + ddg2312 - + (dg233*dg312 + dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg123 + dg213 + dg312)*dg323) + + (dg122 + dg212)*dg333)*ginv33) + + ginv13*(ddg1312 + ddg2311 - + (dg222*dg311 + (dg122 + 4.*dg212)*dg312 + (dg112 + dg211)*dg322)* + ginv22 - (dg133*dg312 + dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg213 + dg312)*dg313 + dg113*dg323) + + (dg112 + dg211)*dg333)*ginv33 - + ginv23*(2.*(dg223*dg311 + dg122*dg313 + dg113*dg322 + + dg211*dg323) + 4.* + ((dg123 + dg213)*dg312 + dg212*dg313 + dg311*dg322 + + dg112*dg323 + pow2(dg312)))) - + (4.*dg311*dg312 + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*pow2(ginv13) - + ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*pow2(ginv23) - + (dg133*dg323 + dg313*(dg233 + 4.*dg323) + (dg123 + dg213)*dg333)* + pow2(ginv33)) + ginv11*(ddg1313*ginv33 - + ginv12*(((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*ginv13 + + ((dg122 + dg212)*dg311 + (4.*dg112 + dg211)*dg312 + dg111*dg322)* + ginv23 + ((dg123 + dg213)*dg311 + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv33) - + ginv22*(((dg122 + 2.*dg212)*dg312 + dg112*dg322)*ginv23 + + ((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323)*ginv33) + + ginv13*(ddg1311 - (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + ((dg123 + dg213)*dg311 + 4.*(dg113 + dg311)*dg312 + + (4.*dg112 + dg211)*dg313 + dg111*dg323)*ginv23 - + (6.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)*ginv33) + + ginv23*(ddg1312 - (dg312*(dg133 + 4.*dg313) + + 2.*((dg123 + dg213)*dg313 + dg113*dg323) + dg112*dg333)*ginv33) \ +- (3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))*pow2(ginv13) - + ((dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg112*dg323 + 2.*pow2(dg312))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (ddg2322 - (6.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + ginv33) - (3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))* + pow2(ginv33)) - (2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + + dg111*dg333)*pow3(ginv13) - + (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)*pow3(ginv23) - + 2.*pow2(dg333)*pow3(ginv33) +; + +R11 += +gammado111*Gfromg1 + gammado112*Gfromg2 + gammado113*Gfromg3 + + (-0.5*ddg1111 + 3.*gamma111*gammado111 + + 2.*(gamma211*gammado112 + gamma311*gammado113) + + gamma211*gammado211 + gamma311*gammado311)*ginv11 + + (-ddg1211 + 3.*(gamma112*gammado111 + gamma111*gammado112) + + 2.*(gamma212*gammado112 + gamma312*gammado113 + + gamma211*gammado122 + gamma311*gammado123) + gamma212*gammado211 + + gamma211*gammado212 + gamma312*gammado311 + gamma311*gammado312)*ginv12 \ ++ (-ddg1311 + 3.*(gamma113*gammado111 + gamma111*gammado113) + + 2.*(gamma213*gammado112 + gamma313*gammado113 + + gamma211*gammado123 + gamma311*gammado133) + gamma213*gammado211 + + gamma211*gammado213 + gamma313*gammado311 + gamma311*gammado313)*ginv13 \ ++ (-0.5*ddg2211 + 3.*gamma112*gammado112 + + 2.*(gamma212*gammado122 + gamma312*gammado123) + + gamma212*gammado212 + gamma312*gammado312)*ginv22 + + (-ddg2311 + 3.*(gamma113*gammado112 + gamma112*gammado113) + + 2.*(gamma213*gammado122 + (gamma212 + gamma313)*gammado123 + + gamma312*gammado133) + gamma213*gammado212 + gamma212*gammado213 + + gamma313*gammado312 + gamma312*gammado313)*ginv23 + + (-0.5*ddg3311 + 3.*gamma113*gammado113 + + 2.*(gamma213*gammado123 + gamma313*gammado133) + + gamma213*gammado213 + gamma313*gammado313)*ginv33 + dG11*g11 + + dG12*g12 + dG13*g13 +; + +R12 += +(-0.5*ddg1112 + gamma112*gammado111 + (gamma111 + gamma212)*gammado112 + + gamma312*gammado113 + gamma111*gammado211 + 2.*gamma211*gammado212 + + gamma311*(gammado213 + gammado312))*ginv11 + + (-ddg1212 + gamma122*gammado111 + (2.*gamma112 + gamma222)*gammado112 + + gamma322*gammado113 + (gamma111 + gamma212)*gammado122 + + gamma112*gammado211 + (gamma111 + 2.*gamma212)*gammado212 + + 2.*gamma211*gammado222 + gamma312* + (gammado123 + gammado213 + gammado312) + + gamma311*(gammado223 + gammado322))*ginv12 + + (-ddg1312 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + (gamma111 + gamma212)*gammado123 + + gamma312*gammado133 + gamma113*gammado211 + + (gamma111 + gamma313)*gammado213 + + 2.*(gamma213*gammado212 + gamma211*gammado223) + + gamma313*gammado312 + gamma311*(gammado233 + gammado323))*ginv13 + + (-0.5*ddg2212 + gamma122*gammado112 + (gamma112 + gamma222)*gammado122 + + gamma322*gammado123 + gamma112*gammado212 + 2.*gamma212*gammado222 + + gamma312*(gammado223 + gammado322))*ginv22 + + (-ddg2312 + gamma123*gammado112 + gamma122*gammado113 + + (gamma113 + gamma223)*gammado122 + + (gamma112 + gamma222 + gamma323)*gammado123 + gamma322*gammado133 + + gamma113*gammado212 + gamma112*gammado213 + + 2.*(gamma213*gammado222 + gamma212*gammado223) + + gamma313*(gammado223 + gammado322) + + gamma312*(gammado233 + gammado323))*ginv23 + + (-0.5*ddg3312 + gamma123*gammado113 + (gamma113 + gamma223)*gammado123 + + gamma323*gammado133 + gamma113*gammado213 + 2.*gamma213*gammado223 + + gamma313*(gammado233 + gammado323))*ginv33 + + 0.5*((gammado112 + gammado211)*Gfromg1 + + (gammado122 + gammado212)*Gfromg2 + (gammado123 + gammado213)*Gfromg3 + + dG21*g11 + (dG11 + dG22)*g12 + dG23*g13 + + dG12*g22 + dG13*g23) +; + +R13 += +(-0.5*ddg1113 + gamma113*gammado111 + gamma213*gammado112 + + (gamma111 + gamma313)*gammado113 + gamma111*gammado311 + + gamma211*(gammado213 + gammado312) + 2.*gamma311*gammado313)*ginv11 + + (-ddg1213 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + gamma213*gammado122 + + (gamma111 + gamma313)*gammado123 + gamma112*gammado311 + + gamma111*gammado312 + gamma212*(gammado213 + gammado312) + + gamma211*(gammado223 + gammado322) + + 2.*(gamma312*gammado313 + gamma311*gammado323))*ginv12 + + (-ddg1313 + gamma133*gammado111 + gamma233*gammado112 + + (2.*gamma113 + gamma333)*gammado113 + + (gamma111 + gamma313)*gammado133 + gamma113*gammado311 + + gamma213*(gammado123 + gammado213 + gammado312) + + (gamma111 + 2.*gamma313)*gammado313 + + gamma211*(gammado233 + gammado323) + 2.*gamma311*gammado333)*ginv13 + + (-0.5*ddg2213 + gamma123*gammado112 + gamma223*gammado122 + + (gamma112 + gamma323)*gammado123 + gamma112*gammado312 + + gamma212*(gammado223 + gammado322) + 2.*gamma312*gammado323)*ginv22 + + (-ddg2313 + gamma133*gammado112 + gamma123*gammado113 + + gamma233*gammado122 + (gamma113 + gamma223 + gamma333)*gammado123 + + (gamma112 + gamma323)*gammado133 + gamma113*gammado312 + + gamma112*gammado313 + gamma213*(gammado223 + gammado322) + + gamma212*(gammado233 + gammado323) + + 2.*(gamma313*gammado323 + gamma312*gammado333))*ginv23 + + (-0.5*ddg3313 + gamma133*gammado113 + gamma233*gammado123 + + (gamma113 + gamma333)*gammado133 + gamma113*gammado313 + + gamma213*(gammado233 + gammado323) + 2.*gamma313*gammado333)*ginv33 + + 0.5*((gammado113 + gammado311)*Gfromg1 + + (gammado123 + gammado312)*Gfromg2 + (gammado133 + gammado313)*Gfromg3 + + dG31*g11 + dG32*g12 + (dG11 + dG33)*g13 + + dG12*g23 + dG13*g33) +; + +R22 += +gammado212*Gfromg1 + gammado222*Gfromg2 + gammado223*Gfromg3 + + (-0.5*ddg1122 + gamma112*(gammado112 + 2.*gammado211) + + 3.*gamma212*gammado212 + gamma312*(2.*gammado213 + gammado312))*ginv11 \ ++ (-ddg1222 + gamma122*(gammado112 + 2.*gammado211) + + gamma112*(gammado122 + 2.*gammado212) + + 3.*(gamma222*gammado212 + gamma212*gammado222) + + 2.*(gamma322*gammado213 + gamma312*gammado223) + + gamma322*gammado312 + gamma312*gammado322)*ginv12 + + (-ddg1322 + gamma123*(gammado112 + 2.*gammado211) + + gamma112*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado212 + gamma212*gammado223) + + 2.*(gamma323*gammado213 + gamma312*gammado233) + + gamma323*gammado312 + gamma312*gammado323)*ginv13 + + (-0.5*ddg2222 + gamma122*(gammado122 + 2.*gammado212) + + 3.*gamma222*gammado222 + gamma322*(2.*gammado223 + gammado322))*ginv22 \ ++ (-ddg2322 + gamma123*(gammado122 + 2.*gammado212) + + gamma122*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado222 + gamma222*gammado223) + + 2.*(gamma323*gammado223 + gamma322*gammado233) + + gamma323*gammado322 + gamma322*gammado323)*ginv23 + + (-0.5*ddg3322 + gamma123*(gammado123 + 2.*gammado213) + + 3.*gamma223*gammado223 + gamma323*(2.*gammado233 + gammado323))*ginv33 \ ++ dG21*g12 + dG22*g22 + dG23*g23 +; + +R23 += +(-0.5*ddg1123 + gamma113*gammado211 + gamma213*gammado212 + + (gamma212 + gamma313)*gammado213 + + gamma112*(gammado113 + gammado311) + gamma212*gammado312 + + 2.*gamma312*gammado313)*ginv11 + + (-ddg1223 + gamma123*gammado211 + (gamma113 + gamma223)*gammado212 + + (gamma222 + gamma323)*gammado213 + gamma213*gammado222 + + (gamma212 + gamma313)*gammado223 + + gamma122*(gammado113 + gammado311) + gamma222*gammado312 + + gamma112*(gammado123 + gammado312) + gamma212*gammado322 + + 2.*(gamma322*gammado313 + gamma312*gammado323))*ginv12 + + (-ddg1323 + gamma133*gammado211 + gamma233*gammado212 + + (gamma113 + gamma223 + gamma333)*gammado213 + gamma213*gammado223 + + (gamma212 + gamma313)*gammado233 + + gamma123*(gammado113 + gammado311) + gamma223*gammado312 + + gamma112*(gammado133 + gammado313) + gamma212*gammado323 + + 2.*(gamma323*gammado313 + gamma312*gammado333))*ginv13 + + (-0.5*ddg2223 + gamma123*gammado212 + gamma223*gammado222 + + (gamma222 + gamma323)*gammado223 + + gamma122*(gammado123 + gammado312) + gamma222*gammado322 + + 2.*gamma322*gammado323)*ginv22 + + (-ddg2323 + gamma133*gammado212 + gamma233*gammado222 + + (2.*gamma223 + gamma333)*gammado223 + + (gamma222 + gamma323)*gammado233 + + gamma123*(gammado123 + gammado213 + gammado312) + + gamma122*(gammado133 + gammado313) + gamma223*gammado322 + + (gamma222 + 2.*gamma323)*gammado323 + 2.*gamma322*gammado333)*ginv23 + + (-0.5*ddg3323 + gamma133*gammado213 + gamma233*gammado223 + + (gamma223 + gamma333)*gammado233 + + gamma123*(gammado133 + gammado313) + gamma223*gammado323 + + 2.*gamma323*gammado333)*ginv33 + + 0.5*((gammado213 + gammado312)*Gfromg1 + + (gammado223 + gammado322)*Gfromg2 + (gammado233 + gammado323)*Gfromg3 + + dG31*g12 + dG21*g13 + dG32*g22 + + (dG22 + dG33)*g23 + dG23*g33) +; + +R33 += +gammado313*Gfromg1 + gammado323*Gfromg2 + gammado333*Gfromg3 + + (-0.5*ddg1133 + gamma113*(gammado113 + 2.*gammado311) + + gamma213*(gammado213 + 2.*gammado312) + 3.*gamma313*gammado313)*ginv11 \ ++ (-ddg1233 + gamma123*(gammado113 + 2.*gammado311) + + gamma113*(gammado123 + 2.*gammado312) + + gamma223*(gammado213 + 2.*gammado312) + + gamma213*(gammado223 + 2.*gammado322) + + 3.*(gamma323*gammado313 + gamma313*gammado323))*ginv12 + + (-ddg1333 + gamma133*(gammado113 + 2.*gammado311) + + gamma233*(gammado213 + 2.*gammado312) + + gamma113*(gammado133 + 2.*gammado313) + + gamma213*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado313 + gamma313*gammado333))*ginv13 + + (-0.5*ddg2233 + gamma123*(gammado123 + 2.*gammado312) + + gamma223*(gammado223 + 2.*gammado322) + 3.*gamma323*gammado323)*ginv22 \ ++ (-ddg2333 + gamma133*(gammado123 + 2.*gammado312) + + gamma123*(gammado133 + 2.*gammado313) + + gamma233*(gammado223 + 2.*gammado322) + + gamma223*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado323 + gamma323*gammado333))*ginv23 + + (-0.5*ddg3333 + gamma133*(gammado133 + 2.*gammado313) + + gamma233*(gammado233 + 2.*gammado323) + 3.*gamma333*gammado333)*ginv33 \ ++ dG31*g13 + dG32*g23 + dG33*g33 +; + +ff += +chi +; + +oochipsipower += +1/chipsipower +; + +f += +oochipsipower*log(ff) +; + +psim4 += +exp(-4.*f) +; + +df1 += +(dchi1*oochipsipower)/chi +; + +df2 += +(dchi2*oochipsipower)/chi +; + +df3 += +(dchi3*oochipsipower)/chi +; + +ddf11 += +(ddchi11*oochipsipower)/chi - chipsipower*pow2(df1) +; + +ddf12 += +-(chipsipower*df1*df2) + (ddchi12*oochipsipower)/chi +; + +ddf13 += +-(chipsipower*df1*df3) + (ddchi13*oochipsipower)/chi +; + +ddf22 += +(ddchi22*oochipsipower)/chi - chipsipower*pow2(df2) +; + +ddf23 += +-(chipsipower*df2*df3) + (ddchi23*oochipsipower)/chi +; + +ddf33 += +(ddchi33*oochipsipower)/chi - chipsipower*pow2(df3) +; + +cddf11 += +ddf11 - df1*gamma111 - df2*gamma211 - df3*gamma311 +; + +cddf12 += +ddf12 - df1*gamma112 - df2*gamma212 - df3*gamma312 +; + +cddf13 += +ddf13 - df1*gamma113 - df2*gamma213 - df3*gamma313 +; + +cddf22 += +ddf22 - df1*gamma122 - df2*gamma222 - df3*gamma322 +; + +cddf23 += +ddf23 - df1*gamma123 - df2*gamma223 - df3*gamma323 +; + +cddf33 += +ddf33 - df1*gamma133 - df2*gamma233 - df3*gamma333 +; + +trcddf += +cddf11*ginv11 + cddf22*ginv22 + + 2.*(cddf12*ginv12 + cddf13*ginv13 + cddf23*ginv23) + cddf33*ginv33 +; + +Rphi11 += +-2.*(cddf11 + trcddf*g11) + (4. - 4.*ginv11*g11)*pow2(df1) - + g11*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi12 += +df1*df2*(4. - 8.*ginv12*g12) - 2.*(cddf12 + trcddf*g12) - + g12*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi13 += +df1*(4.*df3 - 8.*df2*ginv12*g13) - 2.*(cddf13 + trcddf*g13) - + g13*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi22 += +-2.*(cddf22 + trcddf*g22) + (4. - 4.*ginv22*g22)*pow2(df2) - + g22*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv33*pow2(df3))) +; + +Rphi23 += +df2*(4.*df3 - 8.*df1*ginv12*g23) - 2.*(cddf23 + trcddf*g23) - + g23*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi33 += +-2.*(cddf33 + trcddf*g33) - + g33*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2))) + + (4. - 4.*ginv33*g33)*pow2(df3) +; + +Rf11 += +R11 + Rphi11 +; + +Rf12 += +R12 + Rphi12 +; + +Rf13 += +R13 + Rphi13 +; + +Rf22 += +R22 + Rphi22 +; + +Rf23 += +R23 + Rphi23 +; + +Rf33 += +R33 + Rphi33 +; + +Rhat += +psim4*(ginv11*Rf11 + ginv22*Rf22 + + 2.*(ginv12*Rf12 + ginv13*Rf13 + ginv23*Rf23) + ginv33*Rf33) +; + +cdda11 += +dda11 - da2*gamma211 - da3*gamma311 + + 2.*((da2*df1 + da1*df2)*ginv12 + (da3*df1 + da1*df3)*ginv13 + + da2*df2*ginv22 + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g11 \ ++ da1*(-4.*df1 - gamma111 + 2.*df1*ginv11*g11) +; + +cdda12 += +dda12 - 2.*(da2*df1 + da1*df2) - da1*gamma112 - da2*gamma212 - + da3*gamma312 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g12 +; + +cdda13 += +dda13 - 2.*(da3*df1 + da1*df3) - da1*gamma113 - da2*gamma213 - + da3*gamma313 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g13 +; + +cdda22 += +dda22 - da1*gamma122 - da3*gamma322 + + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + (da3*df2 + da2*df3)*ginv23 + + da3*df3*ginv33)*g22 + + da2*(-4.*df2 - gamma222 + 2.*df2*ginv22*g22) +; + +cdda23 += +dda23 - 2.*(da3*df2 + da2*df3) - da1*gamma123 - da2*gamma223 - + da3*gamma323 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g23 +; + +cdda33 += +dda33 - da1*gamma133 - da2*gamma233 + + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23)*g33 + + da3*(-4.*df3 - gamma333 + 2.*df3*ginv33*g33) +; + +dda12 += +dda12 - 2.*(da2*df1 + da1*df2) - da1*gamma112 - da2*gamma212 - + da3*gamma312 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g12 +; + +dda13 += +dda13 - 2.*(da3*df1 + da1*df3) - da1*gamma113 - da2*gamma213 - + da3*gamma313 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g13 +; + +dda23 += +dda23 - 2.*(da3*df2 + da2*df3) - da1*gamma123 - da2*gamma223 - + da3*gamma323 + 2.*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)*g23 +; + +trcdda += +(cdda11*ginv11 + (cdda12 + dda12)*ginv12 + (cdda13 + dda13)*ginv13 + + cdda22*ginv22 + (cdda23 + dda23)*ginv23 + cdda33*ginv33)*psim4 +; + +AA11 += +2.*(ginv23*A12*A13 + + A11*(ginv12*A12 + ginv13*A13)) + ginv11*pow2(A11) + + ginv22*pow2(A12) + ginv33*pow2(A13) +; + +AA12 += +A12*(ginv11*A11 + ginv22*A22) + ginv33*A13*A23 + + ginv13*(A12*A13 + A11*A23) + + ginv23*(A13*A22 + A12*A23) + + ginv12*(A11*A22 + pow2(A12)) +; + +AA13 += +ginv22*A12*A23 + ginv12*(A12*A13 + A11*A23) + + A13*(ginv11*A11 + ginv33*A33) + + ginv23*(A13*A23 + A12*A33) + + ginv13*(A11*A33 + pow2(A13)) +; + +AA21 += +A12*(ginv11*A11 + ginv22*A22) + ginv33*A13*A23 + + ginv13*(A12*A13 + A11*A23) + + ginv23*(A13*A22 + A12*A23) + + ginv12*(A11*A22 + pow2(A12)) +; + +AA22 += +2.*(ginv23*A22*A23 + + A12*(ginv12*A22 + ginv13*A23)) + ginv11*pow2(A12) + + ginv22*pow2(A22) + ginv33*pow2(A23) +; + +AA23 += +ginv11*A12*A13 + ginv12*(A13*A22 + A12*A23) + + A23*(ginv22*A22 + ginv33*A33) + + ginv13*(A13*A23 + A12*A33) + + ginv23*(A22*A33 + pow2(A23)) +; + +AA31 += +ginv22*A12*A23 + ginv12*(A12*A13 + A11*A23) + + A13*(ginv11*A11 + ginv33*A33) + + ginv23*(A13*A23 + A12*A33) + + ginv13*(A11*A33 + pow2(A13)) +; + +AA32 += +ginv11*A12*A13 + ginv12*(A13*A22 + A12*A23) + + A23*(ginv22*A22 + ginv33*A33) + + ginv13*(A13*A23 + A12*A33) + + ginv23*(A22*A33 + pow2(A23)) +; + +AA33 += +2.*(ginv23*A23*A33 + + A13*(ginv12*A23 + ginv13*A33)) + ginv11*pow2(A13) + + ginv22*pow2(A23) + ginv33*pow2(A33) +; + +Ainv11 += +2.*(ginv11*(ginv12*A12 + ginv13*A13) + ginv12*ginv13*A23) + + A11*pow2(ginv11) + A22*pow2(ginv12) + A33*pow2(ginv13) +; + +Ainv12 += +ginv11*(ginv12*A11 + ginv22*A12 + ginv23*A13) + + ginv12*(ginv13*A13 + ginv22*A22 + ginv23*A23) + + ginv13*(ginv22*A23 + ginv23*A33) + A12*pow2(ginv12) +; + +Ainv13 += +ginv11*(ginv13*A11 + ginv23*A12 + ginv33*A13) + + ginv12*(ginv13*A12 + ginv23*A22 + ginv33*A23) + + ginv13*(ginv23*A23 + ginv33*A33) + A13*pow2(ginv13) +; + +Ainv22 += +2.*(ginv12*(ginv22*A12 + ginv23*A13) + ginv22*ginv23*A23) + + A11*pow2(ginv12) + A22*pow2(ginv22) + A33*pow2(ginv23) +; + +Ainv23 += +ginv13*(ginv22*A12 + ginv23*A13) + + ginv12*(ginv13*A11 + ginv23*A12 + ginv33*A13) + + ginv22*(ginv23*A22 + ginv33*A23) + ginv23*ginv33*A33 + + A23*pow2(ginv23) +; + +Ainv33 += +2.*(ginv13*(ginv23*A12 + ginv33*A13) + ginv23*ginv33*A23) + + A11*pow2(ginv13) + A22*pow2(ginv23) + A33*pow2(ginv33) +; + +cdA111 += +dA111 - 2.*(gamma111*A11 + gamma211*A12 + gamma311*A13) +; + +cdA112 += +dA112 - gamma112*A11 - (gamma111 + gamma212)*A12 - + gamma312*A13 - gamma211*A22 - gamma311*A23 +; + +cdA113 += +dA113 - gamma113*A11 - gamma213*A12 - + (gamma111 + gamma313)*A13 - gamma211*A23 - gamma311*A33 +; + +cdA122 += +dA122 - 2.*(gamma112*A12 + gamma212*A22 + gamma312*A23) +; + +cdA123 += +dA123 - gamma113*A12 - gamma112*A13 - gamma213*A22 - + (gamma212 + gamma313)*A23 - gamma312*A33 +; + +cdA133 += +dA133 - 2.*(gamma113*A13 + gamma213*A23 + gamma313*A33) +; + +cdA211 += +dA211 - 2.*(gamma112*A11 + gamma212*A12 + gamma312*A13) +; + +cdA212 += +dA212 - gamma122*A11 - (gamma112 + gamma222)*A12 - + gamma322*A13 - gamma212*A22 - gamma312*A23 +; + +cdA213 += +dA213 - gamma123*A11 - gamma223*A12 - + (gamma112 + gamma323)*A13 - gamma212*A23 - gamma312*A33 +; + +cdA222 += +dA222 - 2.*(gamma122*A12 + gamma222*A22 + gamma322*A23) +; + +cdA223 += +dA223 - gamma123*A12 - gamma122*A13 - gamma223*A22 - + (gamma222 + gamma323)*A23 - gamma322*A33 +; + +cdA233 += +dA233 - 2.*(gamma123*A13 + gamma223*A23 + gamma323*A33) +; + +cdA311 += +dA311 - 2.*(gamma113*A11 + gamma213*A12 + gamma313*A13) +; + +cdA312 += +dA312 - gamma123*A11 - (gamma113 + gamma223)*A12 - + gamma323*A13 - gamma213*A22 - gamma313*A23 +; + +cdA313 += +dA313 - gamma133*A11 - gamma233*A12 - + (gamma113 + gamma333)*A13 - gamma213*A23 - gamma313*A33 +; + +cdA322 += +dA322 - 2.*(gamma123*A12 + gamma223*A22 + gamma323*A23) +; + +cdA323 += +dA323 - gamma133*A12 - gamma123*A13 - gamma233*A22 - + (gamma223 + gamma333)*A23 - gamma323*A33 +; + +cdA333 += +dA333 - 2.*(gamma133*A13 + gamma233*A23 + gamma333*A33) +; + +divbeta += +db11 + db22 + db33 +; + +totdivbeta += +0.66666666666666666667*divbeta +; + +lieg11 += +dg111*beta1 + dg211*beta2 + dg311*beta3 + + (2.*db11 - totdivbeta)*g11 + 2.*(db12*g12 + db13*g13) +; + +lieg12 += +dg112*beta1 + dg212*beta2 + dg312*beta3 + db21*g11 + + (db11 + db22 - totdivbeta)*g12 + db23*g13 + db12*g22 + + db13*g23 +; + +lieg13 += +dg113*beta1 + dg213*beta2 + dg313*beta3 + db31*g11 + + db32*g12 + (db11 + db33 - totdivbeta)*g13 + db12*g23 + + db13*g33 +; + +lieg22 += +dg122*beta1 + dg222*beta2 + dg322*beta3 - + totdivbeta*g22 + 2.*(db21*g12 + db22*g22 + db23*g23) +; + +lieg23 += +dg123*beta1 + dg223*beta2 + dg323*beta3 + db31*g12 + + db21*g13 + db32*g22 + (db22 + db33 - totdivbeta)*g23 + + db23*g33 +; + +lieg33 += +dg133*beta1 + dg233*beta2 + dg333*beta3 - + totdivbeta*g33 + 2.*(db31*g13 + db32*g23 + db33*g33) +; + +lieA11 += +(2.*db11 - totdivbeta)*A11 + 2.*(db12*A12 + db13*A13) + + dA111*beta1 + dA211*beta2 + dA311*beta3 +; + +lieA12 += +db21*A11 + (db11 + db22 - totdivbeta)*A12 + db23*A13 + + db12*A22 + db13*A23 + dA112*beta1 + dA212*beta2 + + dA312*beta3 +; + +lieA13 += +db31*A11 + db32*A12 + (db11 + db33 - totdivbeta)*A13 + + db12*A23 + db13*A33 + dA113*beta1 + dA213*beta2 + + dA313*beta3 +; + +lieA22 += +-(totdivbeta*A22) + 2.*(db21*A12 + db22*A22 + + db23*A23) + dA122*beta1 + dA222*beta2 + dA322*beta3 +; + +lieA23 += +db31*A12 + db21*A13 + db32*A22 + + (db22 + db33 - totdivbeta)*A23 + db23*A33 + dA123*beta1 + + dA223*beta2 + dA323*beta3 +; + +lieA33 += +-(totdivbeta*A33) + 2.*(db31*A13 + db32*A23 + + db33*A33) + dA133*beta1 + dA233*beta2 + dA333*beta3 +; + +betas += +sdown1*beta1 + sdown2*beta2 + sdown3*beta3 +; + +Dbetas += +(db11*sdown1 + db12*sdown2 + db13*sdown3)*sup1 + + (db21*sdown1 + db22*sdown2 + db23*sdown3)*sup2 + + (db31*sdown1 + db32*sdown2 + db33*sdown3)*sup3 +; + +Dalpha += +da1*sup1 + da2*sup2 + da3*sup3 +; + +DKhat += +dKhat1*sup1 + dKhat2*sup2 + dKhat3*sup3 +; + +DK += +dK1*sup1 + dK2*sup2 + dK3*sup3 +; + +DTheta += +dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3 +; + +Gams += +sdown1*G1 + sdown2*G2 + sdown3*G3 +; + +DGams += +(dG11*sdown1 + dG12*sdown2 + dG13*sdown3)*sup1 + + (dG21*sdown1 + dG22*sdown2 + dG23*sdown3)*sup2 + + (dG31*sdown1 + dG32*sdown2 + dG33*sdown3)*sup3 +; + +GamA1 += +qud11*G1 + qud12*G2 + qud13*G3 +; + +GamA2 += +qud21*G1 + qud22*G2 + qud23*G3 +; + +GamA3 += +qud31*G1 + qud32*G2 + qud33*G3 +; + +DGamA1 += +(dG11*qud11 + dG12*qud12 + dG13*qud13)*sup1 + + (dG21*qud11 + dG22*qud12 + dG23*qud13)*sup2 + + (dG31*qud11 + dG32*qud12 + dG33*qud13)*sup3 +; + +DGamA2 += +(dG11*qud21 + dG12*qud22 + dG13*qud23)*sup1 + + (dG21*qud21 + dG22*qud22 + dG23*qud23)*sup2 + + (dG31*qud21 + dG32*qud22 + dG33*qud23)*sup3 +; + +DGamA3 += +(dG11*qud31 + dG12*qud32 + dG13*qud33)*sup1 + + (dG21*qud31 + dG22*qud32 + dG23*qud33)*sup2 + + (dG31*qud31 + dG32*qud32 + dG33*qud33)*sup3 +; + +betaA1 += +qud11*beta1 + qud12*beta2 + qud13*beta3 +; + +betaA2 += +qud21*beta1 + qud22*beta2 + qud23*beta3 +; + +betaA3 += +qud31*beta1 + qud32*beta2 + qud33*beta3 +; + +DbetaA1 += +(db11*qud11 + db12*qud12 + db13*qud13)*sup1 + + (db21*qud11 + db22*qud12 + db23*qud13)*sup2 + + (db31*qud11 + db32*qud12 + db33*qud13)*sup3 +; + +DbetaA2 += +(db11*qud21 + db12*qud22 + db13*qud23)*sup1 + + (db21*qud21 + db22*qud22 + db23*qud23)*sup2 + + (db31*qud21 + db32*qud22 + db33*qud23)*sup3 +; + +DbetaA3 += +(db11*qud31 + db12*qud32 + db13*qud33)*sup1 + + (db21*qud31 + db22*qud32 + db23*qud33)*sup2 + + (db31*qud31 + db32*qud32 + db33*qud33)*sup3 +; + +lienKhat += +-((DKhat + Khat/r)*sqrt(muL)) +; + +lienTheta += +-DTheta - (kappa1*(2. + kappa2) + 1/r)*Theta +; + +lienK += +lienKhat + 2.*lienTheta +; + +rKhat += +lienKhat*alpha + dKhat1*beta1 + dKhat2*beta2 + + dKhat3*beta3 +; + +rGams += +-(((db11*sdown1 + db12*sdown2)*beta1 + + (db21*sdown1 + db22*sdown2 + db23*sdown3)*beta2 + + db31*sdown1*beta3)*pow2(shiftdriver)) + + beta3*(2.*ddb231*sdown1*shiftdriver*beta2 + + sdown2*(2.*ddb132*shiftdriver*beta1 - db32*pow2(shiftdriver)) + + sdown3*(shiftdriver*(dG33 + 2.*ddb133*beta1) - + db33*pow2(shiftdriver))) + + sdown3*(db13*(db21*shiftdriver*beta2 - + beta1*pow2(shiftdriver)) + + shiftdriver*((db12*db23 + db13*(db11 + db33) + dG13)*beta1 + + (db23*db33 + dG23)*beta2 + + beta3*(db13*db31 + db23*db32 + pow2(db33)) + + ddb113*pow2(beta1))) + + shiftdriver*((dG22*sdown2 + db22*(db21*sdown1 + db23*sdown3) + + 2.*ddb123*sdown3*beta1)*beta2 + + 2.*((ddb232*sdown2 + ddb233*sdown3)*beta2*beta3 + + beta1*((ddb121*sdown1 + ddb122*sdown2)*beta2 + + ddb131*sdown1*beta3)) + + sdown2*((db13*db32 + dG12)*beta1 + + (db32*(db22 + db33) + dG32)*beta3 + + db12*((db11 + db22)*beta1 + db31*beta3) + + beta2*(db12*db21 + db23*db32 + pow2(db22))) + + (ddb111*sdown1 + ddb112*sdown2)*pow2(beta1) + + (ddb221*sdown1 + ddb222*sdown2 + ddb223*sdown3)*pow2(beta2) + + (ddb332*sdown2 + ddb333*sdown3)*pow2(beta3) + + sdown1*((db11*db21 + db23*db31 + dG21)*beta2 + + (db21*db32 + db31*(db11 + db33) + dG31)*beta3 + + beta1*(db12*db21 + db13*db31 + dG11 + pow2(db11)) + + ddb331*pow2(beta3))) +; + +rTheta += +lienTheta*alpha + dTheta1*beta1 + dTheta2*beta2 + + dTheta3*beta3 +; + +rACss += +sup1*(2.*lieA13*sup3 + 1.3333333333333333333*dK1*alpha*chi + + sup2*(-(cdda12*psim4) + 2.*(lieA12 - AA12*alpha) + + 0.66666666666666666667*trcdda*g12)) + + sup3*(2.*((psim4*Rf13*sup1 - AA23*sup2)*alpha + + sup2*(lieA23 + (-AA32 + psim4*Rf23)*alpha)) + + 1.3333333333333333333*dK3*alpha*chi + + sup1*(-(dda13*psim4) - 2.*AA13*alpha + + 0.66666666666666666667*trcdda*g13)) + + (lieA11 - cdda11*psim4 - 2.*AA11*alpha + + 0.33333333333333333333*trcdda*g11)*pow2(sup1) + + (lieA22 - 2.*AA22*alpha + 0.33333333333333333333*trcdda*g22)* + pow2(sup2) - psim4*((cdda23 + dda23)*sup2*sup3 + + sup1*(dda12*sup2 + cdda13*sup3) + cdda22*pow2(sup2)) + + (lieA33 - cdda33*psim4 - 2.*AA33*alpha + + 0.33333333333333333333*trcdda*g33)*pow2(sup3) - + alpha*(sup2*(2.*AA21*sup1 + + 0.66666666666666666667*Rhat*sup3*g23) + + 0.33333333333333333333*(Rhat*g11*pow2(sup1) + + dGfromgdu11*qud11*pow2(chi))) + + alpha*(1.3333333333333333333*dK2*sup2*chi + + 2.*(sup1*(-(AA31*sup3) + K*sup2*A12) + K*sup2*sup3*A23 - + DTheta*chi) + ginv11* + (3.*dchi1*(sup1*A11 + sup2*A12 + sup3*A13) - + 2.*(cdA111*sup1 + cdA112*sup2 + cdA113*sup3)*chi) + + ginv12*(3.*(sup1*(dchi2*A11 + dchi1*A12) + + dchi2*(sup2*A12 + sup3*A13) + + dchi1*(sup2*A22 + sup3*A23)) - + 2.*((cdA112 + cdA211)*sup1 + (cdA122 + cdA212)*sup2 + + (cdA123 + cdA213)*sup3)*chi) + + ginv22*(3.*dchi2*(sup1*A12 + sup2*A22 + sup3*A23) - + 2.*(cdA212*sup1 + cdA222*sup2 + cdA223*sup3)*chi) + + ginv13*(3.*(dchi3*(sup1*A11 + sup2*A12) + + (dchi1*sup1 + dchi3*sup3)*A13 + + dchi1*(sup2*A23 + sup3*A33)) - + 2.*((cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 + cdA313)*sup3)*chi) + + ginv23*(3.*(sup1*(dchi3*A12 + dchi2*A13) + + sup2*(dchi3*A22 + dchi2*A23) + + sup3*(dchi3*A23 + dchi2*A33)) - + 2.*((cdA213 + cdA312)*sup1 + (cdA223 + cdA322)*sup2 + + (cdA233 + cdA323)*sup3)*chi) + + ginv33*(3.*dchi3*(sup1*A13 + sup2*A23 + sup3*A33) - + 2.*(cdA313*sup1 + cdA323*sup2 + cdA333*sup3)*chi) - + 0.66666666666666666667*Rhat*sup1*sup3*g13 + + psim4*(2.*Rf12*sup1*sup2 + Rf11*pow2(sup1) + Rf22*pow2(sup2) + + Rf33*pow2(sup3)) + K*(2.*sup1*sup3*A13 + + A11*pow2(sup1) + A22*pow2(sup2) + A33*pow2(sup3)) + + (0.33333333333333333333*dG11*qud11 - + sdown3*(Gfromg3*kappa1 + 0.66666666666666666667*dG33*sup3) + + sdown1*(0.66666666666666666667*dGfromgdu11*sup1 + + kappa1*G1) + kappa1* + (-(Gfromg1*sdown1) - Gfromg2*sdown2 + sdown2*G2 + + sdown3*G3))*pow2(chi) + + 0.33333333333333333333*(-(Rhat* + (g22*pow2(sup2) + g33*pow2(sup3))) + + ((dG12 - dGfromgdu12)*qud12 + (dG13 - dGfromgdu13)*qud13 + + (dG21 - dGfromgdu21)*qud21 + (dG22 - dGfromgdu22)*qud22 + + (dG23 - dGfromgdu23)*qud23 + (dG31 - dGfromgdu31)*qud31 + + (dG32 - dGfromgdu32)*qud32 + (dG33 - dGfromgdu33)*qud33)* + pow2(chi))) + 0.66666666666666666667* + (sup2*(sup3*trcdda*g23 + + (-(dG21*sdown1) - dG22*sdown2 + dGfromgdu22*sdown2 + + dGfromgdu23*sdown3)*alpha*pow2(chi)) + + alpha*((-(sdown3*(dG13*sup1 + dG23*sup2)) + + (-(dG31*sdown1) - dG32*sdown2 + dGfromgdu32*sdown2 + + dGfromgdu33*sdown3)*sup3 + + sdown1*(dGfromgdu21*sup2 + dGfromgdu31*sup3))*pow2(chi) + + sup1*(-(Rhat*sup2*g12) + + (-(dG11*sdown1) - dG12*sdown2 + dGfromgdu12*sdown2 + + dGfromgdu13*sdown3)*pow2(chi)))) +; + +rACqq += +-rACss + (Ainv22*lieg22 + 2.*(Ainv12*lieg12 + Ainv13*lieg13 + + Ainv23*lieg23) - (2.*Ainv22*A22 + + 4.*(Ainv12*A12 + Ainv13*A13 + Ainv23*A23))* + alpha + Ainv11*(lieg11 - 2.*A11*alpha) + + Ainv33*(lieg33 - 2.*A33*alpha))*chi +; + +rGamA1 += +-(((dG11*qud11 + dG12*qud12 + dG13*qud13)*sup1 + + (dG22*qud12 + dG23*qud13)*sup2 + (dG32*qud12 + dG33*qud13)*sup3 + + qud11*(dG21*sup2 + dG31*sup3))*vbetaA) + + (dG11*qud11 + dG12*qud12 + dG13*qud13)*beta1 + + (dG21*qud11 + dG22*qud12 + dG23*qud13)*beta2 + + (dG31*qud11 + dG32*qud12 + dG33*qud13)*beta3 - + ((((db11*quu11 + db21*quu12 + db31*quu13)*sdown1 + + (db12*quu11 + db22*quu12 + db32*quu13)*sdown2 + + (db13*quu11 + db23*quu12)*sdown3)*shiftdriver)/vbetaA + + (0.66666666666666666667*dTheta1*quu11 + + (1.3333333333333333333*dKhat2 + 0.66666666666666666667*dTheta2)* + quu12)*alpha + quu13* + ((db33*sdown3*shiftdriver)/vbetaA + + 1.3333333333333333333*dKhat3*alpha))/chi + + (2.3333333333333333333*((ddb121*qud11 + ddb122*qud12 + ddb123*qud13)* + quu12 + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13)*quu13) + + 0.33333333333333333333*((ddb122*qud22 + ddb123*qud23 + + ddb131*qud31 + ddb132*qud32)*quu11 + + (ddb221*qud21 + ddb222*qud22 + ddb223*qud23 + ddb231*qud31 + + ddb232*qud32 + ddb233*qud33)*quu12 + + (ddb231*qud21 + ddb232*qud22 + ddb233*qud23 + ddb331*qud31 + + ddb332*qud32 + ddb333*qud33)*quu13) + + (ddb221*qud11 + ddb222*qud12 + ddb223*qud13)*quu22 + + 2.*(ddb231*qud11 + ddb232*qud12 + ddb233*qud13)*quu23 + + (ddb331*qud11 + ddb332*qud12 + ddb333*qud13)*quu33 + + 1.3333333333333333333*((ddb111*qud11 + ddb112*qud12)*quu11 + + (ddb132*quu13*sdown2 + ddb113*quu11*sdown3)*sup1 + + (ddb232*quu13*sdown2 + ddb123*quu11*sdown3)*sup2 + + (ddb332*quu13*sdown2 + ddb133*quu11*sdown3)*sup3 + + sdown2*((ddb112*quu11 + ddb122*quu12)*sup1 + + (ddb122*quu11 + ddb222*quu12)*sup2 + + (ddb132*quu11 + ddb232*quu12)*sup3) + + sdown1*((ddb121*quu12 + ddb131*quu13)*sup1 + + (ddb221*quu12 + ddb231*quu13)*sup2 + + (ddb231*quu12 + ddb331*quu13)*sup3) + + sdown3*((ddb123*quu12 + ddb133*quu13)*sup1 + + (ddb223*quu12 + ddb233*quu13)*sup2 + + (ddb233*quu12 + ddb333*quu13)*sup3)) + + (shiftdriver*((db11*qud11 + db12*qud12 + db13*qud13)*sup1 + + (db21*qud11 + db22*qud12 + db23*qud13)*sup2 + + (db31*qud11 + db32*qud12 + db33*qud13)*sup3))/vbetaA + + ((dG21*quu12 + dG31*quu13)*sdown1 + + (dG12*quu11 + dG22*quu12 + dG32*quu13)*sdown2 + + (dG13*quu11 + dG23*quu12 + dG33*quu13)*sdown3)*vbetaA - + 0.66666666666666666667*dTheta3*quu13*alpha + + quu11*(0.33333333333333333333*(ddb121*qud21 + ddb133*qud33) + + dG11*sdown1*vbetaA + 1.3333333333333333333* + (ddb113*qud13 + sdown1*(ddb111*sup1 + ddb121*sup2 + ddb131*sup3) - + dKhat1*alpha)))/chi +; + +rGamA2 += +-(((dG11*qud21 + dG12*qud22 + dG13*qud23)*sup1 + + (dG22*qud22 + dG23*qud23)*sup2 + (dG32*qud22 + dG33*qud23)*sup3 + + qud21*(dG21*sup2 + dG31*sup3))*vbetaA) + + (dG11*qud21 + dG12*qud22 + dG13*qud23)*beta1 + + (dG21*qud21 + dG22*qud22 + dG23*qud23)*beta2 + + (dG31*qud21 + dG32*qud22 + dG33*qud23)*beta3 - + ((((db11*quu12 + db21*quu22 + db31*quu23)*sdown1 + + (db12*quu12 + db22*quu22 + db32*quu23)*sdown2 + + (db13*quu12 + db23*quu22)*sdown3)*shiftdriver)/vbetaA + + (0.66666666666666666667*dTheta1*quu12 + + (1.3333333333333333333*dKhat2 + 0.66666666666666666667*dTheta2)* + quu22)*alpha + quu23* + ((db33*sdown3*shiftdriver)/vbetaA + + 1.3333333333333333333*dKhat3*alpha))/chi + + ((ddb111*qud21 + ddb112*qud22)*quu11 + + 2.*(ddb131*qud21 + ddb132*qud22 + ddb133*qud23)*quu13 + + (1.3333333333333333333*ddb223*qud23 + + 0.33333333333333333333*(ddb121*qud11 + ddb231*qud31))*quu22 + + 2.3333333333333333333*((ddb121*qud21 + ddb122*qud22)*quu12 + + (ddb231*qud21 + ddb232*qud22)*quu23) + + 0.33333333333333333333*((ddb112*qud12 + ddb113*qud13 + + ddb132*qud32 + ddb133*qud33)*quu12 + + (ddb122*qud12 + ddb123*qud13 + ddb232*qud32 + ddb233*qud33)* + quu22 + (ddb132*qud12 + ddb133*qud13 + ddb332*qud32 + + ddb333*qud33)*quu23) + + (ddb331*qud21 + ddb332*qud22 + ddb333*qud23)*quu33 + + 1.3333333333333333333*((ddb221*qud21 + ddb222*qud22)*quu22 + + (ddb132*quu23*sdown2 + ddb113*quu12*sdown3)*sup1 + + (ddb232*quu23*sdown2 + ddb123*quu12*sdown3)*sup2 + + (ddb332*quu23*sdown2 + ddb133*quu12*sdown3)*sup3 + + sdown2*((ddb112*quu12 + ddb122*quu22)*sup1 + + (ddb122*quu12 + ddb222*quu22)*sup2 + + (ddb132*quu12 + ddb232*quu22)*sup3) + + sdown1*((ddb121*quu22 + ddb131*quu23)*sup1 + + (ddb221*quu22 + ddb231*quu23)*sup2 + + (ddb231*quu22 + ddb331*quu23)*sup3) + + sdown3*((ddb123*quu22 + ddb133*quu23)*sup1 + + (ddb223*quu22 + ddb233*quu23)*sup2 + + (ddb233*quu22 + ddb333*quu23)*sup3)) + + qud23*(ddb113*quu11 + (db33*shiftdriver*sup3)/vbetaA) + + (shiftdriver*((db11*qud21 + db12*qud22 + db13*qud23)*sup1 + + (db21*qud21 + db22*qud22 + db23*qud23)*sup2 + + (db31*qud21 + db32*qud22)*sup3))/vbetaA + + ((dG21*quu22 + dG31*quu23)*sdown1 + + (dG12*quu12 + dG22*quu22 + dG32*quu23)*sdown2 + + (dG13*quu12 + dG23*quu22 + dG33*quu23)*sdown3)*vbetaA + + quu23*(2.3333333333333333333*ddb233*qud23 + + 0.33333333333333333333*(ddb131*qud11 + ddb331*qud31) - + 0.66666666666666666667*dTheta3*alpha) + + quu12*(2.3333333333333333333*ddb123*qud23 + + 0.33333333333333333333*(ddb111*qud11 + ddb131*qud31) + + dG11*sdown1*vbetaA + 1.3333333333333333333* + (sdown1*(ddb111*sup1 + ddb121*sup2 + ddb131*sup3) - + dKhat1*alpha)))/chi +; + +rGamA3 += +-(((dG11*qud31 + dG12*qud32 + dG13*qud33)*sup1 + + (dG22*qud32 + dG23*qud33)*sup2 + (dG32*qud32 + dG33*qud33)*sup3 + + qud31*(dG21*sup2 + dG31*sup3))*vbetaA) + + (dG11*qud31 + dG12*qud32 + dG13*qud33)*beta1 + + (dG21*qud31 + dG22*qud32 + dG23*qud33)*beta2 + + (dG31*qud31 + dG32*qud32 + dG33*qud33)*beta3 - + ((((db11*quu13 + db21*quu23 + db31*quu33)*sdown1 + + (db12*quu13 + db22*quu23 + db32*quu33)*sdown2 + + (db13*quu13 + db23*quu23)*sdown3)*shiftdriver)/vbetaA + + (0.66666666666666666667*dTheta1*quu13 + + (1.3333333333333333333*dKhat2 + 0.66666666666666666667*dTheta2)* + quu23)*alpha + quu33* + ((db33*sdown3*shiftdriver)/vbetaA + + 1.3333333333333333333*dKhat3*alpha))/chi + + ((ddb111*qud31 + ddb112*qud32)*quu11 + + 2.*(ddb122*qud32 + ddb123*qud33)*quu12 + + (ddb222*qud32 + ddb223*qud33)*quu22 + + qud31*(2.*ddb121*quu12 + ddb221*quu22) + + (0.33333333333333333333*(ddb121*qud11 + ddb223*qud23) + + 2.3333333333333333333*ddb231*qud31)*quu23 + + 2.3333333333333333333*((ddb132*qud32 + ddb133*qud33)*quu13 + + (ddb232*qud32 + ddb233*qud33)*quu23) + + 0.33333333333333333333*((ddb112*qud12 + ddb113*qud13 + + ddb121*qud21 + ddb122*qud22)*quu13 + + (ddb122*qud12 + ddb123*qud13 + ddb221*qud21 + ddb222*qud22)* + quu23 + (ddb132*qud12 + ddb133*qud13 + ddb231*qud21 + + ddb232*qud22)*quu33) + + 1.3333333333333333333*((ddb332*qud32 + ddb333*qud33)*quu33 + + (ddb132*quu33*sdown2 + ddb113*quu13*sdown3)*sup1 + + (ddb232*quu33*sdown2 + ddb123*quu13*sdown3)*sup2 + + (ddb332*quu33*sdown2 + ddb133*quu13*sdown3)*sup3 + + sdown2*((ddb112*quu13 + ddb122*quu23)*sup1 + + (ddb122*quu13 + ddb222*quu23)*sup2 + + (ddb132*quu13 + ddb232*quu23)*sup3) + + sdown1*((ddb121*quu23 + ddb131*quu33)*sup1 + + (ddb221*quu23 + ddb231*quu33)*sup2 + + (ddb231*quu23 + ddb331*quu33)*sup3) + + sdown3*((ddb123*quu23 + ddb133*quu33)*sup1 + + (ddb223*quu23 + ddb233*quu33)*sup2 + + (ddb233*quu23 + ddb333*quu33)*sup3)) + + qud33*(ddb113*quu11 + (db33*shiftdriver*sup3)/vbetaA) + + (shiftdriver*((db11*qud31 + db12*qud32 + db13*qud33)*sup1 + + (db21*qud31 + db22*qud32 + db23*qud33)*sup2 + + (db31*qud31 + db32*qud32)*sup3))/vbetaA + + ((dG21*quu23 + dG31*quu33)*sdown1 + + (dG12*quu13 + dG22*quu23 + dG32*quu33)*sdown2 + + (dG13*quu13 + dG23*quu23 + dG33*quu33)*sdown3)*vbetaA + + quu33*(0.33333333333333333333*(ddb131*qud11 + ddb233*qud23) + + 1.3333333333333333333*ddb331*qud31 - + 0.66666666666666666667*dTheta3*alpha) + + quu13*(0.33333333333333333333*(ddb111*qud11 + ddb123*qud23) + + ddb131*(2.3333333333333333333*qud31 + + 1.3333333333333333333*sdown1*sup3) + dG11*sdown1*vbetaA + + 1.3333333333333333333*(sdown1*(ddb111*sup1 + ddb121*sup2) - + dKhat1*alpha)))/chi +; + +rACsA1 += +-2.*((AA12*qud21 + AA13*qud31)*sup1 + (AA22*qud21 + AA23*qud31)*sup2 + + (AA32*qud21 + AA33*qud31)*sup3)*alpha - + ((cdda12*qud21 + cdda13*qud31)*sup1 + + (cdda22*qud21 + cdda23*qud31)*sup2 + dda23*qud21*sup3)*chi + + (-(cdda33*qud31*sup3) + 0.66666666666666666667*dK1*qud11*alpha)* + chi + sup1*(qud11*(lieA11 - 2.*AA11*alpha - cdda11*chi) + + qud21*(lieA12 + Rf12*alpha*chi) + + qud31*(lieA13 + Rf13*alpha*chi)) + + sup2*(lieA23*qud31 + qud11*(lieA12 - 2.*AA21*alpha - + dda12*chi + Rf12*alpha*chi) + + qud21*(lieA22 + Rf22*alpha*chi)) + + sup3*(qud11*(lieA13 - 2.*AA31*alpha - dda13*chi) + + qud21*(lieA23 + Rf23*alpha*chi) + + qud31*(lieA33 + alpha*(K*A33 + Rf33*chi)) - + 0.5*dG33*qdd13*alpha*pow2(chi)) + + alpha*(K*(sup1*(qud11*A11 + qud21*A12 + qud31*A13) + + qud11*(sup2*A12 + sup3*A13) + qud21*sup3*A23 + + sup2*(qud21*A22 + qud31*A23)) + + (-(dTheta1*qud11) - dTheta2*qud21 - dTheta3*qud31 + + 0.66666666666666666667*(dK2*qud21 + dK3*qud31) + qud31*Rf23*sup2 + + qud11*(Rf11*sup1 + Rf13*sup3))*chi + + ginv11*(1.5*dchi1*(qud11*A11 + qud21*A12 + qud31*A13) - + (cdA111*qud11 + cdA112*qud21 + cdA113*qud31)*chi) + + ginv12*(1.5*(qud11*(dchi2*A11 + dchi1*A12) + + dchi2*(qud21*A12 + qud31*A13) + + dchi1*(qud21*A22 + qud31*A23)) - + ((cdA112 + cdA211)*qud11 + (cdA122 + cdA212)*qud21 + + (cdA123 + cdA213)*qud31)*chi) + + ginv22*(1.5*dchi2*(qud11*A12 + qud21*A22 + qud31*A23) - + (cdA212*qud11 + cdA222*qud21 + cdA223*qud31)*chi) + + ginv13*(1.5*(dchi3*(qud11*A11 + qud21*A12) + + (dchi1*qud11 + dchi3*qud31)*A13 + + dchi1*(qud21*A23 + qud31*A33)) - + ((cdA113 + cdA311)*qud11 + (cdA123 + cdA312)*qud21 + + (cdA133 + cdA313)*qud31)*chi) + + ginv23*(1.5*(qud11*(dchi3*A12 + dchi2*A13) + + qud21*(dchi3*A22 + dchi2*A23) + + qud31*(dchi3*A23 + dchi2*A33)) - + ((cdA213 + cdA312)*qud11 + (cdA223 + cdA322)*qud21 + + (cdA233 + cdA323)*qud31)*chi) + + ginv33*(1.5*dchi3*(qud11*A13 + qud21*A23 + qud31*A33) - + (cdA313*qud11 + cdA323*qud21 + cdA333*qud31)*chi) + + 0.5*((-(dG11*qdd11) - dG12*qdd12 + dGfromgdu12*qdd12 + + dGfromgdu13*qdd13)*sup1 + + (-(dG21*qdd11) - dG22*qdd12 + dGfromgdu22*qdd12 + + dGfromgdu23*qdd13)*sup2 - + qdd13*(Gfromg3*kappa1 + dG13*sup1 + dG23*sup2) + + (-(dG31*qdd11) - dG32*qdd12 + dGfromgdu32*qdd12 + + dGfromgdu33*qdd13)*sup3 + + qdd11*(dGfromgdu11*sup1 + dGfromgdu21*sup2 + dGfromgdu31*sup3) + + kappa1*(-(Gfromg1*qdd11) - Gfromg2*qdd12 + qdd11*G1 + + qdd12*G2 + qdd13*G3))*pow2(chi)) +; + +rACsA2 += +-2.*((AA12*qud22 + AA13*qud32)*sup1 + (AA22*qud22 + AA23*qud32)*sup2 + + (AA32*qud22 + AA33*qud32)*sup3)*alpha - + ((cdda12*qud22 + cdda13*qud32)*sup1 + + (cdda22*qud22 + cdda23*qud32)*sup2 + dda23*qud22*sup3)*chi + + (-(cdda33*qud32*sup3) + 0.66666666666666666667*dK1*qud12*alpha)* + chi + sup1*(qud12*(lieA11 - 2.*AA11*alpha - cdda11*chi) + + qud22*(lieA12 + Rf12*alpha*chi) + + qud32*(lieA13 + Rf13*alpha*chi)) + + sup2*(lieA23*qud32 + qud12*(lieA12 - 2.*AA21*alpha - + dda12*chi + Rf12*alpha*chi) + + qud22*(lieA22 + Rf22*alpha*chi)) + + sup3*(qud12*(lieA13 - 2.*AA31*alpha - dda13*chi) + + qud22*(lieA23 + Rf23*alpha*chi) + + qud32*(lieA33 + alpha*(K*A33 + Rf33*chi)) - + 0.5*dG33*qdd23*alpha*pow2(chi)) + + alpha*(K*(sup1*(qud12*A11 + qud22*A12 + qud32*A13) + + qud12*(sup2*A12 + sup3*A13) + qud22*sup3*A23 + + sup2*(qud22*A22 + qud32*A23)) + + (-(dTheta1*qud12) - dTheta2*qud22 - dTheta3*qud32 + + 0.66666666666666666667*(dK2*qud22 + dK3*qud32) + qud32*Rf23*sup2 + + qud12*(Rf11*sup1 + Rf13*sup3))*chi + + ginv11*(1.5*dchi1*(qud12*A11 + qud22*A12 + qud32*A13) - + (cdA111*qud12 + cdA112*qud22 + cdA113*qud32)*chi) + + ginv12*(1.5*(qud12*(dchi2*A11 + dchi1*A12) + + dchi2*(qud22*A12 + qud32*A13) + + dchi1*(qud22*A22 + qud32*A23)) - + ((cdA112 + cdA211)*qud12 + (cdA122 + cdA212)*qud22 + + (cdA123 + cdA213)*qud32)*chi) + + ginv22*(1.5*dchi2*(qud12*A12 + qud22*A22 + qud32*A23) - + (cdA212*qud12 + cdA222*qud22 + cdA223*qud32)*chi) + + ginv13*(1.5*(dchi3*(qud12*A11 + qud22*A12) + + (dchi1*qud12 + dchi3*qud32)*A13 + + dchi1*(qud22*A23 + qud32*A33)) - + ((cdA113 + cdA311)*qud12 + (cdA123 + cdA312)*qud22 + + (cdA133 + cdA313)*qud32)*chi) + + ginv23*(1.5*(qud12*(dchi3*A12 + dchi2*A13) + + qud22*(dchi3*A22 + dchi2*A23) + + qud32*(dchi3*A23 + dchi2*A33)) - + ((cdA213 + cdA312)*qud12 + (cdA223 + cdA322)*qud22 + + (cdA233 + cdA323)*qud32)*chi) + + ginv33*(1.5*dchi3*(qud12*A13 + qud22*A23 + qud32*A33) - + (cdA313*qud12 + cdA323*qud22 + cdA333*qud32)*chi) + + 0.5*((-(dG11*qdd12) - dG12*qdd22 + dGfromgdu12*qdd22 + + dGfromgdu13*qdd23)*sup1 + + (-(dG21*qdd12) - dG22*qdd22 + dGfromgdu22*qdd22 + + dGfromgdu23*qdd23)*sup2 - + qdd23*(Gfromg3*kappa1 + dG13*sup1 + dG23*sup2) + + (-(dG31*qdd12) - dG32*qdd22 + dGfromgdu32*qdd22 + + dGfromgdu33*qdd23)*sup3 + + qdd12*(dGfromgdu11*sup1 + dGfromgdu21*sup2 + dGfromgdu31*sup3) + + kappa1*(-(Gfromg1*qdd12) - Gfromg2*qdd22 + qdd12*G1 + + qdd22*G2 + qdd23*G3))*pow2(chi)) +; + +rACsA3 += +-2.*((AA12*qud23 + AA13*qud33)*sup1 + (AA22*qud23 + AA23*qud33)*sup2 + + (AA32*qud23 + AA33*qud33)*sup3)*alpha - + ((cdda12*qud23 + cdda13*qud33)*sup1 + + (cdda22*qud23 + cdda23*qud33)*sup2 + dda23*qud23*sup3)*chi + + (-(cdda33*qud33*sup3) + 0.66666666666666666667*dK1*qud13*alpha)* + chi + sup1*(qud13*(lieA11 - 2.*AA11*alpha - cdda11*chi) + + qud23*(lieA12 + Rf12*alpha*chi) + + qud33*(lieA13 + Rf13*alpha*chi)) + + sup2*(lieA23*qud33 + qud13*(lieA12 - 2.*AA21*alpha - + dda12*chi + Rf12*alpha*chi) + + qud23*(lieA22 + Rf22*alpha*chi)) + + sup3*(qud13*(lieA13 - 2.*AA31*alpha - dda13*chi) + + qud23*(lieA23 + Rf23*alpha*chi) + + qud33*(lieA33 + alpha*(K*A33 + Rf33*chi)) - + 0.5*dG33*qdd33*alpha*pow2(chi)) + + alpha*(K*(sup1*(qud13*A11 + qud23*A12 + qud33*A13) + + qud13*(sup2*A12 + sup3*A13) + qud23*sup3*A23 + + sup2*(qud23*A22 + qud33*A23)) + + (-(dTheta1*qud13) - dTheta2*qud23 - dTheta3*qud33 + + 0.66666666666666666667*(dK2*qud23 + dK3*qud33) + qud33*Rf23*sup2 + + qud13*(Rf11*sup1 + Rf13*sup3))*chi + + ginv11*(1.5*dchi1*(qud13*A11 + qud23*A12 + qud33*A13) - + (cdA111*qud13 + cdA112*qud23 + cdA113*qud33)*chi) + + ginv12*(1.5*(qud13*(dchi2*A11 + dchi1*A12) + + dchi2*(qud23*A12 + qud33*A13) + + dchi1*(qud23*A22 + qud33*A23)) - + ((cdA112 + cdA211)*qud13 + (cdA122 + cdA212)*qud23 + + (cdA123 + cdA213)*qud33)*chi) + + ginv22*(1.5*dchi2*(qud13*A12 + qud23*A22 + qud33*A23) - + (cdA212*qud13 + cdA222*qud23 + cdA223*qud33)*chi) + + ginv13*(1.5*(dchi3*(qud13*A11 + qud23*A12) + + (dchi1*qud13 + dchi3*qud33)*A13 + + dchi1*(qud23*A23 + qud33*A33)) - + ((cdA113 + cdA311)*qud13 + (cdA123 + cdA312)*qud23 + + (cdA133 + cdA313)*qud33)*chi) + + ginv23*(1.5*(qud13*(dchi3*A12 + dchi2*A13) + + qud23*(dchi3*A22 + dchi2*A23) + + qud33*(dchi3*A23 + dchi2*A33)) - + ((cdA213 + cdA312)*qud13 + (cdA223 + cdA322)*qud23 + + (cdA233 + cdA323)*qud33)*chi) + + ginv33*(1.5*dchi3*(qud13*A13 + qud23*A23 + qud33*A33) - + (cdA313*qud13 + cdA323*qud23 + cdA333*qud33)*chi) + + 0.5*((-(dG11*qdd13) - dG12*qdd23 + dGfromgdu12*qdd23 + + dGfromgdu13*qdd33)*sup1 + + (-(dG21*qdd13) - dG22*qdd23 + dGfromgdu22*qdd23 + + dGfromgdu23*qdd33)*sup2 - + qdd33*(Gfromg3*kappa1 + dG13*sup1 + dG23*sup2) + + (-(dG31*qdd13) - dG32*qdd23 + dGfromgdu32*qdd23 + + dGfromgdu33*qdd33)*sup3 + + qdd13*(dGfromgdu11*sup1 + dGfromgdu21*sup2 + dGfromgdu31*sup3) + + kappa1*(-(Gfromg1*qdd13) - Gfromg2*qdd23 + qdd13*G1 + + qdd23*G2 + qdd33*G3))*pow2(chi)) +; + +rACABTF11 += +2.*(lieA12*qPhysuudd1211 + lieA13*qPhysuudd1311 + + qPhysuudd2311*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1111*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1111*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1211*A12 + + qPhysuudd1311*A13 + qPhysuudd2311*A23) + + qPhysuudd3311*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1211 + + qPhysuudd1111*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2211*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1311 - cdA223*qPhysuudd2311 + + cdA322*qPhysuudd2311 + cdA323*qPhysuudd3311 + + (0.5*dchi2*qPhysuudd1111*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1311*sup2 + qPhysuudd1211*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3311*sup1 + dchi2*qPhysuudd1311*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1211*A11 + + dchi1*qPhysuudd2311*A23) + + 0.5*((-(dchi3*qPhysuudd2311*sup1) + dchi2*qPhysuudd1211*sup2)* + A12 + dchi3*qPhysuudd1311*sup3*A13 - + (dchi1*qPhysuudd1211 + dchi3*qPhysuudd2311)*sup2*A22 + + sup1*((dchi1*qPhysuudd1211 - dchi2*qPhysuudd2211)*A12 + + (dchi1*qPhysuudd1311 - dchi2*qPhysuudd2311)*A13 + + dchi1*qPhysuudd2211*A22) - + (dchi3*qPhysuudd3311*sup2 + dchi1*qPhysuudd1211*sup3)* + A23 + ((-(dchi1*qPhysuudd1311) + dchi2*qPhysuudd2311)* + sup2 + (-(dchi2*qPhysuudd2211) + dchi3*qPhysuudd2311)*sup3\ +)*A23 + qPhysuudd3311*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1111 + dchi2*qPhysuudd1211)*A13 + + (dchi1*qPhysuudd1311 + dchi2*qPhysuudd2311)*A33)))/ + chi) - cdda11*qPhysuudd1111*chi + + qPhysuudd1211*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1311*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2211*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2311*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3311*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1211* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1311*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2311*((AA23 + AA32)*alpha + dda23*chi) +; + +rACABTF12 += +2.*(lieA12*qPhysuudd1212 + lieA13*qPhysuudd1312 + + qPhysuudd2312*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1112*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1112*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1212*A12 + + qPhysuudd1312*A13 + qPhysuudd2312*A23) + + qPhysuudd3312*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1212 + + qPhysuudd1112*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2212*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1312 - cdA223*qPhysuudd2312 + + cdA322*qPhysuudd2312 + cdA323*qPhysuudd3312 + + (0.5*dchi2*qPhysuudd1112*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1312*sup2 + qPhysuudd1212*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3312*sup1 + dchi2*qPhysuudd1312*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1212*A11 + + dchi1*qPhysuudd2312*A23) + + 0.5*((-(dchi3*qPhysuudd2312*sup1) + dchi2*qPhysuudd1212*sup2)* + A12 + dchi3*qPhysuudd1312*sup3*A13 - + (dchi1*qPhysuudd1212 + dchi3*qPhysuudd2312)*sup2*A22 + + sup1*((dchi1*qPhysuudd1212 - dchi2*qPhysuudd2212)*A12 + + (dchi1*qPhysuudd1312 - dchi2*qPhysuudd2312)*A13 + + dchi1*qPhysuudd2212*A22) - + (dchi3*qPhysuudd3312*sup2 + dchi1*qPhysuudd1212*sup3)* + A23 + ((-(dchi1*qPhysuudd1312) + dchi2*qPhysuudd2312)* + sup2 + (-(dchi2*qPhysuudd2212) + dchi3*qPhysuudd2312)*sup3\ +)*A23 + qPhysuudd3312*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1112 + dchi2*qPhysuudd1212)*A13 + + (dchi1*qPhysuudd1312 + dchi2*qPhysuudd2312)*A33)))/ + chi) - cdda11*qPhysuudd1112*chi + + qPhysuudd1212*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1312*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2212*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2312*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3312*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1212* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1312*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2312*((AA23 + AA32)*alpha + dda23*chi) +; + +rACABTF13 += +2.*(lieA12*qPhysuudd1213 + lieA13*qPhysuudd1313 + + qPhysuudd2313*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1113*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1113*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1213*A12 + + qPhysuudd1313*A13 + qPhysuudd2313*A23) + + qPhysuudd3313*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1213 + + qPhysuudd1113*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2213*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1313 - cdA223*qPhysuudd2313 + + cdA322*qPhysuudd2313 + cdA323*qPhysuudd3313 + + (0.5*dchi2*qPhysuudd1113*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1313*sup2 + qPhysuudd1213*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3313*sup1 + dchi2*qPhysuudd1313*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1213*A11 + + dchi1*qPhysuudd2313*A23) + + 0.5*((-(dchi3*qPhysuudd2313*sup1) + dchi2*qPhysuudd1213*sup2)* + A12 + dchi3*qPhysuudd1313*sup3*A13 - + (dchi1*qPhysuudd1213 + dchi3*qPhysuudd2313)*sup2*A22 + + sup1*((dchi1*qPhysuudd1213 - dchi2*qPhysuudd2213)*A12 + + (dchi1*qPhysuudd1313 - dchi2*qPhysuudd2313)*A13 + + dchi1*qPhysuudd2213*A22) - + (dchi3*qPhysuudd3313*sup2 + dchi1*qPhysuudd1213*sup3)* + A23 + ((-(dchi1*qPhysuudd1313) + dchi2*qPhysuudd2313)* + sup2 + (-(dchi2*qPhysuudd2213) + dchi3*qPhysuudd2313)*sup3\ +)*A23 + qPhysuudd3313*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1113 + dchi2*qPhysuudd1213)*A13 + + (dchi1*qPhysuudd1313 + dchi2*qPhysuudd2313)*A33)))/ + chi) - cdda11*qPhysuudd1113*chi + + qPhysuudd1213*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1313*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2213*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2313*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3313*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1213* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1313*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2313*((AA23 + AA32)*alpha + dda23*chi) +; + +rACABTF22 += +2.*(lieA12*qPhysuudd1222 + lieA13*qPhysuudd1322 + + qPhysuudd2322*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1122*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1122*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1222*A12 + + qPhysuudd1322*A13 + qPhysuudd2322*A23) + + qPhysuudd3322*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1222 + + qPhysuudd1122*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2222*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1322 - cdA223*qPhysuudd2322 + + cdA322*qPhysuudd2322 + cdA323*qPhysuudd3322 + + (0.5*dchi2*qPhysuudd1122*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1322*sup2 + qPhysuudd1222*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3322*sup1 + dchi2*qPhysuudd1322*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1222*A11 + + dchi1*qPhysuudd2322*A23) + + 0.5*((-(dchi3*qPhysuudd2322*sup1) + dchi2*qPhysuudd1222*sup2)* + A12 + dchi3*qPhysuudd1322*sup3*A13 - + (dchi1*qPhysuudd1222 + dchi3*qPhysuudd2322)*sup2*A22 + + sup1*((dchi1*qPhysuudd1222 - dchi2*qPhysuudd2222)*A12 + + (dchi1*qPhysuudd1322 - dchi2*qPhysuudd2322)*A13 + + dchi1*qPhysuudd2222*A22) - + (dchi3*qPhysuudd3322*sup2 + dchi1*qPhysuudd1222*sup3)* + A23 + ((-(dchi1*qPhysuudd1322) + dchi2*qPhysuudd2322)* + sup2 + (-(dchi2*qPhysuudd2222) + dchi3*qPhysuudd2322)*sup3\ +)*A23 + qPhysuudd3322*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1122 + dchi2*qPhysuudd1222)*A13 + + (dchi1*qPhysuudd1322 + dchi2*qPhysuudd2322)*A33)))/ + chi) - cdda11*qPhysuudd1122*chi + + qPhysuudd1222*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1322*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2222*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2322*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3322*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1222* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1322*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2322*((AA23 + AA32)*alpha + dda23*chi) +; + +rACABTF23 += +2.*(lieA12*qPhysuudd1223 + lieA13*qPhysuudd1323 + + qPhysuudd2323*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1123*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1123*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1223*A12 + + qPhysuudd1323*A13 + qPhysuudd2323*A23) + + qPhysuudd3323*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1223 + + qPhysuudd1123*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2223*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1323 - cdA223*qPhysuudd2323 + + cdA322*qPhysuudd2323 + cdA323*qPhysuudd3323 + + (0.5*dchi2*qPhysuudd1123*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1323*sup2 + qPhysuudd1223*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3323*sup1 + dchi2*qPhysuudd1323*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1223*A11 + + dchi1*qPhysuudd2323*A23) + + 0.5*((-(dchi3*qPhysuudd2323*sup1) + dchi2*qPhysuudd1223*sup2)* + A12 + dchi3*qPhysuudd1323*sup3*A13 - + (dchi1*qPhysuudd1223 + dchi3*qPhysuudd2323)*sup2*A22 + + sup1*((dchi1*qPhysuudd1223 - dchi2*qPhysuudd2223)*A12 + + (dchi1*qPhysuudd1323 - dchi2*qPhysuudd2323)*A13 + + dchi1*qPhysuudd2223*A22) - + (dchi3*qPhysuudd3323*sup2 + dchi1*qPhysuudd1223*sup3)* + A23 + ((-(dchi1*qPhysuudd1323) + dchi2*qPhysuudd2323)* + sup2 + (-(dchi2*qPhysuudd2223) + dchi3*qPhysuudd2323)*sup3\ +)*A23 + qPhysuudd3323*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1123 + dchi2*qPhysuudd1223)*A13 + + (dchi1*qPhysuudd1323 + dchi2*qPhysuudd2323)*A33)))/ + chi) - cdda11*qPhysuudd1123*chi + + qPhysuudd1223*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1323*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2223*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2323*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3323*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1223* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1323*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2323*((AA23 + AA32)*alpha + dda23*chi) +; + +rACABTF33 += +2.*(lieA12*qPhysuudd1233 + lieA13*qPhysuudd1333 + + qPhysuudd2333*(lieA23 - cdA123*sup1*alpha)) + + qPhysuudd1133*(lieA11 + alpha* + (-AA11 - cdA211*sup2 + sup2*(cdA112 - (0.5*dchi1*A12)/chi))) \ ++ alpha*(qPhysuudd1133*(cdA113*sup3 + + 0.66666666666666666667*K*A11) + + 1.3333333333333333333*K*(qPhysuudd1233*A12 + + qPhysuudd1333*A13 + qPhysuudd2333*A23) + + qPhysuudd3333*(-(cdA233*sup2) + 0.66666666666666666667*K*A33) + + sup3*(cdA123*qPhysuudd1233 + + qPhysuudd1133*(-cdA311 + (0.5*dchi3*A11)/chi)) + + qPhysuudd2233*A22*(0.66666666666666666667*K + + (0.5*dchi3*sup3)/chi) + + sup2*(-2.*cdA213*qPhysuudd1333 - cdA223*qPhysuudd2333 + + cdA322*qPhysuudd2333 + cdA323*qPhysuudd3333 + + (0.5*dchi2*qPhysuudd1133*A11)/chi) + + (dchi3*(-0.5*qPhysuudd1333*sup2 + qPhysuudd1233*sup3)*A12 + + (-0.5*dchi3*qPhysuudd3333*sup1 + dchi2*qPhysuudd1333*sup2)* + A13 + sup1*(-0.5*dchi2*qPhysuudd1233*A11 + + dchi1*qPhysuudd2333*A23) + + 0.5*((-(dchi3*qPhysuudd2333*sup1) + dchi2*qPhysuudd1233*sup2)* + A12 + dchi3*qPhysuudd1333*sup3*A13 - + (dchi1*qPhysuudd1233 + dchi3*qPhysuudd2333)*sup2*A22 + + sup1*((dchi1*qPhysuudd1233 - dchi2*qPhysuudd2233)*A12 + + (dchi1*qPhysuudd1333 - dchi2*qPhysuudd2333)*A13 + + dchi1*qPhysuudd2233*A22) - + (dchi3*qPhysuudd3333*sup2 + dchi1*qPhysuudd1233*sup3)* + A23 + ((-(dchi1*qPhysuudd1333) + dchi2*qPhysuudd2333)* + sup2 + (-(dchi2*qPhysuudd2233) + dchi3*qPhysuudd2333)*sup3\ +)*A23 + qPhysuudd3333*(dchi1*sup1 + dchi2*sup2)*A33 - + sup3*((dchi1*qPhysuudd1133 + dchi2*qPhysuudd1233)*A13 + + (dchi1*qPhysuudd1333 + dchi2*qPhysuudd2333)*A33)))/ + chi) - cdda11*qPhysuudd1133*chi + + qPhysuudd1233*(((-cdA112 + cdA211)*sup1 + (cdA122 - cdA212)*sup2 + + (cdA213 - 2.*cdA312)*sup3)*alpha - cdda12*chi) + + qPhysuudd1333*(((-cdA113 + cdA311)*sup1 + (cdA123 + cdA312)*sup2 + + (cdA133 - cdA313)*sup3)*alpha - cdda13*chi) + + qPhysuudd2233*(lieA22 + (-AA22 - cdA122*sup1 + cdA212*sup1 + + cdA223*sup3 - cdA322*sup3)*alpha - cdda22*chi) + + qPhysuudd2333*(((cdA213 + cdA312)*sup1 + (cdA233 - cdA323)*sup3)* + alpha - cdda23*chi) + + qPhysuudd3333*(lieA33 + (-AA33 - cdA133*sup1 + cdA313*sup1)*alpha - + cdda33*chi) - qPhysuudd1233* + ((AA12 + AA21)*alpha + dda12*chi) - + qPhysuudd1333*(alpha*(AA13 + AA31 + + (0.5*dchi3*sup1*A11)/chi) + dda13*chi) - + qPhysuudd2333*((AA23 + AA32)*alpha + dda23*chi) +; + + +if (givehPsi0) { + +gADM11 += +g11/chi +; + +gADM12 += +g12/chi +; + +gADM13 += +g13/chi +; + +gADM21 += +g12/chi +; + +gADM22 += +g22/chi +; + +gADM23 += +g23/chi +; + +gADM31 += +g13/chi +; + +gADM32 += +g23/chi +; + +gADM33 += +g33/chi +; + +vu1 += +-yp +; + +vu2 += +xp +; + +vu3 += +0 +; + +wu1 += +((-(ADMginv13*sup2) + ADMginv12*sup3)*vu1 + + (ADMginv13*sup1 - ADMginv11*sup3)*vu2 + + (-(ADMginv12*sup1) + ADMginv11*sup2)*vu3)/Power(chi,1.5) +; + +wu2 += +((-(ADMginv23*sup2) + ADMginv22*sup3)*vu1 + + (ADMginv23*sup1 - ADMginv12*sup3)*vu2 + + (-(ADMginv22*sup1) + ADMginv12*sup2)*vu3)/Power(chi,1.5) +; + +wu3 += +((-(ADMginv33*sup2) + ADMginv23*sup3)*vu1 + + (ADMginv33*sup1 - ADMginv13*sup3)*vu2 + + (-(ADMginv23*sup1) + ADMginv13*sup2)*vu3)/Power(chi,1.5) +; + +sdotv += +(gADM11*sup1 + gADM21*sup2 + gADM31*sup3)*vu1 + + (gADM12*sup1 + gADM22*sup2 + gADM32*sup3)*vu2 + + (gADM13*sup1 + gADM23*sup2 + gADM33*sup3)*vu3 +; + +vu1 += +-(sdotv*sup1) + vu1 +; + +vu2 += +-(sdotv*sup2) + vu2 +; + +vu3 += +-(sdotv*sup3) + vu3 +; + +vdotv += +(gADM31*vu1 + (gADM23 + gADM32)*vu2)*vu3 + + vu1*((gADM12 + gADM21)*vu2 + gADM13*vu3) + gADM11*pow2(vu1) + + gADM22*pow2(vu2) + gADM33*pow2(vu3) +; + +vu1 += +vu1/Sqrt(vdotv) +; + +vu2 += +vu2/Sqrt(vdotv) +; + +vu3 += +vu3/Sqrt(vdotv) +; + +sdotw += +(gADM11*sup1 + gADM21*sup2 + gADM31*sup3)*wu1 + + (gADM12*sup1 + gADM22*sup2 + gADM32*sup3)*wu2 + + (gADM13*sup1 + gADM23*sup2 + gADM33*sup3)*wu3 +; + +vdotw += +(gADM11*vu1 + gADM21*vu2 + gADM31*vu3)*wu1 + + (gADM12*vu1 + gADM22*vu2 + gADM32*vu3)*wu2 + + (gADM13*vu1 + gADM23*vu2 + gADM33*vu3)*wu3 +; + +wu1 += +-(sdotw*sup1) - vdotw*vu1 + wu1 +; + +wu2 += +-(sdotw*sup2) - vdotw*vu2 + wu2 +; + +wu3 += +-(sdotw*sup3) - vdotw*vu3 + wu3 +; + +wdotw += +(gADM31*wu1 + (gADM23 + gADM32)*wu2)*wu3 + + wu1*((gADM12 + gADM21)*wu2 + gADM13*wu3) + gADM11*pow2(wu1) + + gADM22*pow2(wu2) + gADM33*pow2(wu3) +; + +wu1 += +wu1/Sqrt(wdotw) +; + +wu2 += +wu2/Sqrt(wdotw) +; + +wu3 += +wu3/Sqrt(wdotw) +; + +vd1 += +gADM11*vu1 + gADM12*vu2 + gADM13*vu3 +; + +vd2 += +gADM21*vu1 + gADM22*vu2 + gADM23*vu3 +; + +vd3 += +gADM31*vu1 + gADM32*vu2 + gADM33*vu3 +; + +wd1 += +gADM11*wu1 + gADM12*wu2 + gADM13*wu3 +; + +wd2 += +gADM21*wu1 + gADM22*wu2 + gADM23*wu3 +; + +wd3 += +gADM31*wu1 + gADM32*wu2 + gADM33*wu3 +; + +RehPsi0 += +Power(2.7182818284590452354,pow2(hPsi0parb)* + (2.*hPsi0parc*time - pow2(hPsi0parc) - pow2(time)))*hPsi0para +; + +ImhPsi0 += +0 +; + +rACABTF11 += +rACABTF11 + alpha*chi* + (2.*ImhPsi0*vd1*wd1 + RehPsi0*(pow2(vd1) - pow2(wd1))) +; + +rACABTF12 += +rACABTF12 + (vd2*(RehPsi0*vd1 + ImhPsi0*wd1) + + (ImhPsi0*vd1 - RehPsi0*wd1)*wd2)*alpha*chi +; + +rACABTF13 += +rACABTF13 + (vd3*(RehPsi0*vd1 + ImhPsi0*wd1) + + (ImhPsi0*vd1 - RehPsi0*wd1)*wd3)*alpha*chi +; + +rACABTF22 += +rACABTF22 + alpha*chi* + (2.*ImhPsi0*vd2*wd2 + RehPsi0*(pow2(vd2) - pow2(wd2))) +; + +rACABTF23 += +rACABTF23 + (vd3*(RehPsi0*vd2 + ImhPsi0*wd2) + + (ImhPsi0*vd2 - RehPsi0*wd2)*wd3)*alpha*chi +; + +rACABTF33 += +rACABTF33 + alpha*chi* + (2.*ImhPsi0*vd3*wd3 + RehPsi0*(pow2(vd3) - pow2(wd3))) +; + + + } + +rA11 += +rACABTF11 + 0.5*qdd11*rACqq + 2.* + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)*sdown1 + rACss*pow2(sdown1) +; + +rA12 += +rACABTF12 + 0.5*qdd12*rACqq + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)* + sdown2 + sdown1*(qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3 + + rACss*sdown2) +; + +rA13 += +rACABTF13 + 0.5*qdd13*rACqq + (qud11*rACsA1 + qud21*rACsA2 + qud31*rACsA3)* + sdown3 + sdown1*(qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3 + + rACss*sdown3) +; + +rA22 += +rACABTF22 + 0.5*qdd22*rACqq + 2.* + (qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3)*sdown2 + rACss*pow2(sdown2) +; + +rA23 += +rACABTF23 + 0.5*qdd23*rACqq + (qud12*rACsA1 + qud22*rACsA2 + qud32*rACsA3)* + sdown3 + sdown2*(qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3 + + rACss*sdown3) +; + +rA33 += +rACABTF33 + 0.5*qdd33*rACqq + 2.* + (qud13*rACsA1 + qud23*rACsA2 + qud33*rACsA3)*sdown3 + rACss*pow2(sdown3) +; + +rG1 += +qud11*rGamA1 + qud12*rGamA2 + qud13*rGamA3 + rGams*sup1 +; + +rG2 += +qud21*rGamA1 + qud22*rGamA2 + qud23*rGamA3 + rGams*sup2 +; + +rG3 += +qud31*rGamA1 + qud32*rGamA2 + qud33*rGamA3 + rGams*sup3 +; + +#if 0 +rG1 -= kappa1*(G1-Gfromg1); +rG2 -= kappa1*(G2-Gfromg2); +rG3 -= kappa1*(G3-Gfromg3); + +rA11 -= kappa1*A11/r; +rA12 -= kappa1*A12/r; +rA13 -= kappa1*A13/r; +rA22 -= kappa1*A22/r; +rA23 -= kappa1*A23/r; +rA33 -= kappa1*A33/r; +#endif + +#endif +} /* function */ +// f and tof are uper index +#ifdef fortran1 +void decompose2p1_1 +#endif +#ifdef fortran2 +void DECOMPOSE2P1_1 +#endif +#ifdef fortran3 +void decompose2p1_1_ +#endif +(double & r,double & xp,double & yp,double & zp,double & chi, + double & g11,double & g12,double & g13,double & g22,double & g23,double & g33, + double & f1,double & f2,double & f3,double & tofs,double & tof1,double & tof2,double & tof3) +{ +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double modshatARG; +double oomodshat; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +tofs += +f1*sdown1 + f2*sdown2 + f3*sdown3 +; + +tof1 += +f1*qud11 + f2*qud12 + f3*qud13 +; + +tof2 += +f1*qud21 + f2*qud22 + f3*qud23 +; + +tof3 += +f1*qud31 + f2*qud32 + f3*qud33 +; +} /* function */ +// f and tof are lower index +#ifdef fortran1 +void decompose2p1_2 +#endif +#ifdef fortran2 +void DECOMPOSE2P1_2 +#endif +#ifdef fortran3 +void decompose2p1_2_ +#endif +(double & r,double & xp,double & yp,double & zp,double & chi, + double & g11,double & g12,double & g13,double & g22,double & g23,double & g33, + double & f11,double & f12,double & f13,double & f22,double & f23,double & f33, + double & tofqq,double & tofss,double & tofs1,double & tofs2,double & tofs3, + double & tof11,double & tof12,double & tof13,double & tof22,double & tof23,double & tof33) +{ +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double modshatARG; +double oomodshat; +double qdd11; +double qdd12; +double qdd13; +double qdd22; +double qdd23; +double qdd33; +double qPhysuudd1111; +double qPhysuudd1112; +double qPhysuudd1113; +double qPhysuudd1122; +double qPhysuudd1123; +double qPhysuudd1133; +double qPhysuudd1211; +double qPhysuudd1212; +double qPhysuudd1213; +double qPhysuudd1222; +double qPhysuudd1223; +double qPhysuudd1233; +double qPhysuudd1311; +double qPhysuudd1312; +double qPhysuudd1313; +double qPhysuudd1322; +double qPhysuudd1323; +double qPhysuudd1333; +double qPhysuudd2211; +double qPhysuudd2212; +double qPhysuudd2213; +double qPhysuudd2222; +double qPhysuudd2223; +double qPhysuudd2233; +double qPhysuudd2311; +double qPhysuudd2312; +double qPhysuudd2313; +double qPhysuudd2322; +double qPhysuudd2323; +double qPhysuudd2333; +double qPhysuudd3311; +double qPhysuudd3312; +double qPhysuudd3313; +double qPhysuudd3322; +double qPhysuudd3323; +double qPhysuudd3333; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double quu11; +double quu12; +double quu13; +double quu22; +double quu23; +double quu33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +g12/chi - sdown1*sdown2 +; + +qdd13 += +g13/chi - sdown1*sdown3 +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +g23/chi - sdown2*sdown3 +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +qPhysuudd1111 += +-0.5*qdd11*quu11 + pow2(qud11) +; + +qPhysuudd1112 += +qud11*qud12 - 0.5*qdd12*quu11 +; + +qPhysuudd1113 += +qud11*qud13 - 0.5*qdd13*quu11 +; + +qPhysuudd1122 += +-0.5*qdd22*quu11 + pow2(qud12) +; + +qPhysuudd1123 += +qud12*qud13 - 0.5*qdd23*quu11 +; + +qPhysuudd1133 += +-0.5*qdd33*quu11 + pow2(qud13) +; + +qPhysuudd1211 += +qud11*qud21 - 0.5*qdd11*quu12 +; + +qPhysuudd1212 += +0.5*(qud12*qud21 + qud11*qud22 - qdd12*quu12) +; + +qPhysuudd1213 += +0.5*(qud13*qud21 + qud11*qud23 - qdd13*quu12) +; + +qPhysuudd1222 += +qud12*qud22 - 0.5*qdd22*quu12 +; + +qPhysuudd1223 += +0.5*(qud13*qud22 + qud12*qud23 - qdd23*quu12) +; + +qPhysuudd1233 += +qud13*qud23 - 0.5*qdd33*quu12 +; + +qPhysuudd1311 += +qud11*qud31 - 0.5*qdd11*quu13 +; + +qPhysuudd1312 += +0.5*(qud12*qud31 + qud11*qud32 - qdd12*quu13) +; + +qPhysuudd1313 += +0.5*(qud13*qud31 + qud11*qud33 - qdd13*quu13) +; + +qPhysuudd1322 += +qud12*qud32 - 0.5*qdd22*quu13 +; + +qPhysuudd1323 += +0.5*(qud13*qud32 + qud12*qud33 - qdd23*quu13) +; + +qPhysuudd1333 += +qud13*qud33 - 0.5*qdd33*quu13 +; + +qPhysuudd2211 += +-0.5*qdd11*quu22 + pow2(qud21) +; + +qPhysuudd2212 += +qud21*qud22 - 0.5*qdd12*quu22 +; + +qPhysuudd2213 += +qud21*qud23 - 0.5*qdd13*quu22 +; + +qPhysuudd2222 += +-0.5*qdd22*quu22 + pow2(qud22) +; + +qPhysuudd2223 += +qud22*qud23 - 0.5*qdd23*quu22 +; + +qPhysuudd2233 += +-0.5*qdd33*quu22 + pow2(qud23) +; + +qPhysuudd2311 += +qud21*qud31 - 0.5*qdd11*quu23 +; + +qPhysuudd2312 += +0.5*(qud22*qud31 + qud21*qud32 - qdd12*quu23) +; + +qPhysuudd2313 += +0.5*(qud23*qud31 + qud21*qud33 - qdd13*quu23) +; + +qPhysuudd2322 += +qud22*qud32 - 0.5*qdd22*quu23 +; + +qPhysuudd2323 += +0.5*(qud23*qud32 + qud22*qud33 - qdd23*quu23) +; + +qPhysuudd2333 += +qud23*qud33 - 0.5*qdd33*quu23 +; + +qPhysuudd3311 += +-0.5*qdd11*quu33 + pow2(qud31) +; + +qPhysuudd3312 += +qud31*qud32 - 0.5*qdd12*quu33 +; + +qPhysuudd3313 += +qud31*qud33 - 0.5*qdd13*quu33 +; + +qPhysuudd3322 += +-0.5*qdd22*quu33 + pow2(qud32) +; + +qPhysuudd3323 += +qud32*qud33 - 0.5*qdd23*quu33 +; + +qPhysuudd3333 += +-0.5*qdd33*quu33 + pow2(qud33) +; + +tofss += +2.*(f23*sup2*sup3 + sup1*(f12*sup2 + f13*sup3)) + f11*pow2(sup1) + + f22*pow2(sup2) + f33*pow2(sup3) +; + +tofqq += +f12*quu12 + f13*quu13 + f23*quu23 + 0.5*(f11*quu11 + f22*quu22 + f33*quu33) +; + +tofs1 += +(f11*qud11 + f12*qud21 + f13*qud31)*sup1 + + (f12*qud11 + f22*qud21 + f23*qud31)*sup2 + + (f13*qud11 + f23*qud21 + f33*qud31)*sup3 +; + +tofs2 += +(f11*qud12 + f12*qud22 + f13*qud32)*sup1 + + (f12*qud12 + f22*qud22 + f23*qud32)*sup2 + + (f13*qud12 + f23*qud22 + f33*qud32)*sup3 +; + +tofs3 += +(f11*qud13 + f12*qud23 + f13*qud33)*sup1 + + (f12*qud13 + f22*qud23 + f23*qud33)*sup2 + + (f13*qud13 + f23*qud23 + f33*qud33)*sup3 +; + +tof11 += +f11*qPhysuudd1111 + f22*qPhysuudd2211 + + 2.*(f12*qPhysuudd1211 + f13*qPhysuudd1311 + f23*qPhysuudd2311) + + f33*qPhysuudd3311 +; + +tof12 += +f11*qPhysuudd1112 + f22*qPhysuudd2212 + + 2.*(f12*qPhysuudd1212 + f13*qPhysuudd1312 + f23*qPhysuudd2312) + + f33*qPhysuudd3312 +; + +tof13 += +f11*qPhysuudd1113 + f22*qPhysuudd2213 + + 2.*(f12*qPhysuudd1213 + f13*qPhysuudd1313 + f23*qPhysuudd2313) + + f33*qPhysuudd3313 +; + +tof22 += +f11*qPhysuudd1122 + f22*qPhysuudd2222 + + 2.*(f12*qPhysuudd1222 + f13*qPhysuudd1322 + f23*qPhysuudd2322) + + f33*qPhysuudd3322 +; + +tof23 += +f11*qPhysuudd1123 + f22*qPhysuudd2223 + + 2.*(f12*qPhysuudd1223 + f13*qPhysuudd1323 + f23*qPhysuudd2323) + + f33*qPhysuudd3323 +; + +tof33 += +f11*qPhysuudd1133 + f22*qPhysuudd2233 + + 2.*(f12*qPhysuudd1233 + f13*qPhysuudd1333 + f23*qPhysuudd2333) + + f33*qPhysuudd3333 +; +} /*function */ +// f and tof are uper index +#ifdef fortran1 +void compose2p1_1 +#endif +#ifdef fortran2 +void COMPOSE2P1_1 +#endif +#ifdef fortran3 +void compose2p1_1_ +#endif +(double & r,double & xp,double & yp,double & zp,double & chi, + double & g11,double & g12,double & g13,double & g22,double & g23,double & g33, + double & f1,double & f2,double & f3,double & tofs,double & tof1,double & tof2,double & tof3) +{ +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double modshatARG; +double oomodshat; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +f1 += +qud11*tof1 + qud12*tof2 + qud13*tof3 + sup1*tofs +; + +f2 += +qud21*tof1 + qud22*tof2 + qud23*tof3 + sup2*tofs +; + +f3 += +qud31*tof1 + qud32*tof2 + qud33*tof3 + sup3*tofs +; +} /* function */ +// f and tof are lower index +#ifdef fortran1 +void compose2p1_2 +#endif +#ifdef fortran2 +void COMPOSE2P1_2 +#endif +#ifdef fortran3 +void compose2p1_2_ +#endif +(double & r,double & xp,double & yp,double & zp,double & chi, + double & g11,double & g12,double & g13,double & g22,double & g23,double & g33, + double & f11,double & f12,double & f13,double & f22,double & f23,double & f33, + double & tofqq,double & tofss,double & tofs1,double & tofs2,double & tofs3, + double & tof11,double & tof12,double & tof13,double & tof22,double & tof23,double & tof33) +{ +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double modshatARG; +double oomodshat; +double qdd11; +double qdd12; +double qdd13; +double qdd22; +double qdd23; +double qdd33; +double qPhysuudd1111; +double qPhysuudd1112; +double qPhysuudd1113; +double qPhysuudd1122; +double qPhysuudd1123; +double qPhysuudd1133; +double qPhysuudd1211; +double qPhysuudd1212; +double qPhysuudd1213; +double qPhysuudd1222; +double qPhysuudd1223; +double qPhysuudd1233; +double qPhysuudd1311; +double qPhysuudd1312; +double qPhysuudd1313; +double qPhysuudd1322; +double qPhysuudd1323; +double qPhysuudd1333; +double qPhysuudd2211; +double qPhysuudd2212; +double qPhysuudd2213; +double qPhysuudd2222; +double qPhysuudd2223; +double qPhysuudd2233; +double qPhysuudd2311; +double qPhysuudd2312; +double qPhysuudd2313; +double qPhysuudd2322; +double qPhysuudd2323; +double qPhysuudd2333; +double qPhysuudd3311; +double qPhysuudd3312; +double qPhysuudd3313; +double qPhysuudd3322; +double qPhysuudd3323; +double qPhysuudd3333; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double quu11; +double quu12; +double quu13; +double quu22; +double quu23; +double quu33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + + + +shat1 += +0 +; + +shat2 += +0 +; + +shat3 += +0 +; + + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +g12/chi - sdown1*sdown2 +; + +qdd13 += +g13/chi - sdown1*sdown3 +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +g23/chi - sdown2*sdown3 +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +qPhysuudd1111 += +-0.5*qdd11*quu11 + pow2(qud11) +; + +qPhysuudd1112 += +qud11*qud12 - 0.5*qdd12*quu11 +; + +qPhysuudd1113 += +qud11*qud13 - 0.5*qdd13*quu11 +; + +qPhysuudd1122 += +-0.5*qdd22*quu11 + pow2(qud12) +; + +qPhysuudd1123 += +qud12*qud13 - 0.5*qdd23*quu11 +; + +qPhysuudd1133 += +-0.5*qdd33*quu11 + pow2(qud13) +; + +qPhysuudd1211 += +qud11*qud21 - 0.5*qdd11*quu12 +; + +qPhysuudd1212 += +0.5*(qud12*qud21 + qud11*qud22 - qdd12*quu12) +; + +qPhysuudd1213 += +0.5*(qud13*qud21 + qud11*qud23 - qdd13*quu12) +; + +qPhysuudd1222 += +qud12*qud22 - 0.5*qdd22*quu12 +; + +qPhysuudd1223 += +0.5*(qud13*qud22 + qud12*qud23 - qdd23*quu12) +; + +qPhysuudd1233 += +qud13*qud23 - 0.5*qdd33*quu12 +; + +qPhysuudd1311 += +qud11*qud31 - 0.5*qdd11*quu13 +; + +qPhysuudd1312 += +0.5*(qud12*qud31 + qud11*qud32 - qdd12*quu13) +; + +qPhysuudd1313 += +0.5*(qud13*qud31 + qud11*qud33 - qdd13*quu13) +; + +qPhysuudd1322 += +qud12*qud32 - 0.5*qdd22*quu13 +; + +qPhysuudd1323 += +0.5*(qud13*qud32 + qud12*qud33 - qdd23*quu13) +; + +qPhysuudd1333 += +qud13*qud33 - 0.5*qdd33*quu13 +; + +qPhysuudd2211 += +-0.5*qdd11*quu22 + pow2(qud21) +; + +qPhysuudd2212 += +qud21*qud22 - 0.5*qdd12*quu22 +; + +qPhysuudd2213 += +qud21*qud23 - 0.5*qdd13*quu22 +; + +qPhysuudd2222 += +-0.5*qdd22*quu22 + pow2(qud22) +; + +qPhysuudd2223 += +qud22*qud23 - 0.5*qdd23*quu22 +; + +qPhysuudd2233 += +-0.5*qdd33*quu22 + pow2(qud23) +; + +qPhysuudd2311 += +qud21*qud31 - 0.5*qdd11*quu23 +; + +qPhysuudd2312 += +0.5*(qud22*qud31 + qud21*qud32 - qdd12*quu23) +; + +qPhysuudd2313 += +0.5*(qud23*qud31 + qud21*qud33 - qdd13*quu23) +; + +qPhysuudd2322 += +qud22*qud32 - 0.5*qdd22*quu23 +; + +qPhysuudd2323 += +0.5*(qud23*qud32 + qud22*qud33 - qdd23*quu23) +; + +qPhysuudd2333 += +qud23*qud33 - 0.5*qdd33*quu23 +; + +qPhysuudd3311 += +-0.5*qdd11*quu33 + pow2(qud31) +; + +qPhysuudd3312 += +qud31*qud32 - 0.5*qdd12*quu33 +; + +qPhysuudd3313 += +qud31*qud33 - 0.5*qdd13*quu33 +; + +qPhysuudd3322 += +-0.5*qdd22*quu33 + pow2(qud32) +; + +qPhysuudd3323 += +qud32*qud33 - 0.5*qdd23*quu33 +; + +qPhysuudd3333 += +-0.5*qdd33*quu33 + pow2(qud33) +; + +// my equations +#if 0 +f11 += +qPhysuudd1111*tof11 + qPhysuudd2211*tof22 + + 2.*(qPhysuudd1211*tof12 + qPhysuudd1311*tof13 + qPhysuudd2311*tof23) + + qPhysuudd3311*tof33 + qdd11*tofqq + + 1.*sdown1*(qud11*tofs1 + qud21*tofs2 + qud31*tofs3) + tofss*pow2(sdown1) +; + +f12 += +qPhysuudd1112*tof11 + qPhysuudd2212*tof22 + + 2.*(qPhysuudd1212*tof12 + qPhysuudd1312*tof13 + qPhysuudd2312*tof23) + + qPhysuudd3312*tof33 + qdd12*tofqq + + 0.5*((qud12*sdown1 + qud11*sdown2)*tofs1 + + (qud22*sdown1 + qud21*sdown2)*tofs2 + + (qud32*sdown1 + qud31*sdown2)*tofs3) + sdown1*sdown2*tofss +; + +f13 += +qPhysuudd1113*tof11 + qPhysuudd2213*tof22 + + 2.*(qPhysuudd1213*tof12 + qPhysuudd1313*tof13 + qPhysuudd2313*tof23) + + qPhysuudd3313*tof33 + qdd13*tofqq + + 0.5*((qud13*sdown1 + qud11*sdown3)*tofs1 + + (qud23*sdown1 + qud21*sdown3)*tofs2 + + (qud33*sdown1 + qud31*sdown3)*tofs3) + sdown1*sdown3*tofss +; + +f22 += +qPhysuudd1122*tof11 + qPhysuudd2222*tof22 + + 2.*(qPhysuudd1222*tof12 + qPhysuudd1322*tof13 + qPhysuudd2322*tof23) + + qPhysuudd3322*tof33 + qdd22*tofqq + + 1.*sdown2*(qud12*tofs1 + qud22*tofs2 + qud32*tofs3) + tofss*pow2(sdown2) +; + +f23 += +qPhysuudd1123*tof11 + qPhysuudd2223*tof22 + + 2.*(qPhysuudd1223*tof12 + qPhysuudd1323*tof13 + qPhysuudd2323*tof23) + + qPhysuudd3323*tof33 + qdd23*tofqq + + 0.5*((qud13*sdown2 + qud12*sdown3)*tofs1 + + (qud23*sdown2 + qud22*sdown3)*tofs2 + + (qud33*sdown2 + qud32*sdown3)*tofs3) + sdown2*sdown3*tofss +; + +f33 += +qPhysuudd1133*tof11 + qPhysuudd2233*tof22 + + 2.*(qPhysuudd1233*tof12 + qPhysuudd1333*tof13 + qPhysuudd2333*tof23) + + qPhysuudd3333*tof33 + qdd33*tofqq + + 1.*sdown3*(qud13*tofs1 + qud23*tofs2 + qud33*tofs3) + tofss*pow2(sdown3) +; +// David's equations +#else +f11 += +tof11 + 0.5*qdd11*tofqq + 2.*sdown1* + (qud11*tofs1 + qud21*tofs2 + qud31*tofs3) + tofss*pow2(sdown1) +; + +f12 += +tof12 + 0.5*qdd12*tofqq + (qud12*sdown1 + qud11*sdown2)*tofs1 + + (qud22*sdown1 + qud21*sdown2)*tofs2 + + (qud32*sdown1 + qud31*sdown2)*tofs3 + sdown1*sdown2*tofss +; + +f13 += +tof13 + 0.5*qdd13*tofqq + (qud13*sdown1 + qud11*sdown3)*tofs1 + + (qud23*sdown1 + qud21*sdown3)*tofs2 + + (qud33*sdown1 + qud31*sdown3)*tofs3 + sdown1*sdown3*tofss +; + +f22 += +tof22 + 0.5*qdd22*tofqq + 2.*sdown2* + (qud12*tofs1 + qud22*tofs2 + qud32*tofs3) + tofss*pow2(sdown2) +; + +f23 += +tof23 + 0.5*qdd23*tofqq + (qud13*sdown2 + qud12*sdown3)*tofs1 + + (qud23*sdown2 + qud22*sdown3)*tofs2 + + (qud33*sdown2 + qud32*sdown3)*tofs3 + sdown2*sdown3*tofss +; + +f33 += +tof33 + 0.5*qdd33*tofqq + 2.*sdown3* + (qud13*tofs1 + qud23*tofs2 + qud33*tofs3) + tofss*pow2(sdown3) +; +#endif + +} /* function */ +#ifdef fortran1 +void racqq_point +#endif +#ifdef fortran2 +void RACQQ_POINT +#endif +#ifdef fortran3 +void racqq_point_ +#endif +(double &A11, +double &A12, +double &A13, +double &A22, +double &A23, +double &A33, +double &alpha, +double &beta1, +double &beta2, +double &beta3, +double &chi, +double &db11, +double &db12, +double &db13, +double &db21, +double &db22, +double &db23, +double &db31, +double &db32, +double &db33, +double &dg111, +double &dg112, +double &dg113, +double &dg122, +double &dg123, +double &dg133, +double &dg211, +double &dg212, +double &dg213, +double &dg222, +double &dg223, +double &dg233, +double &dg311, +double &dg312, +double &dg313, +double &dg322, +double &dg323, +double &dg333, +double &g11, +double &g12, +double &g13, +double &g22, +double &g23, +double &g33, +double &rACqq, +double &rACss) +{ + +double Ainv11; +double Ainv12; +double Ainv13; +double Ainv22; +double Ainv23; +double Ainv33; +double detginv; +double divbeta; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double lieg11; +double lieg12; +double lieg13; +double lieg22; +double lieg23; +double lieg33; +double totdivbeta; + + + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +divbeta += +db11 + db22 + db33 +; + +totdivbeta += +0.66666666666666666667*divbeta +; + +Ainv11 += +2.*(A23*ginv12*ginv13 + ginv11*(A12*ginv12 + A13*ginv13)) + + A11*pow2(ginv11) + A22*pow2(ginv12) + A33*pow2(ginv13) +; + +Ainv12 += +ginv11*(A11*ginv12 + A12*ginv22 + A13*ginv23) + + ginv12*(A13*ginv13 + A22*ginv22 + A23*ginv23) + + ginv13*(A23*ginv22 + A33*ginv23) + A12*pow2(ginv12) +; + +Ainv13 += +ginv11*(A11*ginv13 + A12*ginv23 + A13*ginv33) + + ginv12*(A12*ginv13 + A22*ginv23 + A23*ginv33) + + ginv13*(A23*ginv23 + A33*ginv33) + A13*pow2(ginv13) +; + +Ainv22 += +2.*(A23*ginv22*ginv23 + ginv12*(A12*ginv22 + A13*ginv23)) + + A11*pow2(ginv12) + A22*pow2(ginv22) + A33*pow2(ginv23) +; + +Ainv23 += +ginv13*(A12*ginv22 + A13*ginv23) + A33*ginv23*ginv33 + + ginv12*(A11*ginv13 + A12*ginv23 + A13*ginv33) + + ginv22*(A22*ginv23 + A23*ginv33) + A23*pow2(ginv23) +; + +Ainv33 += +2.*(A23*ginv23*ginv33 + ginv13*(A12*ginv23 + A13*ginv33)) + + A11*pow2(ginv13) + A22*pow2(ginv23) + A33*pow2(ginv33) +; + +lieg11 += +beta1*dg111 + beta2*dg211 + beta3*dg311 + + 2.*(db11*g11 + db12*g12 + db13*g13) - g11*totdivbeta +; + +lieg12 += +beta1*dg112 + beta2*dg212 + beta3*dg312 + db21*g11 + db23*g13 + db12*g22 + + db13*g23 + g12*(db11 + db22 - totdivbeta) +; + +lieg13 += +beta1*dg113 + beta2*dg213 + beta3*dg313 + db31*g11 + db32*g12 + db12*g23 + + db13*g33 + g13*(db11 + db33 - totdivbeta) +; + +lieg22 += +beta1*dg122 + beta2*dg222 + beta3*dg322 + + 2.*(db21*g12 + db22*g22 + db23*g23) - g22*totdivbeta +; + +lieg23 += +beta1*dg123 + beta2*dg223 + beta3*dg323 + db31*g12 + db21*g13 + db32*g22 + + db23*g33 + g23*(db22 + db33 - totdivbeta) +; + +lieg33 += +beta1*dg133 + beta2*dg233 + beta3*dg333 + + 2.*(db31*g13 + db32*g23 + db33*g33) - g33*totdivbeta +; + +rACqq += +chi*(-((4.*(A12*Ainv12 + A13*Ainv13 + A23*Ainv23) + + 2.*(A11*Ainv11 + A22*Ainv22 + A33*Ainv33))*alpha) + + Ainv11*lieg11 + Ainv22*lieg22 + + 2.*(Ainv12*lieg12 + Ainv13*lieg13 + Ainv23*lieg23) + Ainv33*lieg33) - + rACss +; + +} /* function */ +#ifdef fortran1 +void rkhat_point +#endif +#ifdef fortran2 +void RKHAT_POINT +#endif +#ifdef fortran3 +void rkhat_point_ +#endif +(double &alpha, +double &beta1, +double &beta2, +double &beta3, +double &chi, +double &dKhat1, +double &dKhat2, +double &dKhat3, +double &dTheta1, +double &dTheta2, +double &dTheta3, +double &g11, +double &g12, +double &g13, +double &g22, +double &g23, +double &g33, +double &kappa1, +double &kappa2, +double &Khat, +double &r, +double &rKhat, +double &Theta, +double &xp, +double &yp, +double &zp) +{ + +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double DKhat; +double DTheta; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double lienK; +double lienKhat; +double lienTheta; +double modshatARG; +double muL; +double oomodshat; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +muL += +2./alpha +; + +DKhat += +dKhat1*sup1 + dKhat2*sup2 + dKhat3*sup3 +; + +DTheta += +dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3 +; + +lienKhat += +-((DKhat + Khat/r)*sqrt(muL)) +; + +lienTheta += +-DTheta - (kappa1*(2. + kappa2) + 1/r)*Theta +; + +lienK += +lienKhat + 2.*lienTheta +; + +rKhat += +beta1*dKhat1 + beta2*dKhat2 + beta3*dKhat3 + alpha*lienKhat +; + +} /* function */ +#ifdef fortran1 +void rtheta_point +#endif +#ifdef fortran2 +void RTHETA_POINT +#endif +#ifdef fortran3 +void rtheta_point_ +#endif +(double &alpha, +double &beta1, +double &beta2, +double &beta3, +double &chi, +double &dTheta1, +double &dTheta2, +double &dTheta3, +double &g11, +double &g12, +double &g13, +double &g22, +double &g23, +double &g33, +double &kappa1, +double &kappa2, +double &r, +double &rTheta, +double &Theta, +double &xp, +double &yp, +double &zp) +{ + +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double DTheta; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double lienTheta; +double modshatARG; +double oomodshat; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; + + + +shat1 += +0 +; + +shat2 += +0 +; + +shat3 += +0 +; + + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +DTheta += +dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3 +; + +lienTheta += +-DTheta - (kappa1*(2. + kappa2) + 1/r)*Theta +; + +rTheta += +beta1*dTheta1 + beta2*dTheta2 + beta3*dTheta3 + alpha*lienTheta +; + +} /* function */ + +#ifdef fortran1 +void rgam_point +#endif +#ifdef fortran2 +void RGAM_POINT +#endif +#ifdef fortran3 +void rgam_point_ +#endif +(double &alpha, +double &beta1, +double &beta2, +double &beta3, +double &chi, +double &db11, +double &db12, +double &db13, +double &db21, +double &db22, +double &db23, +double &db31, +double &db32, +double &db33, +double &ddb111, +double &ddb112, +double &ddb113, +double &ddb121, +double &ddb122, +double &ddb123, +double &ddb131, +double &ddb132, +double &ddb133, +double &ddb221, +double &ddb222, +double &ddb223, +double &ddb231, +double &ddb232, +double &ddb233, +double &ddb331, +double &ddb332, +double &ddb333, +double &dG11, +double &dG12, +double &dG13, +double &dG21, +double &dG22, +double &dG23, +double &dG31, +double &dG32, +double &dG33, +double &dKhat1, +double &dKhat2, +double &dKhat3, +double &dTheta1, +double &dTheta2, +double &dTheta3, +double &g11, +double &g12, +double &g13, +double &g22, +double &g23, +double &g33, +double &r, +double &rGamA1, +double &rGamA2, +double &rGamA3, +double &rGams, +double &shiftdriver, +double &xp, +double &yp, +double &zp) +{ + +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double detginv; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double modshatARG; +double muL; +double muStilde; +double oomodshat; +double qdd11; +double qdd12; +double qdd13; +double qdd22; +double qdd23; +double qdd33; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double quu11; +double quu12; +double quu13; +double quu22; +double quu23; +double quu33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; +double vbetaA; +double vbetas; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +g12/chi - sdown1*sdown2 +; + +qdd13 += +g13/chi - sdown1*sdown3 +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +g23/chi - sdown2*sdown3 +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +muL += +2./alpha +; + +muStilde += +1/chi +; + +vbetas += +2.*sqrt(0.33333333333333333333*muStilde) +; + +vbetaA += +sqrt(muStilde) +; + +rGams += +(beta1*dG11 + beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + ddb221*quu22 + + 2.*(ddb121*quu12 + ddb131*quu13 + ddb231*quu23) + ddb331*quu33)/chi\ +)*sdown1 + (beta1*dG12 + beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + ddb222*quu22 + + 2.*(ddb122*quu12 + ddb132*quu13 + ddb232*quu23) + ddb332*quu33)/chi\ +)*sdown2 + (beta1*dG13 + beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + ddb223*quu22 + + 2.*(ddb123*quu12 + ddb133*quu13 + ddb233*quu23) + ddb333*quu33)/chi\ +)*sdown3 - ((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + ddb121*qud21 + + ddb122*qud22 + ddb123*qud23 + ddb131*qud31 + ddb132*qud32 + + ddb133*qud33)*sup1 + (ddb121*qud11 + ddb122*qud12 + + ddb123*qud13 + ddb221*qud21 + ddb222*qud22 + ddb223*qud23 + + ddb231*qud31 + ddb232*qud32 + ddb233*qud33)*sup2 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb231*qud21 + + ddb232*qud22 + ddb233*qud23 + ddb331*qud31 + ddb332*qud32 + + ddb333*qud33)*sup3)/chi - (dG11 + dG22 + dG33)*vbetas + + 2.*((0.33333333333333333333*alpha* + (dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3))/(chi + chi*vbetas) + + ((db11 + db22 + db33)*shiftdriver)/(vbetaA*sqrt(3.))) + + (1.3333333333333333333*alpha*(dKhat1*sup1 + dKhat2*sup2 + dKhat3*sup3)* + sqrt(muL))/(chi*(vbetas + sqrt(muL))) +; + +rGamA1 += +-(((dG21*qud11 + dG22*qud12 + dG23*qud13)*sup2 + + (dG31*qud11 + dG32*qud12 + dG33*qud13)*sup3)*vbetaA) + + qud11*(beta2*dG21 + beta3*dG31 + + (1.3333333333333333333*ddb111*quu11 + + 2.3333333333333333333*(ddb121*quu12 + ddb131*quu13) + + ddb221*quu22 + ddb331*quu33 + + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud12*(beta2*dG22 + beta3*dG32 + + (1.3333333333333333333*ddb112*quu11 + + 2.3333333333333333333*(ddb122*quu12 + ddb132*quu13) + + ddb222*quu22 + 2.*ddb232*quu23 + ddb332*quu33 + + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/vbetaA)/chi + + dG12*(beta1 - sup1*vbetaA)) + + qud13*(beta2*dG23 + beta3*dG33 + + (1.3333333333333333333*ddb113*quu11 + + 2.3333333333333333333*(ddb123*quu12 + ddb133*quu13) + + ddb223*quu22 + 2.*ddb233*quu23 + ddb333*quu33 + + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/vbetaA)/chi + + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb121*qud21 + ddb122*qud22 + ddb123*qud23 + + ddb131*qud31 + ddb132*qud32 + ddb133*qud33)*quu11 + + (ddb221*qud21 + ddb223*qud23 + ddb231*qud31 + ddb232*qud32 + + ddb233*qud33)*quu12 + + (ddb231*qud21 + ddb232*qud22 + ddb233*qud23 + ddb331*qud31 + + ddb332*qud32)*quu13) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu11 + + 1.3333333333333333333*(dKhat2*quu12 + dKhat3*quu13)) + + 1.3333333333333333333*((ddb132*quu13*sdown2 + ddb113*quu11*sdown3)* + sup1 + (quu13*(ddb231*sdown1 + ddb232*sdown2) + + quu12*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu12*(ddb232*sdown2 + ddb233*sdown3) + + quu13*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu12 + ddb131*quu13)*sup1 + ddb221*quu12*sup2 + + ddb131*quu11*sup3) + + sdown2*((ddb112*quu11 + ddb122*quu12)*sup1 + + quu11*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu12 + ddb133*quu13)*sup1 + + quu11*(ddb123*sup2 + ddb133*sup3))) + + qud11*(2.*ddb231*quu23 + (db21*shiftdriver*sup2)/vbetaA) - + (((db11*quu11 + db21*quu12)*sdown1 + + (db12*quu11 + db22*quu12 + db32*quu13)*sdown2 + + (db13*quu11 + db23*quu12 + db33*quu13)*sdown3)*shiftdriver)/ + vbetaA + ((dG22*quu12 + dG32*quu13)*sdown2 + + (dG13*quu11 + dG23*quu12)*sdown3)*vbetaA + + quu11*(1.3333333333333333333*sdown1*(ddb111*sup1 + ddb121*sup2) + + (dG11*sdown1 + dG12*sdown2)*vbetaA) + + quu12*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb222*qud22 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)) + + quu13*(-0.66666666666666666667*alpha*dTheta3 + + 0.33333333333333333333*ddb333*qud33 - + (db31*sdown1*shiftdriver)/vbetaA + dG31*sdown1*vbetaA + + sdown3*(1.3333333333333333333*ddb233*sup2 + dG33*vbetaA)))/chi +; + +rGamA2 += +-(((dG21*qud21 + dG22*qud22 + dG23*qud23)*sup2 + + (dG31*qud21 + dG32*qud22 + dG33*qud23)*sup3)*vbetaA) + + qud21*(beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + 2.*ddb131*quu13 + + 1.3333333333333333333*ddb221*quu22 + + 2.3333333333333333333*(ddb121*quu12 + ddb231*quu23) + + ddb331*quu33 + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud22*(beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + 2.*ddb132*quu13 + + 1.3333333333333333333*ddb222*quu22 + + 2.3333333333333333333*(ddb122*quu12 + ddb232*quu23) + + ddb332*quu33 + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/ + vbetaA)/chi + dG12*(beta1 - sup1*vbetaA)) + + qud23*(beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + 2.*ddb133*quu13 + + 1.3333333333333333333*ddb223*quu22 + + 2.3333333333333333333*(ddb123*quu12 + ddb233*quu23) + + ddb333*quu33 + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/ + vbetaA)/chi + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + + ddb131*qud31 + ddb132*qud32 + ddb133*qud33)*quu12 + + (ddb121*qud11 + ddb123*qud13 + ddb231*qud31 + ddb232*qud32 + + ddb233*qud33)*quu22 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb331*qud31 + + ddb332*qud32)*quu23) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu12 + + 1.3333333333333333333*(dKhat2*quu22 + dKhat3*quu23)) + + 1.3333333333333333333*((ddb132*quu23*sdown2 + ddb113*quu12*sdown3)* + sup1 + (quu23*(ddb231*sdown1 + ddb232*sdown2) + + quu22*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu22*(ddb232*sdown2 + ddb233*sdown3) + + quu23*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu22 + ddb131*quu23)*sup1 + ddb221*quu22*sup2 + + ddb131*quu12*sup3) + + sdown2*((ddb112*quu12 + ddb122*quu22)*sup1 + + quu12*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu22 + ddb133*quu23)*sup1 + + quu12*(ddb123*sup2 + ddb133*sup3))) - + (((db11*quu12 + db21*quu22)*sdown1 + + (db12*quu12 + db22*quu22 + db32*quu23)*sdown2 + + (db13*quu12 + db23*quu22 + db33*quu23)*sdown3)*shiftdriver)/ + vbetaA + (db21*qud21*shiftdriver*sup2)/vbetaA + + ((dG22*quu22 + dG32*quu23)*sdown2 + (dG13*quu12 + dG23*quu22)*sdown3)* + vbetaA + quu12*(1.3333333333333333333*sdown1* + (ddb111*sup1 + ddb121*sup2) + (dG11*sdown1 + dG12*sdown2)*vbetaA) \ ++ quu22*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb122*qud12 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)) + + quu23*(-0.66666666666666666667*alpha*dTheta3 + + 0.33333333333333333333*ddb333*qud33 - + (db31*sdown1*shiftdriver)/vbetaA + dG31*sdown1*vbetaA + + sdown3*(1.3333333333333333333*ddb233*sup2 + dG33*vbetaA)))/chi +; + +rGamA3 += +-(((dG21*qud31 + dG22*qud32 + dG23*qud33)*sup2 + + (dG31*qud31 + dG32*qud32 + dG33*qud33)*sup3)*vbetaA) + + qud31*(beta2*dG21 + beta3*dG31 + + (ddb111*quu11 + 2.*ddb121*quu12 + ddb221*quu22 + + 2.3333333333333333333*(ddb131*quu13 + ddb231*quu23) + + 1.3333333333333333333*ddb331*quu33 + + (shiftdriver*(db11*sup1 + db31*sup3))/vbetaA)/chi + + dG11*(beta1 - sup1*vbetaA)) + + qud32*(beta2*dG22 + beta3*dG32 + + (ddb112*quu11 + 2.*ddb122*quu12 + ddb222*quu22 + + 2.3333333333333333333*(ddb132*quu13 + ddb232*quu23) + + 1.3333333333333333333*ddb332*quu33 + + (shiftdriver*(db12*sup1 + db22*sup2 + db32*sup3))/vbetaA)/chi + + dG12*(beta1 - sup1*vbetaA)) + + qud33*(beta2*dG23 + beta3*dG33 + + (ddb113*quu11 + 2.*ddb123*quu12 + ddb223*quu22 + + 2.3333333333333333333*(ddb133*quu13 + ddb233*quu23) + + 1.3333333333333333333*ddb333*quu33 + + (shiftdriver*(db13*sup1 + db23*sup2 + db33*sup3))/vbetaA)/chi + + dG13*(beta1 - sup1*vbetaA)) + + (0.33333333333333333333*((ddb111*qud11 + ddb112*qud12 + ddb113*qud13 + + ddb121*qud21 + ddb122*qud22 + ddb123*qud23)*quu13 + + (ddb121*qud11 + ddb123*qud13 + ddb221*qud21 + ddb222*qud22 + + ddb223*qud23)*quu23 + + (ddb131*qud11 + ddb132*qud12 + ddb133*qud13 + ddb231*qud21 + + ddb232*qud22)*quu33) - + alpha*((1.3333333333333333333*dKhat1 + + 0.66666666666666666667*dTheta1)*quu13 + + 1.3333333333333333333*(dKhat2*quu23 + dKhat3*quu33)) + + 1.3333333333333333333*((ddb132*quu33*sdown2 + ddb113*quu13*sdown3)* + sup1 + (quu33*(ddb231*sdown1 + ddb232*sdown2) + + quu23*(ddb222*sdown2 + ddb223*sdown3))*sup2 + + (quu23*(ddb232*sdown2 + ddb233*sdown3) + + quu33*(ddb331*sdown1 + ddb332*sdown2 + ddb333*sdown3))*sup3 + + sdown1*((ddb121*quu23 + ddb131*quu33)*sup1 + ddb221*quu23*sup2 + + ddb131*quu13*sup3) + + sdown2*((ddb112*quu13 + ddb122*quu23)*sup1 + + quu13*(ddb122*sup2 + ddb132*sup3)) + + sdown3*((ddb123*quu23 + ddb133*quu33)*sup1 + + quu13*(ddb123*sup2 + ddb133*sup3))) - + (((db11*quu13 + db21*quu23)*sdown1 + + (db12*quu13 + db22*quu23 + db32*quu33)*sdown2 + + (db13*quu13 + db23*quu23 + db33*quu33)*sdown3)*shiftdriver)/ + vbetaA + (db21*qud31*shiftdriver*sup2)/vbetaA + + ((dG22*quu23 + dG32*quu33)*sdown2 + (dG13*quu13 + dG23*quu23)*sdown3)* + vbetaA + quu13*(1.3333333333333333333*sdown1* + (ddb111*sup1 + ddb121*sup2) + (dG11*sdown1 + dG12*sdown2)*vbetaA) \ ++ quu33*(-0.66666666666666666667*alpha*dTheta3 + + ddb233*(0.33333333333333333333*qud23 + + 1.3333333333333333333*sdown3*sup2) - + (db31*sdown1*shiftdriver)/vbetaA + + (dG31*sdown1 + dG33*sdown3)*vbetaA) + + quu23*(-0.66666666666666666667*alpha*dTheta2 + + 0.33333333333333333333*ddb122*qud12 + + sdown1*(1.3333333333333333333*ddb231*sup3 + dG21*vbetaA)))/chi +; + +} /* function */ +#ifdef fortran1 +void ra_point +#endif +#ifdef fortran2 +void RA_POINT +#endif +#ifdef fortran3 +void ra_point_ +#endif +(double &A11, +double &A12, +double &A13, +double &A22, +double &A23, +double &A33, +double &alpha, +double &beta1, +double &beta2, +double &beta3, +double &chi, +double &da1, +double &dA111, +double &dA112, +double &dA113, +double &dA122, +double &dA123, +double &dA133, +double &da2, +double &dA211, +double &dA212, +double &dA213, +double &dA222, +double &dA223, +double &dA233, +double &da3, +double &dA311, +double &dA312, +double &dA313, +double &dA322, +double &dA323, +double &dA333, +double &db11, +double &db12, +double &db13, +double &db21, +double &db22, +double &db23, +double &db31, +double &db32, +double &db33, +double &dchi1, +double &dchi2, +double &dchi3, +double &dda11, +double &dda12, +double &dda13, +double &dda22, +double &dda23, +double &dda33, +double &ddb111, +double &ddb112, +double &ddb113, +double &ddb121, +double &ddb122, +double &ddb123, +double &ddb131, +double &ddb132, +double &ddb133, +double &ddb221, +double &ddb222, +double &ddb223, +double &ddb231, +double &ddb232, +double &ddb233, +double &ddb331, +double &ddb332, +double &ddb333, +double &ddchi11, +double &ddchi12, +double &ddchi13, +double &ddchi22, +double &ddchi23, +double &ddchi33, +double &ddg1111, +double &ddg1112, +double &ddg1113, +double &ddg1122, +double &ddg1123, +double &ddg1133, +double &ddg1211, +double &ddg1212, +double &ddg1213, +double &ddg1222, +double &ddg1223, +double &ddg1233, +double &ddg1311, +double &ddg1312, +double &ddg1313, +double &ddg1322, +double &ddg1323, +double &ddg1333, +double &ddg2211, +double &ddg2212, +double &ddg2213, +double &ddg2222, +double &ddg2223, +double &ddg2233, +double &ddg2311, +double &ddg2312, +double &ddg2313, +double &ddg2322, +double &ddg2323, +double &ddg2333, +double &ddg3311, +double &ddg3312, +double &ddg3313, +double &ddg3322, +double &ddg3323, +double &ddg3333, +double &dG11, +double &dg111, +double &dg112, +double &dg113, +double &dG12, +double &dg122, +double &dg123, +double &dG13, +double &dg133, +double &dG21, +double &dg211, +double &dg212, +double &dg213, +double &dG22, +double &dg222, +double &dg223, +double &dG23, +double &dg233, +double &dG31, +double &dg311, +double &dg312, +double &dg313, +double &dG32, +double &dg322, +double &dg323, +double &dG33, +double &dg333, +double &dKhat1, +double &dKhat2, +double &dKhat3, +double &dTheta1, +double &dTheta2, +double &dTheta3, +double &G1, +double &g11, +double &g12, +double &g13, +double &G2, +double &g22, +double &g23, +double &G3, +double &g33, +double &kappa1, +double &Khat, +double &r, +double &rACABTF11, +double &rACABTF12, +double &rACABTF13, +double &rACABTF22, +double &rACABTF23, +double &rACABTF33, +double &rACsA1, +double &rACsA2, +double &rACsA3, +double &rACss, +double &Theta, +double &xp, +double &yp, +double &zp) +{ + +double AA11; +double AA12; +double AA13; +double AA21; +double AA22; +double AA23; +double AA31; +double AA32; +double AA33; +double ADMginv11; +double ADMginv12; +double ADMginv13; +double ADMginv22; +double ADMginv23; +double ADMginv33; +double cdA111; +double cdA112; +double cdA113; +double cdA122; +double cdA123; +double cdA133; +double cdA211; +double cdA212; +double cdA213; +double cdA222; +double cdA223; +double cdA233; +double cdA311; +double cdA312; +double cdA313; +double cdA322; +double cdA323; +double cdA333; +double cdda11; +double cdda12; +double cdda13; +double cdda22; +double cdda23; +double cdda33; +double cddf11; +double cddf12; +double cddf13; +double cddf22; +double cddf23; +double cddf33; +double chipsipower; +double ddf11; +double ddf12; +double ddf13; +double ddf22; +double ddf23; +double ddf33; +double detginv; +double df1; +double df2; +double df3; +double dGfromgdu11; +double dGfromgdu12; +double dGfromgdu13; +double dGfromgdu21; +double dGfromgdu22; +double dGfromgdu23; +double dGfromgdu31; +double dGfromgdu32; +double dGfromgdu33; +double divbeta; +double dK1; +double dK2; +double dK3; +double DTheta; +double f; +double ff; +double gamma111; +double gamma112; +double gamma113; +double gamma122; +double gamma123; +double gamma133; +double gamma211; +double gamma212; +double gamma213; +double gamma222; +double gamma223; +double gamma233; +double gamma311; +double gamma312; +double gamma313; +double gamma322; +double gamma323; +double gamma333; +double gammado111; +double gammado112; +double gammado113; +double gammado122; +double gammado123; +double gammado133; +double gammado211; +double gammado212; +double gammado213; +double gammado222; +double gammado223; +double gammado233; +double gammado311; +double gammado312; +double gammado313; +double gammado322; +double gammado323; +double gammado333; +double Gfromg1; +double Gfromg2; +double Gfromg3; +double ginv11; +double ginv12; +double ginv13; +double ginv22; +double ginv23; +double ginv33; +double K; +double lieA11; +double lieA12; +double lieA13; +double lieA22; +double lieA23; +double lieA33; +double modshatARG; +double oochipsipower; +double oomodshat; +double psim4; +double qdd11; +double qdd12; +double qdd13; +double qdd22; +double qdd23; +double qdd33; +double qPhysuudd1111; +double qPhysuudd1112; +double qPhysuudd1113; +double qPhysuudd1122; +double qPhysuudd1123; +double qPhysuudd1133; +double qPhysuudd1211; +double qPhysuudd1212; +double qPhysuudd1213; +double qPhysuudd1222; +double qPhysuudd1223; +double qPhysuudd1233; +double qPhysuudd1311; +double qPhysuudd1312; +double qPhysuudd1313; +double qPhysuudd1322; +double qPhysuudd1323; +double qPhysuudd1333; +double qPhysuudd2211; +double qPhysuudd2212; +double qPhysuudd2213; +double qPhysuudd2222; +double qPhysuudd2223; +double qPhysuudd2233; +double qPhysuudd2311; +double qPhysuudd2312; +double qPhysuudd2313; +double qPhysuudd2322; +double qPhysuudd2323; +double qPhysuudd2333; +double qPhysuudd3311; +double qPhysuudd3312; +double qPhysuudd3313; +double qPhysuudd3322; +double qPhysuudd3323; +double qPhysuudd3333; +double qud11; +double qud12; +double qud13; +double qud21; +double qud22; +double qud23; +double qud31; +double qud32; +double qud33; +double quu11; +double quu12; +double quu13; +double quu22; +double quu23; +double quu33; +double R11; +double R12; +double R13; +double R22; +double R23; +double R33; +double Rf11; +double Rf12; +double Rf13; +double Rf22; +double Rf23; +double Rf33; +double Rhat; +double Rphi11; +double Rphi12; +double Rphi13; +double Rphi22; +double Rphi23; +double Rphi33; +double sdown1; +double sdown2; +double sdown3; +double shat1; +double shat2; +double shat3; +double sup1; +double sup2; +double sup3; +double totdivbeta; +double trcdda; +double trcddf; + + + +chipsipower += +-4. +; + +shat1=xp/r;shat2=yp/r;shat3=zp/r; + +detginv += +1/(2.*g12*g13*g23 - g33*pow2(g12) + g22*(g11*g33 - pow2(g13)) - + g11*pow2(g23)) +; + +ginv11 += +detginv*(g22*g33 - pow2(g23)) +; + +ginv12 += +detginv*(g13*g23 - g12*g33) +; + +ginv13 += +detginv*(-(g13*g22) + g12*g23) +; + +ginv22 += +detginv*(g11*g33 - pow2(g13)) +; + +ginv23 += +detginv*(g12*g13 - g11*g23) +; + +ginv33 += +detginv*(g11*g22 - pow2(g12)) +; + +ADMginv11 += +chi*ginv11 +; + +ADMginv12 += +chi*ginv12 +; + +ADMginv13 += +chi*ginv13 +; + +ADMginv22 += +chi*ginv22 +; + +ADMginv23 += +chi*ginv23 +; + +ADMginv33 += +chi*ginv33 +; + +modshatARG += +2.*(ADMginv23*shat2*shat3 + shat1*(ADMginv12*shat2 + ADMginv13*shat3)) + + ADMginv11*pow2(shat1) + ADMginv22*pow2(shat2) + ADMginv33*pow2(shat3) +; + + +if (modshatARG<0.00001) { + printf("modshat is wrong (%e)\n",modshatARG); + modshatARG = 0.00001; + }oomodshat += +1/sqrt(modshatARG) +; + +sdown1 += +oomodshat*shat1 +; + +sdown2 += +oomodshat*shat2 +; + +sdown3 += +oomodshat*shat3 +; + +sup1 += +ADMginv11*sdown1 + ADMginv12*sdown2 + ADMginv13*sdown3 +; + +sup2 += +ADMginv12*sdown1 + ADMginv22*sdown2 + ADMginv23*sdown3 +; + +sup3 += +ADMginv13*sdown1 + ADMginv23*sdown2 + ADMginv33*sdown3 +; + +qud11 += +1. - sdown1*sup1 +; + +qud12 += +-(sdown2*sup1) +; + +qud13 += +-(sdown3*sup1) +; + +qud21 += +-(sdown1*sup2) +; + +qud22 += +1. - sdown2*sup2 +; + +qud23 += +-(sdown3*sup2) +; + +qud31 += +-(sdown1*sup3) +; + +qud32 += +-(sdown2*sup3) +; + +qud33 += +1. - sdown3*sup3 +; + +qdd11 += +g11/chi - pow2(sdown1) +; + +qdd12 += +g12/chi - sdown1*sdown2 +; + +qdd13 += +g13/chi - sdown1*sdown3 +; + +qdd22 += +g22/chi - pow2(sdown2) +; + +qdd23 += +g23/chi - sdown2*sdown3 +; + +qdd33 += +g33/chi - pow2(sdown3) +; + +quu11 += +ADMginv11 - pow2(sup1) +; + +quu12 += +ADMginv12 - sup1*sup2 +; + +quu13 += +ADMginv13 - sup1*sup3 +; + +quu22 += +ADMginv22 - pow2(sup2) +; + +quu23 += +ADMginv23 - sup2*sup3 +; + +quu33 += +ADMginv33 - pow2(sup3) +; + +qPhysuudd1111 += +-0.5*qdd11*quu11 + pow2(qud11) +; + +qPhysuudd1112 += +qud11*qud12 - 0.5*qdd12*quu11 +; + +qPhysuudd1113 += +qud11*qud13 - 0.5*qdd13*quu11 +; + +qPhysuudd1122 += +-0.5*qdd22*quu11 + pow2(qud12) +; + +qPhysuudd1123 += +qud12*qud13 - 0.5*qdd23*quu11 +; + +qPhysuudd1133 += +-0.5*qdd33*quu11 + pow2(qud13) +; + +qPhysuudd1211 += +qud11*qud21 - 0.5*qdd11*quu12 +; + +qPhysuudd1212 += +0.5*(qud12*qud21 + qud11*qud22 - qdd12*quu12) +; + +qPhysuudd1213 += +0.5*(qud13*qud21 + qud11*qud23 - qdd13*quu12) +; + +qPhysuudd1222 += +qud12*qud22 - 0.5*qdd22*quu12 +; + +qPhysuudd1223 += +0.5*(qud13*qud22 + qud12*qud23 - qdd23*quu12) +; + +qPhysuudd1233 += +qud13*qud23 - 0.5*qdd33*quu12 +; + +qPhysuudd1311 += +qud11*qud31 - 0.5*qdd11*quu13 +; + +qPhysuudd1312 += +0.5*(qud12*qud31 + qud11*qud32 - qdd12*quu13) +; + +qPhysuudd1313 += +0.5*(qud13*qud31 + qud11*qud33 - qdd13*quu13) +; + +qPhysuudd1322 += +qud12*qud32 - 0.5*qdd22*quu13 +; + +qPhysuudd1323 += +0.5*(qud13*qud32 + qud12*qud33 - qdd23*quu13) +; + +qPhysuudd1333 += +qud13*qud33 - 0.5*qdd33*quu13 +; + +qPhysuudd2211 += +-0.5*qdd11*quu22 + pow2(qud21) +; + +qPhysuudd2212 += +qud21*qud22 - 0.5*qdd12*quu22 +; + +qPhysuudd2213 += +qud21*qud23 - 0.5*qdd13*quu22 +; + +qPhysuudd2222 += +-0.5*qdd22*quu22 + pow2(qud22) +; + +qPhysuudd2223 += +qud22*qud23 - 0.5*qdd23*quu22 +; + +qPhysuudd2233 += +-0.5*qdd33*quu22 + pow2(qud23) +; + +qPhysuudd2311 += +qud21*qud31 - 0.5*qdd11*quu23 +; + +qPhysuudd2312 += +0.5*(qud22*qud31 + qud21*qud32 - qdd12*quu23) +; + +qPhysuudd2313 += +0.5*(qud23*qud31 + qud21*qud33 - qdd13*quu23) +; + +qPhysuudd2322 += +qud22*qud32 - 0.5*qdd22*quu23 +; + +qPhysuudd2323 += +0.5*(qud23*qud32 + qud22*qud33 - qdd23*quu23) +; + +qPhysuudd2333 += +qud23*qud33 - 0.5*qdd33*quu23 +; + +qPhysuudd3311 += +-0.5*qdd11*quu33 + pow2(qud31) +; + +qPhysuudd3312 += +qud31*qud32 - 0.5*qdd12*quu33 +; + +qPhysuudd3313 += +qud31*qud33 - 0.5*qdd13*quu33 +; + +qPhysuudd3322 += +-0.5*qdd22*quu33 + pow2(qud32) +; + +qPhysuudd3323 += +qud32*qud33 - 0.5*qdd23*quu33 +; + +qPhysuudd3333 += +-0.5*qdd33*quu33 + pow2(qud33) +; + +K += +Khat + 2.*Theta +; + +dK1 += +dKhat1 + 2.*dTheta1 +; + +dK2 += +dKhat2 + 2.*dTheta2 +; + +dK3 += +dKhat3 + 2.*dTheta3 +; + +gammado111 += +0.5*dg111 +; + +gammado112 += +0.5*dg211 +; + +gammado113 += +0.5*dg311 +; + +gammado122 += +-0.5*dg122 + dg212 +; + +gammado123 += +0.5*(-dg123 + dg213 + dg312) +; + +gammado133 += +-0.5*dg133 + dg313 +; + +gammado211 += +dg112 - 0.5*dg211 +; + +gammado212 += +0.5*dg122 +; + +gammado213 += +0.5*(dg123 - dg213 + dg312) +; + +gammado222 += +0.5*dg222 +; + +gammado223 += +0.5*dg322 +; + +gammado233 += +-0.5*dg233 + dg323 +; + +gammado311 += +dg113 - 0.5*dg311 +; + +gammado312 += +0.5*(dg123 + dg213 - dg312) +; + +gammado313 += +0.5*dg133 +; + +gammado322 += +dg223 - 0.5*dg322 +; + +gammado323 += +0.5*dg233 +; + +gammado333 += +0.5*dg333 +; + +gamma111 += +gammado111*ginv11 + gammado211*ginv12 + gammado311*ginv13 +; + +gamma112 += +gammado112*ginv11 + gammado212*ginv12 + gammado312*ginv13 +; + +gamma113 += +gammado113*ginv11 + gammado213*ginv12 + gammado313*ginv13 +; + +gamma122 += +gammado122*ginv11 + gammado222*ginv12 + gammado322*ginv13 +; + +gamma123 += +gammado123*ginv11 + gammado223*ginv12 + gammado323*ginv13 +; + +gamma133 += +gammado133*ginv11 + gammado233*ginv12 + gammado333*ginv13 +; + +gamma211 += +gammado111*ginv12 + gammado211*ginv22 + gammado311*ginv23 +; + +gamma212 += +gammado112*ginv12 + gammado212*ginv22 + gammado312*ginv23 +; + +gamma213 += +gammado113*ginv12 + gammado213*ginv22 + gammado313*ginv23 +; + +gamma222 += +gammado122*ginv12 + gammado222*ginv22 + gammado322*ginv23 +; + +gamma223 += +gammado123*ginv12 + gammado223*ginv22 + gammado323*ginv23 +; + +gamma233 += +gammado133*ginv12 + gammado233*ginv22 + gammado333*ginv23 +; + +gamma311 += +gammado111*ginv13 + gammado211*ginv23 + gammado311*ginv33 +; + +gamma312 += +gammado112*ginv13 + gammado212*ginv23 + gammado312*ginv33 +; + +gamma313 += +gammado113*ginv13 + gammado213*ginv23 + gammado313*ginv33 +; + +gamma322 += +gammado122*ginv13 + gammado222*ginv23 + gammado322*ginv33 +; + +gamma323 += +gammado123*ginv13 + gammado223*ginv23 + gammado323*ginv33 +; + +gamma333 += +gammado133*ginv13 + gammado233*ginv23 + gammado333*ginv33 +; + +Gfromg1 += +gamma111*ginv11 + gamma122*ginv22 + + 2.*(gamma112*ginv12 + gamma113*ginv13 + gamma123*ginv23) + gamma133*ginv33 +; + +Gfromg2 += +gamma211*ginv11 + gamma222*ginv22 + + 2.*(gamma212*ginv12 + gamma213*ginv13 + gamma223*ginv23) + gamma233*ginv33 +; + +Gfromg3 += +gamma311*ginv11 + gamma322*ginv22 + + 2.*(gamma312*ginv12 + gamma313*ginv13 + gamma323*ginv23) + gamma333*ginv33 +; + +dGfromgdu11 += +-((dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)* + Power(ginv12,3)) - (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + + dg111*dg333)*Power(ginv13,3) - 2.*Power(ginv11,3)*pow2(dg111) + + (ddg1111 - dg111*((8.*dg112 + 2.*dg211)*ginv12 + + (8.*dg113 + 2.*dg311)*ginv13) - + (dg113*(4.*dg112 + dg211) + dg112*dg311 + dg111*(dg213 + dg312))* + ginv23 - ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(dg113*dg311 + dg111*dg313 + 2.*pow2(dg113)))*pow2(ginv11) + + (ddg1122 + ddg1212 - (dg123*(8.*dg112 + 2.*dg211) + + dg113*(4.*dg122 + 2.*dg212) + dg122*dg311 + + 2.*(dg111*dg223 + dg112*(dg213 + dg312)) + dg111*dg322)*ginv13 - + (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + ginv23 - ginv22*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122)) - + ginv33*(dg123*(dg213 + dg312) + dg122*dg313 + dg113*(dg223 + dg322) + + dg112*dg323 + 2.*pow2(dg123)))*pow2(ginv12) + + (ddg1133 + ddg1313 - (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*ginv23 - + ginv22*(dg133*dg212 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*(dg233 + dg323) + 2.*pow2(dg123)) - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133)))*pow2(ginv13) \ ++ ginv13*(ddg1333*ginv33 + ginv22* + (ddg1223 - (dg133*dg222 + dg123*(4.*dg223 + dg322) + + dg122*(dg233 + dg323))*ginv23 - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*ginv33) + + ginv23*(ddg1233 + ddg1323 - + (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)*ginv33) - + (dg123*dg222 + dg122*dg223)*pow2(ginv22) - + (dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + + dg122*dg333)*pow2(ginv23) - 2.*dg133*dg333*pow2(ginv33)) + + ginv11*(ddg1313*ginv33 + ginv12* + (2.*ddg1112 + ddg1211 - + (dg113*(12.*dg112 + 3.*dg211) + 3.*dg112*dg311 + + dg111*(8.*dg123 + 3.*(dg213 + dg312)))*ginv13 - + (dg122*(4.*dg112 + dg211) + 6.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*dg211 + dg122*dg311 + + 4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213 + dg312)) + + dg111*(dg223 + dg322))*ginv23 - + (dg123*dg311 + dg113*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*dg112*dg313 + dg111*dg323)*ginv33) + + ginv22*(ddg1212 - (dg113*dg222 + 2.*(dg123*dg212 + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv23 - + (dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323)*ginv33) + + ginv13*(2.*ddg1113 + ddg1311 - + (dg123*(4.*dg112 + dg211) + dg111*dg223 + + 2.*(dg113*dg212 + dg112*(dg213 + dg312)))*ginv22 - + (dg133*dg211 + dg123*dg311 + + 4.*(dg113*(dg123 + dg213 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + dg323))*ginv23 - + (dg133*(4.*dg113 + dg311) + 6.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1213 + ddg1312 - + (dg133*(dg213 + dg312) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323) + dg112*dg333)*ginv33) - + (3.*dg112*dg211 + dg111*(4.*dg122 + 3.*dg212) + 6.*pow2(dg112))* + pow2(ginv12) - (3.*dg113*dg311 + dg111*(4.*dg133 + 3.*dg313) + + 6.*pow2(dg113))*pow2(ginv13) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (dg133*dg212 + dg123*(dg213 + dg312) + dg122*dg313 + + dg113*(dg223 + dg322) + dg112*(dg233 + dg323))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv12*(ddg1323*ginv33 + ginv22* + (ddg1222 - (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)*ginv23 - + (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33) + + ginv23*(ddg1223 + ddg1322 - + (dg133*(dg223 + dg322) + dg123*(dg233 + 4.*dg323) + dg122*dg333)* + ginv33) + ginv13*(2.*ddg1123 + ddg1213 + ddg1312 - + (dg113*dg222 + 4.*(dg123*(dg122 + dg212) + dg112*dg223) + + dg122*(dg213 + dg312) + dg112*dg322)*ginv22 - + (dg133*(4.*dg123 + dg213 + dg312) + 4.*dg123*dg313 + + dg113*(dg233 + 4.*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg122*dg313 + + dg113*dg322) + 4.* + (dg122*dg133 + dg113*dg223 + dg123*(dg213 + dg312) + + dg112*dg323 + pow2(dg123)))) - + (dg133*(4.*dg112 + dg211) + dg113*(8.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + pow2(ginv13) - 2.*dg122*dg222*pow2(ginv22) - + (dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + pow2(ginv23) - (dg133*dg323 + dg123*dg333)*pow2(ginv33)) +; + +dGfromgdu12 += +-((dg133*dg322 + 2.*(dg133*dg223 + dg123*(dg233 + dg323)) + dg122*dg333)* + Power(ginv23,3)) - 2.*(dg122*dg222*Power(ginv22,3) + + Power(ginv12,3)*(dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112)) + + (dg111*(dg112*ginv22 + dg113*ginv23) + ginv12*pow2(dg111))*pow2(ginv11)\ +) + (ddg1112 + ddg1211 - (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))*ginv13 - + (dg122*(6.*dg112 + 2.*dg211) + 6.*dg112*dg212 + 2.*dg111*dg222)* + ginv22 - (4.*(dg113*(dg122 + dg212) + dg112*(dg123 + dg213)) + + dg122*dg311 + 2.*(dg123*dg211 + dg111*dg223 + dg112*dg312) + + dg111*dg322)*ginv23 - + (dg123*dg311 + dg113*(2.*(dg123 + dg213) + dg312) + dg112*dg313 + + dg111*dg323)*ginv33)*pow2(ginv12) - + ((2.*(dg113*dg123 + dg112*dg133) + dg123*dg311 + dg113*dg312 + + dg112*dg313 + dg111*dg323)*ginv22 + + (dg133*(4.*dg113 + dg311) + 2.*dg113*dg313 + dg111*dg333)*ginv23)* + pow2(ginv13) + (ddg1222 - (4.*(dg123*dg222 + dg122*dg223) + + 2.*dg122*dg322)*ginv23 - + (dg123*(2.*dg223 + dg322) + dg122*dg323)*ginv33)*pow2(ginv22) + + (ddg1233 + ddg1323 - (dg133*(2.*dg233 + 3.*dg323) + 3.*dg123*dg333)* + ginv33)*pow2(ginv23) + ginv11* + (ginv23*(ddg1113 - 2.*dg113*(dg133 + dg313)*ginv33) + + ginv22*(ddg1112 - (dg112*(4.*dg123 + 2.*dg213) + + 2.*(dg113*(dg122 + dg212) + dg112*dg312))*ginv23 - + (dg113*(2.*dg123 + dg312) + dg112*dg313)*ginv33) + + ginv12*(ddg1111 - dg111*(6.*dg113 + 2.*dg311)*ginv13 - + (dg113*(8.*dg112 + 2.*dg211) + dg112*dg311 + + dg111*(2.*(dg123 + dg213) + dg312))*ginv23 - + ginv22*(2.*(dg112*dg211 + dg111*(dg122 + dg212)) + + 6.*pow2(dg112)) - ginv33* + (dg113*dg311 + dg111*dg313 + 2.*pow2(dg113))) - + ginv13*((dg112*(4.*dg113 + dg311) + dg111*(2.*dg123 + dg312))* + ginv22 + ginv23*(dg113*dg311 + dg111*(2.*dg133 + dg313) + + 4.*pow2(dg113))) - dg111*(6.*dg112 + 2.*dg211)*pow2(ginv12) - + 2.*dg112*(dg122 + dg212)*pow2(ginv22) - + (2.*(dg112*dg133 + dg113*(dg123 + dg213)) + dg113*dg312 + dg112*dg313)* + pow2(ginv23)) + ginv13*(ginv22* + (ddg1123 + ddg1312 - (dg133*(2.*dg123 + dg312) + + 2.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33 - + ginv23*(2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg113*dg223 + + dg112*dg233) + dg122*dg313 + dg113*dg322 + + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg123)))) + + ginv23*(ddg1133 + ddg1313 - + ginv33*(3.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))) - + (2.*(dg123*(dg122 + dg212) + dg112*dg223) + dg122*dg312 + + dg112*dg322)*pow2(ginv22) - + (dg133*(4.*dg123 + 2.*(dg213 + dg312)) + + 2.*(dg123*dg313 + dg113*(dg233 + dg323) + dg112*dg333))*pow2(ginv23)\ +) + ginv23*(ddg1333*ginv33 - 2.*dg133*dg333*pow2(ginv33)) + + ginv12*(ddg1313*ginv33 + ginv13* + (ddg1113 + ddg1311 - (2.* + (dg123*dg211 + dg113*(dg122 + dg212) + dg111*dg223) + + dg122*dg311 + dg112*(8.*dg123 + 2.*dg213 + 4.*dg312) + + dg111*dg322)*ginv22 - + (dg133*(4.*dg112 + 2.*dg211) + + dg113*(8.*dg123 + 4.*(dg213 + dg312)) + 4.*dg112*dg313 + + 2.*(dg123*dg311 + dg111*(dg233 + dg323)))*ginv23 - + (dg133*(2.*dg113 + dg311) + 4.*dg113*dg313 + dg111*dg333)*ginv33) + + ginv23*(ddg1123 + 2.*ddg1213 + ddg1312 - + (2.*(dg133*(dg123 + dg213) + dg113*dg233) + dg133*dg312 + + 4.*(dg123*dg313 + dg113*dg323) + dg112*dg333)*ginv33) + + ginv22*(ddg1122 + 2.*ddg1212 - + (4.*(dg122*dg213 + dg113*dg222) + + 6.*(dg123*(dg122 + dg212) + dg112*dg223) + + 3.*(dg122*dg312 + dg112*dg322))*ginv23 - + ginv33*(dg122*dg313 + dg113*dg322 + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + dg112*dg323 + + pow2(dg123)))) - + 2.*(dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113))*pow2(ginv13) - + (4.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))*pow2(ginv22) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*(dg133*(dg122 + dg212) + dg123*dg312 + dg122*dg313 + + dg113*dg322 + dg112*(dg233 + dg323) + pow2(dg123)))*pow2(ginv23) \ +- (dg133*dg313 + dg113*dg333)*pow2(ginv33)) + + ginv22*(ddg1323*ginv33 + ginv23* + (2.*ddg1223 + ddg1322 - (2.*(dg133*dg223 + dg123*dg233) + + dg133*dg322 + 6.*dg123*dg323 + dg122*dg333)*ginv33) - + (2.*(dg133*dg222 + dg122*dg233) + dg123*(6.*dg223 + 3.*dg322) + + 3.*dg122*dg323)*pow2(ginv23) - + (dg133*dg323 + dg123*dg333)*pow2(ginv33)) +; + +dGfromgdu13 += +-((dg133*dg222 + 2.*dg123*(dg223 + dg322) + dg122*(dg233 + 2.*dg323))* + Power(ginv23,3)) - 2.*(dg133*dg333*Power(ginv33,3) + + Power(ginv13,3)*(dg113*dg311 + dg111*(dg133 + dg313) + pow2(dg113)) + + (dg111*(dg112*ginv23 + dg113*ginv33) + ginv13*pow2(dg111))*pow2(ginv11)\ +) - ((dg122*(4.*dg112 + dg211) + 2.*dg112*dg212 + dg111*dg222)*ginv23 + + (2.*(dg113*dg122 + dg112*dg123) + dg123*dg211 + dg113*dg212 + + dg112*dg213 + dg111*dg223)*ginv33 + + 2.*ginv13*(dg112*dg211 + dg111*(dg122 + dg212) + pow2(dg112)))* + pow2(ginv12) + (ddg1113 + ddg1311 - + (dg123*(2.*dg112 + dg211) + dg113*dg212 + dg111*dg223 + + dg112*(dg213 + 2.*dg312))*ginv22 - + (dg133*dg211 + 2.*(dg113*dg213 + dg123*dg311) + + 4.*(dg113*(dg123 + dg312) + dg112*(dg133 + dg313)) + + dg111*(dg233 + 2.*dg323))*ginv23 - + (dg133*(6.*dg113 + 2.*dg311) + 6.*dg113*dg313 + 2.*dg111*dg333)*ginv33\ +)*pow2(ginv13) - (2.*dg122*dg222*ginv23 + + (dg123*dg222 + dg122*dg223)*ginv33)*pow2(ginv22) + + (ddg1223 + ddg1322 - (3.*(dg133*dg223 + dg123*dg233) + 6.*dg123*dg323 + + 2.*(dg133*dg322 + dg122*dg333))*ginv33)*pow2(ginv23) + + ddg1333*pow2(ginv33) + ginv11* + (ddg1113*ginv33 - ginv22*(2.*dg112*(dg122 + dg212)*ginv23 + + (dg113*dg212 + dg112*(2.*dg123 + dg213))*ginv33) + + ginv23*(ddg1112 - (dg113*(4.*dg123 + 2.*dg213) + + 2.*(dg113*dg312 + dg112*(dg133 + dg313)))*ginv33) - + ginv12*(dg111*(6.*dg112 + 2.*dg211)*ginv13 + + (dg113*(4.*dg112 + dg211) + dg111*(2.*dg123 + dg213))*ginv33 + + ginv23*(dg112*dg211 + dg111*(2.*dg122 + dg212) + 4.*pow2(dg112))) + + ginv13*(ddg1111 - (dg113*(8.*dg112 + dg211) + 2.*dg112*dg311 + + dg111*(dg213 + 2.*(dg123 + dg312)))*ginv23 - + ginv22*(dg112*dg211 + dg111*dg212 + 2.*pow2(dg112)) - + ginv33*(2.*(dg113*dg311 + dg111*(dg133 + dg313)) + 6.*pow2(dg113))) \ +- dg111*(6.*dg113 + 2.*dg311)*pow2(ginv13) - + (dg113*dg212 + dg112*dg213 + + 2.*(dg113*dg122 + dg112*(dg123 + dg312)))*pow2(ginv23) - + 2.*dg113*(dg133 + dg313)*pow2(ginv33)) + + ginv12*((ddg1123 + ddg1213)*ginv33 + + ginv13*(ddg1112 + ddg1211 - + (dg122*(2.*dg112 + dg211) + 4.*dg112*dg212 + dg111*dg222)*ginv22 - + (dg123*(8.*dg112 + 2.*dg211) + + 4.*(dg113*(dg122 + dg212) + dg112*(dg213 + dg312)) + + 2.*(dg122*dg311 + dg111*(dg223 + dg322)))*ginv23 - + (dg133*(2.*dg112 + dg211) + + dg113*(8.*dg123 + 4.*dg213 + 2.*dg312) + + 2.*(dg123*dg311 + dg112*dg313) + dg111*(dg233 + 2.*dg323))* + ginv33) - ginv22*((dg122*dg213 + dg113*dg222 + + 2.*(dg123*(dg122 + dg212) + dg112*dg223))*ginv33 + + ginv23*(3.*(dg122*dg212 + dg112*dg222) + 2.*pow2(dg122))) + + ginv23*(ddg1122 + ddg1212 - + ginv33*(dg133*(2.*dg122 + dg212) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322) + + dg112*(dg233 + 2.*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg123)))) - + (4.*(dg112*dg113 + dg111*dg123) + + 2.*(dg113*dg211 + dg112*dg311 + dg111*(dg213 + dg312)))* + pow2(ginv13) - (dg123*(4.*dg122 + 2.*dg212) + + 2.*(dg113*dg222 + dg122*(dg213 + dg312) + dg112*(dg223 + dg322)))* + pow2(ginv23) - (dg133*(2.*dg123 + dg213) + 2.*dg123*dg313 + + dg113*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv22*(ddg1223*ginv33 + ginv23* + (ddg1222 - (dg133*dg222 + dg123*(6.*dg223 + 2.*dg322) + + dg122*(dg233 + 2.*dg323))*ginv33) - + (3.*(dg123*dg222 + dg122*dg223) + 2.*dg122*dg322)*pow2(ginv23) - + (dg133*dg223 + dg123*(dg233 + 2.*dg323))*pow2(ginv33)) + + ginv23*((ddg1233 + 2.*ddg1323)*ginv33 - + (dg133*(2.*dg233 + 4.*dg323) + 4.*dg123*dg333)*pow2(ginv33)) + + ginv13*((ddg1133 + 2.*ddg1313)*ginv33 + + ginv23*(ddg1123 + ddg1213 + 2.*ddg1312 - + (dg133*(6.*dg123 + 3.*dg213 + 4.*dg312) + 6.*dg123*dg313 + + dg113*(3.*dg233 + 6.*dg323) + 4.*dg112*dg333)*ginv33) + + ginv22*(ddg1212 - (dg123*(2.*dg122 + 4.*dg212) + dg113*dg222 + + dg122*(dg213 + 2.*dg312) + dg112*(4.*dg223 + 2.*dg322))*ginv23 - + ginv33*(dg133*dg212 + dg112*(dg233 + 2.*dg323) + + 2.*(dg113*dg223 + dg123*(dg213 + dg312) + pow2(dg123)))) - + (dg122*dg212 + dg112*dg222)*pow2(ginv22) - + (4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg133*(dg122 + dg212) + dg123*dg213 + dg112*dg233 + + dg122*dg313 + dg113*(dg223 + dg322) + pow2(dg123)))*pow2(ginv23) \ +- (4.*(dg133*dg313 + dg113*dg333) + 2.*pow2(dg133))*pow2(ginv33)) +; + +dGfromgdu21 += +-((dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + dg211*dg333)* + Power(ginv13,3)) - 2.*(dg111*dg211*Power(ginv11,3) + + Power(ginv12,3)*(dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212))) + + (ddg1211 - (4.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + 2.*(dg112 + dg211)*dg212*ginv22 - + (2.*(dg113*dg212 + (dg112 + dg211)*dg213) + dg212*dg311 + + dg211*dg312)*ginv23 - + (dg213*(2.*dg113 + dg311) + dg211*dg313)*ginv33 - + ginv12*(4.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211)))*pow2(ginv11) \ ++ (ddg1222 + ddg2212 - (4.*(dg212*(dg123 + dg213) + + (dg112 + dg211)*dg223) + dg222*dg311 + + 2.*(dg122*dg213 + dg113*dg222 + dg212*dg312) + dg211*dg322)*ginv13 \ +- (2.*dg122 + 6.*dg212)*dg222*ginv22 - + ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(2.*(dg123 + dg213) + dg312) + dg222*dg313 + dg213*dg322 + + dg212*dg323)*ginv33)*pow2(ginv12) + + (ddg1233 + ddg2313 - (2.*((dg123 + dg213)*dg223 + dg212*dg233) + + dg223*dg312 + dg212*dg323)*ginv22 - + (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*ginv23 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33)*pow2(ginv13) + + ginv11*(ddg2313*ginv33 + ginv22* + (ddg2212 - (dg222*(2.*dg213 + dg312) + dg212*(4.*dg223 + dg322))* + ginv23 - (dg223*(2.*dg213 + dg312) + dg212*dg323)*ginv33) + + ginv23*(ddg2213 + ddg2312 - + (dg233*(2.*dg213 + dg312) + 2.*(dg223*dg313 + dg213*dg323) + + dg212*dg333)*ginv33) + + ginv13*(2.*ddg1213 + ddg2311 - + (2.*(dg112 + dg211)*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv22 - + (2.*(dg133*dg213 + dg113*dg233) + dg233*dg311 + 6.*dg213*dg313 + + dg211*dg333)*ginv33 - + ginv23*(2.*(dg133*dg212 + dg123*dg213 + dg113*dg223 + + (dg112 + dg211)*dg233) + dg223*dg311 + dg211*dg323 + + 4.*(dg213*dg312 + dg212*dg313 + pow2(dg213)))) + + ginv12*(2.*ddg1212 + ddg2211 - + (6.*(dg113*dg212 + dg112*dg213) + 4.*dg111*dg223 + + 3.*dg212*dg311 + dg211*(4.*dg123 + 6.*dg213 + 3.*dg312))*ginv13 \ +- (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + + (dg112 + dg211)*dg223) + dg222*dg311 + + dg212*(8.*dg213 + 4.*dg312) + dg211*dg322)*ginv23 - + ginv22*(2.*(dg122*dg212 + (dg112 + dg211)*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*dg311 + dg211*dg323 + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313 + + pow2(dg213)))) - + (6.*dg112*dg212 + dg211*(2.*dg122 + 6.*dg212) + 2.*dg111*dg222)* + pow2(ginv12) - (2.*(dg133*dg211 + dg111*dg233) + + dg213*(6.*dg113 + 3.*dg311) + 3.*dg211*dg313)*pow2(ginv13) - + 2.*dg212*dg222*pow2(ginv22) - + (2.*(dg213*dg223 + dg212*dg233) + dg223*dg312 + dg222*dg313 + + dg213*dg322 + dg212*dg323)*pow2(ginv23) - + (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv12*(ddg2323*ginv33 + ginv13* + (2.*ddg1223 + ddg2213 + ddg2312 - + (2.*((dg123 + dg213)*dg222 + dg122*dg223) + dg222*dg312 + + dg212*(8.*dg223 + dg322))*ginv22 - + (dg223*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322) + + 4.*dg212*(dg233 + dg323))*ginv23 - + (2.*(dg133*dg223 + (dg123 + dg213)*dg233) + dg233*dg312 + + 4.*(dg223*dg313 + dg213*dg323) + dg212*dg333)*ginv33) + + ginv23*(ddg2223 + ddg2322 - + (dg233*(2.*dg223 + dg322) + 4.*dg223*dg323 + dg222*dg333)*ginv33) + + ginv22*(ddg2222 - dg222*(6.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223))) - + (4.*(dg123*dg213 + dg113*dg223) + + 2.*((dg112 + dg211)*dg233 + dg223*dg311 + dg213*dg312 + + dg212*(dg133 + dg313) + dg211*dg323 + pow2(dg213)))*pow2(ginv13) \ +- 2.*(pow2(dg222)*pow2(ginv22) + + (dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223))*pow2(ginv23)) - + (dg233*dg323 + dg223*dg333)*pow2(ginv33)) + + ginv13*(ddg2333*ginv33 + ginv22* + (ddg2223 - 2.*dg223*(dg233 + dg323)*ginv33 - + ginv23*(dg223*dg322 + dg222*(2.*dg233 + dg323) + 4.*pow2(dg223))) + + ginv23*(ddg2233 + ddg2323 - + ginv33*(3.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))) - + (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg223*pow2(ginv22) + dg233*dg333*pow2(ginv33))\ +) +; + +dGfromgdu22 += +-((2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)* + Power(ginv12,3)) - (dg233*(4.*dg223 + dg322) + 2.*dg223*dg323 + + dg222*dg333)*Power(ginv23,3) - 2.*Power(ginv22,3)*pow2(dg222) - + (2.*dg111*dg211*ginv12 + (dg112*dg211 + dg111*dg212)*ginv22 + + (dg113*dg211 + dg111*dg213)*ginv23)*pow2(ginv11) + + (ddg1212 + ddg2211 - (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))*ginv13 - + (2.*(dg123*dg212 + dg122*dg213 + dg113*dg222 + dg112*dg223) + + dg222*dg311 + dg212*(8.*dg213 + 2.*dg312) + + dg211*(4.*dg223 + dg322))*ginv23 - + ginv22*(4.*dg211*dg222 + 3.*(dg122*dg212 + dg112*dg222) + + 6.*pow2(dg212)) - ginv33* + (dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + dg212*dg313 + + dg211*dg323 + 2.*pow2(dg213)))*pow2(ginv12) - + ((dg112*dg233 + dg223*(dg113 + dg311) + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + dg211*dg323)*ginv22 + + (dg233*dg311 + 2.*(dg113*dg233 + dg213*(dg133 + dg313)) + + dg211*dg333)*ginv23)*pow2(ginv13) + + (ddg2222 - dg222*(8.*dg223 + 2.*dg322)*ginv23 - + ginv33*(dg223*dg322 + dg222*dg323 + 2.*pow2(dg223)))*pow2(ginv22) + + (ddg2233 + ddg2323 - ginv33* + (3.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233)))*pow2(ginv23) + + ginv13*(ginv22*(ddg1223 + ddg2312 - + (dg122*dg233 + dg222*(dg133 + dg313) + dg213*dg322 + + 4.*(dg223*(dg123 + dg213 + dg312) + dg212*(dg233 + dg323)))* + ginv23 - (dg233*(dg123 + dg312) + dg223*(dg133 + 2.*dg313) + + 2.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv23*(ddg1233 + ddg2313 - + (dg233*(2.*dg133 + 3.*dg313) + 3.*dg213*dg333)*ginv33) - + ((dg122 + 4.*dg212)*dg223 + dg222*(dg123 + dg312) + dg212*dg322)* + pow2(ginv22) - (dg233*(4.*dg213 + 2.*dg312) + + 2.*(dg123*dg233 + dg223*(dg133 + dg313) + dg213*dg323 + + dg212*dg333))*pow2(ginv23)) + + ginv11*(-(ginv13*((2.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + + dg212*dg311 + dg211*(dg123 + dg312))*ginv22 + + (dg111*dg233 + dg213*(4.*dg113 + dg311) + dg211*(dg133 + dg313))* + ginv23)) + ginv12*(ddg1211 - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*ginv13 - + (6.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + dg212*dg311 + + dg211*(dg123 + 4.*dg213 + dg312))*ginv23 - + (dg213*(2.*dg113 + dg311) + dg211*dg313)*ginv33) + + ginv22*(ddg1212 - (dg122*dg213 + dg113*dg222 + 2.*dg112*dg223 + + dg212*(4.*dg213 + 2.*(dg123 + dg312)))*ginv23 - + (dg113*dg223 + dg213*(dg123 + dg312) + dg212*dg313)*ginv33) + + ginv23*(ddg1213 - (dg113*dg233 + dg213*(dg133 + 2.*dg313))*ginv33) - + (3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))*pow2(ginv12) - + (dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))*pow2(ginv22) - + (dg113*dg223 + dg112*dg233 + dg213*(dg123 + dg312) + + dg212*(dg133 + dg313) + 2.*pow2(dg213))*pow2(ginv23)) + + ginv23*(ddg2333*ginv33 - 2.*dg233*dg333*pow2(ginv33)) + + ginv12*(ddg2313*ginv33 + ginv22* + (ddg1222 + 2.*ddg2212 - + ((3.*dg122 + 12.*dg212)*dg223 + + dg222*(8.*dg213 + 3.*(dg123 + dg312)) + 3.*dg212*dg322)*ginv23 \ +- (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + dg222*dg313 + dg213*dg322 + + 2.*dg212*dg323)*ginv33) + + ginv23*(ddg1223 + 2.*ddg2213 + ddg2312 - + (dg233*(dg123 + 4.*dg213 + dg312) + dg223*(dg133 + 4.*dg313) + + 4.*dg213*dg323 + dg212*dg333)*ginv33) + + ginv13*(ddg1213 + ddg2311 - + (dg122*dg213 + dg222*(dg113 + dg311) + + 4.*((dg112 + dg211)*dg223 + dg212*(dg123 + dg213 + dg312)) + + dg211*dg322)*ginv22 - + (dg233*(dg113 + dg311) + dg213*(dg133 + 4.*dg313) + dg211*dg333)* + ginv33 - ginv23*(2.*(dg133*dg212 + dg112*dg233 + dg223*dg311 + + dg211*dg323) + 4.* + (dg113*dg223 + dg211*dg233 + dg213*(dg123 + dg312) + + dg212*dg313 + pow2(dg213)))) - + (dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + pow2(ginv13) - (2.*dg122 + 8.*dg212)*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(8.*dg213 + 2.*(dg123 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + pow2(ginv23) - (dg233*dg313 + dg213*dg333)*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (2.*ddg2223 + ddg2322 - (dg233*(4.*dg223 + dg322) + 6.*dg223*dg323 + + dg222*dg333)*ginv33) - + (3.*dg223*dg322 + dg222*(4.*dg233 + 3.*dg323) + 6.*pow2(dg223))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333)*pow2(ginv33)) +; + +dGfromgdu23 += +-((dg111*dg233 + 2.*dg213*(dg113 + dg311) + dg211*(dg133 + 2.*dg313))* + Power(ginv13,3)) - (2.*dg111*dg211*ginv13 + + (dg112*dg211 + dg111*dg212)*ginv23 + + (dg113*dg211 + dg111*dg213)*ginv33)*pow2(ginv11) - + ((2.*dg112*dg212 + dg211*(dg122 + 4.*dg212) + dg111*dg222)*ginv13 + + (dg122*dg213 + dg212*(dg123 + 2.*dg213) + dg113*dg222 + + (dg112 + 2.*dg211)*dg223)*ginv33 + + 2.*ginv23*(dg122*dg212 + (dg112 + dg211)*dg222 + pow2(dg212)))* + pow2(ginv12) + (ddg1213 + ddg2311 - + ((dg112 + 2.*dg211)*dg223 + dg212*(dg123 + 2.*(dg213 + dg312)))* + ginv22 - (3.*(dg133*dg213 + dg113*dg233) + 6.*dg213*dg313 + + 2.*(dg233*dg311 + dg211*dg333))*ginv33 - + ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg133*dg212 + dg123*dg213 + (dg112 + dg211)*dg233 + + dg223*(dg113 + dg311) + dg211*dg323 + pow2(dg213))))*pow2(ginv13) \ +- 2.*(dg233*dg333*Power(ginv33,3) + + Power(ginv23,3)*(dg223*dg322 + dg222*(dg233 + dg323) + pow2(dg223)) + + (dg222*dg223*ginv33 + ginv23*pow2(dg222))*pow2(ginv22)) + + (ddg2223 + ddg2322 - (dg233*(6.*dg223 + 2.*dg322) + 6.*dg223*dg323 + + 2.*dg222*dg333)*ginv33)*pow2(ginv23) + ddg2333*pow2(ginv33) + + ginv11*(ddg1213*ginv33 + ginv13* + (ddg1211 - 2.*(dg112 + dg211)*dg212*ginv22 - + (4.*(dg113*dg212 + dg112*dg213) + dg111*dg223 + 2.*dg212*dg311 + + dg211*(dg123 + 2.*(dg213 + dg312)))*ginv23 - + (dg111*dg233 + dg213*(6.*dg113 + 2.*dg311) + + dg211*(dg133 + 2.*dg313))*ginv33) - + ginv12*((4.*dg112*dg212 + dg211*(dg122 + 2.*dg212) + dg111*dg222)* + ginv23 + (dg211*(dg123 + 2.*dg213) + + 2.*(dg113*dg212 + dg112*dg213) + dg111*dg223)*ginv33 + + ginv13*(3.*(dg112*dg211 + dg111*dg212) + 2.*pow2(dg211))) - + ginv22*((dg212*(dg123 + 2.*dg213) + dg112*dg223)*ginv33 + + ginv23*(dg122*dg212 + dg112*dg222 + 2.*pow2(dg212))) + + ginv23*(ddg1212 - ginv33* + (dg112*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg113*dg223 + dg213*(dg123 + dg312) + pow2(dg213)))) - + (3.*(dg113*dg211 + dg111*dg213) + 2.*dg211*dg311)*pow2(ginv13) - + (dg122*dg213 + dg113*dg222 + dg112*dg223 + + dg212*(dg123 + 2.*(dg213 + dg312)))*pow2(ginv23) - + (dg113*dg233 + dg213*(dg133 + 2.*dg313))*pow2(ginv33)) + + ginv22*(ddg2223*ginv33 + ginv23* + (ddg2222 - ginv33*(2.*(dg223*dg322 + dg222*(dg233 + dg323)) + + 6.*pow2(dg223))) - dg222*(6.*dg223 + 2.*dg322)*pow2(ginv23) - + 2.*dg223*(dg233 + dg323)*pow2(ginv33)) + + ginv12*((ddg1223 + ddg2213)*ginv33 - + ginv22*((2.*dg122 + 6.*dg212)*dg222*ginv23 + + ((dg123 + 2.*dg213)*dg222 + (dg122 + 4.*dg212)*dg223)*ginv33) + + ginv23*(ddg1222 + ddg2212 - + ((dg122 + 2.*dg212)*dg233 + + dg223*(4.*dg123 + 8.*dg213 + 2.*dg312) + + dg222*(dg133 + 2.*dg313) + 2.*(dg213*dg322 + dg212*dg323))* + ginv33) + ginv13*(ddg1212 + ddg2211 - + (4.*(dg112 + dg211)*dg223 + + dg212*(8.*dg213 + 4.*(dg123 + dg312)) + + 2.*(dg122*dg213 + dg222*(dg113 + dg311) + dg211*dg322))*ginv23 \ +- ginv22*(dg122*dg212 + (dg112 + 2.*dg211)*dg222 + 4.*pow2(dg212)) - + ginv33*((dg112 + 2.*dg211)*dg233 + dg212*(dg133 + 2.*dg313) + + 2.*(dg223*dg311 + dg213*dg312 + dg211*dg323) + + 4.*(dg123*dg213 + dg113*dg223 + pow2(dg213)))) - + (2.*(dg123*dg211 + dg112*dg213 + dg111*dg223 + + dg212*(dg113 + dg311)) + dg211*(4.*dg213 + 2.*dg312))* + pow2(ginv13) - ((2.*dg122 + 4.*dg212)*dg223 + + dg222*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*dg322)* + pow2(ginv23) - ((dg123 + 2.*dg213)*dg233 + + dg223*(dg133 + 2.*dg313) + 2.*dg213*dg323)*pow2(ginv33)) + + ginv13*((ddg1233 + 2.*ddg2313)*ginv33 + + ginv22*(ddg2212 - ((dg122 + 8.*dg212)*dg223 + + dg222*(dg123 + 2.*(dg213 + dg312)) + 2.*dg212*dg322)*ginv23 - + (dg223*(4.*dg213 + 2.*(dg123 + dg312)) + 2.*dg212*(dg233 + dg323))* + ginv33) + ginv23*(ddg1223 + ddg2213 + 2.*ddg2312 - + (3.*(dg133*dg223 + dg123*dg233) + dg233*(6.*dg213 + 4.*dg312) + + 6.*(dg223*dg313 + dg213*dg323) + 4.*dg212*dg333)*ginv33) - + 2.*dg212*dg222*pow2(ginv22) - + ((dg122 + 4.*dg212)*dg233 + dg223*(2.*dg123 + 4.*(dg213 + dg312)) + + dg222*(dg133 + 2.*dg313) + 2.*dg213*dg322 + 4.*dg212*dg323)* + pow2(ginv23) - (dg233*(2.*dg133 + 4.*dg313) + 4.*dg213*dg333)* + pow2(ginv33)) + ginv23*((ddg2233 + 2.*ddg2323)*ginv33 - + (4.*(dg233*dg323 + dg223*dg333) + 2.*pow2(dg233))*pow2(ginv33)) +; + +dGfromgdu31 += +-((dg222*dg311 + dg211*dg322 + 2.*((dg122 + dg212)*dg312 + dg112*dg322))* + Power(ginv12,3)) - 2.*(dg111*dg311*Power(ginv11,3) + + Power(ginv13,3)*(dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313))) + + (ddg1311 - ((4.*dg112 + 2.*dg211)*dg311 + 4.*dg111*dg312)*ginv12 - + (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + (dg311*(dg213 + 2.*dg312) + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313))*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(4.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311)))*pow2(ginv11) \ ++ (ddg1322 + ddg2312 - (2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))* + ginv22 - ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*ginv23 - + (dg313*(dg223 + 2.*dg322) + (dg213 + 2.*(dg123 + dg312))*dg323)* + ginv33 - ginv13*(4.*(dg123*dg312 + dg112*dg323) + + 2.*(dg213*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + dg211*dg323 + pow2(dg312))))*pow2(ginv12) \ ++ (ddg1333 + ddg3313 - (dg233*dg312 + dg223*dg313 + + (dg213 + 2.*(dg123 + dg312))*dg323 + dg212*dg333)*ginv22 - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*ginv23 - + (2.*dg133 + 6.*dg313)*dg333*ginv33)*pow2(ginv13) + + ginv11*(ddg3313*ginv33 + ginv22* + (ddg2312 - (dg222*dg313 + dg213*dg322 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + (dg223*dg313 + (dg213 + 2.*dg312)*dg323)*ginv33) + + ginv23*(ddg2313 + ddg3312 - + (dg313*(dg233 + 4.*dg323) + (dg213 + 2.*dg312)*dg333)*ginv33) + + ginv12*(2.*ddg1312 + ddg2311 - + (dg311*(4.*dg123 + 3.*dg213 + 6.*dg312) + 3.*dg211*dg313 + + 6.*(dg113*dg312 + dg112*dg313) + 4.*dg111*dg323)*ginv13 - + (dg222*dg311 + (2.*dg122 + 6.*dg212)*dg312 + + (2.*dg112 + dg211)*dg322)*ginv22 - + (4.*dg312*dg313 + 2.*((dg123 + dg213)*dg313 + + (dg113 + dg311)*dg323))*ginv33 - + ginv23*((2.*dg123 + 4.*dg213)*dg312 + dg311*(dg223 + 2.*dg322) + + dg211*dg323 + 2.*(dg122*dg313 + dg113*dg322 + dg112*dg323) + + 4.*(dg212*dg313 + pow2(dg312)))) + + ginv13*(2.*ddg1313 + ddg3311 - + ((4.*dg213 + 8.*dg312)*dg313 + dg311*(dg233 + 2.*dg323) + + dg211*dg333 + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + + dg112*dg333))*ginv23 - + ginv22*(dg223*dg311 + dg211*dg323 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312))) - + ginv33*(2.*(dg133*dg313 + (dg113 + dg311)*dg333) + 6.*pow2(dg313))) \ +- ((2.*dg122 + 3.*dg212)*dg311 + (6.*dg112 + 3.*dg211)*dg312 + + 2.*dg111*dg322)*pow2(ginv12) - + (6.*dg113*dg313 + dg311*(2.*dg133 + 6.*dg313) + 2.*dg111*dg333)* + pow2(ginv13) - (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + (dg313*(dg223 + 2.*dg322) + dg213*dg323 + dg312*(dg233 + 2.*dg323) + + dg212*dg333)*pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv12*(ddg3323*ginv33 + ginv13* + (2.*ddg1323 + ddg2313 + ddg3312 - + (dg222*dg313 + (2.*dg123 + dg213)*dg322 + + dg312*(4.*dg223 + 2.*dg322) + (2.*dg122 + 4.*dg212)*dg323)* + ginv22 - ((4.*dg213 + 8.*dg312)*dg323 + + 4.*(dg313*(dg223 + dg322) + dg123*dg323) + + 2.*(dg233*dg312 + dg133*dg322 + (dg122 + dg212)*dg333))*ginv23 \ +- (dg313*(dg233 + 8.*dg323) + (dg213 + 2.*dg312)*dg333 + + 2.*(dg133*dg323 + dg123*dg333))*ginv33) + + ginv22*(ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))) + + ginv23*(ddg2323 + ddg3322 - + ginv33*(dg233*dg323 + (dg223 + 2.*dg322)*dg333 + 4.*pow2(dg323))) - + (dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg312)*dg313 + dg113*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg213*dg313 + dg112*dg333))*pow2(ginv13) - + (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + pow2(ginv23) - 2.*(dg222*dg322*pow2(ginv22) + + dg323*dg333*pow2(ginv33))) + + ginv13*(ddg3333*ginv33 + ginv23* + (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33) + + ginv22*(ddg2323 - (4.*dg223*dg323 + dg322*(dg233 + 2.*dg323) + + dg222*dg333)*ginv23 - + ginv33*(dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))) - + (dg223*dg322 + dg222*dg323)*pow2(ginv22) - + 2.*((dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))*pow2(ginv23) + + pow2(dg333)*pow2(ginv33))) +; + +dGfromgdu32 += +-(((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + Power(ginv12,3)) - 2.*(dg222*dg322*Power(ginv22,3) + + Power(ginv23,3)*(dg233*dg323 + (dg223 + dg322)*dg333 + pow2(dg323))) - + (2.*dg111*dg311*ginv12 + (dg112*dg311 + dg111*dg312)*ginv22 + + (dg113*dg311 + dg111*dg313)*ginv23)*pow2(ginv11) + + (ddg1312 + ddg2311 - (4.*dg311*dg312 + + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*ginv13 - + ((3.*dg122 + 6.*dg212)*dg312 + 3.*dg112*dg322 + + 2.*(dg222*dg311 + dg211*dg322))*ginv22 - + ((dg123 + 2.*(dg213 + dg312))*dg313 + (dg113 + 2.*dg311)*dg323)* + ginv33 - ginv23*(4.*(dg213*dg312 + dg212*dg313) + + 2.*(dg123*dg312 + dg122*dg313 + dg113*dg322 + + dg311*(dg223 + dg322) + (dg112 + dg211)*dg323 + pow2(dg312))))* + pow2(ginv12) - ((dg123*dg313 + dg312*(dg133 + 2.*dg313) + + (dg113 + 2.*dg311)*dg323 + dg112*dg333)*ginv22 + + 2.*ginv23*(dg133*dg313 + (dg113 + dg311)*dg333 + pow2(dg313)))* + pow2(ginv13) + (ddg2322 - 2.*(dg223 + dg322)*dg323*ginv33 - + ginv23*(4.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322)))*pow2(ginv22) \ ++ (ddg2333 + ddg3323 - (2.*dg233 + 6.*dg323)*dg333*ginv33)*pow2(ginv23) + + ginv11*(-(ginv13*((dg311*(dg123 + 2.*dg312) + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv22 + + (4.*dg113*dg313 + dg311*(dg133 + 2.*dg313) + dg111*dg333)*ginv23)\ +) + ginv12*(ddg1311 - ((dg122 + 2.*dg212)*dg311 + + (6.*dg112 + 2.*dg211)*dg312 + dg111*dg322)*ginv22 - + (dg311*(dg123 + 2.*(dg213 + dg312)) + 2.*dg211*dg313 + + 4.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv23 - + 2.*(dg113 + dg311)*dg313*ginv33 - + ginv13*(3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))) + + ginv22*(ddg1312 - ((dg123 + 2.*dg312)*dg313 + dg113*dg323)*ginv33 - + ginv23*(dg122*dg313 + dg113*dg322 + + 2.*((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323 + + pow2(dg312)))) + + ginv23*(ddg1313 - ginv33* + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))) - + ((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*pow2(ginv12) - + ((dg122 + 2.*dg212)*dg312 + dg112*dg322)*pow2(ginv22) - + (dg133*dg312 + (dg123 + 2.*(dg213 + dg312))*dg313 + dg113*dg323 + + dg112*dg333)*pow2(ginv23)) + + ginv13*(ginv23*(ddg1333 + ddg3313 - (2.*dg133 + 6.*dg313)*dg333*ginv33) + + ginv22*(ddg1323 + ddg3312 - + (dg133*dg322 + (4.*dg123 + 2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg313*(dg223 + dg322) + + dg212*dg333))*ginv23 - + ((dg133 + 4.*dg313)*dg323 + (dg123 + 2.*dg312)*dg333)*ginv33) - + (dg123*dg322 + dg122*dg323 + + 2.*(dg312*(dg223 + dg322) + dg212*dg323))*pow2(ginv22) - + (2.*(dg233*dg313 + dg133*dg323 + (dg123 + dg213)*dg333) + + 4.*(dg313*dg323 + dg312*dg333))*pow2(ginv23)) + + ginv12*(ddg3313*ginv33 + ginv22* + (ddg1322 + 2.*ddg2312 - + (4.*(dg222*dg313 + dg213*dg322) + + 3.*(dg123*dg322 + dg122*dg323) + + 6.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 - + ((2.*dg213 + 4.*dg312)*dg323 + + 2.*(dg313*(dg223 + dg322) + dg123*dg323))*ginv33) + + ginv23*(ddg1323 + 2.*ddg2313 + ddg3312 - + (dg133*dg323 + dg313*(2.*dg233 + 8.*dg323) + + (dg123 + 2.*(dg213 + dg312))*dg333)*ginv33) + + ginv13*(ddg1313 + ddg3311 - + (8.*dg312*dg313 + 4.* + ((dg123 + dg213)*dg313 + (dg113 + dg311)*dg323) + + 2.*(dg233*dg311 + dg133*dg312 + (dg112 + dg211)*dg333))*ginv23 \ +- ginv22*(dg122*dg313 + dg113*dg322 + + 2.*(dg213*dg312 + dg212*dg313 + dg311*(dg223 + dg322) + + dg211*dg323) + 4.*(dg123*dg312 + dg112*dg323 + pow2(dg312))) \ +- ginv33*(dg133*dg313 + (dg113 + 2.*dg311)*dg333 + 4.*pow2(dg313))) - + (2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)* + pow2(ginv13) - (2.*dg122*dg322 + 4.*(dg222*dg312 + dg212*dg322))* + pow2(ginv22) - (dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg213 + dg312)*dg323) + + dg122*dg333 + 2.*(dg233*dg312 + dg123*dg323 + dg212*dg333))* + pow2(ginv23) - 2.*dg313*dg333*pow2(ginv33)) + + ginv22*(ddg3323*ginv33 + ginv23* + (2.*ddg2323 + ddg3322 - + ginv33*(2.*(dg233*dg323 + (dg223 + dg322)*dg333) + 6.*pow2(dg323))) \ +- (6.*dg223*dg323 + dg322*(2.*dg233 + 6.*dg323) + 2.*dg222*dg333)* + pow2(ginv23) - 2.*dg323*dg333*pow2(ginv33)) + + ginv23*(ddg3333*ginv33 - 2.*pow2(dg333)*pow2(ginv33)) +; + +dGfromgdu33 += +-((2.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)* + Power(ginv13,3)) - (2.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + + dg222*dg333)*Power(ginv23,3) - 2.*Power(ginv33,3)*pow2(dg333) - + (2.*dg111*dg311*ginv13 + (dg112*dg311 + dg111*dg312)*ginv23 + + (dg113*dg311 + dg111*dg313)*ginv33)*pow2(ginv11) - + (((dg122 + 2.*dg212)*dg311 + 2.*(dg112 + dg211)*dg312 + dg111*dg322)* + ginv13 + (dg222*dg311 + dg211*dg322 + + 2.*((dg122 + dg212)*dg312 + dg112*dg322))*ginv23 + + (dg223*dg311 + (dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + + dg113*dg322 + (dg112 + dg211)*dg323)*ginv33)*pow2(ginv12) + + (ddg1313 + ddg3311 - ((2.*dg213 + 8.*dg312)*dg313 + + dg311*(dg233 + 4.*dg323) + dg211*dg333 + + 2.*(dg133*dg312 + dg123*dg313 + dg113*dg323 + dg112*dg333))*ginv23 \ +- ginv22*(dg223*dg311 + (dg123 + dg213)*dg312 + dg212*dg313 + + (dg112 + dg211)*dg323 + 2.*pow2(dg312)) - + ginv33*(4.*dg311*dg333 + 3.*(dg133*dg313 + dg113*dg333) + + 6.*pow2(dg313)))*pow2(ginv13) - + (2.*dg222*dg322*ginv23 + (dg223*dg322 + dg222*dg323)*ginv33)* + pow2(ginv22) + (ddg2323 + ddg3322 - + ginv33*(4.*dg322*dg333 + 3.*(dg233*dg323 + dg223*dg333) + + 6.*pow2(dg323)))*pow2(ginv23) + ddg3333*pow2(ginv33) + + ginv13*((ddg1333 + 2.*ddg3313)*ginv33 + + ginv22*(ddg2312 - (dg222*dg313 + (dg123 + dg213)*dg322 + + dg122*dg323 + 4.*(dg312*(dg223 + dg322) + dg212*dg323))*ginv23 \ +- (dg312*(dg233 + 4.*dg323) + 2.*(dg223*dg313 + (dg123 + dg213)*dg323) + + dg212*dg333)*ginv33) + + ginv23*(ddg1323 + ddg2313 + 2.*ddg3312 - + (12.*dg313*dg323 + (3.*dg213 + 8.*dg312)*dg333 + + 3.*(dg233*dg313 + dg133*dg323 + dg123*dg333))*ginv33) - + (dg222*dg312 + dg212*dg322)*pow2(ginv22) - + ((dg133 + 4.*dg313)*dg322 + (2.*dg213 + 8.*dg312)*dg323 + + dg122*dg333 + 2.*(dg233*dg312 + dg223*dg313 + dg123*dg323 + + dg212*dg333))*pow2(ginv23) - + (2.*dg133 + 8.*dg313)*dg333*pow2(ginv33)) + + ginv23*((ddg2333 + 2.*ddg3323)*ginv33 - + (2.*dg233 + 8.*dg323)*dg333*pow2(ginv33)) + + ginv12*((ddg1323 + ddg2313)*ginv33 - + ginv22*((2.*dg122*dg322 + 3.*(dg222*dg312 + dg212*dg322))*ginv23 + + (dg222*dg313 + (dg123 + dg213)*dg322 + dg122*dg323 + + 2.*(dg223*dg312 + dg212*dg323))*ginv33) + + ginv23*(ddg1322 + ddg2312 - + (dg233*dg312 + dg133*dg322 + + 4.*(dg313*(dg223 + dg322) + (dg123 + dg213 + dg312)*dg323) + + (dg122 + dg212)*dg333)*ginv33) + + ginv13*(ddg1312 + ddg2311 - + (dg222*dg311 + (dg122 + 4.*dg212)*dg312 + (dg112 + dg211)*dg322)* + ginv22 - (dg133*dg312 + dg311*(dg233 + 4.*dg323) + + 4.*((dg123 + dg213 + dg312)*dg313 + dg113*dg323) + + (dg112 + dg211)*dg333)*ginv33 - + ginv23*(2.*(dg223*dg311 + dg122*dg313 + dg113*dg322 + + dg211*dg323) + 4.* + ((dg123 + dg213)*dg312 + dg212*dg313 + dg311*dg322 + + dg112*dg323 + pow2(dg312)))) - + (4.*dg311*dg312 + 2.*((dg123 + dg213)*dg311 + dg113*dg312 + + (dg112 + dg211)*dg313 + dg111*dg323))*pow2(ginv13) - + ((2.*dg213 + 4.*dg312)*dg322 + + 2.*(dg223*dg312 + dg222*dg313 + dg123*dg322 + + (dg122 + dg212)*dg323))*pow2(ginv23) - + (dg133*dg323 + dg313*(dg233 + 4.*dg323) + (dg123 + dg213)*dg333)* + pow2(ginv33)) + ginv11*(ddg1313*ginv33 - + ginv12*(((3.*dg112 + 2.*dg211)*dg311 + 3.*dg111*dg312)*ginv13 + + ((dg122 + dg212)*dg311 + (4.*dg112 + dg211)*dg312 + dg111*dg322)* + ginv23 + ((dg123 + dg213)*dg311 + dg211*dg313 + + 2.*(dg113*dg312 + dg112*dg313) + dg111*dg323)*ginv33) - + ginv22*(((dg122 + 2.*dg212)*dg312 + dg112*dg322)*ginv23 + + ((dg123 + dg213)*dg312 + dg212*dg313 + dg112*dg323)*ginv33) + + ginv13*(ddg1311 - (dg212*dg311 + (2.*dg112 + dg211)*dg312)*ginv22 - + ((dg123 + dg213)*dg311 + 4.*(dg113 + dg311)*dg312 + + (4.*dg112 + dg211)*dg313 + dg111*dg323)*ginv23 - + (6.*dg113*dg313 + dg311*(dg133 + 4.*dg313) + dg111*dg333)*ginv33) + + ginv23*(ddg1312 - (dg312*(dg133 + 4.*dg313) + + 2.*((dg123 + dg213)*dg313 + dg113*dg323) + dg112*dg333)*ginv33) \ +- (3.*(dg113*dg311 + dg111*dg313) + 2.*pow2(dg311))*pow2(ginv13) - + ((dg123 + dg213)*dg312 + (dg122 + dg212)*dg313 + dg113*dg322 + + dg112*dg323 + 2.*pow2(dg312))*pow2(ginv23) - + (dg133*dg313 + dg113*dg333 + 2.*pow2(dg313))*pow2(ginv33)) + + ginv22*(ddg2323*ginv33 + ginv23* + (ddg2322 - (6.*dg223*dg323 + dg322*(dg233 + 4.*dg323) + dg222*dg333)* + ginv33) - (3.*(dg223*dg322 + dg222*dg323) + 2.*pow2(dg322))* + pow2(ginv23) - (dg233*dg323 + dg223*dg333 + 2.*pow2(dg323))* + pow2(ginv33)) +; + +R11 += +dG11*g11 + dG12*g12 + dG13*g13 + gammado111*Gfromg1 + gammado112*Gfromg2 + + gammado113*Gfromg3 + (-0.5*ddg1111 + 3.*gamma111*gammado111 + + 2.*(gamma211*gammado112 + gamma311*gammado113) + + gamma211*gammado211 + gamma311*gammado311)*ginv11 + + (-ddg1211 + 3.*(gamma112*gammado111 + gamma111*gammado112) + + 2.*(gamma212*gammado112 + gamma312*gammado113 + + gamma211*gammado122 + gamma311*gammado123) + gamma212*gammado211 + + gamma211*gammado212 + gamma312*gammado311 + gamma311*gammado312)*ginv12 \ ++ (-ddg1311 + 3.*(gamma113*gammado111 + gamma111*gammado113) + + 2.*(gamma213*gammado112 + gamma313*gammado113 + + gamma211*gammado123 + gamma311*gammado133) + gamma213*gammado211 + + gamma211*gammado213 + gamma313*gammado311 + gamma311*gammado313)*ginv13 \ ++ (-0.5*ddg2211 + 3.*gamma112*gammado112 + + 2.*(gamma212*gammado122 + gamma312*gammado123) + + gamma212*gammado212 + gamma312*gammado312)*ginv22 + + (-ddg2311 + 3.*(gamma113*gammado112 + gamma112*gammado113) + + 2.*(gamma213*gammado122 + (gamma212 + gamma313)*gammado123 + + gamma312*gammado133) + gamma213*gammado212 + gamma212*gammado213 + + gamma313*gammado312 + gamma312*gammado313)*ginv23 + + (-0.5*ddg3311 + 3.*gamma113*gammado113 + + 2.*(gamma213*gammado123 + gamma313*gammado133) + gamma213*gammado213 + + gamma313*gammado313)*ginv33 +; + +R12 += +0.5*(dG21*g11 + (dG11 + dG22)*g12 + dG23*g13 + dG12*g22 + dG13*g23 + + (gammado112 + gammado211)*Gfromg1 + + (gammado122 + gammado212)*Gfromg2 + (gammado123 + gammado213)*Gfromg3) \ ++ (-0.5*ddg1112 + gamma112*gammado111 + (gamma111 + gamma212)*gammado112 + + gamma312*gammado113 + gamma111*gammado211 + 2.*gamma211*gammado212 + + gamma311*(gammado213 + gammado312))*ginv11 + + (-ddg1212 + gamma122*gammado111 + (2.*gamma112 + gamma222)*gammado112 + + gamma322*gammado113 + (gamma111 + gamma212)*gammado122 + + gamma112*gammado211 + (gamma111 + 2.*gamma212)*gammado212 + + 2.*gamma211*gammado222 + + gamma312*(gammado123 + gammado213 + gammado312) + + gamma311*(gammado223 + gammado322))*ginv12 + + (-ddg1312 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + (gamma111 + gamma212)*gammado123 + + gamma312*gammado133 + gamma113*gammado211 + + (gamma111 + gamma313)*gammado213 + + 2.*(gamma213*gammado212 + gamma211*gammado223) + + gamma313*gammado312 + gamma311*(gammado233 + gammado323))*ginv13 + + (-0.5*ddg2212 + gamma122*gammado112 + (gamma112 + gamma222)*gammado122 + + gamma322*gammado123 + gamma112*gammado212 + 2.*gamma212*gammado222 + + gamma312*(gammado223 + gammado322))*ginv22 + + (-ddg2312 + gamma123*gammado112 + gamma122*gammado113 + + (gamma113 + gamma223)*gammado122 + + (gamma112 + gamma222 + gamma323)*gammado123 + gamma322*gammado133 + + gamma113*gammado212 + gamma112*gammado213 + + 2.*(gamma213*gammado222 + gamma212*gammado223) + + gamma313*(gammado223 + gammado322) + + gamma312*(gammado233 + gammado323))*ginv23 + + (-0.5*ddg3312 + gamma123*gammado113 + (gamma113 + gamma223)*gammado123 + + gamma323*gammado133 + gamma113*gammado213 + 2.*gamma213*gammado223 + + gamma313*(gammado233 + gammado323))*ginv33 +; + +R13 += +0.5*(dG31*g11 + dG32*g12 + (dG11 + dG33)*g13 + dG12*g23 + dG13*g33 + + (gammado113 + gammado311)*Gfromg1 + + (gammado123 + gammado312)*Gfromg2 + (gammado133 + gammado313)*Gfromg3) \ ++ (-0.5*ddg1113 + gamma113*gammado111 + gamma213*gammado112 + + (gamma111 + gamma313)*gammado113 + gamma111*gammado311 + + gamma211*(gammado213 + gammado312) + 2.*gamma311*gammado313)*ginv11 + + (-ddg1213 + gamma123*gammado111 + (gamma113 + gamma223)*gammado112 + + (gamma112 + gamma323)*gammado113 + gamma213*gammado122 + + (gamma111 + gamma313)*gammado123 + gamma112*gammado311 + + gamma111*gammado312 + gamma212*(gammado213 + gammado312) + + gamma211*(gammado223 + gammado322) + + 2.*(gamma312*gammado313 + gamma311*gammado323))*ginv12 + + (-ddg1313 + gamma133*gammado111 + gamma233*gammado112 + + (2.*gamma113 + gamma333)*gammado113 + + (gamma111 + gamma313)*gammado133 + gamma113*gammado311 + + gamma213*(gammado123 + gammado213 + gammado312) + + (gamma111 + 2.*gamma313)*gammado313 + + gamma211*(gammado233 + gammado323) + 2.*gamma311*gammado333)*ginv13 + + (-0.5*ddg2213 + gamma123*gammado112 + gamma223*gammado122 + + (gamma112 + gamma323)*gammado123 + gamma112*gammado312 + + gamma212*(gammado223 + gammado322) + 2.*gamma312*gammado323)*ginv22 + + (-ddg2313 + gamma133*gammado112 + gamma123*gammado113 + + gamma233*gammado122 + (gamma113 + gamma223 + gamma333)*gammado123 + + (gamma112 + gamma323)*gammado133 + gamma113*gammado312 + + gamma112*gammado313 + gamma213*(gammado223 + gammado322) + + gamma212*(gammado233 + gammado323) + + 2.*(gamma313*gammado323 + gamma312*gammado333))*ginv23 + + (-0.5*ddg3313 + gamma133*gammado113 + gamma233*gammado123 + + (gamma113 + gamma333)*gammado133 + gamma113*gammado313 + + gamma213*(gammado233 + gammado323) + 2.*gamma313*gammado333)*ginv33 +; + +R22 += +dG21*g12 + dG22*g22 + dG23*g23 + gammado212*Gfromg1 + gammado222*Gfromg2 + + gammado223*Gfromg3 + (-0.5*ddg1122 + + gamma112*(gammado112 + 2.*gammado211) + 3.*gamma212*gammado212 + + gamma312*(2.*gammado213 + gammado312))*ginv11 + + (-ddg1222 + gamma122*(gammado112 + 2.*gammado211) + + gamma112*(gammado122 + 2.*gammado212) + + 3.*(gamma222*gammado212 + gamma212*gammado222) + + 2.*(gamma322*gammado213 + gamma312*gammado223) + + gamma322*gammado312 + gamma312*gammado322)*ginv12 + + (-ddg1322 + gamma123*(gammado112 + 2.*gammado211) + + gamma112*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado212 + gamma212*gammado223) + + 2.*(gamma323*gammado213 + gamma312*gammado233) + + gamma323*gammado312 + gamma312*gammado323)*ginv13 + + (-0.5*ddg2222 + gamma122*(gammado122 + 2.*gammado212) + + 3.*gamma222*gammado222 + gamma322*(2.*gammado223 + gammado322))*ginv22 \ ++ (-ddg2322 + gamma123*(gammado122 + 2.*gammado212) + + gamma122*(gammado123 + 2.*gammado213) + + 3.*(gamma223*gammado222 + gamma222*gammado223) + + 2.*(gamma323*gammado223 + gamma322*gammado233) + + gamma323*gammado322 + gamma322*gammado323)*ginv23 + + (-0.5*ddg3322 + gamma123*(gammado123 + 2.*gammado213) + + 3.*gamma223*gammado223 + gamma323*(2.*gammado233 + gammado323))*ginv33 +; + +R23 += +0.5*(dG31*g12 + dG21*g13 + dG32*g22 + (dG22 + dG33)*g23 + dG23*g33 + + (gammado213 + gammado312)*Gfromg1 + + (gammado223 + gammado322)*Gfromg2 + (gammado233 + gammado323)*Gfromg3) \ ++ (-0.5*ddg1123 + gamma113*gammado211 + gamma213*gammado212 + + (gamma212 + gamma313)*gammado213 + + gamma112*(gammado113 + gammado311) + gamma212*gammado312 + + 2.*gamma312*gammado313)*ginv11 + + (-ddg1223 + gamma123*gammado211 + (gamma113 + gamma223)*gammado212 + + (gamma222 + gamma323)*gammado213 + gamma213*gammado222 + + (gamma212 + gamma313)*gammado223 + + gamma122*(gammado113 + gammado311) + gamma222*gammado312 + + gamma112*(gammado123 + gammado312) + gamma212*gammado322 + + 2.*(gamma322*gammado313 + gamma312*gammado323))*ginv12 + + (-ddg1323 + gamma133*gammado211 + gamma233*gammado212 + + (gamma113 + gamma223 + gamma333)*gammado213 + gamma213*gammado223 + + (gamma212 + gamma313)*gammado233 + + gamma123*(gammado113 + gammado311) + gamma223*gammado312 + + gamma112*(gammado133 + gammado313) + gamma212*gammado323 + + 2.*(gamma323*gammado313 + gamma312*gammado333))*ginv13 + + (-0.5*ddg2223 + gamma123*gammado212 + gamma223*gammado222 + + (gamma222 + gamma323)*gammado223 + + gamma122*(gammado123 + gammado312) + gamma222*gammado322 + + 2.*gamma322*gammado323)*ginv22 + + (-ddg2323 + gamma133*gammado212 + gamma233*gammado222 + + (2.*gamma223 + gamma333)*gammado223 + + (gamma222 + gamma323)*gammado233 + + gamma123*(gammado123 + gammado213 + gammado312) + + gamma122*(gammado133 + gammado313) + gamma223*gammado322 + + (gamma222 + 2.*gamma323)*gammado323 + 2.*gamma322*gammado333)*ginv23 + + (-0.5*ddg3323 + gamma133*gammado213 + gamma233*gammado223 + + (gamma223 + gamma333)*gammado233 + + gamma123*(gammado133 + gammado313) + gamma223*gammado323 + + 2.*gamma323*gammado333)*ginv33 +; + +R33 += +dG31*g13 + dG32*g23 + dG33*g33 + gammado313*Gfromg1 + gammado323*Gfromg2 + + gammado333*Gfromg3 + (-0.5*ddg1133 + + gamma113*(gammado113 + 2.*gammado311) + + gamma213*(gammado213 + 2.*gammado312) + 3.*gamma313*gammado313)*ginv11 \ ++ (-ddg1233 + gamma123*(gammado113 + 2.*gammado311) + + gamma113*(gammado123 + 2.*gammado312) + + gamma223*(gammado213 + 2.*gammado312) + + gamma213*(gammado223 + 2.*gammado322) + + 3.*(gamma323*gammado313 + gamma313*gammado323))*ginv12 + + (-ddg1333 + gamma133*(gammado113 + 2.*gammado311) + + gamma233*(gammado213 + 2.*gammado312) + + gamma113*(gammado133 + 2.*gammado313) + + gamma213*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado313 + gamma313*gammado333))*ginv13 + + (-0.5*ddg2233 + gamma123*(gammado123 + 2.*gammado312) + + gamma223*(gammado223 + 2.*gammado322) + 3.*gamma323*gammado323)*ginv22 \ ++ (-ddg2333 + gamma133*(gammado123 + 2.*gammado312) + + gamma123*(gammado133 + 2.*gammado313) + + gamma233*(gammado223 + 2.*gammado322) + + gamma223*(gammado233 + 2.*gammado323) + + 3.*(gamma333*gammado323 + gamma323*gammado333))*ginv23 + + (-0.5*ddg3333 + gamma133*(gammado133 + 2.*gammado313) + + gamma233*(gammado233 + 2.*gammado323) + 3.*gamma333*gammado333)*ginv33 +; + +ff += +chi +; + +oochipsipower += +1/chipsipower +; + +f += +oochipsipower*log(ff) +; + +psim4 += +exp(-4.*f) +; + +df1 += +(dchi1*oochipsipower)/chi +; + +df2 += +(dchi2*oochipsipower)/chi +; + +df3 += +(dchi3*oochipsipower)/chi +; + +ddf11 += +(ddchi11*oochipsipower)/chi - chipsipower*pow2(df1) +; + +ddf12 += +-(chipsipower*df1*df2) + (ddchi12*oochipsipower)/chi +; + +ddf13 += +-(chipsipower*df1*df3) + (ddchi13*oochipsipower)/chi +; + +ddf22 += +(ddchi22*oochipsipower)/chi - chipsipower*pow2(df2) +; + +ddf23 += +-(chipsipower*df2*df3) + (ddchi23*oochipsipower)/chi +; + +ddf33 += +(ddchi33*oochipsipower)/chi - chipsipower*pow2(df3) +; + +cddf11 += +ddf11 - df1*gamma111 - df2*gamma211 - df3*gamma311 +; + +cddf12 += +ddf12 - df1*gamma112 - df2*gamma212 - df3*gamma312 +; + +cddf13 += +ddf13 - df1*gamma113 - df2*gamma213 - df3*gamma313 +; + +cddf22 += +ddf22 - df1*gamma122 - df2*gamma222 - df3*gamma322 +; + +cddf23 += +ddf23 - df1*gamma123 - df2*gamma223 - df3*gamma323 +; + +cddf33 += +ddf33 - df1*gamma133 - df2*gamma233 - df3*gamma333 +; + +trcddf += +cddf11*ginv11 + cddf22*ginv22 + + 2.*(cddf12*ginv12 + cddf13*ginv13 + cddf23*ginv23) + cddf33*ginv33 +; + +Rphi11 += +-2.*(cddf11 + g11*trcddf) + (4. - 4.*g11*ginv11)*pow2(df1) - + g11*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi12 += +df1*df2*(4. - 8.*g12*ginv12) - 2.*(cddf12 + g12*trcddf) - + g12*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi13 += +df1*(4.*df3 - 8.*df2*g13*ginv12) - 2.*(cddf13 + g13*trcddf) - + g13*(8.*df3*(df1*ginv13 + df2*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + ginv33*pow2(df3))) +; + +Rphi22 += +-2.*(cddf22 + g22*trcddf) + (4. - 4.*g22*ginv22)*pow2(df2) - + g22*(8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv33*pow2(df3))) +; + +Rphi23 += +df2*(-8.*df1*g23*ginv12 + df3*(4. - 8.*g23*ginv23)) - + 2.*(cddf23 + g23*trcddf) - g23* + (8.*df1*df3*ginv13 + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2) + + ginv33*pow2(df3))) +; + +Rphi33 += +-2.*(cddf33 + g33*trcddf) - g33* + (8.*(df1*(df2*ginv12 + df3*ginv13) + df2*df3*ginv23) + + 4.*(ginv11*pow2(df1) + ginv22*pow2(df2))) + + (4. - 4.*g33*ginv33)*pow2(df3) +; + +Rf11 += +R11 + Rphi11 +; + +Rf12 += +R12 + Rphi12 +; + +Rf13 += +R13 + Rphi13 +; + +Rf22 += +R22 + Rphi22 +; + +Rf23 += +R23 + Rphi23 +; + +Rf33 += +R33 + Rphi33 +; + +Rhat += +psim4*(ginv11*Rf11 + ginv22*Rf22 + + 2.*(ginv12*Rf12 + ginv13*Rf13 + ginv23*Rf23) + ginv33*Rf33) +; + +cdda11 += +dda11 - da2*gamma211 - da3*gamma311 + + da1*(-gamma111 + df1*(-4. + 2.*g11*ginv11)) + + 2.*g11*((da2*df1 + da1*df2)*ginv12 + (da3*df1 + da1*df3)*ginv13 + + da2*df2*ginv22 + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +cdda12 += +dda12 - da1*gamma112 - da2*gamma212 - da3*gamma312 + + 2.*(-(da2*df1) - da1*df2 + g12* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda13 += +dda13 - da1*gamma113 - da2*gamma213 - da3*gamma313 + + 2.*(-(da3*df1) - da1*df3 + g13* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda22 += +dda22 - da1*gamma122 - da2*(4.*df2 + gamma222) - da3*gamma322 + + 2.*g22*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +cdda23 += +dda23 - da1*gamma123 - da2*gamma223 - da3*gamma323 + + 2.*(-(da3*df2) - da2*df3 + g23* + (da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33)) +; + +cdda33 += +dda33 - da1*gamma133 - da2*gamma233 - da3*(4.*df3 + gamma333) + + 2.*g33*(da1*df1*ginv11 + (da2*df1 + da1*df2)*ginv12 + + (da3*df1 + da1*df3)*ginv13 + da2*df2*ginv22 + + (da3*df2 + da2*df3)*ginv23 + da3*df3*ginv33) +; + +trcdda += +(cdda11*ginv11 + cdda22*ginv22 + + 2.*(cdda12*ginv12 + cdda13*ginv13 + cdda23*ginv23) + cdda33*ginv33)*psim4 +; + +AA11 += +2.*(A11*(A12*ginv12 + A13*ginv13) + A12*A13*ginv23) + ginv11*pow2(A11) + + ginv22*pow2(A12) + ginv33*pow2(A13) +; + +AA12 += +(A12*A13 + A11*A23)*ginv13 + A12*(A11*ginv11 + A22*ginv22) + + (A13*A22 + A12*A23)*ginv23 + A13*A23*ginv33 + ginv12*(A11*A22 + pow2(A12)) +; + +AA13 += +(A12*A13 + A11*A23)*ginv12 + A12*A23*ginv22 + (A13*A23 + A12*A33)*ginv23 + + A13*(A11*ginv11 + A33*ginv33) + ginv13*(A11*A33 + pow2(A13)) +; + +AA21 += +(A12*A13 + A11*A23)*ginv13 + A12*(A11*ginv11 + A22*ginv22) + + (A13*A22 + A12*A23)*ginv23 + A13*A23*ginv33 + ginv12*(A11*A22 + pow2(A12)) +; + +AA22 += +2.*(A12*(A22*ginv12 + A23*ginv13) + A22*A23*ginv23) + ginv11*pow2(A12) + + ginv22*pow2(A22) + ginv33*pow2(A23) +; + +AA23 += +A12*A13*ginv11 + (A13*A22 + A12*A23)*ginv12 + (A13*A23 + A12*A33)*ginv13 + + A23*(A22*ginv22 + A33*ginv33) + ginv23*(A22*A33 + pow2(A23)) +; + +AA31 += +(A12*A13 + A11*A23)*ginv12 + A12*A23*ginv22 + (A13*A23 + A12*A33)*ginv23 + + A13*(A11*ginv11 + A33*ginv33) + ginv13*(A11*A33 + pow2(A13)) +; + +AA32 += +A12*A13*ginv11 + (A13*A22 + A12*A23)*ginv12 + (A13*A23 + A12*A33)*ginv13 + + A23*(A22*ginv22 + A33*ginv33) + ginv23*(A22*A33 + pow2(A23)) +; + +AA33 += +2.*(A13*(A23*ginv12 + A33*ginv13) + A23*A33*ginv23) + ginv11*pow2(A13) + + ginv22*pow2(A23) + ginv33*pow2(A33) +; + +cdA111 += +dA111 - 2.*(A11*gamma111 + A12*gamma211 + A13*gamma311) +; + +cdA112 += +dA112 - A11*gamma112 - A22*gamma211 - A12*(gamma111 + gamma212) - + A23*gamma311 - A13*gamma312 +; + +cdA113 += +dA113 - A11*gamma113 - A23*gamma211 - A12*gamma213 - A33*gamma311 - + A13*(gamma111 + gamma313) +; + +cdA122 += +dA122 - 2.*(A12*gamma112 + A22*gamma212 + A23*gamma312) +; + +cdA123 += +dA123 - A13*gamma112 - A12*gamma113 - A22*gamma213 - A33*gamma312 - + A23*(gamma212 + gamma313) +; + +cdA133 += +dA133 - 2.*(A13*gamma113 + A23*gamma213 + A33*gamma313) +; + +cdA211 += +dA211 - 2.*(A11*gamma112 + A12*gamma212 + A13*gamma312) +; + +cdA212 += +dA212 - A11*gamma122 - A22*gamma212 - A12*(gamma112 + gamma222) - + A23*gamma312 - A13*gamma322 +; + +cdA213 += +dA213 - A11*gamma123 - A23*gamma212 - A12*gamma223 - A33*gamma312 - + A13*(gamma112 + gamma323) +; + +cdA222 += +dA222 - 2.*(A12*gamma122 + A22*gamma222 + A23*gamma322) +; + +cdA223 += +dA223 - A13*gamma122 - A12*gamma123 - A22*gamma223 - A33*gamma322 - + A23*(gamma222 + gamma323) +; + +cdA233 += +dA233 - 2.*(A13*gamma123 + A23*gamma223 + A33*gamma323) +; + +cdA311 += +dA311 - 2.*(A11*gamma113 + A12*gamma213 + A13*gamma313) +; + +cdA312 += +dA312 - A11*gamma123 - A22*gamma213 - A12*(gamma113 + gamma223) - + A23*gamma313 - A13*gamma323 +; + +cdA313 += +dA313 - A11*gamma133 - A23*gamma213 - A12*gamma233 - A33*gamma313 - + A13*(gamma113 + gamma333) +; + +cdA322 += +dA322 - 2.*(A12*gamma123 + A22*gamma223 + A23*gamma323) +; + +cdA323 += +dA323 - A13*gamma123 - A12*gamma133 - A22*gamma233 - A33*gamma323 - + A23*(gamma223 + gamma333) +; + +cdA333 += +dA333 - 2.*(A13*gamma133 + A23*gamma233 + A33*gamma333) +; + +divbeta += +db11 + db22 + db33 +; + +totdivbeta += +0.66666666666666666667*divbeta +; + +lieA11 += +beta1*dA111 + beta2*dA211 + beta3*dA311 + + 2.*(A11*db11 + A12*db12 + A13*db13) - A11*totdivbeta +; + +lieA12 += +beta1*dA112 + beta2*dA212 + beta3*dA312 + A22*db12 + A23*db13 + A11*db21 + + A13*db23 + A12*(db11 + db22 - totdivbeta) +; + +lieA13 += +beta1*dA113 + beta2*dA213 + beta3*dA313 + A23*db12 + A33*db13 + A11*db31 + + A12*db32 + A13*(db11 + db33 - totdivbeta) +; + +lieA22 += +beta1*dA122 + beta2*dA222 + beta3*dA322 + + 2.*(A12*db21 + A22*db22 + A23*db23) - A22*totdivbeta +; + +lieA23 += +beta1*dA123 + beta2*dA223 + beta3*dA323 + A13*db21 + A33*db23 + A12*db31 + + A22*db32 + A23*(db22 + db33 - totdivbeta) +; + +lieA33 += +beta1*dA133 + beta2*dA233 + beta3*dA333 + + 2.*(A13*db31 + A23*db32 + A33*db33) - A33*totdivbeta +; + +DTheta += +dTheta1*sup1 + dTheta2*sup2 + dTheta3*sup3 +; + +rACss += +2.*((A23*alpha*K + lieA23)*sup2*sup3 + + sup1*((A12*alpha*K + lieA12)*sup2 + A13*alpha*K*sup3) + + psim4*((-cdda23 + alpha*Rf23)*sup2*sup3 + + sup1*((-cdda12 + alpha*Rf12)*sup2 - cdda13*sup3))) + + 0.66666666666666666667*(g13*sup1 + g23*sup2)*sup3*trcdda + + sup1*(2.*(-(AA31*alpha) + lieA13)*sup3 + + 0.66666666666666666667*g12*sup2*trcdda) + + (lieA11 + psim4*(-cdda11 + alpha*Rf11) + + 0.33333333333333333333*g11*(-(alpha*Rhat) + trcdda))*pow2(sup1) + + (lieA22 - cdda22*psim4 + alpha* + (A22*K + psim4*Rf22 - 0.33333333333333333333*g22*Rhat) + + 0.33333333333333333333*g22*trcdda)*pow2(sup2) + + (lieA33 - cdda33*psim4 + alpha* + (A33*K + psim4*Rf33 - 0.33333333333333333333*g33*Rhat) + + 0.33333333333333333333*g33*trcdda)*pow2(sup3) + + alpha*(ginv11*((-2.*cdA111*chi + 3.*A11*dchi1)*sup1 + + (-2.*cdA112*chi + 3.*A12*dchi1)*sup2 + + (-2.*cdA113*chi + 3.*A13*dchi1)*sup3) + + ginv22*((-2.*cdA212*chi + 3.*A12*dchi2)*sup1 + + (-2.*cdA222*chi + 3.*A22*dchi2)*sup2 + + (-2.*cdA223*chi + 3.*A23*dchi2)*sup3) + + ginv33*((-2.*cdA313*chi + 3.*A13*dchi3)*sup1 + + (-2.*cdA323*chi + 3.*A23*dchi3)*sup2 + + (-2.*cdA333*chi + 3.*A33*dchi3)*sup3) + + chi*(-2.*DTheta + 1.3333333333333333333* + (dK1*sup1 + dK2*sup2 + dK3*sup3)) + + ginv12*((-2.*cdA212*chi + 3.*A12*dchi2)*sup2 + + (-2.*cdA213*chi + 3.*A13*dchi2)*sup3 - + 2.*chi*((cdA112 + cdA211)*sup1 + cdA122*sup2 + cdA123*sup3) + + 3.*((A12*dchi1 + A11*dchi2)*sup1 + dchi1*(A22*sup2 + A23*sup3))) + + ginv13*((-2.*cdA312*chi + 3.*A12*dchi3)*sup2 + + (-2.*cdA313*chi + 3.*A13*dchi3)*sup3 - + 2.*chi*((cdA113 + cdA311)*sup1 + cdA123*sup2 + cdA133*sup3) + + 3.*((A13*dchi1 + A11*dchi3)*sup1 + dchi1*(A23*sup2 + A33*sup3))) + + ginv23*((-2.*cdA322*chi + 3.*A22*dchi3)*sup2 + + (-2.*cdA323*chi + 3.*A23*dchi3)*sup3 - + 2.*chi*((cdA213 + cdA312)*sup1 + cdA223*sup2 + cdA233*sup3) + + 3.*((A13*dchi2 + A12*dchi3)*sup1 + dchi2*(A23*sup2 + A33*sup3))) + + (0.33333333333333333333*((dG11 - dGfromgdu11)*qud11 + + (dG12 - dGfromgdu12)*qud12 + (dG13 - dGfromgdu13)*qud13 + + (dG21 - dGfromgdu21)*qud21 + (dG22 - dGfromgdu22)*qud22 + + (dG23 - dGfromgdu23)*qud23 + (dG31 - dGfromgdu31)*qud31 + + (dG32 - dGfromgdu32)*qud32 + (dG33 - dGfromgdu33)*qud33) + + kappa1*((G1 - Gfromg1)*sdown1 + (G2 - Gfromg2)*sdown2 + + (G3 - Gfromg3)*sdown3) + + 0.66666666666666666667* + ((dGfromgdu21*sdown1 + dGfromgdu22*sdown2)*sup2 + + sdown3*((-dG13 + dGfromgdu13)*sup1 - dG23*sup2 - dG33*sup3) + + sdown1*((-dG11 + dGfromgdu11)*sup1 - dG21*sup2 - dG31*sup3 + + dGfromgdu31*sup3) + + sdown2*((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3 + + dGfromgdu32*sup3)))*pow2(chi) + + 0.66666666666666666667*sup2* + (-(Rhat*(g12*sup1 + g23*sup3)) + dGfromgdu23*sdown3*pow2(chi)) + + sup3*((2.*psim4*Rf13 - 0.66666666666666666667*g13*Rhat)*sup1 + + 0.66666666666666666667*dGfromgdu33*sdown3*pow2(chi)) + + (-2.*AA11 + A11*K)*pow2(sup1) - + 2.*((AA23 + AA32)*sup2*sup3 + sup1*((AA12 + AA21)*sup2 + AA13*sup3) + + AA22*pow2(sup2) + AA33*pow2(sup3))) +; + +rACsA1 += +(qud11*(lieA11 + alpha*chi*Rf11) + + qud21*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud31*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud11*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud21*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud31*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud11 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud21 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud31) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud11 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud21 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud31) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud11 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud21 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud31) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud11 + + (0.66666666666666666667*dK2 - dTheta2)*qud21 + + (0.66666666666666666667*dK3 - dTheta3)*qud31) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud21 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud31 - + chi*((cdA112 + cdA211)*qud11 + cdA122*qud21 + cdA123*qud31) + + 1.5*((A12*dchi1 + A11*dchi2)*qud11 + dchi1*(A22*qud21 + A23*qud31))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud21 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud31 - + chi*((cdA113 + cdA311)*qud11 + cdA123*qud21 + cdA133*qud31) + + 1.5*((A13*dchi1 + A11*dchi3)*qud11 + dchi1*(A23*qud21 + A33*qud31))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud21 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud31 - + chi*((cdA213 + cdA312)*qud11 + cdA223*qud21 + cdA233*qud31) + + 1.5*((A13*dchi2 + A12*dchi3)*qud11 + dchi2*(A23*qud21 + A33*qud31))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd11 + (G2 - Gfromg2)*qdd12 + + (G3 - Gfromg3)*qdd13) - dG13*qdd13*sup1 - dG21*qdd11*sup2 + + (dGfromgdu22*qdd12 - dG23*qdd13)*sup2 + + (dGfromgdu31*qdd11 + dGfromgdu32*qdd12 - dG33*qdd13)*sup3 + + qdd11*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd12* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud11 + 0.5*dGfromgdu13*qdd13*pow2(chi))) + + sup2*(chi*(-(cdda12*qud11) - cdda22*qud21 - cdda23*qud31 + + alpha*qud21*Rf22) + alpha* + (chi*(qud11*Rf12 + qud31*Rf23) + 0.5*dGfromgdu23*qdd13*pow2(chi))) + + sup3*(chi*(-(cdda13*qud11) - cdda23*qud21 - cdda33*qud31 + + alpha*qud21*Rf23) + alpha* + (chi*(qud11*Rf13 + qud31*Rf33) + 0.5*dGfromgdu33*qdd13*pow2(chi))) +; + +rACsA2 += +(qud12*(lieA11 + alpha*chi*Rf11) + + qud22*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud32*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud12*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud22*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud32*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud12 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud22 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud32) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud12 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud22 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud32) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud12 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud22 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud32) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud12 + + (0.66666666666666666667*dK2 - dTheta2)*qud22 + + (0.66666666666666666667*dK3 - dTheta3)*qud32) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud22 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud32 - + chi*((cdA112 + cdA211)*qud12 + cdA122*qud22 + cdA123*qud32) + + 1.5*((A12*dchi1 + A11*dchi2)*qud12 + dchi1*(A22*qud22 + A23*qud32))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud22 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud32 - + chi*((cdA113 + cdA311)*qud12 + cdA123*qud22 + cdA133*qud32) + + 1.5*((A13*dchi1 + A11*dchi3)*qud12 + dchi1*(A23*qud22 + A33*qud32))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud22 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud32 - + chi*((cdA213 + cdA312)*qud12 + cdA223*qud22 + cdA233*qud32) + + 1.5*((A13*dchi2 + A12*dchi3)*qud12 + dchi2*(A23*qud22 + A33*qud32))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd12 + (G2 - Gfromg2)*qdd22 + + (G3 - Gfromg3)*qdd23) - dG13*qdd23*sup1 - dG21*qdd12*sup2 + + (dGfromgdu22*qdd22 - dG23*qdd23)*sup2 + + (dGfromgdu31*qdd12 + dGfromgdu32*qdd22 - dG33*qdd23)*sup3 + + qdd12*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd22* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud12 + 0.5*dGfromgdu13*qdd23*pow2(chi))) + + sup2*(chi*(-(cdda12*qud12) - cdda22*qud22 - cdda23*qud32 + + alpha*qud22*Rf22) + alpha* + (chi*(qud12*Rf12 + qud32*Rf23) + 0.5*dGfromgdu23*qdd23*pow2(chi))) + + sup3*(chi*(-(cdda13*qud12) - cdda23*qud22 - cdda33*qud32 + + alpha*qud22*Rf23) + alpha* + (chi*(qud12*Rf13 + qud32*Rf33) + 0.5*dGfromgdu33*qdd23*pow2(chi))) +; + +rACsA3 += +(qud13*(lieA11 + alpha*chi*Rf11) + + qud23*(lieA12 + alpha*(-2.*AA12 + chi*Rf12)) + + qud33*(lieA13 + alpha*(-2.*AA13 + chi*Rf13)))*sup1 + + qud13*((-(cdda11*chi) + A11*alpha*K)*sup1 + lieA12*sup2 + + (A13*alpha*K + lieA13)*sup3 + + alpha*((-2.*AA21 + A12*K)*sup2 - 2.*AA31*sup3)) + + qud23*((-(cdda12*chi) + A12*alpha*K)*sup1 + lieA22*sup2 + + (A23*alpha*K + lieA23)*sup3 + + alpha*((-2.*AA22 + A22*K)*sup2 - 2.*AA32*sup3)) + + qud33*((-(cdda13*chi) + A13*alpha*K)*sup1 + lieA23*sup2 + + (A33*alpha*K + lieA33)*sup3 + + alpha*((-2.*AA23 + A23*K)*sup2 - 2.*AA33*sup3)) + + alpha*(ginv11*((-(cdA111*chi) + 1.5*A11*dchi1)*qud13 + + (-(cdA112*chi) + 1.5*A12*dchi1)*qud23 + + (-(cdA113*chi) + 1.5*A13*dchi1)*qud33) + + ginv22*((-(cdA212*chi) + 1.5*A12*dchi2)*qud13 + + (-(cdA222*chi) + 1.5*A22*dchi2)*qud23 + + (-(cdA223*chi) + 1.5*A23*dchi2)*qud33) + + ginv33*((-(cdA313*chi) + 1.5*A13*dchi3)*qud13 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud23 + + (-(cdA333*chi) + 1.5*A33*dchi3)*qud33) + + chi*((0.66666666666666666667*dK1 - dTheta1)*qud13 + + (0.66666666666666666667*dK2 - dTheta2)*qud23 + + (0.66666666666666666667*dK3 - dTheta3)*qud33) + + ginv12*((-(cdA212*chi) + 1.5*A12*dchi2)*qud23 + + (-(cdA213*chi) + 1.5*A13*dchi2)*qud33 - + chi*((cdA112 + cdA211)*qud13 + cdA122*qud23 + cdA123*qud33) + + 1.5*((A12*dchi1 + A11*dchi2)*qud13 + dchi1*(A22*qud23 + A23*qud33))\ +) + ginv13*((-(cdA312*chi) + 1.5*A12*dchi3)*qud23 + + (-(cdA313*chi) + 1.5*A13*dchi3)*qud33 - + chi*((cdA113 + cdA311)*qud13 + cdA123*qud23 + cdA133*qud33) + + 1.5*((A13*dchi1 + A11*dchi3)*qud13 + dchi1*(A23*qud23 + A33*qud33))\ +) + ginv23*((-(cdA322*chi) + 1.5*A22*dchi3)*qud23 + + (-(cdA323*chi) + 1.5*A23*dchi3)*qud33 - + chi*((cdA213 + cdA312)*qud13 + cdA223*qud23 + cdA233*qud33) + + 1.5*((A13*dchi2 + A12*dchi3)*qud13 + dchi2*(A23*qud23 + A33*qud33))\ +) + 0.5*(kappa1*((G1 - Gfromg1)*qdd13 + (G2 - Gfromg2)*qdd23 + + (G3 - Gfromg3)*qdd33) - dG13*qdd33*sup1 - dG21*qdd13*sup2 + + (dGfromgdu22*qdd23 - dG23*qdd33)*sup2 + + (dGfromgdu31*qdd13 + dGfromgdu32*qdd23 - dG33*qdd33)*sup3 + + qdd13*((-dG11 + dGfromgdu11)*sup1 + dGfromgdu21*sup2 - + dG31*sup3) + qdd23* + ((-dG12 + dGfromgdu12)*sup1 - dG22*sup2 - dG32*sup3))*pow2(chi) + + sup1*(-2.*AA11*qud13 + 0.5*dGfromgdu13*qdd33*pow2(chi))) + + sup2*(chi*(-(cdda12*qud13) - cdda22*qud23 - cdda23*qud33 + + alpha*qud23*Rf22) + alpha* + (chi*(qud13*Rf12 + qud33*Rf23) + 0.5*dGfromgdu23*qdd33*pow2(chi))) + + sup3*(chi*(-(cdda13*qud13) - cdda23*qud23 - cdda33*qud33 + + alpha*qud23*Rf23) + alpha* + (chi*(qud13*Rf13 + qud33*Rf33) + 0.5*dGfromgdu33*qdd33*pow2(chi))) +; + +rACABTF11 += +-(qPhysuudd1211*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3311*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1111*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1211* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1311*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2211*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2311*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1311 + AA22*qPhysuudd2211 + AA23*qPhysuudd2311 + + AA33*qPhysuudd3311 + qPhysuudd1111*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1311 + + (0.5*(A12*dchi1*qPhysuudd1111 + A23*dchi3*qPhysuudd3311))/chi)* + sup2) - qPhysuudd3311*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1211*sup3 + + qPhysuudd1211*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1311*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2211* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2311*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2311*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1211 + A13*dchi2*qPhysuudd1311)*sup2 + + (A12*dchi3*qPhysuudd1211 - + 0.5*dchi1*(A13*qPhysuudd1111 + A23*qPhysuudd1211))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1211 - + dchi3*(A11*qPhysuudd1311 + A12*qPhysuudd2311) + + dchi1*(A22*qPhysuudd2211 + A33*qPhysuudd3311))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1311) - + A22*dchi3*qPhysuudd2311 + + dchi2*(A11*qPhysuudd1111 + A33*qPhysuudd3311))*sup2 + + (-(A33*dchi1*qPhysuudd1311) + + A13*(-(dchi2*qPhysuudd1211) + dchi3*qPhysuudd1311) + + dchi3*(A11*qPhysuudd1111 + A22*qPhysuudd2211) + + A23*(-(dchi2*qPhysuudd2211) + dchi3*qPhysuudd2311))*sup3))/chi) +; + +rACABTF12 += +-(qPhysuudd1212*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3312*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1112*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1212* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1312*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2212*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2312*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1312 + AA22*qPhysuudd2212 + AA23*qPhysuudd2312 + + AA33*qPhysuudd3312 + qPhysuudd1112*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1312 + + (0.5*(A12*dchi1*qPhysuudd1112 + A23*dchi3*qPhysuudd3312))/chi)* + sup2) - qPhysuudd3312*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1212*sup3 + + qPhysuudd1212*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1312*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2212* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2312*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2312*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1212 + A13*dchi2*qPhysuudd1312)*sup2 + + (A12*dchi3*qPhysuudd1212 - + 0.5*dchi1*(A13*qPhysuudd1112 + A23*qPhysuudd1212))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1212 - + dchi3*(A11*qPhysuudd1312 + A12*qPhysuudd2312) + + dchi1*(A22*qPhysuudd2212 + A33*qPhysuudd3312))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1312) - + A22*dchi3*qPhysuudd2312 + + dchi2*(A11*qPhysuudd1112 + A33*qPhysuudd3312))*sup2 + + (-(A33*dchi1*qPhysuudd1312) + + A13*(-(dchi2*qPhysuudd1212) + dchi3*qPhysuudd1312) + + dchi3*(A11*qPhysuudd1112 + A22*qPhysuudd2212) + + A23*(-(dchi2*qPhysuudd2212) + dchi3*qPhysuudd2312))*sup3))/chi) +; + +rACABTF13 += +-(qPhysuudd1213*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3313*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1113*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1213* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1313*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2213*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2313*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1313 + AA22*qPhysuudd2213 + AA23*qPhysuudd2313 + + AA33*qPhysuudd3313 + qPhysuudd1113*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1313 + + (0.5*(A12*dchi1*qPhysuudd1113 + A23*dchi3*qPhysuudd3313))/chi)* + sup2) - qPhysuudd3313*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1213*sup3 + + qPhysuudd1213*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1313*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2213* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2313*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2313*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1213 + A13*dchi2*qPhysuudd1313)*sup2 + + (A12*dchi3*qPhysuudd1213 - + 0.5*dchi1*(A13*qPhysuudd1113 + A23*qPhysuudd1213))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1213 - + dchi3*(A11*qPhysuudd1313 + A12*qPhysuudd2313) + + dchi1*(A22*qPhysuudd2213 + A33*qPhysuudd3313))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1313) - + A22*dchi3*qPhysuudd2313 + + dchi2*(A11*qPhysuudd1113 + A33*qPhysuudd3313))*sup2 + + (-(A33*dchi1*qPhysuudd1313) + + A13*(-(dchi2*qPhysuudd1213) + dchi3*qPhysuudd1313) + + dchi3*(A11*qPhysuudd1113 + A22*qPhysuudd2213) + + A23*(-(dchi2*qPhysuudd2213) + dchi3*qPhysuudd2313))*sup3))/chi) +; + +rACABTF22 += +-(qPhysuudd1222*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3322*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1122*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1222* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1322*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2222*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2322*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1322 + AA22*qPhysuudd2222 + AA23*qPhysuudd2322 + + AA33*qPhysuudd3322 + qPhysuudd1122*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1322 + + (0.5*(A12*dchi1*qPhysuudd1122 + A23*dchi3*qPhysuudd3322))/chi)* + sup2) - qPhysuudd3322*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1222*sup3 + + qPhysuudd1222*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1322*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2222* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2322*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2322*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1222 + A13*dchi2*qPhysuudd1322)*sup2 + + (A12*dchi3*qPhysuudd1222 - + 0.5*dchi1*(A13*qPhysuudd1122 + A23*qPhysuudd1222))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1222 - + dchi3*(A11*qPhysuudd1322 + A12*qPhysuudd2322) + + dchi1*(A22*qPhysuudd2222 + A33*qPhysuudd3322))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1322) - + A22*dchi3*qPhysuudd2322 + + dchi2*(A11*qPhysuudd1122 + A33*qPhysuudd3322))*sup2 + + (-(A33*dchi1*qPhysuudd1322) + + A13*(-(dchi2*qPhysuudd1222) + dchi3*qPhysuudd1322) + + dchi3*(A11*qPhysuudd1122 + A22*qPhysuudd2222) + + A23*(-(dchi2*qPhysuudd2222) + dchi3*qPhysuudd2322))*sup3))/chi) +; + +rACABTF23 += +-(qPhysuudd1223*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3323*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1123*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1223* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1323*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2223*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2323*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1323 + AA22*qPhysuudd2223 + AA23*qPhysuudd2323 + + AA33*qPhysuudd3323 + qPhysuudd1123*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1323 + + (0.5*(A12*dchi1*qPhysuudd1123 + A23*dchi3*qPhysuudd3323))/chi)* + sup2) - qPhysuudd3323*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1223*sup3 + + qPhysuudd1223*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1323*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2223* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2323*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2323*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1223 + A13*dchi2*qPhysuudd1323)*sup2 + + (A12*dchi3*qPhysuudd1223 - + 0.5*dchi1*(A13*qPhysuudd1123 + A23*qPhysuudd1223))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1223 - + dchi3*(A11*qPhysuudd1323 + A12*qPhysuudd2323) + + dchi1*(A22*qPhysuudd2223 + A33*qPhysuudd3323))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1323) - + A22*dchi3*qPhysuudd2323 + + dchi2*(A11*qPhysuudd1123 + A33*qPhysuudd3323))*sup2 + + (-(A33*dchi1*qPhysuudd1323) + + A13*(-(dchi2*qPhysuudd1223) + dchi3*qPhysuudd1323) + + dchi3*(A11*qPhysuudd1123 + A22*qPhysuudd2223) + + A23*(-(dchi2*qPhysuudd2223) + dchi3*qPhysuudd2323))*sup3))/chi) +; + +rACABTF33 += +-(qPhysuudd1233*(2.*cdda12*chi + alpha*(AA21 + cdA112*sup1))) + + qPhysuudd3333*(-(cdda33*chi) + lieA33 + + alpha*(0.66666666666666666667*A33*K + cdA313*sup1 + cdA323*sup2)) + + qPhysuudd1133*(-(cdda11*chi) + lieA11 + + alpha*(-AA11 + 0.66666666666666666667*A11*K + cdA112*sup2 + + cdA113*sup3)) + qPhysuudd1233* + (2.*lieA12 + alpha*(-AA12 + 1.3333333333333333333*A12*K + cdA211*sup1 + + cdA122*sup2 + cdA123*sup3)) + + qPhysuudd1333*(2.*(-(cdda13*chi) + lieA13) + + alpha*(-AA31 + 1.3333333333333333333*A13*K + cdA311*sup1 + + cdA123*sup2 + cdA133*sup3)) + + qPhysuudd2233*(-(cdda22*chi) + lieA22 + + alpha*(0.66666666666666666667*A22*K + cdA212*sup1 + cdA223*sup3)) + + qPhysuudd2333*(2.*(-(cdda23*chi) + lieA23) + + alpha*(-AA32 + 1.3333333333333333333*A23*K + cdA213*sup1 + + cdA322*sup2 + cdA233*sup3)) - + alpha*(AA13*qPhysuudd1333 + AA22*qPhysuudd2233 + AA23*qPhysuudd2333 + + AA33*qPhysuudd3333 + qPhysuudd1133*(cdA211*sup2 + cdA311*sup3)) + + alpha*(-((2.*cdA213*qPhysuudd1333 + + (0.5*(A12*dchi1*qPhysuudd1133 + A23*dchi3*qPhysuudd3333))/chi)* + sup2) - qPhysuudd3333*((cdA133 + (0.5*A13*dchi3)/chi)*sup1 + + cdA233*sup2) - 2.*cdA312*qPhysuudd1233*sup3 + + qPhysuudd1233*((-cdA212 + (0.5*A12*dchi2)/chi)*sup2 + cdA213*sup3) + + qPhysuudd1333*((-cdA113 + (0.5*A13*dchi1)/chi)*sup1 + cdA312*sup2 - + cdA313*sup3) - qPhysuudd2233* + ((cdA122 + (0.5*A12*dchi2)/chi)*sup1 + cdA322*sup3) + + qPhysuudd2333*((cdA312 + (A23*dchi1)/chi)*sup1 + + (0.5*A23*dchi2*sup2)/chi - cdA323*sup3) - + qPhysuudd2333*((2.*cdA123 + (0.5*A13*dchi2)/chi)*sup1 + cdA223*sup2 + + (0.5*A33*dchi2*sup3)/chi) + + ((-0.5*A22*dchi1*qPhysuudd1233 + A13*dchi2*qPhysuudd1333)*sup2 + + (A12*dchi3*qPhysuudd1233 - + 0.5*dchi1*(A13*qPhysuudd1133 + A23*qPhysuudd1233))*sup3 + + 0.5*(((A12*dchi1 - A11*dchi2)*qPhysuudd1233 - + dchi3*(A11*qPhysuudd1333 + A12*qPhysuudd2333) + + dchi1*(A22*qPhysuudd2233 + A33*qPhysuudd3333))*sup1 + + (-((A23*dchi1 + A12*dchi3)*qPhysuudd1333) - + A22*dchi3*qPhysuudd2333 + + dchi2*(A11*qPhysuudd1133 + A33*qPhysuudd3333))*sup2 + + (-(A33*dchi1*qPhysuudd1333) + + A13*(-(dchi2*qPhysuudd1233) + dchi3*qPhysuudd1333) + + dchi3*(A11*qPhysuudd1133 + A22*qPhysuudd2233) + + A23*(-(dchi2*qPhysuudd2233) + dchi3*qPhysuudd2333))*sup3))/chi) +; + +} /* function */ + +} diff --git a/AMSS_NCKU_source/cpm_map.C b/AMSS_NCKU_source/cpm_map.C new file mode 100644 index 0000000..be80f8a --- /dev/null +++ b/AMSS_NCKU_source/cpm_map.C @@ -0,0 +1,93 @@ +#include +#include + +#include "stdc.h" +#include "util.h" +#include "cpm_map.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + + template + cpm_map::cpm_map(int min_i_in, int max_i_in, + fp_t fixed_point) + : min_i_(min_i_in), max_i_(max_i_in), + map_is_plus_(false) + { + const fp_t d_offset = 2.0 * fixed_point; + if (!fuzzy::is_integer(d_offset)) + then error_exit(ERROR_EXIT, + "***** cpm_map::cpm_map (mirror):\n" + " fixed_point=%g isn't (fuzzily) integral or half-integral!\n", + double(fixed_point)); /*NOTREACHED*/ + + offset_ = round::to_integer(d_offset); + + assert( + map_unchecked(fuzzy::floor(fixed_point)) == + fuzzy::ceiling(fixed_point)); + } + + //****************************************************************************** + + // + // This function constructs a generic cpm_map object, with the mapping + // specified by a sample point sample_i --> sample_j and by sign. + // The sample point need not be in the map's domain/range. + // + template + cpm_map::cpm_map(int min_i_in, int max_i_in, + int sample_i, int sample_j, + bool map_is_plus_in) + : min_i_(min_i_in), max_i_(max_i_in), + offset_(map_is_plus_in ? sample_j - sample_i + : sample_j + sample_i), + map_is_plus_(map_is_plus_in) + { + assert(map_unchecked(sample_i) == sample_j); + } + + //****************************************************************************** + + // + // This function constructs a generic cpm_map object, with the mapping + // specified by a *fp* sample point sample_i --> sample_j (which + // must specify an integer --> integer mapping, i.e. 4.2 --> 4.2 is + // ok for a + map, and 4.5 --> 4.5 is ok for a minus map, but 4.2 --> 4.7 + // is never ok) and by sign. The sample point need not be in the map's + // domain/range. + // + template + cpm_map::cpm_map(int min_i_in, int max_i_in, + fp_t sample_i, fp_t sample_j, + bool map_is_plus_in) + : min_i_(min_i_in), max_i_(max_i_in), + map_is_plus_(map_is_plus_in) + { + const fp_t fp_offset = map_is_plus_in ? sample_j - sample_i + : sample_j + sample_i; + if (!fuzzy::is_integer(fp_offset)) + then error_exit(ERROR_EXIT, + "***** cpm_map::cpm_map (generic via fp sample point):\n" + " fp_offset=%g isn't fuzzily integral!\n" + " ==> sample_i=%g --> sample_j=%g\n" + " doesn't fuzzily specify an integer --> integer mapping!\n", + double(fp_offset), + double(sample_i), double(sample_j)); /*NOTREACHED*/ + + offset_ = round::to_integer(fp_offset); + + // verify that we have setup correct + assert( + map_unchecked(fuzzy::floor(sample_i)) == + (map_is_plus_in ? fuzzy::floor(sample_j) + : fuzzy::ceiling(sample_j))); + } + + template class cpm_map; + template class cpm_map; + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/cpm_map.h b/AMSS_NCKU_source/cpm_map.h new file mode 100644 index 0000000..92e0596 --- /dev/null +++ b/AMSS_NCKU_source/cpm_map.h @@ -0,0 +1,120 @@ +#ifndef AHFINDERDIRECT__CPM_MAP_HH +#define AHFINDERDIRECT__CPM_MAP_HH +namespace AHFinderDirect +{ + namespace jtutil + { + + template + class cpm_map + { + public: + // bounds info -- domain + int min_i() const { return min_i_; } + int max_i() const { return max_i_; } + int N_points() const + { + return jtutil::how_many_in_range(min_i_, max_i_); + } + bool in_domain(int i) const { return (i >= min_i_) && (i <= max_i_); } + + // is the mapping + or - ? + bool is_plus() const { return map_is_plus_; } + bool is_minus() const { return !map_is_plus_; } + int sign() const { return map_is_plus_ ? +1 : -1; } + fp_t fp_sign() const { return map_is_plus_ ? +1.0 : -1.0; } + + // the mapping itself + int map_unchecked(int i) const + { + return map_is_plus_ ? offset_ + i + : offset_ - i; + } + int inv_map_unchecked(int j) const + { + return map_is_plus_ ? j - offset_ + : offset_ - j; + } + int map(int i) const + { + assert(in_domain(i)); + return map_unchecked(i); + } + int inv_map(int j) const + { + int i = inv_map_unchecked(j); + assert(in_domain(i)); + return i; + } + + // bounds info -- range + // ... we use the unchecked map here in case the domain is empty + int min_j() const + { + return map_is_plus_ ? map_unchecked(min_i_) + : map_unchecked(max_i_); + } + int max_j() const + { + return map_is_plus_ ? map_unchecked(max_i_) + : map_unchecked(min_i_); + } + bool in_range(int j) const { return in_domain(inv_map_unchecked(j)); } + + // + // constructors + // + + // "mirror" map: i --> const - i + // ... map specified by fixed point (must be integer or half-integer) + // ... fixed point need not be in domain/range + cpm_map(int min_i_in, int max_i_in, + fp_t fixed_point); + + // "shift" map: i --> const + i + // ... map specified by shift amount + // ... default is identity map + cpm_map(int min_i_in, int max_i_in, + int shift_amount = 0) + : min_i_(min_i_in), max_i_(max_i_in), + offset_(shift_amount), map_is_plus_(true) + { + } + + // generic map: i --> const +/- i + // ... map specified by sample point sample_i --> sample_j + // and by sign (one of {plus,minus}_map ) + // ... sample point need not be in domain/range + cpm_map(int min_i_in, int max_i_in, + int sample_i, int sample_j, + bool map_is_plus_in); + + // generic map: i --> const +/- i + // ... map specified by *fp* sample point sample_i --> sample_j + // (must specify an integer --> integer mapping) + // and by sign (one of {plus,minus}_map ) + // ... hence if sign is -1, then sample_i and sample_j + // must both be half-integral + // ... sample point need *not* be in domain/range + cpm_map(int min_i_in, int max_i_in, + fp_t sample_i, fp_t sample_j, + bool map_is_plus_in); + + // no need for explicit destructor, compiler-generated no-op is ok + // ditto for copy constructor and assignment operator + + private: + // bounds (inclusive) + int min_i_, max_i_; + + // these define the actual mapping + int offset_; + bool map_is_plus_; + }; + + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect + +#endif /* AHFINDERDIRECT__CPM_MAP_HH */ diff --git a/AMSS_NCKU_source/derivatives.h b/AMSS_NCKU_source/derivatives.h new file mode 100644 index 0000000..2f2f6ce --- /dev/null +++ b/AMSS_NCKU_source/derivatives.h @@ -0,0 +1,76 @@ + +#ifndef DERIVATIVES +#define DERIVATIVES + +#ifdef fortran1 +#define f_fderivs fderivs +#define f_fderivs_sh fderivs_sh +#define f_fderivs_shc fderivs_shc +#define f_fdderivs_shc fdderivs_shc +#define f_fdderivs fdderivs +#endif +#ifdef fortran2 +#define f_fderivs FDERIVS +#define f_fderivs_sh FDERIVS_SH +#define f_fderivs_shc FDERIVS_SHC +#define f_fdderivs_shc FDDERIVS_SHC +#define f_fdderivs FDDERIVS +#endif +#ifdef fortran3 +#define f_fderivs fderivs_ +#define f_fderivs_sh fderivs_sh_ +#define f_fderivs_shc fderivs_shc_ +#define f_fdderivs_shc fdderivs_shc_ +#define f_fdderivs fdderivs_ +#endif + +extern "C" +{ + void f_fderivs(int *, double *, + double *, double *, double *, + double *, double *, double *, + double &, double &, double &, int &, int &); +} + +extern "C" +{ + void f_fderivs_sh(int *, double *, + double *, double *, double *, + double *, double *, double *, + double &, double &, double &, int &, int &, int &); +} + +extern "C" +{ + void f_fderivs_shc(int *, double *, + double *, double *, double *, + double *, double *, double *, + double &, double &, double &, int &, int &, int &, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *); +} + +extern "C" +{ + void f_fdderivs_shc(int *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double &, double &, double &, int &, int &, int &, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_fdderivs(int *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double &, double &, double &, int &, int &); +} + +#endif /* DERIVATIVES */ diff --git a/AMSS_NCKU_source/diff_new.f90 b/AMSS_NCKU_source/diff_new.f90 new file mode 100644 index 0000000..93954f1 --- /dev/null +++ b/AMSS_NCKU_source/diff_new.f90 @@ -0,0 +1,4303 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 2_nd oder accurate +! +! f(i+1) - f(i-1) +! fx(i) = ----------------------- +! 2 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-2) - 2 f(i) + f(i+2) +! fxx(i) = -------------------------------- +! 4 dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivsdavid(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = F1o4 /( dX * dX ) + Sdydy = F1o4 /( dY * dY ) + Sdzdz = F1o4 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 2 f(i) + f(i+2) +! fxx(i) = -------------------------------- +! 4 dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-2,j,k)-TWO*fh(i,j,k) & + +fh(i+2,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = (fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) )/dX/dX + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-2,k)-TWO*fh(i,j,k) & + +fh(i,j+2,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + fyy(i,j,k) = (fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) )/dY/dY + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k) & + +fh(i,j,k+2) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + fzz(i,j,k) = (fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) )/dZ/dZ + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivsdavid + +#elif (ghost_width == 3) +! fourth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 4_th oder accurate +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +#if 0 +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif +#elif 0 +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+3 <= imax .and. i-1 >= imin)then + fx(i,j,k)=d12dx*(-3.d0*fh(i-1,j,k)-1.d1*fh(i,j,k)+1.8d1*fh(i+1,j,k)-6.d0*fh(i+2,j,k)+fh(i+3,j,k)) + elseif(i+1 <= imax .and. i-3 >= imin)then + fx(i,j,k)=d12dx*( 3.d0*fh(i+1,j,k)+1.d1*fh(i,j,k)-1.8d1*fh(i-1,j,k)+6.d0*fh(i-2,j,k)-fh(i-3,j,k)) +! set imax and imin 0 + endif +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+3 <= jmax .and. j-1 >= jmin)then + fy(i,j,k)=d12dy*(-3.d0*fh(i,j-1,k)-1.d1*fh(i,j,k)+1.8d1*fh(i,j+1,k)-6.d0*fh(i,j+2,k)+fh(i,j+3,k)) + elseif(j+1 <= jmax .and. j-3 >= jmin)then + fy(i,j,k)=d12dy*( 3.d0*fh(i,j+1,k)+1.d1*fh(i,j,k)-1.8d1*fh(i,j-1,k)+6.d0*fh(i,j-2,k)-fh(i,j-3,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+3 <= kmax .and. k-1 >= kmin)then + fz(i,j,k)=d12dz*(-3.d0*fh(i,j,k-1)-1.d1*fh(i,j,k)+1.8d1*fh(i,j,k+1)-6.d0*fh(i,j,k+2)+fh(i,j,k+3)) + elseif(k+1 <= kmax .and. k-3 >= kmin)then + fz(i,j,k)=d12dz*( 3.d0*fh(i,j,k+1)+1.d1*fh(i,j,k)-1.8d1*fh(i,j,k-1)+6.d0*fh(i,j,k-2)-fh(i,j,k-3)) + +! set kmax and kmin 0 + endif +#else +! for bam comparison + if(i+2 <= imax .and. i-2 >= imin .and. & + j+2 <= jmax .and. j-2 >= jmin .and. & + k+2 <= kmax .and. k-2 >= kmin) then + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + elseif(i+1 <= imax .and. i-1 >= imin .and. & + j+1 <= jmax .and. j-1 >= jmin .and. & + k+1 <= kmax .and. k-1 >= kmin) then + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + endif +#endif + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 4_th oder accurate +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 +! +! - ( - f(i+2,j+2) + 8 f(i+1,j+2) - 8 f(i-1,j+2) + f(i-2,j+2) ) +! + 8 ( - f(i+2,j+1) + 8 f(i+1,j+1) - 8 f(i-1,j+1) + f(i-2,j+1) ) +! - 8 ( - f(i+2,j-1) + 8 f(i+1,j-1) - 8 f(i-1,j-1) + f(i-2,j-1) ) +! + ( - f(i+2,j-2) + 8 f(i+1,j-2) - 8 f(i-1,j-2) + f(i-2,j-2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +#if 0 +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif +#else +! for bam comparison + if(i+2 <= imax .and. i-2 >= imin .and. & + j+2 <= jmax .and. j-2 >= jmin .and. & + k+2 <= kmax .and. k-2 >= kmin) then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. & + j+1 <= jmax .and. j-1 >= jmin .and. & + k+1 <= kmax .and. k-1 >= kmin) then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif +#endif + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#elif (ghost_width == 4) +! sixth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 6_th oder accurate +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 6_th oder accurate +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#elif (ghost_width == 5) +! eighth order code + +! PRD 77, 024034 (2008) +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 8_th oder accurate +! +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d840dy,d840dz + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + d840dy = ONE/F840/dY + d840dz = ONE/F840/dZ + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dy,d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dy = ONE/F840/dY + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dz,d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dz = ONE/F840/dZ + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 8_th oder accurate +! +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 +! +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz,Edxdx,Edydy,Edzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz,Edxdy,Edxdz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Edxdx = F1o5040 /( dX * dX ) + Edydy = F1o5040 /( dY * dY ) + Edzdz = F1o5040 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + Edxdy = F1o705600 /( dX * dY ) + Edxdz = F1o705600 /( dX * dZ ) + Edydz = F1o705600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx,Edxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + Edxdx = F1o5040 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy,Edydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + Edydy = F1o5040 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz,Edzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + Edzdz = F1o5040 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy,Edxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + Edxdy = F1o705600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz,Edxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + Edxdz = F1o705600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + Edydz = F1o705600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#endif diff --git a/AMSS_NCKU_source/diff_new_sh.f90 b/AMSS_NCKU_source/diff_new_sh.f90 new file mode 100644 index 0000000..91d21d7 --- /dev/null +++ b/AMSS_NCKU_source/diff_new_sh.f90 @@ -0,0 +1,4777 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 2_nd oder accurate +! +! f(i+1) - f(i-1) +! fx(i) = ----------------------- +! 2 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx_sh + + subroutine fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy_sh + + subroutine fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz_sh + + subroutine fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy_sh + + subroutine fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz_sh + + subroutine fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz_sh + +#elif (ghost_width == 3) +! fourth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 4_th oder accurate +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 4_th oder accurate +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 +! +! - ( - f(i+2,j+2) + 8 f(i+1,j+2) - 8 f(i-1,j+2) + f(i-2,j+2) ) +! + 8 ( - f(i+2,j+1) + 8 f(i+1,j+1) - 8 f(i-1,j+1) + f(i-2,j+1) ) +! - 8 ( - f(i+2,j-1) + 8 f(i+1,j-1) - 8 f(i-1,j-1) + f(i-2,j-1) ) +! + ( - f(i+2,j-2) + 8 f(i+1,j-2) - 8 f(i-1,j-2) + f(i-2,j-2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx_sh + + subroutine fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy_sh + + subroutine fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz_sh + + subroutine fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy_sh + + subroutine fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz_sh + + subroutine fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz_sh + +#elif (ghost_width == 4) +! sixth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 6_th oder accurate +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 6_th oder accurate +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx_sh + + subroutine fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy_sh + + subroutine fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz_sh + + subroutine fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy_sh + + subroutine fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz_sh + + subroutine fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz_sh + +#elif (ghost_width == 5) +! eighth order code + +! PRD 77, 024034 (2008) +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 8_th oder accurate +! +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d840dy,d840dz + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + d840dy = ONE/F840/dY + d840dz = ONE/F840/dZ + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dy,d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + d840dy = ONE/F840/dY + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dz,d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + d840dz = ONE/F840/dZ + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + enddo + enddo + enddo + + return + + end subroutine fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 8_th oder accurate +! +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 +! +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz,Edxdx,Edydy,Edzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz,Edxdy,Edxdz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Edxdx = F1o5040 /( dX * dX ) + Edydy = F1o5040 /( dY * dY ) + Edzdz = F1o5040 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + Edxdy = F1o705600 /( dX * dY ) + Edxdz = F1o705600 /( dX * dZ ) + Edydz = F1o705600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx,Edxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + Edxdx = F1o5040 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx_sh + + subroutine fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy,Edydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + Edydy = F1o5040 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy_sh + + subroutine fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz,Edzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + Edzdz = F1o5040 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz_sh + + subroutine fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy,Edxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + Edxdy = F1o705600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy_sh + + subroutine fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz,Edxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + Edxdz = F1o705600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz_sh + + subroutine fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + Edydz = F1o705600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz_sh + +#endif + +!common code for different finite difference order +subroutine fderivs_shc(ex,f,fx,fy,fz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + implicit none + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,intent(in ):: SYM1,SYM2,SYM3 + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(out),dimension(ex(1),ex(2),ex(3))::fx,fy,fz + +#if 0 + integer :: i,j,k + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + call point_fderivs_shc(ex,f,fx(i,j,k),fy(i,j,k),fz(i,j,k),crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + enddo + enddo + enddo +#else + double precision,dimension(ex(1),ex(2),ex(3))::gx,gy,gz + + call fderivs_sh(ex,f,gx,gy,gz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst) + + fx = dRdx*gz+drhodx*gx+dsigmadx*gy + fy = dRdy*gz+drhody*gx+dsigmady*gy + fz = dRdz*gz+drhodz*gx+dsigmadz*gy +#endif + + return + +end subroutine fderivs_shc + +subroutine fdderivs_shc(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + implicit none + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,intent(in ):: SYM1,SYM2,SYM3 + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double precision,intent(out),dimension(ex(1),ex(2),ex(3))::fxx,fxy,fxz,fyy,fyz,fzz + +#if 0 + integer :: i,j,k + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + call point_fdderivs_shc(ex,f,fxx(i,j,k),fxy(i,j,k),fxz(i,j,k),fyy(i,j,k),fyz(i,j,k),fzz(i,j,k),crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + enddo + enddo + enddo +#else + double precision,dimension(ex(1),ex(2),ex(3))::gx,gy,gz,gxx,gxy,gxz,gyy,gyz,gzz + real*8,parameter :: TWO = 2.d0 + + call fderivs_sh(ex,f,gx,gy,gz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst) + call fdderivs_sh(ex,f,gxx,gxy,gxz,gyy,gyz,gzz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst) + + fxx = dRdxx*gz+drhodxx*gx+dsigmadxx*gy + & + dRdx*dRdx*gzz+drhodx*drhodx*gxx+dsigmadx*dsigmadx*gyy + & + TWO*(dRdx*drhodx*gxz+dRdx*dsigmadx*gyz+drhodx*dsigmadx*gxy) + fyy = dRdyy*gz+drhodyy*gx+dsigmadyy*gy + & + dRdy*dRdy*gzz+drhody*drhody*gxx+dsigmady*dsigmady*gyy + & + TWO*(dRdy*drhody*gxz+dRdy*dsigmady*gyz+drhody*dsigmady*gxy) + fzz = dRdzz*gz+drhodzz*gx+dsigmadzz*gy + & + dRdz*dRdz*gzz+drhodz*drhodz*gxx+dsigmadz*dsigmadz*gyy + & + TWO*(dRdz*drhodz*gxz+dRdz*dsigmadz*gyz+drhodz*dsigmadz*gxy) + fxy = dRdxy*gz+drhodxy*gx+dsigmadxy*gy + & + dRdx*drhody*gxz+dRdx*dsigmady*gyz+drhodx*dsigmady*gxy + & + dRdy*drhodx*gxz+dRdy*dsigmadx*gyz+drhody*dsigmadx*gxy + & + dRdx*dRdy*gzz+drhodx*drhody*gxx+dsigmadx*dsigmady*gyy + fxz = dRdxz*gz+drhodxz*gx+dsigmadxz*gy + & + dRdx*drhodz*gxz+dRdx*dsigmadz*gyz+drhodx*dsigmadz*gxy + & + dRdz*drhodx*gxz+dRdz*dsigmadx*gyz+drhodz*dsigmadx*gxy + & + dRdx*dRdz*gzz+drhodx*drhodz*gxx+dsigmadx*dsigmadz*gyy + fyz = dRdyz*gz+drhodyz*gx+dsigmadyz*gy + & + dRdz*drhody*gxz+dRdz*dsigmady*gyz+drhodz*dsigmady*gxy + & + dRdy*drhodz*gxz+dRdy*dsigmadz*gyz+drhody*dsigmadz*gxy + & + dRdz*dRdy*gzz+drhodz*drhody*gxx+dsigmadz*dsigmady*gyy +#endif + + return + +end subroutine fdderivs_shc diff --git a/AMSS_NCKU_source/diff_newwb.f90 b/AMSS_NCKU_source/diff_newwb.f90 new file mode 100644 index 0000000..e6ee09d --- /dev/null +++ b/AMSS_NCKU_source/diff_newwb.f90 @@ -0,0 +1,4958 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 2_nd oder accurate +! +! f(i+1) - f(i-1) +! fx(i) = ----------------------- +! 2 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fderivs i= ",i + endif +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fderivs j= ",j + endif +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fderivs k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fdx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fdy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fdz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs i= ",i + endif + + +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs j= ",j + endif + +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs k= ",k + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:fdderivs: i,j = ",i,j + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddxx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddyy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddzz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:xy: i,j = ",i,j + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-2) - 2 f(i) + f(i+2) +! fxx(i) = -------------------------------- +! 4 dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivsdavid(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(1,ex,f,fh,SoA) + + Sdxdx = F1o4 /( dX * dX ) + Sdydy = F1o4 /( dY * dY ) + Sdzdz = F1o4 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 2 f(i) + f(i+2) +! fxx(i) = -------------------------------- +! 4 dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-2,j,k)-TWO*fh(i,j,k) & + +fh(i+2,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = (fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) )/dX/dX + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-2,k)-TWO*fh(i,j,k) & + +fh(i,j+2,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + fyy(i,j,k) = (fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) )/dY/dY + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k) & + +fh(i,j,k+2) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + fzz(i,j,k) = (fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) )/dZ/dZ + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivsdavid + +#elif (ghost_width == 3) +! fourth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 4_th oder accurate +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fderivs i= ",i + endif +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fderivs j= ",j + endif +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fderivs k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fdx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fdy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fdz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 4_th oder accurate +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 +! +! - ( - f(i+2,j+2) + 8 f(i+1,j+2) - 8 f(i-1,j+2) + f(i-2,j+2) ) +! + 8 ( - f(i+2,j+1) + 8 f(i+1,j+1) - 8 f(i-1,j+1) + f(i-2,j+1) ) +! - 8 ( - f(i+2,j-1) + 8 f(i+1,j-1) - 8 f(i-1,j-1) + f(i-2,j-1) ) +! + ( - f(i+2,j-2) + 8 f(i+1,j-2) - 8 f(i-1,j-2) + f(i-2,j-2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs i= ",i + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs j= ",j + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs k= ",k + endif +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:fdderivs: i,j = ",i,j + endif +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddxx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddyy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddzz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:xy: i,j = ",i,j + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(2,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#elif (ghost_width == 4) +! sixth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 6_th oder accurate +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fderivs i= ",i + endif +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fderivs j= ",j + endif +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fderivs k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fdx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fdy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fdz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 6_th oder accurate +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs i= ",i + endif + + +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs j= ",j + endif + +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs k= ",k + endif +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:fdderivs: i,j = ",i,j + endif +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddxx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddyy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddzz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:xy: i,j = ",i,j + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(3,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#elif (ghost_width == 5) +! eighth order code + +! PRD 77, 024034 (2008) +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 8_th oder accurate +! +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine fderivs(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d840dy,d840dz + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + d840dy = ONE/F840/dY + d840dz = ONE/F840/dZ + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fderivs i= ",i + endif +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fderivs j= ",j + endif +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fderivs k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fderivs +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine fdx(ex,f,fx,X,SYM1,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fx + real*8, intent(in ):: X(ex(1)),SYM1 + +!~~~~~~ other variables + + real*8 :: dX + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dx,d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + + SoA(1) = SYM1 +! no use + SoA(2) = SYM1 + SoA(3) = SYM1 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dx = ONE/F840/dX + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx(i,j,k)=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx(i,j,k)=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx(i,j,k)=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx(i,j,k)=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx(i,j,k)=(-fh(i,j,k)+fh(i+1,j,k))/dX + elseif(i==imax)then + fx(i,j,k)=(-fh(i-1,j,k)+fh(i,j,k))/dX + else + write(*,*)"error in diff_new.f90:fdx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fdx +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine fdy(ex,f,fy,Y,SYM2,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fy + real*8, intent(in ):: Y(ex(2)),SYM2 + +!~~~~~~ other variables + + real*8 :: dY + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dy,d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dY = Y(2)-Y(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM2 + SoA(2) = SYM2 + SoA(3) = SYM2 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dy = ONE/F840/dY + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy(i,j,k)=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy(i,j,k)=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy(i,j,k)=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy(i,j,k)=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy(i,j,k)=(-fh(i,j,k)+fh(i,j+1,k))/dY + elseif(j==jmax)then + fy(i,j,k)=(-fh(i,j-1,k)+fh(i,j,k))/dY + else + write(*,*)"error in diff_new.f90:fdy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fdy +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine fdz(ex,f,fz,Z,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: fz + real*8, intent(in ):: Z(ex(3)),SYM3 + +!~~~~~~ other variables + + real*8 :: dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: d840dz,d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + + SoA(1) = SYM3 + SoA(2) = SYM3 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + d840dz = ONE/F840/dZ + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz(i,j,k)=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz(i,j,k)=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz(i,j,k)=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz(i,j,k)=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz(i,j,k)=(-fh(i,j,k)+fh(i,j,k+1))/dZ + elseif(k==kmax)then + fz(i,j,k)=(-fh(i,j,k-1)+fh(i,j,k))/dZ + else + write(*,*)"error in diff_new.f90:fdz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fdz +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 8_th oder accurate +! +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 +! +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine fdderivs(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz,Edxdx,Edydy,Edzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz,Edxdy,Edxdz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Edxdx = F1o5040 /( dX * dX ) + Edydy = F1o5040 /( dY * dY ) + Edzdz = F1o5040 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + Edxdy = F1o705600 /( dX * dY ) + Edxdz = F1o705600 /( dX * dZ ) + Edydz = F1o705600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs i= ",i + endif + +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs j= ",j + endif + +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fdderivs k= ",k + endif +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:fdderivs: i,j = ",i,j + endif +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fdderivs +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine fddxx(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdx,Fdxdx,Xdxdx,Edxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + Edxdx = F1o5040 /( dX * dX ) + + fxx = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + + fxx(i,j,k) = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + fxx(i,j,k) = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx(i,j,k) = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx(i,j,k) = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + elseif(i==imin)then + fxx(i,j,k)=Sdxdx*(fh(i,j,k)-TWO*fh(i+1,j,k) & + +fh(i+2,j,k) ) + elseif(i==imax)then + fxx(i,j,k)=Sdxdx*(fh(i-2,j,k)-TWO*fh(i-1,j,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddxx i= ",i + endif + + enddo + enddo + enddo + + return + + end subroutine fddxx + + subroutine fddyy(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydy,Fdydy,Xdydy,Edydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + Edydy = F1o5040 /( dY * dY ) + + fyy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy(i,j,k) = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy(i,j,k) = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy(i,j,k) = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy(i,j,k) = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + elseif(j==jmin)then + fyy(i,j,k)=Sdydy*(fh(i,j,k)-TWO*fh(i,j+1,k) & + +fh(i,j+2,k) ) + elseif(j==jmax)then + fyy(i,j,k)=Sdydy*(fh(i,j-2,k)-TWO*fh(i,j-1,k) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddyy j= ",j + endif + + enddo + enddo + enddo + + return + + end subroutine fddyy + + subroutine fddzz(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdzdz,Fdzdz,Xdzdz,Edzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + Edzdz = F1o5040 /( dZ * dZ ) + + fzz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz(i,j,k) = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz(i,j,k) = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz(i,j,k) = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz(i,j,k) = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + elseif(k==kmin)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k)-TWO*fh(i,j,k+1) & + +fh(i,j,k+2) ) + elseif(k==kmax)then + fzz(i,j,k)=Sdzdz*(fh(i,j,k-2)-TWO*fh(i,j,k-1) & + +fh(i,j,k) ) + else + write(*,*)"error in diff_new.f90:fddzz k= ",k + endif + + enddo + enddo + enddo + + return + + end subroutine fddzz + + subroutine fddxy(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdy,Fdxdy,Xdxdy,Edxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + Edxdy = F1o705600 /( dX * dY ) + + fxy = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + + fxy(i,j,k) = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy(i,j,k) = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy(i,j,k) = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy(i,j,k) = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + elseif(i==imin .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i,j-1,k)-fh(i+1,j-1,k)-fh(i,j+1,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(i==imax .and. j+1 <= jmax .and. j-1 >= jmin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i,j-1,k)-fh(i-1,j+1,k)+fh(i,j+1,k))/TWO/dX/dY + elseif(j==jmin .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j,k)-fh(i-1,j+1,k)-fh(i+1,j,k)+fh(i+1,j+1,k))/TWO/dX/dY + elseif(j==jmax .and. i+1 <= imax .and. i-1 >= imin)then + fxy(i,j,k) = (fh(i-1,j-1,k)-fh(i-1,j,k)-fh(i+1,j-1,k)+fh(i+1,j,k))/TWO/dX/dY + elseif(i==imin .and. j==jmin)then + fxy(i,j,k) = (fh(i+1,j+1,k)-fh(i+1,j,k)-fh(i,j+1,k)+fh(i,j,k))/dX/dY + elseif(i==imin .and. j==jmax)then + fxy(i,j,k) = (fh(i+1,j,k)-fh(i+1,j-1,k)-fh(i,j,k)+fh(i,j-1,k))/dX/dY + elseif(i==imax .and. j==jmin)then + fxy(i,j,k) = (fh(i,j+1,k)-fh(i,j,k)-fh(i-1,j+1,k)+fh(i-1,j,k))/dX/dY + elseif(i==imax .and. j==jmax)then + fxy(i,j,k) = (fh(i,j,k)-fh(i,j-1,k)-fh(i-1,j,k)+fh(i-1,j-1,k))/dX/dY + else + write(*,*)"error in diff_new.f90:xy: i,j = ",i,j + endif + + enddo + enddo + enddo + + return + + end subroutine fddxy + + subroutine fddxz(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdxdz,Fdxdz,Xdxdz,Edxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + Edxdz = F1o705600 /( dX * dZ ) + + fxz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz(i,j,k) = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz(i,j,k) = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz(i,j,k) = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + elseif(i==imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i,j,k-1)-fh(i+1,j,k-1)-fh(i,j,k+1)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(i==imax .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i,j,k-1)-fh(i-1,j,k+1)+fh(i,j,k+1))/TWO/dX/dZ + elseif(k==kmin .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dX/dZ + elseif(k==kmax .and. i+1 <= imax .and. i-1 >= imin)then + fxz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dX/dZ + elseif(i==imin .and. k==kmin)then + fxz(i,j,k) = (fh(i+1,j,k+1)-fh(i+1,j,k)-fh(i,j,k+1)+fh(i,j,k))/dX/dZ + elseif(i==imin .and. k==kmax)then + fxz(i,j,k) = (fh(i+1,j,k)-fh(i+1,j,k-1)-fh(i,j,k)+fh(i,j,k-1))/dX/dZ + elseif(i==imax .and. k==kmin)then + fxz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i-1,j,k+1)+fh(i-1,j,k))/dX/dZ + elseif(i==imax .and. k==kmax)then + fxz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i-1,j,k)+fh(i-1,j,k-1))/dX/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: i,k = ",i,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddxz + + subroutine fddyz(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry) + implicit none + + integer, intent(in ):: ex(1:3),symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, dimension(ex(1),ex(2),ex(3)),intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + real*8, dimension(3) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: Sdydz,Fdydz,Xdydz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + SoA(1) = SYM1 + SoA(2) = SYM2 + SoA(3) = SYM3 + + call symmetry_bd(4,ex,f,fh,SoA) + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + Edydz = F1o705600 /( dY * dZ ) + + fyz = ZEO + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz(i,j,k) = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz(i,j,k) = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz(i,j,k) = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + elseif(j==jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j,k-1)-fh(i,j+1,k-1)-fh(i,j,k+1)+fh(i,j+1,k+1))/TWO/dY/dZ + elseif(j==jmax .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz(i,j,k) = (fh(i,j-1,k-1)-fh(i,j,k-1)-fh(i,j-1,k+1)+fh(i,j,k+1))/TWO/dY/dZ + elseif(k==kmin .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k)-fh(i-1,j,k+1)-fh(i+1,j,k)+fh(i+1,j,k+1))/TWO/dY/dZ + elseif(k==kmax .and. j+1 <= jmax .and. j-1 >= jmin)then + fyz(i,j,k) = (fh(i-1,j,k-1)-fh(i-1,j,k)-fh(i+1,j,k-1)+fh(i+1,j,k))/TWO/dY/dZ + elseif(j==jmin .and. k==kmin)then + fyz(i,j,k) = (fh(i,j+1,k+1)-fh(i,j+1,k)-fh(i,j,k+1)+fh(i,j,k))/dY/dZ + elseif(j==jmin .and. k==kmax)then + fyz(i,j,k) = (fh(i,j+1,k)-fh(i,j+1,k-1)-fh(i,j,k)+fh(i,j,k-1))/dY/dZ + elseif(j==jmax .and. k==kmin)then + fyz(i,j,k) = (fh(i,j,k+1)-fh(i,j,k)-fh(i,j-1,k+1)+fh(i,j-1,k))/dY/dZ + elseif(j==jmax .and. k==kmax)then + fyz(i,j,k) = (fh(i,j,k)-fh(i,j,k-1)-fh(i,j-1,k)+fh(i,j-1,k-1))/dY/dZ + else + write(*,*)"error in diff_new.f90:fdderivs: j,k = ",j,k + endif + + enddo + enddo + enddo + + return + + end subroutine fddyz + +#endif diff --git a/AMSS_NCKU_source/driver.h b/AMSS_NCKU_source/driver.h new file mode 100644 index 0000000..39c6053 --- /dev/null +++ b/AMSS_NCKU_source/driver.h @@ -0,0 +1,108 @@ +#ifndef DRIVER_H +#define DRIVER_H +#include +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" + +namespace AHFinderDirect +{ + struct iteration_status_buffers + { + int *hn_buffer; + int *iteration_buffer; + enum expansion_status *expansion_status_buffer; + fp *mean_horizon_radius_buffer; + fp *Theta_infinity_norm_buffer; + bool *found_horizon_buffer; + + jtutil::array2d *send_buffer_ptr; + jtutil::array2d *receive_buffer_ptr; + + iteration_status_buffers() + : hn_buffer(NULL), iteration_buffer(NULL), + expansion_status_buffer(NULL), + mean_horizon_radius_buffer(NULL), + Theta_infinity_norm_buffer(NULL), + found_horizon_buffer(NULL), + send_buffer_ptr(NULL), receive_buffer_ptr(NULL) + { + } + }; + + // + // This struct holds interprocessor-communication buffers for broadcasting + // the BH diagnostics and horizon shape from the processor which finds a + // given horizon, to all processors. + // + struct horizon_buffers + { + int N_buffer; + double *send_buffer; + double *receive_buffer; + + horizon_buffers() + : N_buffer(0), + send_buffer(NULL), + receive_buffer(NULL) + { + } + }; + // + struct AH_data + { + patch_system *ps_ptr; + Jacobian *Jac_ptr; + double surface_expansion; + + bool initial_find_flag; + bool recentering_flag, stop_finding, find_trigger; + + bool found_flag; // did we find this horizon (successfully) + + struct BH_diagnostics BH_diagnostics; + FILE *BH_diagnostics_fileptr; + + // interprocessor-communication buffers + // for this horizon's BH diagnostics and (optionally) horizon shape + struct horizon_buffers horizon_buffers; + }; + + // initial_guess.cc + void setup_initial_guess(patch_system &ps, + fp x_center, fp y_center, fp z_center, + fp x_radius, fp y_radius, fp z_radius); + + // Newton.cc + void Newton(int N_procs, int N_active_procs, int my_proc, + horizon_sequence &hs, struct AH_data *const AH_data_array[], + struct iteration_status_buffers &isb, int *dumpid, double *); + +} // namespace AHFinderDirect +#endif /* DRIVER_H */ diff --git a/AMSS_NCKU_source/empart.f90 b/AMSS_NCKU_source/empart.f90 new file mode 100644 index 0000000..c29e80e --- /dev/null +++ b/AMSS_NCKU_source/empart.f90 @@ -0,0 +1,610 @@ + +!including advection term in this routine + function compute_rhs_empart(ext, X, Y, Z, & + chi , dxx , dxy , dxz , dyy , dyz , dzz,& + Lap , betax , betay , betaz , trK, & + Ex, Ey, Ez, Bx, By, Bz, Kpsi, Kphi,Jx,Jy,Jz,qchar, & + Ex_rhs, Ey_rhs, Ez_rhs, Bx_rhs, By_rhs, Bz_rhs, Kpsi_rhs, Kphi_rhs, & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Symmetry,Lev,eps) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3), Symmetry,Lev + real*8, intent(in ):: X(1:ext(1)),Y(1:ext(2)),Z(1:ext(3)) + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Jx,Jy,Jz,qchar + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,dxy,dxz,dyy,dyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: Lap, betax, betay, betaz, trK + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Ex_rhs, Ey_rhs, Ez_rhs + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Bx_rhs, By_rhs, Bz_rhs, Kpsi_rhs, Kphi_rhs + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: rho,Sx,Sy,Sz + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Sxx,Sxy,Sxz,Syy,Syz,Szz + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz,gxy,gxz,gyz + real*8, dimension(ext(1),ext(2),ext(3)) :: chix,chiy,chiz,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ext(1),ext(2),ext(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ext(1),ext(2),ext(3)) :: betayx,betayy,betayz + real*8, dimension(ext(1),ext(2),ext(3)) :: betazx,betazy,betazz + real*8, dimension(ext(1),ext(2),ext(3)) :: alpn1,chin1 + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Exx,Exy,Exz,Eyx,Eyy,Eyz,Ezx,Ezy,Ezz + real*8, dimension(ext(1),ext(2),ext(3)) :: Bxx,Bxy,Bxz,Byx,Byy,Byz,Bzx,Bzy,Bzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Kpsix,Kpsiy,Kpsiz + real*8, dimension(ext(1),ext(2),ext(3)) :: Kphix,Kphiy,Kphiz + real*8, dimension(ext(1),ext(2),ext(3)) :: lEx,lEy,lEz,lBx,lBy,lBz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F3o2=1.5d0,EIT=8.d0 + real*8,parameter :: kappa = 1.d0 +!!! sanity check + dX = sum(Ex)+sum(Ey)+sum(Ez)+sum(Bx)+sum(By)+sum(Bz)+sum(Kpsi)+sum(Kphi) + if(dX.ne.dX) then + if(sum(Ex).ne.sum(Ex))write(*,*)"empart.f90: find NaN in Ex" + if(sum(Ey).ne.sum(Ey))write(*,*)"empart.f90: find NaN in Ey" + if(sum(Ez).ne.sum(Ez))write(*,*)"empart.f90: find NaN in Ez" + if(sum(Bx).ne.sum(Bx))write(*,*)"empart.f90: find NaN in Bx" + if(sum(By).ne.sum(By))write(*,*)"empart.f90: find NaN in By" + if(sum(Bz).ne.sum(Bz))write(*,*)"empart.f90: find NaN in Bz" + if(sum(Kpsi).ne.sum(Kpsi))write(*,*)"empart.f90: find NaN in Kpsi" + if(sum(Kphi).ne.sum(Kphi))write(*,*)"empart.f90: find NaN in Kphi" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + chi3o2 = dsqrt(chin1)**3 + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + gxy = dxy + gxz = dxz + gyz = dyz + + call fderivs(ext,Lap,Lapx,Lapy,Lapz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + call fderivs(ext,betax,betaxx,betaxy,betaxz,X,Y,Z,ANTI, SYM, SYM,Symmetry,Lev) + call fderivs(ext,betay,betayx,betayy,betayz,X,Y,Z, SYM,ANTI, SYM,Symmetry,Lev) + call fderivs(ext,betaz,betazx,betazy,betazz,X,Y,Z, SYM, SYM,ANTI,Symmetry,Lev) + + call fderivs(ext,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,symmetry,Lev) + + call fderivs(ext,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ext,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + call fderivs(ext,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,Lev) + call fderivs(ext,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + call fderivs(ext,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,Lev) + call fderivs(ext,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + + call fderivs(ext,Kpsi,Kpsix,Kpsiy,Kpsiz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + call fderivs(ext,Kphi,Kphix,Kphiy,Kphiz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev) + + call fderivs(ext,Ex,Exx,Exy,Exz,X,Y,Z,ANTI,SYM,SYM ,Symmetry,Lev) + call fderivs(ext,Ey,Eyx,Eyy,Eyz,X,Y,Z,SYM,ANTI,SYM ,Symmetry,Lev) + call fderivs(ext,Ez,Ezx,Ezy,Ezz,X,Y,Z,SYM,SYM,ANTI ,Symmetry,Lev) + + call fderivs(ext,Bx,Bxx,Bxy,Bxz,X,Y,Z,SYM,ANTI,ANTI ,Symmetry,Lev) + call fderivs(ext,By,Byx,Byy,Byz,X,Y,Z,ANTI,SYM,ANTI ,Symmetry,Lev) + call fderivs(ext,Bz,Bzx,Bzy,Bzz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,Lev) + +! physical gij + gxx = gxx/chin1 + gxy = gxy/chin1 + gxz = gxz/chin1 + gyy = gyy/chin1 + gyz = gyz/chin1 + gzz = gzz/chin1 +!physical gij,k + gxxx = (gxxx-gxx*chix)/chin1 + gxxy = (gxxy-gxx*chiy)/chin1 + gxxz = (gxxz-gxx*chiz)/chin1 + gxyx = (gxyx-gxy*chix)/chin1 + gxyy = (gxyy-gxy*chiy)/chin1 + gxyz = (gxyz-gxy*chiz)/chin1 + gxzx = (gxzx-gxz*chix)/chin1 + gxzy = (gxzy-gxz*chiy)/chin1 + gxzz = (gxzz-gxz*chiz)/chin1 + gyyx = (gyyx-gyy*chix)/chin1 + gyyy = (gyyy-gyy*chiy)/chin1 + gyyz = (gyyz-gyy*chiz)/chin1 + gyzx = (gyzx-gyz*chix)/chin1 + gyzy = (gyzy-gyz*chiy)/chin1 + gyzz = (gyzz-gyz*chiz)/chin1 + gzzx = (gzzx-gzz*chix)/chin1 + gzzy = (gzzy-gzz*chiy)/chin1 + gzzz = (gzzz-gzz*chiz)/chin1 + +! physical inverse metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + Ex_rhs = alpn1*trK*Ex-(Ex*betaxx+Ey*betaxy+Ez*betaxz) & + -FOUR*PI*alpn1*Jx-alpn1*(gupxx*Kpsix+gupxy*Kpsiy+gupxz*Kpsiz) & + +chi3o2*( & + ((gxz*Bx+gyz*By+gzz*Bz)*Lapy+alpn1*(gxz*Bxy+gyz*Byy+gzz*Bzy)+alpn1*(Bx*gxzy+By*gyzy+Bz*gzzy))-& + ((gxy*Bx+gyy*By+gyz*Bz)*Lapz+alpn1*(gxy*Bxz+gyy*Byz+gyz*Bzz)+alpn1*(Bx*gxyz+By*gyyz+Bz*gyzz))) + Ey_rhs = alpn1*trK*Ey-(Ex*betayx+Ey*betayy+Ez*betayz) & + -FOUR*PI*alpn1*Jy-alpn1*(gupxy*Kpsix+gupyy*Kpsiy+gupyz*Kpsiz) & + +chi3o2*( & + ((gxx*Bx+gxy*By+gxz*Bz)*Lapz+alpn1*(gxx*Bxz+gxy*Byz+gxz*Bzz)+alpn1*(Bx*gxxz+By*gxyz+Bz*gxzz))-& + ((gxz*Bx+gyz*By+gzz*Bz)*Lapx+alpn1*(gxz*Bxx+gyz*Byx+gzz*Bzx)+alpn1*(Bx*gxzx+By*gyzx+Bz*gzzx))) + Ez_rhs = alpn1*trK*Ez-(Ex*betazx+Ey*betazy+Ez*betazz) & + -FOUR*PI*alpn1*Jz-alpn1*(gupxz*Kpsix+gupyz*Kpsiy+gupzz*Kpsiz) & + +chi3o2*( & + ((gxy*Bx+gyy*By+gyz*Bz)*Lapx+alpn1*(gxy*Bxx+gyy*Byx+gyz*Bzx)+alpn1*(Bx*gxyx+By*gyyx+Bz*gyzx))-& + ((gxx*Bx+gxy*By+gxz*Bz)*Lapy+alpn1*(gxx*Bxy+gxy*Byy+gxz*Bzy)+alpn1*(Bx*gxxy+By*gxyy+Bz*gxzy))) + + Bx_rhs = alpn1*trK*Bx-(Bx*betaxx+By*betaxy+Bz*betaxz) & + -alpn1*(gupxx*Kphix+gupxy*Kphiy+gupxz*Kphiz) & + -chi3o2*( & + ((gxz*Ex+gyz*Ey+gzz*Ez)*Lapy+alpn1*(gxz*Exy+gyz*Eyy+gzz*Ezy)+alpn1*(Ex*gxzy+Ey*gyzy+Ez*gzzy))-& + ((gxy*Ex+gyy*Ey+gyz*Ez)*Lapz+alpn1*(gxy*Exz+gyy*Eyz+gyz*Ezz)+alpn1*(Ex*gxyz+Ey*gyyz+Ez*gyzz))) + By_rhs = alpn1*trK*By-(Bx*betayx+By*betayy+Bz*betayz) & + -alpn1*(gupxy*Kphix+gupyy*Kphiy+gupyz*Kphiz) & + -chi3o2*( & + ((gxx*Ex+gxy*Ey+gxz*Ez)*Lapz+alpn1*(gxx*Exz+gxy*Eyz+gxz*Ezz)+alpn1*(Ex*gxxz+Ey*gxyz+Ez*gxzz))-& + ((gxz*Ex+gyz*Ey+gzz*Ez)*Lapx+alpn1*(gxz*Exx+gyz*Eyx+gzz*Ezx)+alpn1*(Ex*gxzx+Ey*gyzx+Ez*gzzx))) + Bz_rhs = alpn1*trK*Bz-(Bx*betazx+By*betazy+Bz*betazz) & + -alpn1*(gupxz*Kphix+gupyz*Kphiy+gupzz*Kphiz) & + -chi3o2*( & + ((gxy*Ex+gyy*Ey+gyz*Ez)*Lapx+alpn1*(gxy*Exx+gyy*Eyx+gyz*Ezx)+alpn1*(Ex*gxyx+Ey*gyyx+Ez*gyzx))-& + ((gxx*Ex+gxy*Ey+gxz*Ez)*Lapy+alpn1*(gxx*Exy+gxy*Eyy+gxz*Ezy)+alpn1*(Ex*gxxy+Ey*gxyy+Ez*gxzy))) + + Kpsi_rhs = FOUR*PI*alpn1*qchar-alpn1*kappa*Kpsi - & + alpn1*(Exx+Eyy+Ezz-F3o2/chin1*(chix*Ex+chiy*Ey+chiz*Ez)) + Kphi_rhs = -alpn1*kappa*Kphi - & + alpn1*(Bxx+Byy+Bzz-F3o2/chin1*(chix*Bx+chiy*By+chiz*Bz)) + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part + call lopsided(ext,X,Y,Z,KPsi,KPsi_rhs,betax,betay,betaz,Symmetry,SSS) + call lopsided(ext,X,Y,Z,KPhi,KPhi_rhs,betax,betay,betaz,Symmetry,SSS) + + call lopsided(ext,X,Y,Z,Ex,Ex_rhs,betax,betay,betaz,Symmetry,ASS) + call lopsided(ext,X,Y,Z,Ey,Ey_rhs,betax,betay,betaz,Symmetry,SAS) + call lopsided(ext,X,Y,Z,Ez,Ez_rhs,betax,betay,betaz,Symmetry,SSA) + + call lopsided(ext,X,Y,Z,Bx,Bx_rhs,betax,betay,betaz,Symmetry,SAA) + call lopsided(ext,X,Y,Z,By,By_rhs,betax,betay,betaz,Symmetry,ASA) + call lopsided(ext,X,Y,Z,Bz,Bz_rhs,betax,betay,betaz,Symmetry,AAS) + +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + + call kodis(ext,X,Y,Z,Kpsi,Kpsi_rhs,SSS,Symmetry,eps) + call kodis(ext,X,Y,Z,Kphi,Kphi_rhs,SSS,Symmetry,eps) + call kodis(ext,X,Y,Z,Ex,Ex_rhs,ASS,Symmetry,eps) + call kodis(ext,X,Y,Z,Ey,Ey_rhs,SAS,Symmetry,eps) + call kodis(ext,X,Y,Z,Ez,Ez_rhs,SSA,Symmetry,eps) + call kodis(ext,X,Y,Z,Bx,Bx_rhs,SAA,Symmetry,eps) + call kodis(ext,X,Y,Z,By,By_rhs,ASA,Symmetry,eps) + call kodis(ext,X,Y,Z,Bz,Bz_rhs,AAS,Symmetry,eps) + + endif +! stress-energy tensor + rho = (gxx*(Ex*Ex+Bx*Bx)+gyy*(Ey*Ey+By*By)+gzz*(Ez*Ez+Bz*Bz) + & + +TWO*(gxy*(Ex*Ey+Bx*By)+gxz*(Ex*Ez+Bx*Bz)+gyz*(Ey*Ez+By*Bz)))/EIT/PI + Sx = (Ey*Bz-Ez*By)/FOUR/PI/chi3o2 + Sy = (Ez*Bx-Ex*Bz)/FOUR/PI/chi3o2 + Sz = (Ex*By-Ey*Bx)/FOUR/PI/chi3o2 + lEx = gxx*Ex+gxy*Ey+gxz*Ez + lEy = gxy*Ex+gyy*Ey+gyz*Ez + lEz = gxz*Ex+gyz*Ey+gzz*Ez + lBx = gxx*Bx+gxy*By+gxz*Bz + lBy = gxy*Bx+gyy*By+gyz*Bz + lBz = gxz*Bx+gyz*By+gzz*Bz + Sxx = rho*gxx-(lEx*lEx+lBx*lBx)/FOUR/PI + Sxy = rho*gxy-(lEx*lEy+lBx*lBy)/FOUR/PI + Sxz = rho*gxz-(lEx*lEz+lBx*lBz)/FOUR/PI + Syy = rho*gyy-(lEy*lEy+lBy*lBy)/FOUR/PI + Syz = rho*gyz-(lEy*lEz+lBy*lBz)/FOUR/PI + Szz = rho*gzz-(lEz*lEz+lBz*lBz)/FOUR/PI + + gont = 0 + + return + + end function compute_rhs_empart +!including advection term in this routine +! for shell + function compute_rhs_empart_ss(ext,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , dxx , dxy , dxz , dyy , dyz , dzz,& + Lap , betax , betay , betaz , trK, & + Ex, Ey, Ez, Bx, By, Bz, Kpsi, Kphi,Jx,Jy,Jz,qchar, & + Ex_rhs, Ey_rhs, Ez_rhs, Bx_rhs, By_rhs, Bz_rhs, Kpsi_rhs, Kphi_rhs, & + rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, & + Symmetry,Lev,eps,sst) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3), Symmetry,Lev,sst + double precision,intent(in),dimension(ext(1))::crho + double precision,intent(in),dimension(ext(2))::sigma + double precision,intent(in),dimension(ext(3))::R + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::x,y,z + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Jx,Jy,Jz,qchar + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,dxy,dxz,dyy,dyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: Lap, betax, betay, betaz, trK + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Ex_rhs, Ey_rhs, Ez_rhs + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Bx_rhs, By_rhs, Bz_rhs, Kpsi_rhs, Kphi_rhs + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: rho,Sx,Sy,Sz + real*8, dimension(ext(1),ext(2),ext(3)),intent(out) :: Sxx,Sxy,Sxz,Syy,Syz,Szz + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz,gxy,gxz,gyz + real*8, dimension(ext(1),ext(2),ext(3)) :: chix,chiy,chiz,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ext(1),ext(2),ext(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Lapx,Lapy,Lapz + real*8, dimension(ext(1),ext(2),ext(3)) :: betaxx,betaxy,betaxz + real*8, dimension(ext(1),ext(2),ext(3)) :: betayx,betayy,betayz + real*8, dimension(ext(1),ext(2),ext(3)) :: betazx,betazy,betazz + real*8, dimension(ext(1),ext(2),ext(3)) :: alpn1,chin1 + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Exx,Exy,Exz,Eyx,Eyy,Eyz,Ezx,Ezy,Ezz + real*8, dimension(ext(1),ext(2),ext(3)) :: Bxx,Bxy,Bxz,Byx,Byy,Byz,Bzx,Bzy,Bzz + real*8, dimension(ext(1),ext(2),ext(3)) :: Kpsix,Kpsiy,Kpsiz + real*8, dimension(ext(1),ext(2),ext(3)) :: Kphix,Kphiy,Kphiz + real*8, dimension(ext(1),ext(2),ext(3)) :: lEx,lEy,lEz,lBx,lBy,lBz + + real*8,dimension(3) ::SSS,AAS,ASA,SAA,ASS,SAS,SSA + real*8 :: dX, dY, dZ, PI + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8, parameter :: F3o2=1.5d0,EIT=8.d0 + real*8,parameter :: kappa = 1.d0 + +!!! sanity check + dX = sum(Ex)+sum(Ey)+sum(Ez)+sum(Bx)+sum(By)+sum(Bz)+sum(Kpsi)+sum(Kphi) + if(dX.ne.dX) then + if(sum(Ex).ne.sum(Ex))write(*,*)"empart.f90: find NaN in Ex" + if(sum(Ey).ne.sum(Ey))write(*,*)"empart.f90: find NaN in Ey" + if(sum(Ez).ne.sum(Ez))write(*,*)"empart.f90: find NaN in Ez" + if(sum(Bx).ne.sum(Bx))write(*,*)"empart.f90: find NaN in Bx" + if(sum(By).ne.sum(By))write(*,*)"empart.f90: find NaN in By" + if(sum(Bz).ne.sum(Bz))write(*,*)"empart.f90: find NaN in Bz" + if(sum(Kpsi).ne.sum(Kpsi))write(*,*)"empart.f90: find NaN in Kpsi" + if(sum(Kphi).ne.sum(Kphi))write(*,*)"empart.f90: find NaN in Kphi" + gont = 1 + return + endif + + PI = dacos(-ONE) + + dX = crho(2) - crho(1) + dY = sigma(2) - sigma(1) + dZ = R(2) - R(1) + + alpn1 = Lap + ONE + chin1 = chi + ONE + chi3o2 = dsqrt(chin1)**3 + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + gxy = dxy + gxz = dxz + gyz = dyz + + call fderivs_shc(ext,Lap,Lapx,Lapy,Lapz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,betax,betaxx,betaxy,betaxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,betay,betayx,betayy,betayz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,betaz,betazx,betazy,betazz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ext,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ext,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ext,Kpsi,Kpsix,Kpsiy,Kpsiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,Kphi,Kphix,Kphiy,Kphiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ext,Ex,Exx,Exy,Exz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,Ey,Eyx,Eyy,Eyz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,Ez,Ezx,Ezy,Ezz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +#if 1 + call fderivs_shc(ext,Bx,Bxx,Bxy,Bxz,crho,sigma,R, SYM,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,By,Byx,Byy,Byz,crho,sigma,R,ANTI, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,Bz,Bzx,Bzy,Bzz,crho,sigma,R,ANTI,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +#else + call fderivs_shc(ext,Bx,Bxx,Bxy,Bxz,crho,sigma,R,ANTI, SYM, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,By,Byx,Byy,Byz,crho,sigma,R, SYM,ANTI, SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ext,Bz,Bzx,Bzy,Bzz,crho,sigma,R, SYM, SYM,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +#endif +! check axal vector +! physical gij + gxx = gxx/chin1 + gxy = gxy/chin1 + gxz = gxz/chin1 + gyy = gyy/chin1 + gyz = gyz/chin1 + gzz = gzz/chin1 +!physical gij,k + gxxx = (gxxx-gxx*chix)/chin1 + gxxy = (gxxy-gxx*chiy)/chin1 + gxxz = (gxxz-gxx*chiz)/chin1 + gxyx = (gxyx-gxy*chix)/chin1 + gxyy = (gxyy-gxy*chiy)/chin1 + gxyz = (gxyz-gxy*chiz)/chin1 + gxzx = (gxzx-gxz*chix)/chin1 + gxzy = (gxzy-gxz*chiy)/chin1 + gxzz = (gxzz-gxz*chiz)/chin1 + gyyx = (gyyx-gyy*chix)/chin1 + gyyy = (gyyy-gyy*chiy)/chin1 + gyyz = (gyyz-gyy*chiz)/chin1 + gyzx = (gyzx-gyz*chix)/chin1 + gyzy = (gyzy-gyz*chiy)/chin1 + gyzz = (gyzz-gyz*chiz)/chin1 + gzzx = (gzzx-gzz*chix)/chin1 + gzzy = (gzzy-gzz*chiy)/chin1 + gzzz = (gzzz-gzz*chiz)/chin1 + +! physical inverse metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + Ex_rhs = alpn1*trK*Ex-(Ex*betaxx+Ey*betaxy+Ez*betaxz) & + -FOUR*PI*alpn1*Jx-alpn1*(gupxx*Kpsix+gupxy*Kpsiy+gupxz*Kpsiz) & + +chi3o2*( & + ((gxz*Bx+gyz*By+gzz*Bz)*Lapy+alpn1*(gxz*Bxy+gyz*Byy+gzz*Bzy)+alpn1*(Bx*gxzy+By*gyzy+Bz*gzzy))-& + ((gxy*Bx+gyy*By+gyz*Bz)*Lapz+alpn1*(gxy*Bxz+gyy*Byz+gyz*Bzz)+alpn1*(Bx*gxyz+By*gyyz+Bz*gyzz))) + Ey_rhs = alpn1*trK*Ey-(Ex*betayx+Ey*betayy+Ez*betayz) & + -FOUR*PI*alpn1*Jy-alpn1*(gupxy*Kpsix+gupyy*Kpsiy+gupyz*Kpsiz) & + +chi3o2*( & + ((gxx*Bx+gxy*By+gxz*Bz)*Lapz+alpn1*(gxx*Bxz+gxy*Byz+gxz*Bzz)+alpn1*(Bx*gxxz+By*gxyz+Bz*gxzz))-& + ((gxz*Bx+gyz*By+gzz*Bz)*Lapx+alpn1*(gxz*Bxx+gyz*Byx+gzz*Bzx)+alpn1*(Bx*gxzx+By*gyzx+Bz*gzzx))) + Ez_rhs = alpn1*trK*Ez-(Ex*betazx+Ey*betazy+Ez*betazz) & + -FOUR*PI*alpn1*Jz-alpn1*(gupxz*Kpsix+gupyz*Kpsiy+gupzz*Kpsiz) & + +chi3o2*( & + ((gxy*Bx+gyy*By+gyz*Bz)*Lapx+alpn1*(gxy*Bxx+gyy*Byx+gyz*Bzx)+alpn1*(Bx*gxyx+By*gyyx+Bz*gyzx))-& + ((gxx*Bx+gxy*By+gxz*Bz)*Lapy+alpn1*(gxx*Bxy+gxy*Byy+gxz*Bzy)+alpn1*(Bx*gxxy+By*gxyy+Bz*gxzy))) + + Bx_rhs = alpn1*trK*Bx-(Bx*betaxx+By*betaxy+Bz*betaxz) & + -alpn1*(gupxx*Kphix+gupxy*Kphiy+gupxz*Kphiz) & + -chi3o2*( & + ((gxz*Ex+gyz*Ey+gzz*Ez)*Lapy+alpn1*(gxz*Exy+gyz*Eyy+gzz*Ezy)+alpn1*(Ex*gxzy+Ey*gyzy+Ez*gzzy))-& + ((gxy*Ex+gyy*Ey+gyz*Ez)*Lapz+alpn1*(gxy*Exz+gyy*Eyz+gyz*Ezz)+alpn1*(Ex*gxyz+Ey*gyyz+Ez*gyzz))) + By_rhs = alpn1*trK*By-(Bx*betayx+By*betayy+Bz*betayz) & + -alpn1*(gupxy*Kphix+gupyy*Kphiy+gupyz*Kphiz) & + -chi3o2*( & + ((gxx*Ex+gxy*Ey+gxz*Ez)*Lapz+alpn1*(gxx*Exz+gxy*Eyz+gxz*Ezz)+alpn1*(Ex*gxxz+Ey*gxyz+Ez*gxzz))-& + ((gxz*Ex+gyz*Ey+gzz*Ez)*Lapx+alpn1*(gxz*Exx+gyz*Eyx+gzz*Ezx)+alpn1*(Ex*gxzx+Ey*gyzx+Ez*gzzx))) + Bz_rhs = alpn1*trK*Bz-(Bx*betazx+By*betazy+Bz*betazz) & + -alpn1*(gupxz*Kphix+gupyz*Kphiy+gupzz*Kphiz) & + -chi3o2*( & + ((gxy*Ex+gyy*Ey+gyz*Ez)*Lapx+alpn1*(gxy*Exx+gyy*Eyx+gyz*Ezx)+alpn1*(Ex*gxyx+Ey*gyyx+Ez*gyzx))-& + ((gxx*Ex+gxy*Ey+gxz*Ez)*Lapy+alpn1*(gxx*Exy+gxy*Eyy+gxz*Ezy)+alpn1*(Ex*gxxy+Ey*gxyy+Ez*gxzy))) + + Kpsi_rhs = FOUR*PI*alpn1*qchar-alpn1*kappa*Kpsi - & + alpn1*(Exx+Eyy+Ezz-F3o2/chin1*(chix*Ex+chiy*Ey+chiz*Ez)) + Kphi_rhs = -alpn1*kappa*Kphi - & + alpn1*(Bxx+Byy+Bzz-F3o2/chin1*(chix*Bx+chiy*By+chiz*Bz)) + + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + AAS(1)=ANTI + AAS(2)=ANTI + AAS(3)=SYM + + ASA(1)=ANTI + ASA(2)=SYM + ASA(3)=ANTI + + SAA(1)=SYM + SAA(2)=ANTI + SAA(3)=ANTI + + ASS(1)=ANTI + ASS(2)=SYM + ASS(3)=SYM + + SAS(1)=SYM + SAS(2)=ANTI + SAS(3)=SYM + + SSA(1)=SYM + SSA(2)=SYM + SSA(3)=ANTI + +!!!!!!!!!advection term part + Kpsi_rhs = Kpsi_rhs + betax*Kpsix+betay*Kpsiy+betaz*Kpsiz + Kphi_rhs = Kphi_rhs + betax*Kphix+betay*Kphiy+betaz*Kphiz + + Ex_rhs = Ex_rhs + betax*Exx+betay*Exy+betaz*Exz + Ey_rhs = Ey_rhs + betax*Eyx+betay*Eyy+betaz*Eyz + Ez_rhs = Ez_rhs + betax*Ezx+betay*Ezy+betaz*Ezz + + Bx_rhs = Bx_rhs + betax*Bxx+betay*Bxy+betaz*Bxz + By_rhs = By_rhs + betax*Byx+betay*Byy+betaz*Byz + Bz_rhs = Bz_rhs + betax*Bzx+betay*Bzy+betaz*Bzz + +! numerical dissipation part + if(eps>0)then +! usual Kreiss-Oliger dissipation + + call kodis_sh(ext,crho,sigma,R,Kpsi,Kpsi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Kphi,Kphi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Ex,Ex_rhs,ASS,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Ey,Ey_rhs,SAS,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Ez,Ez_rhs,SSA,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Bx,Bx_rhs,SAA,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,By,By_rhs,ASA,Symmetry,eps,sst) + call kodis_sh(ext,crho,sigma,R,Bz,Bz_rhs,AAS,Symmetry,eps,sst) + + endif +! stress-energy tensor + rho = (gxx*(Ex*Ex+Bx*Bx)+gyy*(Ey*Ey+By*By)+gzz*(Ez*Ez+Bz*Bz) + & + +TWO*(gxy*(Ex*Ey+Bx*By)+gxz*(Ex*Ez+Bx*Bz)+gyz*(Ey*Ez+By*Bz)))/EIT/PI + Sx = (Ey*Bz-Ez*By)/FOUR/PI/chi3o2 + Sy = (Ez*Bx-Ex*Bz)/FOUR/PI/chi3o2 + Sz = (Ex*By-Ey*Bx)/FOUR/PI/chi3o2 + lEx = gxx*Ex+gxy*Ey+gxz*Ez + lEy = gxy*Ex+gyy*Ey+gyz*Ez + lEz = gxz*Ex+gyz*Ey+gzz*Ez + lBx = gxx*Bx+gxy*By+gxz*Bz + lBy = gxy*Bx+gyy*By+gyz*Bz + lBz = gxz*Bx+gyz*By+gzz*Bz + Sxx = rho*gxx-(lEx*lEx+lBx*lBx)/FOUR/PI + Sxy = rho*gxy-(lEx*lEy+lBx*lBy)/FOUR/PI + Sxz = rho*gxz-(lEx*lEz+lBx*lBz)/FOUR/PI + Syy = rho*gyy-(lEy*lEy+lBy*lBy)/FOUR/PI + Syz = rho*gyz-(lEy*lEz+lBy*lBz)/FOUR/PI + Szz = rho*gzz-(lEz*lEz+lBz*lBz)/FOUR/PI + + gont = 0 + + return + + end function compute_rhs_empart_ss diff --git a/AMSS_NCKU_source/empart.h b/AMSS_NCKU_source/empart.h new file mode 100644 index 0000000..98b205e --- /dev/null +++ b/AMSS_NCKU_source/empart.h @@ -0,0 +1,45 @@ + +#ifndef EMPART_H +#define EMPART_H + +#ifdef fortran1 +#define f_compute_rhs_empart compute_rhs_empart +#define f_compute_rhs_empart_ss compute_rhs_empart_ss +#endif +#ifdef fortran2 +#define f_compute_rhs_empart COMPUTE_RHS_EMPART +#define f_compute_rhs_empart_ss COMPUTE_RHS_EMPART_SS +#endif +#ifdef fortran3 +#define f_compute_rhs_empart compute_rhs_empart_ +#define f_compute_rhs_empart_ss compute_rhs_empart_ss_ +#endif + +extern "C" +{ + int f_compute_rhs_empart(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + int &, int &, double &); +} + +extern "C" +{ + int f_compute_rhs_empart_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, + int &, int &, double &, int &); +} +#endif /* EMPART_H */ diff --git a/AMSS_NCKU_source/enforce_algebra.f90 b/AMSS_NCKU_source/enforce_algebra.f90 new file mode 100644 index 0000000..71f3da2 --- /dev/null +++ b/AMSS_NCKU_source/enforce_algebra.f90 @@ -0,0 +1,198 @@ + +!----------------------------------------------------------------------------- +! +! remove the trace of Aij +! trace-free Aij and enforce the determinant of bssn metric to one +!----------------------------------------------------------------------------- + + subroutine enforce_ag(ex, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Axx,Axy,Axz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Ayy,Ayz,Azz + +!~~~~~~~> Local variable: + + real*8, dimension(ex(1),ex(2),ex(3)) :: trA,detg + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + real*8, parameter :: F1o3 = 1.D0 / 3.D0, ONE = 1.D0, TWO = 2.D0 + +!~~~~~~> + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + detg = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / detg + gupxy = - ( gxy * gzz - gyz * gxz ) / detg + gupxz = ( gxy * gyz - gyy * gxz ) / detg + gupyy = ( gxx * gzz - gxz * gxz ) / detg + gupyz = - ( gxx * gyz - gxy * gxz ) / detg + gupzz = ( gxx * gyy - gxy * gxy ) / detg + + trA = gupxx * Axx + gupyy * Ayy + gupzz * Azz & + + TWO * (gupxy * Axy + gupxz * Axz + gupyz * Ayz) + + Axx = Axx - F1o3 * gxx * trA + Axy = Axy - F1o3 * gxy * trA + Axz = Axz - F1o3 * gxz * trA + Ayy = Ayy - F1o3 * gyy * trA + Ayz = Ayz - F1o3 * gyz * trA + Azz = Azz - F1o3 * gzz * trA + + detg = ONE / ( detg ** F1o3 ) + + gxx = gxx * detg + gxy = gxy * detg + gxz = gxz * detg + gyy = gyy * detg + gyz = gyz * detg + gzz = gzz * detg + + dxx = gxx - ONE + dyy = gyy - ONE + dzz = gzz - ONE + + return + + end subroutine enforce_ag +#if 1 +!---------------------------------------------------------------------------------- +! swap the turn of a and g +!---------------------------------------------------------------------------------- + subroutine enforce_ga(ex, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Axx,Axy,Axz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Ayy,Ayz,Azz + +!~~~~~~~> Local variable: + + real*8, dimension(ex(1),ex(2),ex(3)) :: trA + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + real*8, parameter :: F1o3 = 1.D0 / 3.D0, ONE = 1.D0, TWO = 2.D0 + +!~~~~~~> + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE +! for g + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + + gupzz = ONE / ( gupzz ** F1o3 ) + + gxx = gxx * gupzz + gxy = gxy * gupzz + gxz = gxz * gupzz + gyy = gyy * gupzz + gyz = gyz * gupzz + gzz = gzz * gupzz + + dxx = gxx - ONE + dyy = gyy - ONE + dzz = gzz - ONE +! for A + + gupxx = ( gyy * gzz - gyz * gyz ) + gupxy = - ( gxy * gzz - gyz * gxz ) + gupxz = ( gxy * gyz - gyy * gxz ) + gupyy = ( gxx * gzz - gxz * gxz ) + gupyz = - ( gxx * gyz - gxy * gxz ) + gupzz = ( gxx * gyy - gxy * gxy ) + + trA = gupxx * Axx + gupyy * Ayy + gupzz * Azz & + + TWO * (gupxy * Axy + gupxz * Axz + gupyz * Ayz) + + Axx = Axx - F1o3 * gxx * trA + Axy = Axy - F1o3 * gxy * trA + Axz = Axz - F1o3 * gxz * trA + Ayy = Ayy - F1o3 * gyy * trA + Ayz = Ayz - F1o3 * gyz * trA + Azz = Azz - F1o3 * gzz * trA + + return + + end subroutine enforce_ga +#else +!---------------------------------------------------------------------------------- +! duplicate bam +!---------------------------------------------------------------------------------- + subroutine enforce_ga(ex, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: dxx,dyy,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: gxy,gxz,gyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Axx,Axy,Axz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Ayy,Ayz,Azz + +!~~~~~~~> Local variable: + + real*8, dimension(ex(1),ex(2),ex(3)) :: trA + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: aux,detginv + real*8, parameter :: oot = 1.D0 / 3.D0, ONE = 1.D0, TWO = 2.D0 + +!~~~~~~> + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE +! for g +aux = (2.d0*gxy*gxz*gyz + gxx*gyy*gzz & + - gzz*gxy**2 - gyy*gxz**2 - gxx*gyz**2)**(-oot) + + gxx = gxx * aux + gxy = gxy * aux + gxz = gxz * aux + gyy = gyy * aux + gyz = gyz * aux + gzz = gzz * aux + + dxx = gxx - ONE + dyy = gyy - ONE + dzz = gzz - ONE +! for A + +detginv = 1/(2.d0*gxy*gxz*gyz + gxx*gyy*gzz & + - gzz*gxy**2 - gyy*gxz**2 - gxx*gyz**2) + +trA = detginv*(-2.d0*Ayz*gxx*gyz + Axx*gyy*gzz + & + gxx*(Azz*gyy + Ayy*gzz) + 2.d0*(gxz*(Ayz*gxy - Axz*gyy + & + Axy*gyz) + gxy*(Axz*gyz - Axy*gzz)) - Azz*gxy**2 - Ayy*gxz**2 - & + Axx*gyz**2) + +aux = -(oot*trA) + + Axx = Axx + aux * gxx + Axy = Axy + aux * gxy + Axz = Axz + aux * gxz + Ayy = Ayy + aux * gyy + Ayz = Ayz + aux * gyz + Azz = Azz + aux * gzz + + return + + end subroutine enforce_ga +#endif diff --git a/AMSS_NCKU_source/enforce_algebra.h b/AMSS_NCKU_source/enforce_algebra.h new file mode 100644 index 0000000..e6eeaad --- /dev/null +++ b/AMSS_NCKU_source/enforce_algebra.h @@ -0,0 +1,30 @@ + +#ifndef ENFORCE_ALGEBRA_H +#define ENFORCE_ALGEBRA_H + +#ifdef fortran1 +#define f_enforce_ag enforce_ag +#define f_enforce_ga enforce_ga +#endif +#ifdef fortran2 +#define f_enforce_ag ENFORCE_AG +#define f_enforce_ga ENFORCE_GA +#endif +#ifdef fortran3 +#define f_enforce_ag enforce_ag_ +#define f_enforce_ga enforce_ga_ +#endif + +extern "C" +{ + void f_enforce_ag(int *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_enforce_ga(int *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} +#endif /* ENFORCE_ALGEBRA_H */ diff --git a/AMSS_NCKU_source/error_exit.C b/AMSS_NCKU_source/error_exit.C new file mode 100644 index 0000000..b0eae77 --- /dev/null +++ b/AMSS_NCKU_source/error_exit.C @@ -0,0 +1,38 @@ +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + int error_exit(int msg_level, const char *format, ...) + { + const int N_buffer = 2000; + char buffer[N_buffer]; + + va_list ap; + va_start(ap, format); + vsnprintf(buffer, N_buffer, format, ap); + va_end(ap); + + const int len = strlen(buffer); + if ((len > 0) && (buffer[len - 1] == '\n')) + then buffer[len - 1] = '\0'; + + CCTK_VWarn(msg_level, __LINE__, __FILE__, CCTK_THORNSTRING, "%s", buffer); + + // if we got here, evidently msg_level wasn't drastic enough + abort(); /*NOTREACHED*/ + } + + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/expansion.C b/AMSS_NCKU_source/expansion.C new file mode 100644 index 0000000..44c5f3c --- /dev/null +++ b/AMSS_NCKU_source/expansion.C @@ -0,0 +1,1682 @@ + + +#include "macrodef.h" +#ifdef With_AHF + +#include +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "myglobal.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +// all the code in this file is inside this namespace +namespace AHFinderDirect +{ + using jtutil::error_exit; + using jtutil::pow2; + using jtutil::pow4; + + namespace + { + + void setup_xyz_posns(patch_system &ps, bool print_msg_flag); + enum expansion_status + interpolate_geometry(patch_system *ps_ptr, + bool initial_flag, + bool print_msg_flag); + void convert_conformal_to_physical(patch_system &ps, + bool print_msg_flag); + + bool h_is_finite(patch_system &ps, bool initial_flag, + bool print_msg_flag); + bool geometry_is_finite(patch_system &ps, bool initial_flag, + bool print_msg_flag); + + bool compute_Theta(patch_system &ps, fp add_to_expansion, + bool Jacobian_flag, jtutil::norm *Theta_norms_ptr, + bool initial_flag, + bool print_msg_flag); + } + + extern struct state state; + //****************************************************************************** + enum expansion_status + expansion(patch_system *ps_ptr, fp add_to_expansion, + bool initial_flag, + bool Jacobian_flag /* = false */, + jtutil::norm *Theta_norms_ptr /* = NULL */) + { + const bool active_flag = (ps_ptr != NULL); + + if (active_flag) + then + { + // + // normal computation + // + + // fill in values of all ghosted gridfns in ghost zones + ps_ptr->synchronize(); + + if (!h_is_finite(*ps_ptr, initial_flag, false)) + then return expansion_failure__surface_nonfinite; + + // set up xyz positions of grid points + setup_xyz_posns(*ps_ptr, false); + } + + { + // this is the only function we call unconditionally; it looks at + // ps_ptr (non-NULL vs NULL) to choose a normal vs dummy computation + const enum expansion_status status = interpolate_geometry(ps_ptr, + initial_flag, + false); + + if (status != expansion_success) + then return status; // *** ERROR RETURN *** + if (active_flag) + convert_conformal_to_physical(*ps_ptr, false); + } + + if (active_flag) + then + { + if (!geometry_is_finite(*ps_ptr, initial_flag, false)) + then return expansion_failure__geometry_nonfinite; + + // compute remaining gridfns --> $\Theta$ + // and optionally also the Jacobian coefficients + // by algebraic ops and angular finite differencing + if (!compute_Theta(*ps_ptr, add_to_expansion, + Jacobian_flag, Theta_norms_ptr, + initial_flag, + false)) + then return expansion_failure__gij_not_positive_definite; + // *** ERROR RETURN *** + } + + return expansion_success; // *** NORMAL RETURN *** + } + + //****************************************************************************** + namespace + { + void setup_xyz_posns(patch_system &ps, bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " xyz positions and derivative coefficients"); + + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const fp r = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + + fp local_x, local_y, local_z; + p.xyz_of_r_rho_sigma(r, rho, sigma, local_x, local_y, local_z); + + const fp global_x = ps.origin_x() + local_x; + const fp global_y = ps.origin_y() + local_y; + const fp global_z = ps.origin_z() + local_z; + + p.gridfn(gfns::gfn__global_x, irho, isigma) = global_x; + p.gridfn(gfns::gfn__global_y, irho, isigma) = global_y; + p.gridfn(gfns::gfn__global_z, irho, isigma) = global_z; + + const fp global_xx = global_x * global_x; + const fp global_xy = global_x * global_y; + const fp global_xz = global_x * global_z; + const fp global_yy = global_y * global_y; + const fp global_yz = global_y * global_z; + const fp global_zz = global_z * global_z; + + p.gridfn(gfns::gfn__global_xx, irho, isigma) = global_xx; + p.gridfn(gfns::gfn__global_xy, irho, isigma) = global_xy; + p.gridfn(gfns::gfn__global_xz, irho, isigma) = global_xz; + p.gridfn(gfns::gfn__global_yy, irho, isigma) = global_yy; + p.gridfn(gfns::gfn__global_yz, irho, isigma) = global_yz; + p.gridfn(gfns::gfn__global_zz, irho, isigma) = global_zz; + } + } + } + } + } + + //****************************************************************************** + namespace + { + enum expansion_status + interpolate_geometry(patch_system *ps_ptr, + bool initial_flag, + bool print_msg_flag) + { + int status = 1; + +#define CAST_PTR_OR_NULL(type_, ptr_) \ + (ps_ptr == NULL) ? NULL : static_cast(ptr_) + + // + // ***** interpolation points ***** + // + const int N_interp_points = (ps_ptr == NULL) ? 0 : ps_ptr->N_grid_points(); + double *interp_coords[3] = { + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_x)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_y)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__global_z)), + }; + + double *const output_arrays[] = { + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_11)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_111)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_211)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_311)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_12)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_112)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_212)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_312)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_13)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_113)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_213)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_313)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_22)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_122)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_222)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_322)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_23)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_123)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_223)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_323)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__g_dd_33)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_133)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_233)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_g_dd_333)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__psi)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_1)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_2)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__partial_d_psi_3)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_11)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_12)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_13)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_22)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_23)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__K_dd_33)), + CAST_PTR_OR_NULL(double *, ps_ptr->gridfn_data(gfns::gfn__trK)), + }; + + const int N_output_arrays_dim = sizeof(output_arrays) / sizeof(output_arrays[0]); + const int N_output_arrays_use = N_output_arrays_dim; + + int s; + int Npts = 0; + for (int ncpu = 0; ncpu < state.N_procs; ncpu++) + { + + if (state.my_proc == ncpu) + Npts = N_interp_points; + + MPI_Bcast(&Npts, 1, MPI_INT, ncpu, MPI_COMM_WORLD); + + if (Npts != 0) + { + if (state.my_proc == ncpu) + { + memcpy(state.oX, interp_coords[0], Npts * sizeof(double)); + memcpy(state.oY, interp_coords[1], Npts * sizeof(double)); + memcpy(state.oZ, interp_coords[2], Npts * sizeof(double)); + } + MPI_Bcast(state.oX, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + MPI_Bcast(state.oY, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + MPI_Bcast(state.oZ, Npts, MPI_DOUBLE, ncpu, MPI_COMM_WORLD); + + // each cpu calls interpolator + s = globalInterpGFL(state.oX, state.oY, state.oZ, Npts, state.Data); // 1 succuss; 0 fail + + if (state.my_proc == ncpu) + { + status = s; + + if (status == 1) + { + for (int ngf = 0; ngf < N_output_arrays_use; ngf++) + { + memcpy(output_arrays[ngf], state.Data + ngf * N_interp_points, + sizeof(double) * N_interp_points); + } + } + else + { + char filename[100]; + sprintf(filename, "check%05d.dat", state.my_proc); + if (ps_ptr) + ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_11, true, gfns::gfn__h, filename); + // MPI_Abort(MPI_COMM_WORLD,1); + return expansion_failure__surface_outside_grid; + } + } + } + } + +#if 0 + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_11,true,gfns::gfn__h,"check.dat"); + char filename[100]; + sprintf(filename,"g311%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_311,true,gfns::gfn__h,filename); + sprintf(filename,"g12%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_12,true,gfns::gfn__h,filename); + sprintf(filename,"g112%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_112,true,gfns::gfn__h,filename); + sprintf(filename,"g212%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_212,true,gfns::gfn__h,filename); + sprintf(filename,"g312%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_312,true,gfns::gfn__h,filename); + sprintf(filename,"g13%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_13,true,gfns::gfn__h,filename); + sprintf(filename,"g113%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_113,true,gfns::gfn__h,filename); + sprintf(filename,"g213%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_213,true,gfns::gfn__h,filename); + sprintf(filename,"g313%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_313,true,gfns::gfn__h,filename); + sprintf(filename,"g22%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_22,true,gfns::gfn__h,filename); + sprintf(filename,"g122%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_122,true,gfns::gfn__h,filename); + sprintf(filename,"g222%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_222,true,gfns::gfn__h,filename); + sprintf(filename,"g322%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_322,true,gfns::gfn__h,filename); + sprintf(filename,"g23%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_23,true,gfns::gfn__h,filename); + sprintf(filename,"g123%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_123,true,gfns::gfn__h,filename); + sprintf(filename,"g223%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_223,true,gfns::gfn__h,filename); + sprintf(filename,"g323%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_323,true,gfns::gfn__h,filename); + sprintf(filename,"g33%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__g_dd_33,true,gfns::gfn__h,filename); + sprintf(filename,"g133%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_133,true,gfns::gfn__h,filename); + sprintf(filename,"g233%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_233,true,gfns::gfn__h,filename); + sprintf(filename,"g333%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_g_dd_333,true,gfns::gfn__h,filename); + sprintf(filename,"psi%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__psi,true,gfns::gfn__h,filename); + sprintf(filename,"psi1%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_psi_1,true,gfns::gfn__h,filename); + sprintf(filename,"psi2%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_psi_2,true,gfns::gfn__h,filename); + sprintf(filename,"psi3%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__partial_d_psi_3,true,gfns::gfn__h,filename); + sprintf(filename,"K11%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_11,true,gfns::gfn__h,filename); + sprintf(filename,"K12%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_12,true,gfns::gfn__h,filename); + sprintf(filename,"K13%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_13,true,gfns::gfn__h,filename); + sprintf(filename,"K22%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_22,true,gfns::gfn__h,filename); + sprintf(filename,"K23%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_23,true,gfns::gfn__h,filename); + sprintf(filename,"K33%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__K_dd_33,true,gfns::gfn__h,filename); + sprintf(filename,"trK%02d.dat",state.my_proc); + if(ps_ptr) ps_ptr->print_gridfn_with_xyz(gfns::gfn__trK,true,gfns::gfn__h,filename); + + MPI_Abort(MPI_COMM_WORLD,1); +#endif + + if (status == 0) + then error_exit(ERROR_EXIT, + "***** interpolate_geometry(): error return %d from interpolator!\n", + status); /*NOTREACHED*/ + + return expansion_success; // *** NORMAL RETURN *** + } + } + + //****************************************************************************** + namespace + { + void convert_conformal_to_physical(patch_system &ps, bool print_msg_flag) + { + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + for (int isigma = p.min_isigma(); isigma <= p.max_isigma(); ++isigma) + { + + const fp psi = (p.gridfn(gfns::gfn__psi, irho, isigma)); + const fp psi3 = jtutil::pow3(psi); + const fp psi4 = jtutil::pow4(psi); + + const fp partial_d_psi_1 = p.gridfn(gfns::gfn__partial_d_psi_1, irho, isigma); + const fp partial_d_psi_2 = p.gridfn(gfns::gfn__partial_d_psi_2, irho, isigma); + const fp partial_d_psi_3 = p.gridfn(gfns::gfn__partial_d_psi_3, irho, isigma); + + const fp stored_g_dd_11 = p.gridfn(gfns::gfn__g_dd_11, irho, isigma); + const fp stored_g_dd_12 = p.gridfn(gfns::gfn__g_dd_12, irho, isigma); + const fp stored_g_dd_13 = p.gridfn(gfns::gfn__g_dd_13, irho, isigma); + const fp stored_g_dd_22 = p.gridfn(gfns::gfn__g_dd_22, irho, isigma); + const fp stored_g_dd_23 = p.gridfn(gfns::gfn__g_dd_23, irho, isigma); + const fp stored_g_dd_33 = p.gridfn(gfns::gfn__g_dd_33, irho, isigma); + + p.gridfn(gfns::gfn__g_dd_11, irho, isigma) *= psi4; + p.gridfn(gfns::gfn__g_dd_12, irho, isigma) *= psi4; + p.gridfn(gfns::gfn__g_dd_13, irho, isigma) *= psi4; + p.gridfn(gfns::gfn__g_dd_22, irho, isigma) *= psi4; + p.gridfn(gfns::gfn__g_dd_23, irho, isigma) *= psi4; + p.gridfn(gfns::gfn__g_dd_33, irho, isigma) *= psi4; + + p.gridfn(gfns::gfn__partial_d_g_dd_111, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_11 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_111, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_112, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_12 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_112, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_113, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_13 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_113, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_122, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_22 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_122, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_123, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_23 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_123, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_133, irho, isigma) = 4.0 * psi3 * partial_d_psi_1 * stored_g_dd_33 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_133, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_211, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_11 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_211, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_212, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_12 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_212, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_213, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_13 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_213, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_222, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_22 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_222, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_223, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_23 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_223, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_233, irho, isigma) = 4.0 * psi3 * partial_d_psi_2 * stored_g_dd_33 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_233, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_311, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_11 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_311, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_312, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_12 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_312, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_313, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_13 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_313, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_322, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_22 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_322, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_323, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_23 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_323, irho, isigma); + p.gridfn(gfns::gfn__partial_d_g_dd_333, irho, isigma) = 4.0 * psi3 * partial_d_psi_3 * stored_g_dd_33 + psi4 * p.gridfn(gfns::gfn__partial_d_g_dd_333, irho, isigma); + + // K_ij = psi4 \tilde{A}_ij + (1/3) g_ij TrK, g_ij = psi4 \tilde{g}_ij + const fp stored_trKo3 = p.gridfn(gfns::gfn__trK, irho, isigma) / 3.0; + const fp stored_K_dd_11 = p.gridfn(gfns::gfn__K_dd_11, irho, isigma); + const fp stored_K_dd_12 = p.gridfn(gfns::gfn__K_dd_12, irho, isigma); + const fp stored_K_dd_13 = p.gridfn(gfns::gfn__K_dd_13, irho, isigma); + const fp stored_K_dd_22 = p.gridfn(gfns::gfn__K_dd_22, irho, isigma); + const fp stored_K_dd_23 = p.gridfn(gfns::gfn__K_dd_23, irho, isigma); + const fp stored_K_dd_33 = p.gridfn(gfns::gfn__K_dd_33, irho, isigma); + + p.gridfn(gfns::gfn__K_dd_11, irho, isigma) = psi4 * + (stored_K_dd_11 + stored_g_dd_11 * stored_trKo3); + p.gridfn(gfns::gfn__K_dd_12, irho, isigma) = psi4 * + (stored_K_dd_12 + stored_g_dd_12 * stored_trKo3); + p.gridfn(gfns::gfn__K_dd_13, irho, isigma) = psi4 * + (stored_K_dd_13 + stored_g_dd_13 * stored_trKo3); + p.gridfn(gfns::gfn__K_dd_22, irho, isigma) = psi4 * + (stored_K_dd_22 + stored_g_dd_22 * stored_trKo3); + p.gridfn(gfns::gfn__K_dd_23, irho, isigma) = psi4 * + (stored_K_dd_23 + stored_g_dd_23 * stored_trKo3); + p.gridfn(gfns::gfn__K_dd_33, irho, isigma) = psi4 * + (stored_K_dd_33 + stored_g_dd_33 * stored_trKo3); + + } // end for irho isigma + } + } + } + + namespace + { + bool h_is_finite(patch_system &ps, bool initial_flag, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, " checking that h is finite"); + + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const fp h = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + if (!finite(h)) + then + { + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + const fp drho = jtutil::degrees_of_radians(rho); + const fp dsigma = jtutil::degrees_of_radians(sigma); + CCTK_VWarn(1, + __LINE__, __FILE__, CCTK_THORNSTRING, + "\n" + " h=%g isn't finite!\n" + " %s patch (rho,sigma)=(%g,%g) (drho,dsigma)=(%g,%g)\n", + double(h), + p.name(), double(rho), double(sigma), + double(drho), double(dsigma)); + return false; // *** found a NaN *** + } + } + } + } + return true; // *** all values finite *** + } + } + + //****************************************************************************** + namespace + { + bool geometry_is_finite(patch_system &ps, bool initial_flag, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, " checking that geometry is finite"); + + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const fp g_dd_11 = p.gridfn(gfns::gfn__g_dd_11, irho, isigma); + const fp g_dd_12 = p.gridfn(gfns::gfn__g_dd_12, irho, isigma); + const fp g_dd_13 = p.gridfn(gfns::gfn__g_dd_13, irho, isigma); + const fp g_dd_22 = p.gridfn(gfns::gfn__g_dd_22, irho, isigma); + const fp g_dd_23 = p.gridfn(gfns::gfn__g_dd_23, irho, isigma); + const fp g_dd_33 = p.gridfn(gfns::gfn__g_dd_33, irho, isigma); + + const fp K_dd_11 = p.gridfn(gfns::gfn__K_dd_11, irho, isigma); + const fp K_dd_12 = p.gridfn(gfns::gfn__K_dd_12, irho, isigma); + const fp K_dd_13 = p.gridfn(gfns::gfn__K_dd_13, irho, isigma); + const fp K_dd_22 = p.gridfn(gfns::gfn__K_dd_22, irho, isigma); + const fp K_dd_23 = p.gridfn(gfns::gfn__K_dd_23, irho, isigma); + const fp K_dd_33 = p.gridfn(gfns::gfn__K_dd_33, irho, isigma); + + const fp partial_d_g_dd_111 = p.gridfn(gfns::gfn__partial_d_g_dd_111, irho, isigma); + const fp partial_d_g_dd_112 = p.gridfn(gfns::gfn__partial_d_g_dd_112, irho, isigma); + const fp partial_d_g_dd_113 = p.gridfn(gfns::gfn__partial_d_g_dd_113, irho, isigma); + const fp partial_d_g_dd_122 = p.gridfn(gfns::gfn__partial_d_g_dd_122, irho, isigma); + const fp partial_d_g_dd_123 = p.gridfn(gfns::gfn__partial_d_g_dd_123, irho, isigma); + const fp partial_d_g_dd_133 = p.gridfn(gfns::gfn__partial_d_g_dd_133, irho, isigma); + const fp partial_d_g_dd_211 = p.gridfn(gfns::gfn__partial_d_g_dd_211, irho, isigma); + const fp partial_d_g_dd_212 = p.gridfn(gfns::gfn__partial_d_g_dd_212, irho, isigma); + const fp partial_d_g_dd_213 = p.gridfn(gfns::gfn__partial_d_g_dd_213, irho, isigma); + const fp partial_d_g_dd_222 = p.gridfn(gfns::gfn__partial_d_g_dd_222, irho, isigma); + const fp partial_d_g_dd_223 = p.gridfn(gfns::gfn__partial_d_g_dd_223, irho, isigma); + const fp partial_d_g_dd_233 = p.gridfn(gfns::gfn__partial_d_g_dd_233, irho, isigma); + const fp partial_d_g_dd_311 = p.gridfn(gfns::gfn__partial_d_g_dd_311, irho, isigma); + const fp partial_d_g_dd_312 = p.gridfn(gfns::gfn__partial_d_g_dd_312, irho, isigma); + const fp partial_d_g_dd_313 = p.gridfn(gfns::gfn__partial_d_g_dd_313, irho, isigma); + const fp partial_d_g_dd_322 = p.gridfn(gfns::gfn__partial_d_g_dd_322, irho, isigma); + const fp partial_d_g_dd_323 = p.gridfn(gfns::gfn__partial_d_g_dd_323, irho, isigma); + const fp partial_d_g_dd_333 = p.gridfn(gfns::gfn__partial_d_g_dd_333, irho, isigma); + + if (!finite(g_dd_11) || !finite(g_dd_12) || !finite(g_dd_13) || !finite(g_dd_22) || !finite(g_dd_23) || !finite(g_dd_33) || !finite(K_dd_11) || !finite(K_dd_12) || !finite(K_dd_13) || !finite(K_dd_22) || !finite(K_dd_23) || !finite(K_dd_33) || !finite(partial_d_g_dd_111) || !finite(partial_d_g_dd_112) || !finite(partial_d_g_dd_113) || !finite(partial_d_g_dd_122) || !finite(partial_d_g_dd_123) || !finite(partial_d_g_dd_133) || !finite(partial_d_g_dd_211) || !finite(partial_d_g_dd_212) || !finite(partial_d_g_dd_213) || !finite(partial_d_g_dd_222) || !finite(partial_d_g_dd_223) || !finite(partial_d_g_dd_233) || !finite(partial_d_g_dd_311) || !finite(partial_d_g_dd_312) || !finite(partial_d_g_dd_313) || !finite(partial_d_g_dd_322) || !finite(partial_d_g_dd_323) || !finite(partial_d_g_dd_333)) + then + { + const fp h = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + const fp drho = jtutil::degrees_of_radians(rho); + const fp dsigma = jtutil::degrees_of_radians(sigma); + fp local_x, local_y, local_z; + p.xyz_of_r_rho_sigma(h, rho, sigma, local_x, local_y, local_z); + const fp global_x = ps.origin_x() + local_x; + const fp global_y = ps.origin_y() + local_y; + const fp global_z = ps.origin_z() + local_z; + CCTK_VWarn(1, + __LINE__, __FILE__, CCTK_THORNSTRING, + "\n" + " geometry isn't finite at %s patch\n" + " h=%g (rho,sigma)=(%g,%g) (drho,dsigma)=(%g,%g)\n" + " local_(x,y,z)=(%g,%g,%g)\n" + " global_(x,y,z)=(%g,%g,%g)\n" + " g_dd_11=%g _12=%g _13=%g\n" + " _22=%g _23=%g _33=%g\n" + " K_dd_11=%g _12=%g _13=%g\n" + " _22=%g _23=%g _33=%g\n" + " partial_d_g_dd_111=%g _112=%g _113=%g\n" + " _122=%g _123=%g _133=%g\n" + " partial_d_g_dd_211=%g _212=%g _213=%g\n" + " _222=%g _223=%g _233=%g\n" + " partial_d_g_dd_311=%g _312=%g _313=%g\n" + " _322=%g _323=%g _333=%g\n", + p.name(), + double(h), double(rho), double(sigma), + double(drho), double(dsigma), + double(local_x), double(local_y), double(local_z), + double(global_x), double(global_y), double(global_z), + double(g_dd_11), double(g_dd_12), double(g_dd_13), + double(g_dd_22), double(g_dd_23), double(g_dd_33), + double(K_dd_11), double(K_dd_12), double(K_dd_13), + double(K_dd_22), double(K_dd_23), double(K_dd_33), + double(partial_d_g_dd_111), + double(partial_d_g_dd_112), + double(partial_d_g_dd_113), + double(partial_d_g_dd_122), + double(partial_d_g_dd_123), + double(partial_d_g_dd_133), + double(partial_d_g_dd_211), + double(partial_d_g_dd_212), + double(partial_d_g_dd_213), + double(partial_d_g_dd_222), + double(partial_d_g_dd_223), + double(partial_d_g_dd_233), + double(partial_d_g_dd_311), + double(partial_d_g_dd_312), + double(partial_d_g_dd_313), + double(partial_d_g_dd_322), + double(partial_d_g_dd_323), + double(partial_d_g_dd_333)); + return false; // *** found a NaN *** + } + } + } + } + return true; // *** no NaNs found *** + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function computes the expansion Theta(h), and optionally also + // its Jacobian coefficients, (from which the Jacobian matrix may be + // computed later). This function uses a mixture of algebraic operations + // and (rho,sigma) finite differencing. The computation is done entirely + // on the nominal angular grid. + // + // N.b. This function #includes "cg.hh", which defines "dangerous" macros + // which will stay in effect for the rest of this compilation unit! + // + // Arguments: + // Jacobian_flag = true to compute the Jacobian coefficients, + // false to skip this. + // + // Results: + // This function returns true for a successful computation, or false + // if the computation failed because Theta_D <= 0 (this means the interpolated + // g_ij isn't positive definite). + // + namespace + { + bool compute_Theta(patch_system &ps, fp add_to_expansion, + bool Jacobian_flag, jtutil::norm *Theta_norms_ptr, + bool initial_flag, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, " computing Theta(h)"); + + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + // + // compute the X_ud and X_udd derivative coefficients + // ... n.b. this uses the *local* (x,y,z) coordinates + // + const fp r = p.ghosted_gridfn(gfns::gfn__h, irho, isigma); + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + fp xx, yy, zz; + p.xyz_of_r_rho_sigma(r, rho, sigma, xx, yy, zz); + + // 1st derivative coefficients X_ud + const fp X_ud_11 = p.partial_rho_wrt_x(xx, yy, zz); + const fp X_ud_12 = p.partial_rho_wrt_y(xx, yy, zz); + const fp X_ud_13 = p.partial_rho_wrt_z(xx, yy, zz); + const fp X_ud_21 = p.partial_sigma_wrt_x(xx, yy, zz); + const fp X_ud_22 = p.partial_sigma_wrt_y(xx, yy, zz); + const fp X_ud_23 = p.partial_sigma_wrt_z(xx, yy, zz); + + // 2nd derivative coefficient gridfns X_udd + const fp X_udd_111 = p.partial2_rho_wrt_xx(xx, yy, zz); + const fp X_udd_112 = p.partial2_rho_wrt_xy(xx, yy, zz); + const fp X_udd_113 = p.partial2_rho_wrt_xz(xx, yy, zz); + const fp X_udd_122 = p.partial2_rho_wrt_yy(xx, yy, zz); + const fp X_udd_123 = p.partial2_rho_wrt_yz(xx, yy, zz); + const fp X_udd_133 = p.partial2_rho_wrt_zz(xx, yy, zz); + const fp X_udd_211 = p.partial2_sigma_wrt_xx(xx, yy, zz); + const fp X_udd_212 = p.partial2_sigma_wrt_xy(xx, yy, zz); + const fp X_udd_213 = p.partial2_sigma_wrt_xz(xx, yy, zz); + const fp X_udd_222 = p.partial2_sigma_wrt_yy(xx, yy, zz); + const fp X_udd_223 = p.partial2_sigma_wrt_yz(xx, yy, zz); + const fp X_udd_233 = p.partial2_sigma_wrt_zz(xx, yy, zz); + +#define RATIONAL(num, den) (num / den) + +#define PARTIAL_RHO(ghosted_gridfn_name) \ + p.partial_rho(gfns::gfn__##ghosted_gridfn_name, irho, isigma) +#define PARTIAL_SIGMA(ghosted_gridfn_name) \ + p.partial_sigma(gfns::gfn__##ghosted_gridfn_name, irho, isigma) +#define PARTIAL_RHO_RHO(ghosted_gridfn_name) \ + p.partial_rho_rho(gfns::gfn__##ghosted_gridfn_name, irho, isigma) +#define PARTIAL_RHO_SIGMA(ghosted_gridfn_name) \ + p.partial_rho_sigma(gfns::gfn__##ghosted_gridfn_name, irho, isigma) +#define PARTIAL_SIGMA_SIGMA(ghosted_gridfn_name) \ + p.partial_sigma_sigma(gfns::gfn__##ghosted_gridfn_name, irho, isigma) + +#define h p.ghosted_gridfn(gfns::gfn__h, irho, isigma) +#define r h + +#define g_dd_11 p.gridfn(gfns::gfn__g_dd_11, irho, isigma) +#define g_dd_12 p.gridfn(gfns::gfn__g_dd_12, irho, isigma) +#define g_dd_13 p.gridfn(gfns::gfn__g_dd_13, irho, isigma) +#define g_dd_22 p.gridfn(gfns::gfn__g_dd_22, irho, isigma) +#define g_dd_23 p.gridfn(gfns::gfn__g_dd_23, irho, isigma) +#define g_dd_33 p.gridfn(gfns::gfn__g_dd_33, irho, isigma) +#define K_dd_11 p.gridfn(gfns::gfn__K_dd_11, irho, isigma) +#define K_dd_12 p.gridfn(gfns::gfn__K_dd_12, irho, isigma) +#define K_dd_13 p.gridfn(gfns::gfn__K_dd_13, irho, isigma) +#define K_dd_22 p.gridfn(gfns::gfn__K_dd_22, irho, isigma) +#define K_dd_23 p.gridfn(gfns::gfn__K_dd_23, irho, isigma) +#define K_dd_33 p.gridfn(gfns::gfn__K_dd_33, irho, isigma) + +#define partial_d_g_dd_111 p.gridfn(gfns::gfn__partial_d_g_dd_111, irho, isigma) +#define partial_d_g_dd_112 p.gridfn(gfns::gfn__partial_d_g_dd_112, irho, isigma) +#define partial_d_g_dd_113 p.gridfn(gfns::gfn__partial_d_g_dd_113, irho, isigma) +#define partial_d_g_dd_122 p.gridfn(gfns::gfn__partial_d_g_dd_122, irho, isigma) +#define partial_d_g_dd_123 p.gridfn(gfns::gfn__partial_d_g_dd_123, irho, isigma) +#define partial_d_g_dd_133 p.gridfn(gfns::gfn__partial_d_g_dd_133, irho, isigma) +#define partial_d_g_dd_211 p.gridfn(gfns::gfn__partial_d_g_dd_211, irho, isigma) +#define partial_d_g_dd_212 p.gridfn(gfns::gfn__partial_d_g_dd_212, irho, isigma) +#define partial_d_g_dd_213 p.gridfn(gfns::gfn__partial_d_g_dd_213, irho, isigma) +#define partial_d_g_dd_222 p.gridfn(gfns::gfn__partial_d_g_dd_222, irho, isigma) +#define partial_d_g_dd_223 p.gridfn(gfns::gfn__partial_d_g_dd_223, irho, isigma) +#define partial_d_g_dd_233 p.gridfn(gfns::gfn__partial_d_g_dd_233, irho, isigma) +#define partial_d_g_dd_311 p.gridfn(gfns::gfn__partial_d_g_dd_311, irho, isigma) +#define partial_d_g_dd_312 p.gridfn(gfns::gfn__partial_d_g_dd_312, irho, isigma) +#define partial_d_g_dd_313 p.gridfn(gfns::gfn__partial_d_g_dd_313, irho, isigma) +#define partial_d_g_dd_322 p.gridfn(gfns::gfn__partial_d_g_dd_322, irho, isigma) +#define partial_d_g_dd_323 p.gridfn(gfns::gfn__partial_d_g_dd_323, irho, isigma) +#define partial_d_g_dd_333 p.gridfn(gfns::gfn__partial_d_g_dd_333, irho, isigma) + +#define Theta p.gridfn(gfns::gfn__Theta, irho, isigma) + +#define partial_Theta_wrt_partial_d_h_1 \ + p.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_1, irho, isigma) +#define partial_Theta_wrt_partial_d_h_2 \ + p.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_2, irho, isigma) +#define partial_Theta_wrt_partial_dd_h_11 \ + p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_11, irho, isigma) +#define partial_Theta_wrt_partial_dd_h_12 \ + p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_12, irho, isigma) +#define partial_Theta_wrt_partial_dd_h_22 \ + p.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_22, irho, isigma) + +#define save_Theta p.gridfn(gfns::gfn__save_Theta, irho, isigma) +#define Delta_h p.gridfn(gfns::gfn__Delta_h, irho, isigma) + + fp g_uu_11; + fp g_uu_12; + fp g_uu_13; + fp g_uu_22; + fp g_uu_23; + fp g_uu_33; + fp K; + fp K_uu_11; + fp K_uu_12; + fp K_uu_13; + fp K_uu_22; + fp K_uu_23; + fp K_uu_33; + + fp partial_d_ln_sqrt_g_1; + fp partial_d_ln_sqrt_g_2; + fp partial_d_ln_sqrt_g_3; + + fp partial_d_g_uu_111; + fp partial_d_g_uu_112; + fp partial_d_g_uu_113; + fp partial_d_g_uu_122; + fp partial_d_g_uu_123; + fp partial_d_g_uu_133; + fp partial_d_g_uu_211; + fp partial_d_g_uu_212; + fp partial_d_g_uu_213; + fp partial_d_g_uu_222; + fp partial_d_g_uu_223; + fp partial_d_g_uu_233; + fp partial_d_g_uu_311; + fp partial_d_g_uu_312; + fp partial_d_g_uu_313; + fp partial_d_g_uu_322; + fp partial_d_g_uu_323; + fp partial_d_g_uu_333; + + fp Theta_A; + fp Theta_B; + fp Theta_C; + fp Theta_D; + + { + // g_uu + fp t1, t2, t4, t5, t7, t8, t11, t12, t14, t15; + fp t18, t21; + t1 = g_dd_22; + t2 = g_dd_33; + t4 = g_dd_23; + t5 = t4 * t4; + t7 = g_dd_11; + t8 = t7 * t1; + t11 = g_dd_12; + t12 = t11 * t11; + t14 = g_dd_13; + t15 = t11 * t14; + t18 = t14 * t14; + t21 = 1 / (t8 * t2 - t7 * t5 - t12 * t2 + 2.0 * t15 * t4 - t18 * t1); + g_uu_11 = (t1 * t2 - t5) * t21; + g_uu_12 = -(t11 * t2 - t14 * t4) * t21; + g_uu_13 = -(-t11 * t4 + t14 * t1) * t21; + g_uu_22 = (t7 * t2 - t18) * t21; + g_uu_23 = -(t7 * t4 - t15) * t21; + g_uu_33 = (t8 - t12) * t21; + } + + { + // K, K_uu + fp t1, t2, t4, t5, t8, t9, t12, t13, t15, t16; + fp t19, t20, t22, t24, t27, t30, t32, t35, t42, t44; + fp t46, t48, t50, t60, t62, t69, t71, t74, t85, t95; + t1 = g_uu_11; + t2 = K_dd_11; + t4 = g_uu_12; + t5 = K_dd_12; + t8 = g_uu_13; + t9 = K_dd_13; + t12 = g_uu_22; + t13 = K_dd_22; + t15 = g_uu_23; + t16 = K_dd_23; + t19 = g_uu_33; + t20 = K_dd_33; + K = t1 * t2 + 2.0 * t4 * t5 + 2.0 * t8 * t9 + t12 * t13 + 2.0 * t15 * t16 + t19 * t20; + t22 = t1 * t1; + t24 = t4 * t1; + t27 = t8 * t1; + t30 = t4 * t4; + t32 = t8 * t4; + t35 = t8 * t8; + K_uu_11 = t22 * t2 + 2.0 * t24 * t5 + 2.0 * t27 * t9 + t30 * t13 + 2.0 * t32 * t16 + t35 * t20; + t42 = t4 * t12; + t44 = t8 * t12; + t46 = t1 * t15; + t48 = t15 * t4; + t50 = t8 * t15; + K_uu_12 = t24 * t2 + t30 * t5 + t32 * t9 + t1 * t12 * t5 + t42 * t13 + t44 * t16 + t46 * t9 + t48 * t16 + + t50 * t20; + t60 = t4 * t19; + t62 = t8 * t19; + K_uu_13 = t27 * t2 + t32 * t5 + t35 * t9 + t46 * t5 + t48 * t13 + t50 * t16 + t1 * t19 * t9 + t60 * t16 + + t62 * t20; + t69 = t12 * t12; + t71 = t15 * t12; + t74 = t15 * t15; + K_uu_22 = t30 * t2 + 2.0 * t42 * t5 + 2.0 * t48 * t9 + t69 * t13 + 2.0 * t71 * t16 + t74 * t20; + t85 = t15 * t19; + K_uu_23 = t32 * t2 + t44 * t5 + t50 * t9 + t48 * t5 + t71 * t13 + t74 * t16 + t60 * t9 + t12 * t19 * t16 + + t85 * t20; + t95 = t19 * t19; + K_uu_33 = t35 * t2 + 2.0 * t50 * t5 + 2.0 * t62 * t9 + t74 * t13 + 2.0 * t85 * t16 + t95 * t20; + } + + { + // partial_d_g_uu + fp t1, t2, t3, t5, t6, t7, t10, t11, t12, t15; + fp t16, t18, t19, t22, t23, t28, t29, t31, t33, t35; + fp t36, t38, t40, t48, t49, t51, t53, t60, t62, t65; + fp t74, t76, t86, t88, t90, t93, t96, t98, t101, t148; + fp t150, t153, t156, t158, t161; + t1 = g_uu_11; + t2 = t1 * t1; + t3 = partial_d_g_dd_111; + t5 = g_uu_12; + t6 = t5 * t1; + t7 = partial_d_g_dd_112; + t10 = g_uu_13; + t11 = t10 * t1; + t12 = partial_d_g_dd_113; + t15 = t5 * t5; + t16 = partial_d_g_dd_122; + t18 = t10 * t5; + t19 = partial_d_g_dd_123; + t22 = t10 * t10; + t23 = partial_d_g_dd_133; + partial_d_g_uu_111 = -t2 * t3 - 2.0 * t6 * t7 - 2.0 * t11 * t12 - t15 * t16 - 2.0 * t18 * t19 - t22 * t23; + t28 = g_uu_22; + t29 = t1 * t28; + t31 = t5 * t28; + t33 = t10 * t28; + t35 = g_uu_23; + t36 = t1 * t35; + t38 = t5 * t35; + t40 = t10 * t35; + partial_d_g_uu_112 = -t6 * t3 - t15 * t7 - t18 * t12 - t29 * t7 - t31 * t16 - t33 * t19 - t36 * t12 - t38 * t19 - t40 * t23; + t48 = g_uu_33; + t49 = t1 * t48; + t51 = t48 * t5; + t53 = t10 * t48; + partial_d_g_uu_113 = -t11 * t3 - t18 * t7 - t22 * t12 - t36 * t7 - t38 * t16 - t40 * t19 - t49 * t12 - t51 * t19 - t53 * t23; + t60 = t28 * t28; + t62 = t35 * t28; + t65 = t35 * t35; + partial_d_g_uu_122 = -t15 * t3 - 2.0 * t31 * t7 - 2.0 * t38 * t12 - t60 * t16 - 2.0 * t62 * t19 - + t65 * t23; + t74 = t28 * t48; + t76 = t35 * t48; + partial_d_g_uu_123 = -t18 * t3 - t33 * t7 - t40 * t12 - t38 * t7 - t62 * t16 - t65 * t19 - t51 * t12 - t74 * t19 - t76 * t23; + t86 = t48 * t48; + partial_d_g_uu_133 = -t22 * t3 - 2.0 * t40 * t7 - 2.0 * t53 * t12 - t65 * t16 - 2.0 * t76 * t19 - + t86 * t23; + t88 = partial_d_g_dd_211; + t90 = partial_d_g_dd_212; + t93 = partial_d_g_dd_213; + t96 = partial_d_g_dd_222; + t98 = partial_d_g_dd_223; + t101 = partial_d_g_dd_233; + partial_d_g_uu_211 = -t2 * t88 - 2.0 * t6 * t90 - 2.0 * t11 * t93 - t15 * t96 - 2.0 * t18 * t98 - + t22 * t101; + partial_d_g_uu_212 = -t6 * t88 - t15 * t90 - t18 * t93 - t29 * t90 - t31 * t96 - t33 * t98 - t36 * t93 - t38 * t98 - t40 * t101; + partial_d_g_uu_213 = -t11 * t88 - t18 * t90 - t22 * t93 - t36 * t90 - t38 * t96 - t40 * t98 - t49 * t93 - t51 * t98 - t53 * t101; + partial_d_g_uu_222 = -t15 * t88 - 2.0 * t31 * t90 - 2.0 * t38 * t93 - t60 * t96 - 2.0 * t62 * t98 - t65 * t101; + partial_d_g_uu_223 = -t18 * t88 - t33 * t90 - t40 * t93 - t38 * t90 - t62 * t96 - t65 * t98 - t51 * t93 - t74 * t98 - t76 * t101; + partial_d_g_uu_233 = -t22 * t88 - 2.0 * t40 * t90 - 2.0 * t53 * t93 - t65 * t96 - 2.0 * t76 * t98 - t86 * t101; + t148 = partial_d_g_dd_311; + t150 = partial_d_g_dd_312; + t153 = partial_d_g_dd_313; + t156 = partial_d_g_dd_322; + t158 = partial_d_g_dd_323; + t161 = partial_d_g_dd_333; + partial_d_g_uu_311 = -t2 * t148 - 2.0 * t6 * t150 - 2.0 * t11 * t153 - t15 * t156 - 2.0 * t18 * t158 - t22 * t161; + partial_d_g_uu_312 = -t6 * t148 - t15 * t150 - t18 * t153 - t29 * t150 - t31 * t156 - t33 * t158 - t36 * t153 - t38 * t158 - t40 * t161; + partial_d_g_uu_313 = -t11 * t148 - t18 * t150 - t22 * t153 - t36 * t150 - t38 * t156 - t40 * t158 - t49 * t153 - t51 * t158 - t53 * t161; + partial_d_g_uu_322 = -t15 * t148 - 2.0 * t31 * t150 - 2.0 * t38 * t153 - t60 * t156 - 2.0 * t62 * t158 - t65 * t161; + partial_d_g_uu_323 = -t18 * t148 - t33 * t150 - t40 * t153 - t38 * t150 - t62 * t156 - t65 * t158 - t51 * t153 - t74 * t158 - t76 * t161; + partial_d_g_uu_333 = -t22 * t148 - 2.0 * t40 * t150 - 2.0 * t53 * t153 - t65 * t156 - 2.0 * t76 * t158 - t86 * t161; + } + + { + // partial_d_ln_sqrt_g + fp t1, t5, t8, t11, t15, t18; + t1 = g_uu_11; + t5 = g_uu_12; + t8 = g_uu_13; + t11 = g_uu_22; + t15 = g_uu_23; + t18 = g_uu_33; + partial_d_ln_sqrt_g_1 = RATIONAL(1.0, 2.0) * t1 * partial_d_g_dd_111 + t5 * partial_d_g_dd_112 + t8 * partial_d_g_dd_113 + RATIONAL(1.0, 2.0) * t11 * partial_d_g_dd_122 + t15 * partial_d_g_dd_123 + RATIONAL(1.0, 2.0) * t18 * partial_d_g_dd_133; + partial_d_ln_sqrt_g_2 = RATIONAL(1.0, 2.0) * t1 * partial_d_g_dd_211 + t5 * partial_d_g_dd_212 + t8 * partial_d_g_dd_213 + RATIONAL(1.0, 2.0) * t11 * partial_d_g_dd_222 + t15 * partial_d_g_dd_223 + RATIONAL(1.0, 2.0) * t18 * partial_d_g_dd_233; + partial_d_ln_sqrt_g_3 = RATIONAL(1.0, 2.0) * t1 * partial_d_g_dd_311 + t5 * partial_d_g_dd_312 + t8 * partial_d_g_dd_313 + RATIONAL(1.0, 2.0) * t11 * partial_d_g_dd_322 + t15 * partial_d_g_dd_323 + RATIONAL(1.0, 2.0) * t18 * partial_d_g_dd_333; + } + + { + // Theta_A, Theta_B, Theta_C, Theta_D + fp t1, t2, t3, t5, t6, t8, t9, t11, t12, t14; + fp t15, t17, t19, t25, t26, t27, t29, t31, t34, t35; + fp t37, t39, t40, t42, t44, t46, t47, t49, t56, t61; + fp t63, t65, t66, t67, t82, t93, t98, t100, t102, t106; + fp t107, t110, t111, t112, t116, t119, t120, t121, t123, t124; + fp t127, t128, t129, t130, t131, t133, t134, t135, t137, t138; + fp t139, t141, t142, t143, t148, t149, t150, t153, t154, t155; + fp t158, t159, t160, t163, t164, t167, t168, t171, t172, t177; + fp t181, t182, t185, t186, t189, t191, t197, t198, t200, t205; + fp t220, t224, t232, t239, t266, t273, t276, t280, t283, t289; + fp t292, t302, t303, t306, t307, t310, t311, t314, t317, t326; + fp t330, t334, t337, t340, t343, t353, t355, t356, t360, t362; + fp t366, t382, t387, t394, t431, t440, t444, t447, t450, t465; + t1 = g_uu_13; + t2 = t1 * t1; + t3 = 1 / r; + t5 = X_ud_13; + t6 = PARTIAL_RHO(h); + t8 = X_ud_23; + t9 = PARTIAL_SIGMA(h); + t11 = zz * t3 - t5 * t6 - t8 * t9; + t12 = t11 * t11; + t14 = yy * yy; + t15 = zz * zz; + t17 = r * r; + t19 = 1 / t17 / r; + t25 = X_ud_11; + t26 = t25 * t25; + t27 = PARTIAL_RHO_RHO(h); + t29 = X_ud_21; + t31 = PARTIAL_RHO_SIGMA(h); + t34 = t29 * t29; + t35 = PARTIAL_SIGMA_SIGMA(h); + t37 = (t14 + t15) * t19 - X_udd_111 * t6 - X_udd_211 * t9 - t26 * t27 - 2.0 * t29 * t25 * t31 - t34 * t35; + t39 = g_uu_23; + t40 = t39 * t39; + t42 = X_ud_12; + t44 = X_ud_22; + t46 = yy * t3 - t42 * t6 - t44 * t9; + t47 = t46 * t46; + t49 = xx * xx; + t56 = t5 * t5; + t61 = t8 * t8; + t63 = (t49 + t14) * t19 - X_udd_133 * t6 - X_udd_233 * t9 - t56 * t27 - 2.0 * t8 * t5 * t31 - t61 * t35; + t65 = t1 * t11; + t66 = g_uu_22; + t67 = t66 * t46; + t82 = -xx * yy * t19 - X_udd_112 * t6 - X_udd_212 * t9 - t25 * t42 * t27 - t29 * t42 * t31 - t25 * t44 * t31 - t29 * t44 * t35; + t93 = t42 * t42; + t98 = t44 * t44; + t100 = (t49 + t15) * t19 - X_udd_122 * t6 - X_udd_222 * t9 - t93 * t27 - 2.0 * t44 * t42 * t31 - + t98 * t35; + t102 = t39 * t11; + t106 = t1 * t12; + t107 = partial_d_g_uu_123; + t110 = g_uu_12; + t111 = t110 * t47; + t112 = partial_d_g_uu_112; + t116 = xx * t3 - t25 * t6 - t29 * t9; + t119 = t66 * t47; + t120 = partial_d_g_uu_212; + t121 = t120 * t116; + t123 = t39 * t47; + t124 = partial_d_g_uu_312; + t127 = g_uu_11; + t128 = t116 * t116; + t129 = t127 * t128; + t130 = partial_d_g_uu_113; + t131 = t130 * t11; + t133 = t1 * t128; + t134 = partial_d_g_uu_313; + t135 = t134 * t11; + t137 = g_uu_33; + t138 = t137 * t12; + t139 = t134 * t116; + t141 = -t2 * t12 * t37 - t40 * t47 * t63 - 2.0 * t65 * t67 * t82 - t40 * t12 * t100 - 2.0 * t102 * t67 * t100 - t106 * t107 * t46 - t111 * t112 * t116 - t119 * t121 - t123 * t124 * t116 - t129 * t131 - t133 * t135 - + t138 * t139; + t142 = t39 * t12; + t143 = partial_d_g_uu_213; + t148 = t1 * t116; + t149 = partial_d_g_uu_322; + t150 = t149 * t47; + t153 = t110 * t116; + t154 = partial_d_g_uu_222; + t155 = t154 * t47; + t158 = t127 * t116; + t159 = partial_d_g_uu_122; + t160 = t159 * t47; + t163 = partial_d_g_uu_333; + t164 = t163 * t12; + t167 = partial_d_g_uu_133; + t168 = t167 * t12; + t171 = partial_d_g_uu_233; + t172 = t171 * t12; + t177 = t110 * t46; + t181 = partial_d_g_uu_323; + t182 = t181 * t11; + t185 = t137 * t11; + t186 = t124 * t46; + t189 = -t142 * t143 * t116 - t106 * t130 * t116 + RATIONAL(-1.0, 2.0) * t148 * t150 + + RATIONAL(-1.0, 2.0) * t153 * t155 + RATIONAL(-1.0, 2.0) * t158 * t160 + RATIONAL(-1.0, 2.0) * t148 * t164 + RATIONAL(-1.0, 2.0) * t158 * t168 + RATIONAL(-1.0, 2.0) * t153 * t172 + RATIONAL(-1.0, 2.0) * t65 * t160 - 2.0 * t65 * t177 * t37 - t148 * t182 * t46 - t185 * t186 * t116; + t191 = t127 * t127; + t197 = t110 * t128; + t198 = t143 * t11; + t200 = t137 * t137; + t205 = t39 * t46; + t220 = -xx * zz * t19 - X_udd_113 * t6 - X_udd_213 * t9 - t25 * t5 * t27 - t29 * t5 * t31 - t25 * t8 * t31 - t29 * t8 * t35; + t224 = t12 * t11; + t232 = t1 * t220; + t239 = -t191 * t128 * t37 - 2.0 * t142 * t1 * t82 - t197 * t198 - t200 * t12 * t63 - t177 * t131 * t116 - 2.0 * t65 * t205 * t220 + RATIONAL(-1.0, 2.0) * t39 * t224 * t171 - t67 * t198 * t116 - t205 * t135 * t116 - 2.0 * t138 * t232 + RATIONAL(-1.0, 2.0) * t205 * t164 + RATIONAL(-1.0, 2.0) * t177 * t168; + t266 = -yy * zz * t19 - X_udd_123 * t6 - X_udd_223 * t9 - t42 * t5 * t27 - t44 * t5 * t31 - t42 * t8 * t31 - t44 * t8 * t35; + t273 = t110 * t110; + t276 = t47 * t46; + t280 = t39 * t266; + t283 = t158 * t37; + t289 = t148 * t266; + t292 = RATIONAL(-1.0, 2.0) * t67 * t172 + RATIONAL(-1.0, 2.0) * t185 * t150 + RATIONAL(-1.0, 2.0) * t102 * t155 - 2.0 * t197 * t127 * t82 - 2.0 * t133 * t127 * t220 - 2.0 * t133 * t110 * t266 + + RATIONAL(-1.0, 2.0) * t1 * t224 * t167 - t273 * t128 * t100 + RATIONAL(-1.0, 2.0) * t39 * t276 * t149 - 2.0 * t138 * t280 - 2.0 * t65 * t283 + RATIONAL(-1.0, 2.0) * t110 * t276 * t159 - 2.0 * t67 * t289; + t302 = partial_d_g_uu_311; + t303 = t302 * t128; + t306 = partial_d_g_uu_211; + t307 = t306 * t128; + t310 = partial_d_g_uu_111; + t311 = t310 * t128; + t314 = t148 * t63; + t317 = t153 * t266; + t326 = t107 * t11; + t330 = RATIONAL(-1.0, 2.0) * t66 * t276 * t154 - 2.0 * t273 * t46 * t116 * t82 + RATIONAL(-1.0, 2.0) * t205 * t303 + RATIONAL(-1.0, 2.0) * t67 * t307 + RATIONAL(-1.0, 2.0) * t177 * t311 - 2.0 * t205 * t314 - 2.0 * t205 * t317 + RATIONAL(-1.0, 2.0) * t185 * t303 + RATIONAL(-1.0, 2.0) * t102 * t307 + RATIONAL(-1.0, 2.0) * t65 * t311 - t111 * t326 - t158 * t326 * t46; + t334 = t158 * t82; + t337 = t110 * t82; + t340 = t158 * t220; + t343 = t153 * t100; + t353 = t112 * t46; + t355 = partial_d_g_uu_223; + t356 = t355 * t11; + t360 = t120 * t46; + t362 = -2.0 * t177 * t148 * t220 - 2.0 * t67 * t334 - 2.0 * t119 * t337 - 2.0 * t205 * t340 - 2.0 * t67 * t343 + RATIONAL(-1.0, 2.0) * t137 * t224 * t163 - t2 * t128 * t63 - t273 * t47 * t37 - t129 * t353 - + t119 * t356 - t123 * t182 - t133 * t186 - t197 * t360; + t366 = t181 * t46; + t382 = t66 * t66; + t387 = t128 * t116; + t394 = -t142 * t355 * t46 - t138 * t366 - 2.0 * t177 * t283 - 2.0 * t123 * t110 * t220 - 2.0 * t123 * t66 * t266 - t153 * t356 * t46 - t65 * t353 * t116 - t102 * t360 * t116 - t382 * t47 * t100 - 2.0 * t185 * t317 + RATIONAL(-1.0, 2.0) * t127 * t387 * t310 + RATIONAL(-1.0, 2.0) * t110 * t387 * t306; + t431 = RATIONAL(-1.0, 2.0) * t1 * t387 * t302 - 2.0 * t2 * t11 * t116 * t220 - 2.0 * t185 * t314 - 2.0 * t102 * t289 - 2.0 * t65 * t153 * t82 - 2.0 * t185 * t205 * t63 - 2.0 * t40 * t11 * t46 * t266 - 2.0 * t102 * t343 - 2.0 * t102 * t334 - 2.0 * t185 * t340 - 2.0 * t102 * t177 * t82 - 2.0 * t185 * t67 * t266 - 2.0 * t185 * t177 * t220; + Theta_A = t141 + t189 + t239 + t292 + t330 + t362 + t394 + t431; + t440 = t310 * t116 + t121 + t139 + t353 + t154 * t46 + t366 + t131 + t356 + t163 * t11 + t127 * t37 + 2.0 * t337 + 2.0 * t232; + t444 = partial_d_ln_sqrt_g_1; + t447 = partial_d_ln_sqrt_g_2; + t450 = partial_d_ln_sqrt_g_3; + t465 = t66 * t100 + 2.0 * t280 + t137 * t63 + t127 * t444 * t116 + t110 * t447 * t116 + t1 * t450 * t116 + t110 * t444 * t46 + t66 * t447 * t46 + t39 * t450 * t46 + t1 * t444 * t11 + t39 * t447 * t11 + t137 * t450 * t11; + Theta_B = t440 + t465; + Theta_C = K_uu_11 * t128 + 2.0 * K_uu_12 * t46 * t116 + 2.0 * K_uu_13 * t11 * t116 + K_uu_22 * t47 + 2.0 * K_uu_23 * t11 * t46 + K_uu_33 * t12; + Theta_D = t129 + 2.0 * t177 * t116 + 2.0 * t65 * t116 + t119 + 2.0 * t102 * t46 + t138; + } + + if (Theta_D <= 0) + then + { + CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING, + "\n" + " compute_Theta(): Theta_D = $g^{ij} s_i s_j$ = %g <= 0\n" + " at %s patch rho=%g sigma=%g!\n" + " (i.e. the interpolated g_ij isn't positive definite)", + double(Theta_D), + p.name(), double(rho), double(sigma)); + + cout << g_dd_11 << "," << g_dd_12 << "," << g_dd_13 << "," << g_dd_22 << "," << g_dd_23 << "," << g_dd_33 << endl; + cout << xx << "," << yy << "," << zz << endl; + return false; // *** ERROR RETURN *** + } + + // compute H via equation (14) of my 1996 horizon finding paper + const fp sqrt_Theta_D = sqrt(Theta_D); + Theta = +Theta_A / (Theta_D * sqrt_Theta_D) + Theta_B / sqrt_Theta_D + Theta_C / Theta_D - K + add_to_expansion; + + // update running norms of Theta(h) function + if (Theta_norms_ptr != NULL) + then Theta_norms_ptr->data(Theta); + + if (Jacobian_flag) + then + { + // partial_Theta_wrt_partial_d_h, + // partial_Theta_wrt_partial_dd_h + fp t1, t2, t3, t4, t5, t7, t8, t10, t11, t13; + fp t14, t16, t18, t20, t22, t24, t26, t28, t29, t31; + fp t32, t35, t37, t38, t41, t42, t43, t46, t48, t52; + fp t54, t55, t59, t60, t63, t67, t68, t69, t70, t71; + fp t74, t76, t78, t80, t83, t85, t86, t92, t93, t94; + fp t98, t99, t102, t103, t104, t107, t108, t112, t113, t114; + fp t115, t116, t118, t119, t120, t122, t123, t126, t127, t128; + fp t133, t136, t140, t141, t142, t143, t153, t156, t158, t160; + fp t162, t165, t167, t168, t171, t172, t173, t174, t179, t183; + fp t185, t189, t190, t193, t194, t195, t197, t198, t202, t205; + fp t208, t209, t212, t216, t217, t218, t220, t222, t223, t224; + fp t226, t227, t232, t235, t236, t237, t238, t240, t247, t248; + fp t249, t254, t259, t263, t266, t267, t275, t278, t281, t284; + fp t287, t288, t291, t296, t297, t298, t300, t307, t309, t311; + fp t314, t316, t317, t322, t325, t326, t329, t334, t335, t336; + fp t340, t346, t350, t351, t352, t354, t357, t358, t359, t361; + fp t364, t365, t366, t368, t370, t373, t374, t376, t381, t385; + fp t386, t392, t398, t401, t404, t405, t407, t408, t411, t414; + fp t416, t417, t419, t421, t422, t424, t428, t431, t432, t434; + fp t437, t440, t442, t449, t454, t458, t461, t467, t470, t471; + fp t474, t475, t481, t485, t489, t494, t498, t503, t504, t505; + fp t507, t514, t518, t534, t536, t542, t545, t548, t551, t552; + fp t559, t561, t562, t565, t569, t571, t572, t573, t575, t576; + fp t588, t589, t590, t593, t594, t599, t601, t605, t608, t609; + fp t612, t613, t627, t632, t633, t640, t644, t652, t656, t664; + fp t669, t672, t677, t678, t680, t694, t704, t707, t712, t716; + fp t723, t738, t741, t746, t748, t750, t774, t776, t780, t785; + fp t787, t792, t796, t797, t799, t800, t802, t803, t805, t807; + fp t809, t811, t813, t815, t817, t819, t822, t824, t827, t829; + fp t832, t835, t837, t840, t843, t847, t860, t869, t871, t876; + fp t882, t886, t890, t891, t897, t899, t900, t902, t904, t905; + fp t907, t913, t920, t929, t930, t933, t938, t944, t947, t949; + fp t962, t970, t971, t976, t979, t983, t996, t997, t1000, t1001; + fp t1004, t1010, t1012, t1015, t1033, t1036, t1039, t1047, t1048, t1050; + fp t1062, t1065, t1070, t1074, t1075, t1078, t1080, t1082, t1087, t1093; + fp t1095, t1097, t1103, t1107, t1112, t1114, t1138, t1139, t1141, t1145; + fp t1150, t1163, t1166, t1169, t1174, t1186, t1189, t1192, t1200, t1214; + fp t1234, t1266, t1281, t1289, t1300, t1301, t1308, t1335, t1342, t1345; + fp t1364, t1370, t1405, t1414, t1427, t1457, t1460, t1463, t1465, t1469; + fp t1475, t1476, t1477, t1483, t1486, t1487, t1491, t1492, t1493, t1497; + fp t1505, t1508, t1510, t1513, t1516, t1517, t1520, t1526, t1536, t1547; + fp t1552, t1555, t1558, t1561, t1572, t1580, t1594, t1600, t1606, t1610; + fp t1622, t1629, t1639, t1641, t1643, t1645, t1648, t1655, t1659, t1660; + fp t1666, t1667, t1684, t1697, t1704, t1718, t1721, t1739, t1748, t1751; + fp t1757, t1760, t1761, t1768, t1771, t1783, t1785, t1788, t1791, t1803; + fp t1809, t1812, t1825; + t1 = g_uu_13; + t2 = X_ud_13; + t3 = t1 * t2; + t4 = g_uu_12; + t5 = 1 / r; + t7 = X_ud_11; + t8 = PARTIAL_RHO(h); + t10 = X_ud_21; + t11 = PARTIAL_SIGMA(h); + t13 = xx * t5 - t7 * t8 - t10 * t11; + t14 = t4 * t13; + t16 = r * r; + t18 = 1 / t16 / r; + t20 = X_udd_112; + t22 = X_udd_212; + t24 = X_ud_12; + t26 = PARTIAL_RHO_RHO(h); + t28 = t10 * t24; + t29 = PARTIAL_RHO_SIGMA(h); + t31 = X_ud_22; + t32 = t7 * t31; + t35 = PARTIAL_SIGMA_SIGMA(h); + t37 = -xx * yy * t18 - t20 * t8 - t22 * t11 - t7 * t24 * t26 - t28 * t29 - t32 * t29 - t10 * t31 * t35; + t38 = t14 * t37; + t41 = g_uu_22; + t42 = t41 * t24; + t43 = t1 * t13; + t46 = X_udd_123; + t48 = X_udd_223; + t52 = t31 * t2; + t54 = X_ud_23; + t55 = t24 * t54; + t59 = -yy * zz * t18 - t46 * t8 - t48 * t11 - t24 * t2 * t26 - t52 * t29 - t55 * t29 - t31 * t54 * t35; + t60 = t43 * t59; + t63 = g_uu_23; + t67 = yy * t5 - t24 * t8 - t31 * t11; + t68 = t63 * t67; + t69 = t1 * t7; + t70 = xx * xx; + t71 = yy * yy; + t74 = X_udd_133; + t76 = X_udd_233; + t78 = t2 * t2; + t80 = t54 * t2; + t83 = t54 * t54; + t85 = (t70 + t71) * t18 - t74 * t8 - t76 * t11 - t78 * t26 - 2.0 * t80 * t29 - t83 * t35; + t86 = t69 * t85; + t92 = zz * t5 - t2 * t8 - t54 * t11; + t93 = t63 * t92; + t94 = t4 * t67; + t98 = t41 * t67; + t99 = t69 * t59; + t102 = g_uu_33; + t103 = t102 * t92; + t104 = t43 * t74; + t107 = t1 * t92; + t108 = t4 * t7; + t112 = g_uu_11; + t113 = t112 * t13; + t114 = partial_d_g_uu_123; + t115 = t114 * t2; + t116 = t115 * t67; + t118 = partial_d_g_uu_211; + t119 = t118 * t13; + t120 = t119 * t7; + t122 = t63 * t2; + t123 = t94 * t37; + t126 = partial_d_g_uu_122; + t127 = t126 * t67; + t128 = t127 * t24; + t133 = t98 * t37; + t136 = X_udd_113; + t140 = 2.0 * t3 * t38 + 2.0 * t42 * t60 + 2.0 * t68 * t86 + 2.0 * t93 * t94 * t20 + 2.0 * t98 * t99 + 2.0 * t103 * t104 + 2.0 * t107 * t108 * t37 + t113 * t116 + t93 * t120 + 2.0 * t122 * t123 + t113 * t128 + 2.0 * t107 * t14 * t20 + 2.0 * t3 * t133 + 2.0 * t107 * t68 * t136; + t141 = partial_d_g_uu_311; + t142 = t141 * t13; + t143 = t142 * t7; + t153 = zz * zz; + t156 = X_udd_122; + t158 = X_udd_222; + t160 = t24 * t24; + t162 = t31 * t24; + t165 = t31 * t31; + t167 = (t70 + t153) * t18 - t156 * t8 - t158 * t11 - t160 * t26 - 2.0 * t162 * t29 - t165 * t35; + t168 = t108 * t167; + t171 = t13 * t13; + t172 = t112 * t171; + t173 = partial_d_g_uu_112; + t174 = t173 * t24; + t179 = X_udd_213; + t183 = t10 * t2; + t185 = t7 * t54; + t189 = -xx * zz * t18 - t136 * t8 - t179 * t11 - t7 * t2 * t26 - t183 * t29 - t185 * t29 - t10 * t54 * t35; + t190 = t68 * t189; + t193 = t112 * t7; + t194 = t114 * t92; + t195 = t194 * t67; + t197 = t4 * t4; + t198 = t197 * t67; + t202 = t108 * t59; + t205 = t193 * t37; + t208 = t102 * t2; + t209 = t14 * t59; + t212 = t63 * t24; + t216 = t63 * t63; + t217 = t92 * t92; + t218 = t216 * t217; + t220 = t103 * t143 + 2.0 * t94 * t43 * t136 + 2.0 * t107 * t98 * t20 + 2.0 * t68 * t104 + 2.0 * t93 * t168 + t172 * t174 + 2.0 * t3 * t190 + t193 * t195 + 2.0 * t198 * t7 * t37 + 2.0 * t103 * t202 + 2.0 * t93 * t205 + 2.0 * t208 * t209 + 2.0 * t107 * t212 * t189 + t218 * t156; + t222 = t1 * t1; + t223 = t222 * t217; + t224 = X_udd_111; + t226 = t102 * t102; + t227 = t226 * t217; + t232 = t113 * t189; + t235 = t67 * t67; + t236 = t41 * t235; + t237 = partial_d_g_uu_223; + t238 = t237 * t2; + t240 = t194 * t24; + t247 = partial_d_g_uu_333; + t248 = t247 * t92; + t249 = t248 * t2; + t254 = t113 * t136; + t259 = t1 * t171; + t263 = t193 * t189; + t266 = t223 * t224 + t227 * t74 + 2.0 * t107 * t42 * t37 + 2.0 * t208 * t232 + t236 * t238 + t113 * t240 + 2.0 * t93 * t98 * t156 + 2.0 * t68 * t202 + t43 * t249 + 2.0 * t93 * t42 * t167 + 2.0 * t103 * t254 + 2.0 * t212 * t209 + 2.0 * t259 * t4 * t46 + 2.0 * t103 * t263; + t267 = t98 * t167; + t275 = t14 * t46; + t278 = t43 * t46; + t281 = t113 * t224; + t284 = t113 * t37; + t287 = t102 * t217; + t288 = t63 * t46; + t291 = t113 * t20; + t296 = partial_d_g_uu_312; + t297 = t296 * t67; + t298 = t297 * t13; + t300 = t222 * t92; + t307 = X_udd_211; + t309 = t7 * t7; + t311 = t10 * t7; + t314 = t10 * t10; + t316 = (t71 + t153) * t18 - t224 * t8 - t307 * t11 - t309 * t26 - 2.0 * t311 * t29 - t314 * t35; + t317 = t113 * t316; + t322 = 2.0 * t122 * t267 + 2.0 * t94 * t69 * t189 + 4.0 * t43 * t263 + 2.0 * t103 * t275 + 2.0 * t98 * t278 + 2.0 * t107 * t281 + 2.0 * t122 * t284 + 2.0 * t287 * t288 + 2.0 * t93 * t291 + 2.0 * t68 * t275 + t208 * t298 + 2.0 * t300 * t7 * t189 + 2.0 * t3 * t317 + 2.0 * t103 * t86; + t325 = t4 * t24; + t326 = t325 * t189; + t329 = t43 * t85; + t334 = partial_d_g_uu_313; + t335 = t334 * t92; + t336 = t335 * t13; + t340 = t335 * t7; + t346 = t63 * t59; + t350 = partial_d_g_uu_111; + t351 = t350 * t13; + t352 = t351 * t7; + t354 = t193 * t316; + t357 = partial_d_g_uu_113; + t358 = t357 * t2; + t359 = t358 * t13; + t361 = t94 * t189; + t364 = partial_d_g_uu_323; + t365 = t364 * t2; + t366 = t365 * t67; + t368 = 2.0 * t103 * t326 + 2.0 * t208 * t329 + 2.0 * t212 * t329 + t212 * t336 + 4.0 * t68 * t326 + + t68 * t340 + 2.0 * t93 * t278 + 4.0 * t43 * t202 + 4.0 * t103 * t346 * t2 + t94 * t352 + 2.0 * t107 * t354 + t94 * t359 + 2.0 * t208 * t361 + t43 * t366; + t370 = t41 * t59 * t24; + t373 = t357 * t92; + t374 = t373 * t13; + t376 = t1 * t189; + t381 = t63 * t235; + t385 = partial_d_g_uu_133; + t386 = t385 * t217; + t392 = t4 * t20; + t398 = t350 * t171; + t401 = t118 * t171; + t404 = t334 * t2; + t405 = t404 * t13; + t407 = t4 * t37; + t408 = t407 * t24; + t411 = t43 * t189; + t414 = 4.0 * t68 * t370 + t325 * t374 + 4.0 * t103 * t376 * t2 + t98 * t120 + 2.0 * t381 * t41 * t46 + + RATIONAL(1.0, 2.0) * t193 * t386 + 2.0 * t381 * t4 * t136 + 2.0 * t236 * t392 + 2.0 * t259 * t112 * t136 + + RATIONAL(1.0, 2.0) * t3 * t398 + RATIONAL(1.0, 2.0) * t122 * t401 + t68 * t405 + 4.0 * t98 * t408 + 2.0 * t325 * t411; + t416 = t364 * t92; + t417 = t416 * t67; + t419 = t297 * t7; + t421 = t296 * t24; + t422 = t421 * t13; + t424 = t1 * t37; + t428 = t94 * t316; + t431 = t41 * t41; + t432 = t431 * t235; + t434 = t126 * t235; + t437 = t247 * t217; + t440 = t416 * t24; + t442 = t373 * t7; + t449 = t431 * t67; + t454 = t69 * t417 + t103 * t419 + t103 * t422 + 4.0 * t93 * t424 * t2 + 2.0 * t3 * t428 + t432 * t156 + RATIONAL(1.0, 2.0) * t193 * t434 + RATIONAL(1.0, 2.0) * t69 * t437 + t43 * t440 + t94 * t442 + 2.0 * t300 * t13 * t136 + t381 * t296 * t7 + 2.0 * t449 * t167 * t24 + t259 * t421; + t458 = t350 * t7; + t461 = t4 * t235; + t467 = t13 * t189; + t470 = t237 * t92; + t471 = t470 * t24; + t474 = t385 * t92; + t475 = t474 * t2; + t481 = t13 * t37; + t485 = t67 * t59; + t489 = t238 * t67; + t494 = RATIONAL(3.0, 2.0) * t259 * t141 * t7 + RATIONAL(3.0, 2.0) * t172 * t458 + t461 * t115 + 2.0 * t198 * t13 * t20 + 2.0 * t222 * t2 * t467 + 2.0 * t98 * t471 + t113 * t475 + 2.0 * t107 * t94 * t224 + 2.0 * t197 * t24 * t481 + 2.0 * t216 * t2 * t485 + t68 * t249 + t14 * t489 + t107 * t128 + 2.0 * t93 * t99; + t498 = t470 * t67; + t503 = partial_d_g_uu_233; + t504 = t503 * t92; + t505 = t504 * t2; + t507 = t4 * t171; + t514 = t216 * t92; + t518 = t334 * t7; + t534 = t108 * t498 + 2.0 * t103 * t94 * t136 + t14 * t505 + RATIONAL(3.0, 2.0) * t507 * t118 * t7 + 2.0 * t107 * t325 * t316 + 2.0 * t514 * t24 * t59 + t287 * t518 + t259 * t404 + RATIONAL(3.0, 2.0) * t461 * t126 * t24 + 2.0 * t514 * t67 * t46 + RATIONAL(1.0, 2.0) * t3 * t434 + 2.0 * t68 * t440 + t172 * t358 + 2.0 * t68 * t422; + t536 = partial_d_g_uu_213; + t542 = t98 * t59; + t545 = t68 * t85; + t548 = t216 * t235; + t551 = t536 * t13; + t552 = t551 * t2; + t559 = t174 * t13; + t561 = t536 * t92; + t562 = t561 * t7; + t565 = t226 * t92; + t569 = t94 * t475 + t507 * t536 * t2 + 2.0 * t43 * t340 + t14 * t471 + 2.0 * t208 * t542 + 2.0 * t208 * t545 + t548 * t74 + t98 * t505 + 2.0 * t93 * t552 + 2.0 * t94 * t240 + 2.0 * t113 * t442 + t107 * t559 + 2.0 * t14 * t562 + 2.0 * t565 * t85 * t2; + t571 = partial_d_g_uu_322; + t572 = t571 * t67; + t573 = t572 * t24; + t575 = t173 * t67; + t576 = t575 * t13; + t588 = partial_d_g_uu_212; + t589 = t588 * t24; + t590 = t589 * t13; + t593 = t588 * t67; + t594 = t593 * t13; + t599 = t575 * t7; + t601 = t63 * t217; + t605 = t141 * t171; + t608 = t43 * t573 + t3 * t576 + 2.0 * t103 * t405 + 2.0 * t43 * t419 + t103 * t573 + 2.0 * t107 * t359 + 2.0 * t514 * t167 * t2 + t93 * t590 + t381 * t365 + t122 * t594 + 2.0 * t103 * t98 * t46 + t107 * t599 + + 2.0 * t601 * t1 * t20 + RATIONAL(1.0, 2.0) * t208 * t605; + t609 = t593 * t7; + t612 = partial_d_g_uu_222; + t613 = t612 * t24; + t627 = t588 * t7; + t632 = t612 * t67; + t633 = t632 * t24; + t640 = t216 * t67; + t644 = 2.0 * t14 * t609 + RATIONAL(3.0, 2.0) * t236 * t613 + t93 * t609 + 2.0 * t113 * t599 + + RATIONAL(1.0, 2.0) * t42 * t401 + 2.0 * t107 * t116 + RATIONAL(1.0, 2.0) * t325 * t398 + 2.0 * t103 * t366 + t236 * t627 + 2.0 * t103 * t212 * t85 + t14 * t633 + 2.0 * t93 * t489 + RATIONAL(3.0, 2.0) * t381 * t571 * t24 + 2.0 * t640 * t85 * t24; + t652 = t364 * t24; + t656 = t1 * t217; + t664 = t247 * t2; + t669 = t1 * t136; + t672 = t503 * t217; + t677 = t112 * t112; + t678 = t677 * t171; + t680 = 4.0 * t14 * t205 + 2.0 * t103 * t68 * t74 + t287 * t652 + t461 * t173 * t7 + t656 * t114 * t24 + t601 * t237 * t24 + t507 * t589 + t601 * t536 * t7 + RATIONAL(3.0, 2.0) * t287 * t664 + RATIONAL(1.0, 2.0) * t212 * t437 + 2.0 * t287 * t669 + RATIONAL(1.0, 2.0) * t108 * t672 + RATIONAL(1.0, 2.0) * t42 * t672 + t678 * t224; + t694 = t677 * t13; + t704 = t571 * t235; + t707 = t612 * t235; + t712 = t222 * t13; + t716 = 2.0 * t98 * t590 + 2.0 * t300 * t316 * t2 + 2.0 * t94 * t559 + t98 * t562 + 2.0 * t122 * t60 + + t93 * t633 + 2.0 * t103 * t370 + 2.0 * t694 * t316 * t7 + RATIONAL(3.0, 2.0) * t656 * t385 * t2 + RATIONAL(3.0, 2.0) * t601 * t503 * t2 + RATIONAL(1.0, 2.0) * t208 * t704 + RATIONAL(1.0, 2.0) * t122 * t707 + + RATIONAL(1.0, 2.0) * t69 * t704 + 2.0 * t712 * t85 * t7; + t723 = t197 * t13; + t738 = t14 * t167; + t741 = t14 * t156; + t746 = t561 * t13; + t748 = t197 * t235; + t750 = 2.0 * t198 * t316 * t24 + t656 * t357 * t7 + 2.0 * t723 * t167 * t7 + t68 * t143 + 2.0 * t507 * t112 * t20 + 2.0 * t94 * t354 + t98 * t552 + RATIONAL(1.0, 2.0) * t108 * t707 + RATIONAL(1.0, 2.0) * t212 * t605 + 2.0 * t122 * t738 + 2.0 * t98 * t741 + 2.0 * t93 * t408 + t42 * t746 + t748 * t224; + t774 = t197 * t171; + t776 = t222 * t171; + t780 = 2.0 * t94 * t281 + 2.0 * t42 * t284 + 2.0 * t98 * t168 + t107 * t352 + 2.0 * t212 * t232 + 2.0 * t93 * t741 + RATIONAL(1.0, 2.0) * t325 * t386 + 2.0 * t42 * t738 + 2.0 * t98 * t205 + 2.0 * t98 * t291 + + 2.0 * t325 * t317 + 2.0 * t68 * t254 + t774 * t156 + t776 * t74 + 2.0 * t68 * t263; + t785 = pow(Theta_D, 1.0 * RATIONAL(1.0, 2.0)); + t787 = 1 / t785 / Theta_D; + t792 = -t458 - t627 - t518 - t174 - t613 - t652 - t358 - t238 - t664 - t112 * t224 - 2.0 * t392 - 2.0 * t669; + t796 = partial_d_ln_sqrt_g_1; + t797 = t112 * t796; + t799 = partial_d_ln_sqrt_g_2; + t800 = t4 * t799; + t802 = partial_d_ln_sqrt_g_3; + t803 = t1 * t802; + t805 = t4 * t796; + t807 = t41 * t799; + t809 = t63 * t802; + t811 = t1 * t796; + t813 = t63 * t799; + t815 = t102 * t802; + t817 = -t41 * t156 - 2.0 * t288 - t102 * t74 - t797 * t7 - t800 * t7 - t803 * t7 - t805 * t24 - t807 * t24 - t809 * t24 - t811 * t2 - t813 * t2 - t815 * t2; + t819 = 1 / t785; + t822 = K_uu_11 * t13; + t824 = K_uu_12; + t827 = t824 * t67; + t829 = K_uu_13; + t832 = t829 * t92; + t835 = K_uu_22 * t67; + t837 = K_uu_23; + t840 = t837 * t92; + t843 = K_uu_33 * t92; + t847 = 1 / Theta_D; + t860 = Theta_D * Theta_D; + t869 = RATIONAL(3.0, 2.0) * Theta_A / t785 / t860 + RATIONAL(1.0, 2.0) * Theta_B * t787 + Theta_C / t860; + partial_Theta_wrt_partial_d_h_1 = (t140 + t220 + t266 + t322 + t368 + t414 + t454 + + t494 + t534 + t569 + t608 + t644 + t680 + t716 + t750 + t780) * + t787 + + (t792 + t817) * t819 + (-2.0 * t822 * t7 - 2.0 * t824 * t24 * t13 - 2.0 * t827 * t7 - 2.0 * t829 * t2 * t13 - 2.0 * t832 * t7 - 2.0 * t835 * t24 - 2.0 * t837 * t2 * t67 - 2.0 * t840 * t24 - 2.0 * t843 * t2) * t847 - (-2.0 * t113 * t7 - 2.0 * t325 * t13 - 2.0 * t94 * t7 - 2.0 * t3 * t13 - 2.0 * t107 * t7 - 2.0 * t98 * t24 - 2.0 * t122 * t67 - 2.0 * t93 * t24 - 2.0 * t103 * t2) * t869; + t871 = t113 * t22; + t876 = t63 * t54; + t882 = t551 * t54; + t886 = t561 * t10; + t890 = t112 * t10; + t891 = t890 * t316; + t897 = t334 * t10; + t899 = 2.0 * t93 * t871 + t381 * t296 * t10 + t876 * t594 + 2.0 * t93 * t94 * t22 + t432 * t158 + 2.0 * t93 * t882 + t218 * t158 + 2.0 * t14 * t886 + t748 * t307 + 2.0 * t94 * t891 + t890 * t195 + t548 * t76 + t223 * t307 + t287 * t897; + t900 = t194 * t31; + t902 = t334 * t54; + t904 = t114 * t54; + t905 = t904 * t67; + t907 = t63 * t31; + t913 = t102 * t54; + t920 = t14 * t48; + t929 = t4 * t10; + t930 = t929 * t59; + t933 = t335 * t10; + t938 = t113 * t900 + t259 * t902 + t113 * t905 + 2.0 * t907 * t209 + 2.0 * t300 * t13 * t179 + 2.0 * t913 * t545 + t507 * t536 * t54 + t601 * t536 * t10 + 2.0 * t68 * t920 + 2.0 * t712 * t85 * t10 + 2.0 * t449 * t167 * t31 + 2.0 * t68 * t930 + t68 * t933 + 2.0 * t197 * t31 * t481; + t944 = t1 * t54; + t947 = t588 * t31; + t949 = t113 * t307; + t962 = t364 * t54; + t970 = t4 * t31; + t971 = t970 * t189; + t976 = t913 * t298 + 2.0 * t103 * t907 * t85 + 2.0 * t944 * t317 + t507 * t947 + 2.0 * t107 * t949 + + RATIONAL(3.0, 2.0) * t507 * t118 * t10 + 2.0 * t259 * t4 * t48 + t259 * t296 * t31 + 2.0 * t107 * t891 + + t381 * t962 + 2.0 * t198 * t13 * t22 + 2.0 * t103 * t68 * t76 + 2.0 * t103 * t971 + 2.0 * t876 * t60; + t979 = t416 * t31; + t983 = t351 * t10; + t996 = t1 * t10; + t997 = t996 * t85; + t1000 = t41 * t31; + t1001 = t1000 * t59; + t1004 = t996 * t59; + t1010 = t142 * t10; + t1012 = 2.0 * t907 * t329 + t43 * t979 + 2.0 * t913 * t361 + t107 * t983 + 2.0 * t944 * t38 + 4.0 * t93 * t424 * t54 + 2.0 * t107 * t929 * t37 + 2.0 * t103 * t94 * t179 + 2.0 * t68 * t997 + 2.0 * t103 * t1001 + + 2.0 * t98 * t1004 + t970 * t374 + 2.0 * t913 * t542 + t103 * t1010; + t1015 = t119 * t10; + t1033 = t43 * t48; + t1036 = t297 * t10; + t1039 = t373 * t10; + t1047 = t357 * t54; + t1048 = t1047 * t13; + t1050 = t93 * t1015 + 2.0 * t107 * t1000 * t37 + 2.0 * t259 * t112 * t179 + 2.0 * t970 * t411 + 2.0 * t944 * t133 + 2.0 * t93 * t1004 + 2.0 * t103 * t98 * t48 + t774 * t158 + 2.0 * t98 * t1033 + 2.0 * t43 * t1036 + 2.0 * t113 * t1039 + 2.0 * t1000 * t60 + 2.0 * t94 * t43 * t179 + t94 * t1048; + t1062 = t43 * t76; + t1065 = t113 * t179; + t1070 = t470 * t31; + t1074 = t237 * t54; + t1075 = t1074 * t67; + t1078 = t504 * t54; + t1080 = t474 * t54; + t1082 = 2.0 * t107 * t98 * t22 + 2.0 * t94 * t996 * t189 + t98 * t1015 + 2.0 * t970 * t317 + 2.0 * t876 * t123 + 2.0 * t68 * t1062 + 2.0 * t68 * t1065 + 2.0 * t944 * t428 + t14 * t1070 + 2.0 * t94 * t949 + t14 * t1075 + t94 * t1039 + t14 * t1078 + t113 * t1080; + t1087 = t112 * t189 * t10; + t1093 = t248 * t54; + t1095 = t127 * t31; + t1097 = t572 * t31; + t1103 = t296 * t13 * t31; + t1107 = t407 * t31; + t1112 = t632 * t31; + t1114 = 4.0 * t43 * t930 + 4.0 * t43 * t1087 + t227 * t76 + 4.0 * t68 * t971 + t68 * t1093 + t107 * t1095 + t103 * t1097 + 4.0 * t68 * t1001 + t98 * t1078 + 2.0 * t68 * t1103 + t678 * t307 + 4.0 * t98 * t1107 + + RATIONAL(1.0, 2.0) * t1000 * t672 + t93 * t1112; + t1138 = t173 * t31; + t1139 = t1138 * t13; + t1141 = t4 * t22; + t1145 = 2.0 * t381 * t41 * t48 + 2.0 * t216 * t54 * t485 + t103 * t1103 + RATIONAL(1.0, 2.0) * t996 * t704 + t103 * t1036 + t601 * t237 * t31 + t172 * t1047 + RATIONAL(3.0, 2.0) * t601 * t503 * t54 + + 2.0 * t514 * t31 * t59 + 2.0 * t514 * t67 * t48 + t776 * t76 + t107 * t1139 + 2.0 * t236 * t1141 + t996 * t417; + t1150 = t593 * t10; + t1163 = t947 * t13; + t1166 = t962 * t67; + t1169 = t575 * t10; + t1174 = t944 * t576 + t93 * t1150 + 2.0 * t723 * t167 * t10 + RATIONAL(1.0, 2.0) * t890 * t386 + RATIONAL(1.0, 2.0) * t929 * t672 + RATIONAL(1.0, 2.0) * t944 * t434 + RATIONAL(1.0, 2.0) * t907 * t437 + t93 * t1163 + t98 * t882 + t43 * t1166 + t1000 * t746 + t107 * t1169 + t43 * t1097 + 2.0 * t107 * t1048; + t1186 = t112 * t37 * t10; + t1189 = t929 * t167; + t1192 = t14 * t158; + t1200 = t43 * t1093 + t907 * t336 + 2.0 * t98 * t1070 + t113 * t1095 + 2.0 * t113 * t1169 + t68 * t1010 + t98 * t886 + t94 * t1080 + 4.0 * t14 * t1186 + 2.0 * t93 * t1189 + 2.0 * t93 * t1192 + 2.0 * t913 * t232 + 2.0 * t876 * t738 + t14 * t1112; + t1214 = t902 * t13; + t1234 = 2.0 * t107 * t14 * t22 + 2.0 * t1000 * t738 + 2.0 * t876 * t267 + 2.0 * t107 * t68 * t179 + + 2.0 * t94 * t900 + t68 * t1214 + 2.0 * t103 * t920 + 2.0 * t944 * t190 + 2.0 * t68 * t1087 + 2.0 * t93 * t98 * t158 + 2.0 * t907 * t232 + 2.0 * t93 * t1000 * t167 + 2.0 * t98 * t1192 + 2.0 * t98 * t1189; + t1266 = 2.0 * t103 * t1065 + t94 * t983 + 2.0 * t1000 * t284 + 2.0 * t198 * t316 * t31 + 2.0 * t107 * t907 * t189 + RATIONAL(1.0, 2.0) * t890 * t434 + 2.0 * t103 * t1166 + 2.0 * t43 * t933 + 2.0 * t103 * t930 + 2.0 * t94 * t1139 + 2.0 * t98 * t1163 + 2.0 * t98 * t1186 + RATIONAL(3.0, 2.0) * t259 * t141 * t10 + + 2.0 * t222 * t54 * t467; + t1281 = t588 * t10; + t1289 = t247 * t54; + t1300 = 2.0 * t300 * t10 * t189 + RATIONAL(3.0, 2.0) * t656 * t385 * t54 + t461 * t904 + t172 * t1138 + t236 * t1074 + 2.0 * t694 * t316 * t10 + t236 * t1281 + RATIONAL(3.0, 2.0) * t381 * t571 * t31 + + RATIONAL(3.0, 2.0) * t461 * t126 * t31 + RATIONAL(3.0, 2.0) * t287 * t1289 + 2.0 * t103 * t1087 + 2.0 * t107 * t905 + 2.0 * t68 * t979 + 2.0 * t98 * t871; + t1301 = t612 * t31; + t1308 = t364 * t31; + t1335 = RATIONAL(3.0, 2.0) * t236 * t1301 + 2.0 * t93 * t1075 + 2.0 * t14 * t1150 + t287 * t1308 + t656 * t114 * t31 + t461 * t173 * t10 + RATIONAL(1.0, 2.0) * t1000 * t401 + t656 * t357 * t10 + + 2.0 * t300 * t316 * t54 + 2.0 * t507 * t112 * t22 + 2.0 * t640 * t85 * t31 + 2.0 * t601 * t1 * t22 + RATIONAL(1.0, 2.0) * t876 * t707 + 2.0 * t565 * t85 * t54; + t1342 = t63 * t48; + t1345 = t1 * t179; + t1364 = t350 * t10; + t1370 = RATIONAL(1.0, 2.0) * t913 * t704 + 2.0 * t514 * t167 * t54 + 2.0 * t287 * t1342 + 2.0 * t287 * t1345 + RATIONAL(1.0, 2.0) * t970 * t398 + RATIONAL(1.0, 2.0) * t996 * t437 + RATIONAL(1.0, 2.0) * t907 * t605 + RATIONAL(1.0, 2.0) * t944 * t398 + RATIONAL(1.0, 2.0) * t876 * t401 + + RATIONAL(1.0, 2.0) * t913 * t605 + RATIONAL(1.0, 2.0) * t929 * t707 + RATIONAL(1.0, 2.0) * t970 * t386 + RATIONAL(3.0, 2.0) * t172 * t1364 + 2.0 * t198 * t10 * t37; + t1405 = 4.0 * t103 * t376 * t54 + 2.0 * t103 * t1214 + 4.0 * t103 * t346 * t54 + 2.0 * t93 * t1107 + + 2.0 * t107 * t94 * t307 + 2.0 * t107 * t970 * t316 + 2.0 * t913 * t209 + 2.0 * t381 * t4 * t179 + t929 * t498 + + 2.0 * t93 * t1033 + 2.0 * t103 * t997 + 2.0 * t103 * t1062 + 2.0 * t913 * t329 + 2.0 * t876 * t284 + 2.0 * t93 * t1186; + t1414 = -t1364 - t1281 - t897 - t1138 - t1301 - t1308 - t1047 - t1074 - t1289 - t112 * t307 - 2.0 * t1141 - 2.0 * t1345; + t1427 = -t41 * t158 - 2.0 * t1342 - t102 * t76 - t797 * t10 - t800 * t10 - t803 * t10 - t805 * t31 - + t807 * t31 - t809 * t31 - t811 * t54 - t813 * t54 - t815 * t54; + partial_Theta_wrt_partial_d_h_2 = (t899 + t938 + t976 + t1012 + t1050 + t1082 + t1114 + t1145 + t1174 + t1200 + t1234 + t1266 + t1300 + t1335 + t1370 + t1405) * t787 + (t1414 + t1427) * t819 + (-2.0 * t822 * t10 - 2.0 * t824 * t31 * t13 - 2.0 * t827 * t10 - 2.0 * t829 * t54 * t13 - 2.0 * t832 * t10 - 2.0 * t835 * t31 - 2.0 * t837 * t54 * t67 - 2.0 * t840 * t31 - 2.0 * t843 * t54) * t847 - (-2.0 * t113 * t10 - 2.0 * t970 * t13 - 2.0 * t94 * t10 - 2.0 * t944 * t13 - 2.0 * t107 * t10 - 2.0 * t98 * t31 - 2.0 * t876 * t67 - 2.0 * t93 * t31 - 2.0 * t103 * t54) * t869; + t1457 = t14 * t160; + t1460 = t69 * t2; + t1463 = t68 * t4; + t1465 = t13 * t24 * t2; + t1469 = t43 * t78; + t1475 = t103 * t4; + t1476 = t67 * t7; + t1477 = t1476 * t2; + t1483 = t212 * t2; + t1486 = t107 * t41; + t1487 = t1476 * t24; + t1491 = 2.0 * t98 * t1457 + 2.0 * t287 * t1460 + 2.0 * t1463 * t1465 + t774 * t160 + 2.0 * t68 * t1469 + 2.0 * t107 * t94 * t309 + 2.0 * t1475 * t1477 + 2.0 * t381 * t108 * t2 + 2.0 * t287 * t1483 + 2.0 * t1486 * t1487 + t218 * t160; + t1492 = t13 * t7; + t1493 = t1492 * t24; + t1497 = t113 * t309; + t1505 = t98 * t1; + t1508 = t103 * t41; + t1510 = t67 * t24 * t2; + t1513 = t93 * t4; + t1516 = t94 * t1; + t1517 = t1492 * t2; + t1520 = t107 * t4; + t1526 = 2.0 * t198 * t1493 + t223 * t309 + 2.0 * t107 * t1497 + 2.0 * t259 * t193 * t2 + 2.0 * t93 * t1457 + 2.0 * t1505 * t1465 + 2.0 * t1508 * t1510 + 2.0 * t1513 * t1487 + 2.0 * t1516 * t1517 + 2.0 * t1520 * t1493 + 2.0 * t103 * t68 * t78; + t1536 = t93 * t112; + t1547 = t93 * t1; + t1552 = t432 * t160 + 2.0 * t93 * t98 * t160 + t548 * t78 + 2.0 * t514 * t1510 + t748 * t309 + 2.0 * t1536 * t1493 + 2.0 * t300 * t1517 + 2.0 * t381 * t42 * t2 + 2.0 * t507 * t193 * t24 + 2.0 * t1547 * t1465 + + 2.0 * t1475 * t1465; + t1555 = t103 * t112; + t1558 = t98 * t112; + t1561 = t108 * t24; + t1572 = t68 * t112; + t1580 = 2.0 * t1547 * t1477 + 2.0 * t1555 * t1517 + 2.0 * t1558 * t1493 + 2.0 * t236 * t1561 + + 2.0 * t259 * t325 * t2 + t776 * t78 + t678 * t309 + t227 * t78 + 2.0 * t94 * t1497 + 2.0 * t1572 * t1517 + 2.0 * t103 * t1469 + 2.0 * t601 * t69 * t24; + partial_Theta_wrt_partial_dd_h_11 = (t1491 + t1526 + t1552 + t1580) * t787 + (-t112 * t309 - 2.0 * t1561 - 2.0 * t1460 - t41 * t160 - 2.0 * t1483 - t102 * t78) * t819; + t1594 = -t183 - t185; + t1600 = t67 * t10; + t1606 = -t28 - t32; + t1610 = t1 * t1594; + t1622 = 2.0 * t218 * t162 - 2.0 * t107 * t68 * t1594 + 2.0 * t432 * t162 + 4.0 * t1520 * t1600 * t7 + 2.0 * t776 * t80 - 2.0 * t601 * t1 * t1606 - 2.0 * t287 * t1610 + 2.0 * t223 * t311 + 2.0 * t748 * t311 - 2.0 * t93 * t94 * t1606 + 2.0 * t774 * t162; + t1629 = -t52 - t55; + t1639 = t113 * t1606; + t1641 = t113 * t1594; + t1643 = t14 * t1629; + t1645 = -t381 * t4 * t1594 - t300 * t13 * t1594 - t107 * t98 * t1606 - t259 * t4 * t1629 - t103 * t94 * t1594 - t107 * t14 * t1606 + t678 * t311 - t507 * t112 * t1606 - t93 * t1639 - t103 * t1641 - t103 * t1643; + t1648 = t43 * t1629; + t1655 = t13 * t54 * t2; + t1659 = t13 * t10; + t1660 = t1659 * t7; + t1666 = t13 * t31; + t1667 = t1666 * t24; + t1684 = -2.0 * t93 * t1648 + 2.0 * t227 * t80 + 4.0 * t103 * t1 * t1655 + 4.0 * t94 * t112 * t1660 - 2.0 * t198 * t13 * t1606 + 4.0 * t1513 * t1667 - 2.0 * t514 * t67 * t1629 - 2.0 * t94 * t43 * t1594 + 4.0 * t68 * t1 * t1655 + 4.0 * t98 * t4 * t1667 - 2.0 * t98 * t1639; + t1697 = t4 * t1606; + t1704 = t67 * t31; + t1718 = t63 * t1629; + t1721 = -2.0 * t259 * t112 * t1594 - 2.0 * t68 * t1643 - 2.0 * t68 * t1641 - 2.0 * t98 * t1648 + + 4.0 * t107 * t112 * t1660 - 2.0 * t236 * t1697 - 2.0 * t381 * t41 * t1629 + 4.0 * t93 * t41 * t1704 * t24 - 2.0 * t103 * t98 * t1629 + 2.0 * t548 * t80 + 4.0 * t103 * t63 * t67 * t54 * t2 - 2.0 * t287 * t1718; + partial_Theta_wrt_partial_dd_h_12 = (t1622 + 2.0 * t1645 + t1684 + t1721) * t787 + (-2.0 * t890 * t7 + 2.0 * t1697 + 2.0 * t1610 - 2.0 * t1000 * t24 + 2.0 * t1718 - 2.0 * t913 * t2) * t819; + t1739 = t996 * t54; + t1748 = t1704 * t54; + t1751 = t1600 * t54; + t1757 = t1600 * t31; + t1760 = 2.0 * t507 * t890 * t31 + 2.0 * t93 * t98 * t165 + t227 * t83 + t548 * t83 + 2.0 * t287 * t1739 + 2.0 * t259 * t970 * t54 + 2.0 * t601 * t996 * t31 + 2.0 * t514 * t1748 + 2.0 * t1547 * t1751 + 2.0 * t107 * t94 * t314 + 2.0 * t1486 * t1757; + t1761 = t907 * t54; + t1768 = t1659 * t31; + t1771 = t113 * t314; + t1783 = 2.0 * t287 * t1761 + t748 * t314 + t774 * t165 + t678 * t314 + t223 * t314 + 2.0 * t198 * t1768 + 2.0 * t94 * t1771 + 2.0 * t1513 * t1757 + 2.0 * t1520 * t1768 + 2.0 * t1475 * t1751 + 2.0 * t103 * t68 * t83; + t1785 = t1666 * t54; + t1788 = t1659 * t54; + t1791 = t43 * t83; + t1803 = t14 * t165; + t1809 = 2.0 * t1547 * t1785 + 2.0 * t1516 * t1788 + 2.0 * t68 * t1791 + 2.0 * t1558 * t1768 + 2.0 * t259 * t890 * t54 + 2.0 * t107 * t1771 + 2.0 * t1463 * t1785 + 2.0 * t98 * t1803 + t218 * t165 + t776 * t83 + + t432 * t165; + t1812 = t929 * t31; + t1825 = t1572 * t1788 + t1505 * t1785 + t236 * t1812 + t103 * t1791 + t300 * t1788 + t381 * t1000 * t54 + t381 * t929 * t54 + t93 * t1803 + t1555 * t1788 + t1536 * t1768 + t1475 * t1785 + t1508 * t1748; + partial_Theta_wrt_partial_dd_h_22 = (t1760 + t1783 + t1809 + 2.0 * t1825) * t787 + (-t112 * t314 - 2.0 * t1812 - 2.0 * t1739 - t41 * t165 - 2.0 * t1761 - t102 * t83) * t819; + } + } + } + } + + return true; // *** NORMAL RETURN *** + } + } + +} // namespace AHFinderDirect +#endif diff --git a/AMSS_NCKU_source/expansion_Jacobian.C b/AMSS_NCKU_source/expansion_Jacobian.C new file mode 100644 index 0000000..ba53210 --- /dev/null +++ b/AMSS_NCKU_source/expansion_Jacobian.C @@ -0,0 +1,386 @@ + + +#include "macrodef.h" +#ifdef With_AHF + +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + namespace + { + + void expansion_Jacobian_partial_SD(patch_system &ps, Jacobian &Jac, + bool print_msg_flag); + + void add_ghost_zone_Jacobian(const patch_system &ps, + Jacobian &Jac, + fp mol, + const patch &xp, const ghost_zone &xmgz, + int x_II, + int xm_irho, int xm_isigma); + + enum expansion_status + expansion_Jacobian_dr_FD(patch_system *ps_ptr, Jacobian *Jac_ptr, fp add_to_expansion, + bool initial_flag, + bool print_msg_flag); + } + + //****************************************************************************** + + // + // If ps_ptr != NULL and Jac_ptr != NULL, this function computes the + // Jacobian matrix J[Theta(h)] of the expansion Theta(h). We assume + // that Theta(h) has already been computed. + // + // If ps_ptr == NULL and Jac_ptr == NULL, this function does a dummy + // computation, in which only any expansion() (and hence geometry + // interpolator) calls are done, these with the number of interpolation + // points set to 0 and all the output array pointers set to NULL. + // + // It's illegal for one but not both of ps_ptr and Jac_ptr to be NULL. + // + // Arguments: + // ps_ptr --> The patch system, or == NULL to do (only) a dummy computation. + // Jac_ptr --> The Jacobian, or == NULL to do (only) a dummy computation. + // add_to_expansion = A real number to add to the expansion. + // + // Results: + // This function returns a status code indicating whether the computation + // succeeded or failed, and if the latter, what caused the failure. + // + enum expansion_status + expansion_Jacobian(patch_system *ps_ptr, Jacobian *Jac_ptr, + fp add_to_expansion, + bool initial_flag, + bool print_msg_flag /* = false */) + { + const bool active_flag = (ps_ptr != NULL) && (Jac_ptr != NULL); + enum expansion_status status; + + if (active_flag) + then expansion_Jacobian_partial_SD(*ps_ptr, *Jac_ptr, + print_msg_flag); + // this function looks at ps_ptr and Jac_ptr (non-NULL vs NULL) + // to choose a normal vs dummy computation + { + status = expansion_Jacobian_dr_FD(ps_ptr, Jac_ptr, add_to_expansion, + initial_flag, + print_msg_flag); + if (status != expansion_success) + then return status; // *** ERROR RETURN *** + } + + return expansion_success; // *** NORMAL RETURN *** + } + // + // This function computes the partial derivative terms in the Jacobian + // matrix of the expansion Theta(h), by symbolic differentiation from + // the Jacobian coefficient (angular) gridfns. The Jacobian is traversed + // by rows, using equation (25) of my 1996 apparent horizon finding paper. + // + // Inputs (angular gridfns, on ghosted grid): + // h # shape of trial surface + // Theta # Theta(h) assumed to already be computed + // partial_Theta_wrt_partial_d_h # Jacobian coefficients + // partial_Theta_wrt_partial_dd_h # (also assumed to already be computed) + // + // Outputs: + // The Jacobian matrix is stored in the Jacobian object Jac. + // + namespace + { + void expansion_Jacobian_partial_SD(patch_system &ps, Jacobian &Jac, + bool print_msg_flag) + { + Jac.zero_matrix(); + ps.compute_synchronize_Jacobian(); + + for (int xpn = 0; xpn < ps.N_patches(); ++xpn) + { + patch &xp = ps.ith_patch(xpn); + + for (int x_irho = xp.min_irho(); x_irho <= xp.max_irho(); ++x_irho) + { + for (int x_isigma = xp.min_isigma(); x_isigma <= xp.max_isigma(); ++x_isigma) + { + // + // compute the main Jacobian terms for this grid point, i.e. + // partial Theta(this point x, Jacobian row II) + // --------------------------------------------- + // partial h(other points y, Jacobian column JJ) + // + + // Jacobian row index + const int II = ps.gpn_of_patch_irho_isigma(xp, x_irho, x_isigma); + + // Jacobian coefficients for this point + const fp Jacobian_coeff_rho = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_1, + x_irho, x_isigma); + const fp Jacobian_coeff_sigma = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_d_h_2, + x_irho, x_isigma); + const fp Jacobian_coeff_rho_rho = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_11, + x_irho, x_isigma); + const fp Jacobian_coeff_rho_sigma = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_12, + x_irho, x_isigma); + const fp Jacobian_coeff_sigma_sigma = xp.gridfn(gfns::gfn__partial_Theta_wrt_partial_dd_h_22, + x_irho, x_isigma); + + // partial_rho, partial_rho_rho + { + for (int m_irho = xp.molecule_min_m(); + m_irho <= xp.molecule_max_m(); + ++m_irho) + { + const int xm_irho = x_irho + m_irho; + const fp Jac_rho = Jacobian_coeff_rho * xp.partial_rho_coeff(m_irho); + const fp Jac_rho_rho = Jacobian_coeff_rho_rho * xp.partial_rho_rho_coeff(m_irho); + const fp Jac_sum = Jac_rho + Jac_rho_rho; + if (xp.is_in_nominal_grid(xm_irho, x_isigma)) + then + { + const int xm_JJ = Jac.II_of_patch_irho_isigma(xp, xm_irho, x_isigma); + Jac.sum_into_element(II, xm_JJ, Jac_sum); + } + else + add_ghost_zone_Jacobian(ps, Jac, + Jac_sum, + xp, xp.minmax_rho_ghost_zone(m_irho < 0), + II, xm_irho, x_isigma); + } + } + + // partial_sigma, partial_sigma_sigma + { + for (int m_isigma = xp.molecule_min_m(); + m_isigma <= xp.molecule_max_m(); + ++m_isigma) + { + const int xm_isigma = x_isigma + m_isigma; + const fp Jac_sigma = Jacobian_coeff_sigma * xp.partial_sigma_coeff(m_isigma); + const fp Jac_sigma_sigma = Jacobian_coeff_sigma_sigma * xp.partial_sigma_sigma_coeff(m_isigma); + const fp Jac_sum = Jac_sigma + Jac_sigma_sigma; + if (xp.is_in_nominal_grid(x_irho, xm_isigma)) + then + { + const int xm_JJ = Jac.II_of_patch_irho_isigma(xp, x_irho, xm_isigma); + Jac.sum_into_element(II, xm_JJ, Jac_sum); + } + else + add_ghost_zone_Jacobian(ps, Jac, + Jac_sum, + xp, xp.minmax_sigma_ghost_zone(m_isigma < 0), + II, x_irho, xm_isigma); + } + } + + // partial_rho_sigma + { + for (int m_irho = xp.molecule_min_m(); + m_irho <= xp.molecule_max_m(); + ++m_irho) + { + for (int m_isigma = xp.molecule_min_m(); + m_isigma <= xp.molecule_max_m(); + ++m_isigma) + { + const int xm_irho = x_irho + m_irho; + const int xm_isigma = x_isigma + m_isigma; + const fp Jac_rho_sigma = Jacobian_coeff_rho_sigma * xp.partial_rho_sigma_coeff(m_irho, m_isigma); + if (xp.is_in_nominal_grid(xm_irho, xm_isigma)) + then + { + const int xm_JJ = Jac.II_of_patch_irho_isigma(xp, xm_irho, xm_isigma); + Jac.sum_into_element(II, xm_JJ, Jac_rho_sigma); + } + else + { + const ghost_zone &xmgz = xp.corner_ghost_zone_containing_point(m_irho < 0, m_isigma < 0, + xm_irho, xm_isigma); + add_ghost_zone_Jacobian(ps, Jac, + Jac_rho_sigma, + xp, xmgz, + II, xm_irho, xm_isigma); + } + } + } + } + } + } + } + } + } + + //****************************************************************************** + + // + // This function adds the ghost-zone Jacobian dependency contributions + // for a single ghost-zone point, to a Jacobian matrix. + // + // Arguments: + // ps = The patch system. + // Jac = (out) The Jacobian matrix. + // mol = The molecule coefficient. + // xp = The patch containing the center point of the molecule. + // xmgz = If the x+m point is in a ghost zone, this must be that ghost zone. + // If the x+m point is not in a ghost zone, this argument is ignored. + // x_II = The Jacobian row of the x point. + // xm_(irho,isigma) = The coordinates (in xp) of the x+m point of the molecule. + + namespace + { + void add_ghost_zone_Jacobian(const patch_system &ps, + Jacobian &Jac, + fp mol, + const patch &xp, const ghost_zone &xmgz, + int x_II, + int xm_irho, int xm_isigma) + { + const patch_edge &xme = xmgz.my_edge(); + const int xm_iperp = xme.iperp_of_irho_isigma(xm_irho, xm_isigma); + const int xm_ipar = xme.ipar_of_irho_isigma(xm_irho, xm_isigma); + + // FIXME: this won't change from one call to another + // ==> it would be more efficient to reuse the same buffer + // across multiple calls on this function + int global_min_ym, global_max_ym; + ps.synchronize_Jacobian_global_minmax_ym(global_min_ym, global_max_ym); + jtutil::array1d Jacobian_buffer(global_min_ym, global_max_ym); + + // on what other points y does this molecule point xm depend + // via the patch_system::synchronize() operation? + int y_iperp; + int y_posn, min_ym, max_ym; + const patch_edge &ye = ps.synchronize_Jacobian(xmgz, + xm_iperp, xm_ipar, + y_iperp, + y_posn, min_ym, max_ym, + Jacobian_buffer); + patch &yp = ye.my_patch(); + + // add the Jacobian contributions from the ym points + for (int ym = min_ym; ym <= max_ym; ++ym) + { + const int y_ipar = y_posn + ym; + const int y_irho = ye.irho_of_iperp_ipar(y_iperp, y_ipar); + const int y_isigma = ye.isigma_of_iperp_ipar(y_iperp, y_ipar); + const int y_JJ = Jac.II_of_patch_irho_isigma(yp, y_irho, y_isigma); + Jac.sum_into_element(x_II, y_JJ, mol * Jacobian_buffer(ym)); + } + } + } + + //****************************************************************************** + + // + // If ps_ptr != NULL and Jac_ptr != NULL, this function sums the d/dr + // terms into the Jacobian matrix of the expansion Theta(h), computing + // those terms by finite differencing. + // + // If ps_ptr == NULL and Jac_ptr == NULL, this function does a dummy + // computation, in which only any expansion() (and hence geometry + // interpolator) calls are done, these with the number of interpolation + // points set to 0 and all the output array pointers set to NULL. + // + // It's illegal for one but not both of ps_ptr and Jac_ptr to be NULL. + // + // The basic algorithm is that + // Jac += diag[ (Theta(h+epsilon) - Theta(h)) / epsilon ] + // + // Inputs (angular gridfns, on ghosted grid): + // h # shape of trial surface + // Theta # Theta(h) assumed to already be computed + // + // Outputs: + // Jac += d/dr terms + // + // Results: + // This function returns a status code indicating whether the computation + // succeeded or failed, and if the latter, what caused the failure. + // + namespace + { + enum expansion_status + expansion_Jacobian_dr_FD(patch_system *ps_ptr, Jacobian *Jac_ptr, fp add_to_expansion, + bool initial_flag, + bool print_msg_flag) + { + const bool active_flag = (ps_ptr != NULL) && (Jac_ptr != NULL); + + const double epsilon = 1e-6; + // compute Theta(h+epsilon) + if (active_flag) + then + { + ps_ptr->gridfn_copy(gfns::gfn__Theta, gfns::gfn__save_Theta); + ps_ptr->add_to_ghosted_gridfn(epsilon, gfns::gfn__h); + } + const enum expansion_status status = expansion(ps_ptr, add_to_expansion, + initial_flag); + if (status != expansion_success) + then return status; // *** ERROR RETURN *** + + if (active_flag) + then + { + for (int pn = 0; pn < ps_ptr->N_patches(); ++pn) + { + patch &p = ps_ptr->ith_patch(pn); + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const int II = ps_ptr->gpn_of_patch_irho_isigma(p, irho, isigma); + const fp old_Theta = p.gridfn(gfns::gfn__save_Theta, + irho, isigma); + const fp new_Theta = p.gridfn(gfns::gfn__Theta, + irho, isigma); + const fp d_dr_term = (new_Theta - old_Theta) / epsilon; + Jac_ptr->sum_into_element(II, II, d_dr_term); + } + } + } + + // restore h and Theta + ps_ptr->add_to_ghosted_gridfn(-epsilon, gfns::gfn__h); + ps_ptr->gridfn_copy(gfns::gfn__save_Theta, gfns::gfn__Theta); + } + + return expansion_success; // *** NORMAL RETURN *** + } + } + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif diff --git a/AMSS_NCKU_source/fadmquantites_bssn.f90 b/AMSS_NCKU_source/fadmquantites_bssn.f90 new file mode 100644 index 0000000..1bced91 --- /dev/null +++ b/AMSS_NCKU_source/fadmquantites_bssn.f90 @@ -0,0 +1,245 @@ + +!----------------------------------------------------------------------------- +! ADM quantites for surface intergral +!----------------------------------------------------------------------------- + subroutine admmass_bssn(ex, X, Y, Z, & + chi , trK, & + dxx , gxy , gxz , dyy , gyz , dzz , & + Axx , Axy , Axz , Ayy , Ayz , Azz , & + Gamx , Gamy , Gamz , & + massx,massy,massz, symmetry) + + implicit none + !~~~~~~= Input parameters: + + integer,intent(in) :: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: massx,massy,massz +! local variables + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: f + real*8 :: PI, F1o2pi + real*8, parameter :: ONE = 1.d0, F1o8 = 1.d0/8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: dX, dY, dZ + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + PI = dacos( - ONE ) + F1o2pi = ONE / ( 2.d0 * PI ) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + + f=1/4.d0/(chi+ONE)**1.25d0 +! mass_i = (Gami/8 + gupij*phi_j/(4*chi^1.25))/(2*Pi) + massx = (F1o8*Gamx + f*(gupxx*chix+gupxy*chiy+gupxz*chiz))*F1o2pi + massy = (F1o8*Gamy + f*(gupxy*chix+gupyy*chiy+gupyz*chiz))*F1o2pi + massz = (F1o8*Gamz + f*(gupxz*chix+gupyz*chiy+gupzz*chiz))*F1o2pi + + return + + end subroutine admmass_bssn +!----------------------------------------------------------------------------------------------- +! P^i = int r^j p_ji +!----------------------------------------------------------------------------------------------- + subroutine admmomentum_bssn(ex, & + chi, trK, & + dxx , gxy , gxz , dyy , gyz , dzz , & + Axx , Axy , Axz , Ayy , Ayz , Azz , & + Gamx , Gamy , Gamz , & + pxx,pxy,pxz,pyy,pyz,pzz) + + implicit none + !~~~~~~= Input parameters: + + integer,intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: pxx,pxy,pxz,pyy,pyz,pzz +! local variables + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,chim4 + real*8 :: PI, F1o8pi + real*8, parameter :: ONE = 1.d0, F1o3 = 1.d0/3.d0 + + PI = acos( - ONE ) + F1o8pi = ONE / ( 8.d0 * PI ) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + chim4=1.d0/(chi+ONE)**4 + Kxx = chim4*(Axx+F1o3*gxx*trK) + Kxy = chim4*(Axy+F1o3*gxy*trK) + Kxz = chim4*(Axz+F1o3*gxz*trK) + Kyy = chim4*(Ayy+F1o3*gyy*trK) + Kyz = chim4*(Ayz+F1o3*gyz*trK) + Kzz = chim4*(Azz+F1o3*gzz*trK) + + pxx = (Kxx-trK)*F1o8pi + pxy = (Kxy )*F1o8pi + pxz = (Kxz )*F1o8pi + pyy = (Kyy-trK)*F1o8pi + pyz = (Kyz )*F1o8pi + pzz = (Kzz-trK)*F1o8pi + + return + + end subroutine admmomentum_bssn +!----------------------------------------------------------------------------------------------- +! S^i = int r^j s_ji +!----------------------------------------------------------------------------------------------- + subroutine admangularmomentum_bssn(ex,X,Y,Z,& + pxx,pxy,pxz,pyy,pyz,pzz, & + sxx,sxy,sxz,syx,syy,syz,szx,szy,szz) + + implicit none + !~~~~~~= Input parameters: + + integer,intent(in) :: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: pxx,pxy,pxz,pyy,pyz,pzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: sxx,sxy,sxz,syx,syy,syz,szx,szy,szz +!local variable + real*8, dimension(ex(1),ex(2),ex(3))::XX,YY,ZZ + integer::i,j,k + + do j = 1,ex(2) + do k = 1,ex(3) + XX(:,j,k) = X + enddo + enddo + + do i = 1,ex(1) + do k = 1,ex(3) + YY(i,:,k) = Y + enddo + enddo + + do i = 1,ex(1) + do j = 1,ex(2) + ZZ(i,j,:) = Z + enddo + enddo + + sxx = YY*pxy - ZZ*pxz + sxy = YY*pyy - ZZ*pyz + sxz = YY*pyz - ZZ*pzz + syx = ZZ*pxy - YY*pxz + syy = ZZ*pyy - YY*pyz + syz = ZZ*pyz - YY*pzz + szx = XX*pxy - YY*pxx + szy = XX*pyy - YY*pxy + szz = XX*pyz - YY*pxz + + return + + end subroutine admangularmomentum_bssn + +! for shell + subroutine admmass_bssn_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi , trK, & + dxx , gxy , gxz , dyy , gyz , dzz , & + Axx , Axy , Axz , Ayy , Ayz , Azz , & + Gamx , Gamy , Gamz , & + massx,massy,massz, symmetry,sst) + + implicit none + !~~~~~~= Input parameters: + + integer,intent(in) :: ex(1:3),symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: massx,massy,massz +! local variables + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz +! inverse metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz +! partial derivative of chi, chi_i + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: f + real*8 :: PI, F1o2pi + real*8, parameter :: ONE = 1.d0, F1o8 = 1.d0/8.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: dX, dY, dZ + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + PI = dacos( - ONE ) + F1o2pi = ONE / ( 2.d0 * PI ) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + f=1/4.d0/(chi+ONE)**1.25d0 +! mass_i = (Gami/8 + gupij*phi_j/(4*chi^1.25))/(2*Pi) + massx = (F1o8*Gamx + f*(gupxx*chix+gupxy*chiy+gupxz*chiz))*F1o2pi + massy = (F1o8*Gamy + f*(gupxy*chix+gupyy*chiy+gupyz*chiz))*F1o2pi + massz = (F1o8*Gamz + f*(gupxz*chix+gupyz*chiy+gupzz*chiz))*F1o2pi + + return + + end subroutine admmass_bssn_ss diff --git a/AMSS_NCKU_source/fadmquantites_bssn.h b/AMSS_NCKU_source/fadmquantites_bssn.h new file mode 100644 index 0000000..1aa1b9c --- /dev/null +++ b/AMSS_NCKU_source/fadmquantites_bssn.h @@ -0,0 +1,60 @@ + +#ifndef FADMQUANTITES_H +#define FADMQUANTITES_H + +#ifdef fortran1 +#define f_admmass_bssn admmass_bssn +#define f_admmass_bssn_ss admmass_bssn_ss +#define f_admmomentum_bssn admmomentum_bssn +#endif +#ifdef fortran2 +#define f_admmass_bssn ADMMASS_BSSN +#define f_admmass_bssn_ss ADMMASS_BSSN_SS +#define f_admmomentum_bssn ADMMOMENTUM_BSSN +#endif +#ifdef fortran3 +#define f_admmass_bssn admmass_bssn_ +#define f_admmass_bssn_ss admmass_bssn_ss_ +#define f_admmomentum_bssn admmomentum_bssn_ +#endif + +extern "C" +{ + void f_admmass_bssn(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + int &); +} + +extern "C" +{ + void f_admmass_bssn_ss(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + int &, int &); +} + +extern "C" +{ + void f_admmomentum_bssn(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} +#endif /* FADMQUANTITES_H */ diff --git a/AMSS_NCKU_source/fd_grid.C b/AMSS_NCKU_source/fd_grid.C new file mode 100644 index 0000000..62c5940 --- /dev/null +++ b/AMSS_NCKU_source/fd_grid.C @@ -0,0 +1,79 @@ +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + //***************************************************************************** + + // + // This function computes a single coefficient of a 1st derivative + // molecule, for unit grid spacing. + // + // static + fp fd_grid::dx_coeff(int m) + { + switch (m) + { + case -2: + return FD_GRID__ORDER4__DX__COEFF_M2; + case -1: + return FD_GRID__ORDER4__DX__COEFF_M1; + case 0: + return FD_GRID__ORDER4__DX__COEFF_0; + case +1: + return FD_GRID__ORDER4__DX__COEFF_P1; + case +2: + return FD_GRID__ORDER4__DX__COEFF_P2; + + default: + cout << "***** fd_grid::dx_coeff(): m=" << m << " is outside order=4 molecule radius=" << FD_GRID__MOL_RADIUS << endl; + abort(); + } + } + + //***************************************************************************** + + // + // This function computes a single coefficient of a 2nd derivative + // molecule, for unit grid spacing. + // + // static + fp fd_grid::dxx_coeff(int m) + { + switch (m) + { + case -2: + return FD_GRID__ORDER4__DXX__COEFF_M2; + case -1: + return FD_GRID__ORDER4__DXX__COEFF_M1; + case 0: + return FD_GRID__ORDER4__DXX__COEFF_0; + case +1: + return FD_GRID__ORDER4__DXX__COEFF_P1; + case +2: + return FD_GRID__ORDER4__DXX__COEFF_P2; + + default: + cout << "***** fd_grid::dx_coeff(): m=" << m << " is outside order=4 molecule radius=" << FD_GRID__MOL_RADIUS << endl; + abort(); + } + } + + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/fd_grid.h b/AMSS_NCKU_source/fd_grid.h new file mode 100644 index 0000000..ed52205 --- /dev/null +++ b/AMSS_NCKU_source/fd_grid.h @@ -0,0 +1,459 @@ +#ifndef FD_GRID_H +#define FD_GRID_H +namespace AHFinderDirect +{ + + //****************************************************************************** + + // + // *** Implementation Notes -- Overview *** + // + + // + // The key design problem for our finite differencing is how to + // implement an entire family of 5(9) finite difference operations in + // 2D(3D) + // + // partial_rho partial_sigma + // partial_{rho,rho} partial_{rho,sigma} + // partial_{sigma,sigma} + // + // partial_x partial_y partial_z + // partial_xx partial_xy partial_xz + // partial_yy partial_yz + // partial_zz + // + // without having to write out the finite differencing molecules multiple + // times, and while still preserving maximum inline-function efficiency. + // In particular, mixed 2nd-order derivative operations like partial_xy + // should be automatically composed from the two individual 1st derivative + // operations (partial_x and partial_y). + // + + // + // Our basic approach is to define each finite difference molecule in + // a generic 1-dimensional form using an abstract "data(m)" interface. + // Here we use the terminology that a finite difference molecule is + // defined as + // out[k] = sum(m) c[m] * in[k+m] + // where c[] is the vector/matrix of molecule coefficients, and m is + // the (integer) relative grid coordinate within a molecule. + // + // That is, for example, we define the usual 2nd order centered 1st + // derivative operator as + // diff = 0.5*inv_delta_x*(data(+1) - data(-1)) + // leaving unspecified just what the data source is. We then use this + // with an appropriate data source (indexing along that gridfn array axis) + // for each directional derivative operation, and we compose two of + // these, using the first along x as the data source for the second + // along y, for the mixed 2nd-order derivative operation. + // + + //****************************************************************************** + + // + // *** Implementation Notes -- Techniques using C++ Templates *** + // + + // + // There are two plausible ways to use C++ templates + // [C++ templates are described in detail in chapter 13 of + // Stroustrup's "The C++ Programming Language" (3rd Edition), + // hereinafter "C++PL", and chapter 15 of Stroustrup's + // "The Design and Evolution of C++", hereinafter "D&EC++".] + // to write the sort of generic-at-compile-time code we want: + // - Template specializations for each axis, as discussed in D&EC++ + // section 15.10.3. + // - Overloaded functions for each axis, with an argument type + // (possibly that of an extra unused argument) selecting the + // appropriate axis and hence the appropriate function. This + // technique is discussed in D&EC++ section 15.6.3.1. + // + // Quoting from D&EC++ (section 15.6.3.1), + // + // The fundamental observation is that every property + // of a type or an algorithm can be represented by a + // type (possibly defined specificaly to do exactly + // that). That done, such a type can be used to guide + // the overload resolution to select a function that + // depends on the desired property. [...] + // + // Please note that thanks to inlining this resolution + // is done at compile-time, so the appropriate [...] + // function will be called directly without any run-time + // overhead. + // + // Quoting from C++PL3 (section 13.4), + // + // Passing [...] operations as a template parameter has two + // significant benefits compared to alternatives such as + // passing pointers to functions. Several operations can + // be passed as a single argument with no run-time cost. + // In addition, the [...] operators [passed this way] are + // trivial to inline, whereas inlininkg a call through a + // pointer to function requires exceptional attention from + // a compiler. + // + + // + // In my opinion the template-specialization design is cleaner, and it + // clearly has no run-time cost (whereas the overloaded-function design + // may have a run-time cost for constructing and passing unused objects), + // so we use it here. + // + // There are, however, two (non-fatal) problema with this approach: + // - Unfortunately, it appears C++ (or at least gcc 2.95.1) forbids + // template specialization within a class, so some of the functions + // which whould logically be class members, must instead be defined + // outside any class. We use the namespace fd_stuff:: to hide + // these from the outside world. + // - C++PL3, section C.13.3, states that + // Only class templates can be template arguments. + // so we have to use dummy classes around some of our template + // functions. To avoid extra constructor/destructor overhead, we + // make these template functions static. + // + + //****************************************************************************** + + // + // *** Implementation Notes -- Techniques using the C/C++ Preprocessor *** + // + + // + // The fundamental problem with the template approaches is portability: + // Although the C++ standard describes powerful template facilities, not + // all C++ compilers yet fully support these. As an alternative, we can + // use the C/C++ preprocessor. This is ugly and dangerous (global names!), + // but is probably simpler than any of the template approaches. It can + // provide the same finite differencing functionality and efficiency as + // the template-based approaches. + // + // Because of its greater portability, we use the preprocessor-based + // approach here. + // + + //****************************************************************************** + + // + // *** Implementation Notes -- Run-Time Choice of Molecules *** + // + // *If* we want to allow the finite differencing scheme to be changed + // at run-time (e.g. from a parameter file), there are three plausible + // ways to do this: + // - Using switch(molecule_type) , as is standard in C. This is + // simple, and for this particular application quite well-structured + // and maintainable (there are only a few different molecule types, + // all centralized in this file). + // - Using virtual functions, with molecule a virtual base class + // and individual molecules derived from it. This is elegant, but + // may have some performance problems (below). It also requires some + // sort of switch-based "object factory" to interface with with the + // molecule-choice parameters. + // - Write all the finite differencing code multiple times, once for + // each finite differencing scheme. + // + // The typical use of these functions will be from within a loop over + // a whole grid. In both cases we can expect excellent accuracy from + // modern hardware branch prediction (and thus minimal performance loss + // from the branching). It's reasonable to expect a compiler to fully + // inline the switch-based code, exposing all the gridfn array subscriptings + // to strength reduction etc, but this is much trickier for the + // virtual-function--based code. For this reason, the switch-based + // design seems superior to the virtual-function--based one. + // + // However, at present we don't implement any run-time selection: we + // "just" fix the finite differencing scheme at compile time via the + // preprocessor. + // + + //****************************************************************************** + + // + // *** finite difference molecules *** + // + + //************************************** + + // + // define the actual molecules + // + // In the following macros, we first define all the distinct floating- + // -point numbers appearing in a molecules as "K" constants (all > 0), + // then define the actual derivative and its molecule coefficients + // using +/- the "K" constants, with multiplies by 1.0 elided and 0 + // terms skipped in computing the derivative. This (hopefully) gives + // maximum efficiency by avoiding the generated code loading the same + // constants multiple times. + // + + // + // The molecule macros all take the following arguments: + // inv_delta_x_ = inverse of grid spacing in the finite differencing + // direction + // data_= a data-fetching function or macro: data_(ghosted_gfn, irho, isigma) + // is the data to be finite differenced + // irho_plus_m_ = a function or macro: irho_plus_m_(irho,m) returns the + // rho coordinate to be passed to data_() for the [m] + // molecule coefficient + // isigma_plus_m_ = same thing, for the sigma coordinate + // + // n.b. We grab the variables ghosted_gfn, irho, and isigma from the calling + // environment, and we define assorted local variables as needed! + // + + //************************************** + + // + // 2nd order + // + +#define FD_GRID__ORDER2__MOL_RADIUS 1 +#define FD_GRID__ORDER2__MOL_DIAMETER 3 + +#define FD_GRID__ORDER2__DX__KPM1 0.5 +#define FD_GRID__ORDER2__DX(inv_delta_x_, data_, \ + irho_plus_m_, isigma_plus_m_) \ + const fp data_p1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +1), \ + isigma_plus_m_(isigma, +1)); \ + const fp data_m1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -1), \ + isigma_plus_m_(isigma, -1)); \ + const fp sum = FD_GRID__ORDER2__DX__KPM1 * (data_p1 - data_m1); \ + return inv_delta_x_ * sum; /* end macro */ +#define FD_GRID__ORDER2__DX__COEFF_M1 (-FD_GRID__ORDER2__DX__KPM1) +#define FD_GRID__ORDER2__DX__COEFF_0 0.0 +#define FD_GRID__ORDER2__DX__COEFF_P1 (+FD_GRID__ORDER2__DX__KPM1) + +#define FD_GRID__ORDER2__DXX__K0 2.0 +#define FD_GRID__ORDER2__DXX(inv_delta_x_, data_, \ + irho_plus_m_, isigma_plus_m_) \ + const fp data_p1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +1), \ + isigma_plus_m_(isigma, +1)); \ + const fp data_0 = data_(ghosted_gfn, \ + irho_plus_m_(irho, 0), \ + isigma_plus_m_(isigma, 0)); \ + const fp data_m1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -1), \ + isigma_plus_m_(isigma, -1)); \ + const fp sum = data_m1 - FD_GRID__ORDER2__DXX__K0 * data_0 + data_p1; \ + return jtutil::pow2(inv_delta_x_) * sum; /* end macro */ +#define FD_GRID__ORDER2__DXX__COEFF_M1 1.0 +#define FD_GRID__ORDER2__DXX__COEFF_0 (-FD_GRID__ORDER2__DXX__K0) +#define FD_GRID__ORDER2__DXX__COEFF_P1 1.0 + + //************************************** + + // + // 4th order + // + +#define FD_GRID__ORDER4__MOL_RADIUS 2 +#define FD_GRID__ORDER4__MOL_DIAMETER 5 + +#define FD_GRID__ORDER4__DX__KPM2 (1.0 / 12.0) +#define FD_GRID__ORDER4__DX__KPM1 (8.0 / 12.0) +#define FD_GRID__ORDER4__DX(inv_delta_x_, data_, \ + irho_plus_m_, isigma_plus_m_) \ + const fp data_p2 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +2), \ + isigma_plus_m_(isigma, +2)); \ + const fp data_p1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +1), \ + isigma_plus_m_(isigma, +1)); \ + const fp data_m1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -1), \ + isigma_plus_m_(isigma, -1)); \ + const fp data_m2 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -2), \ + isigma_plus_m_(isigma, -2)); \ + const fp sum = FD_GRID__ORDER4__DX__KPM1 * (data_p1 - data_m1) + FD_GRID__ORDER4__DX__KPM2 * (data_m2 - data_p2); \ + /* printf("(%2d %2d) %f %f %f %f\n",irho, isigma,data_m2, data_m1,data_p1, data_p2);*/ \ + return inv_delta_x_ * sum; /* end macro */ +#define FD_GRID__ORDER4__DX__COEFF_M2 (+FD_GRID__ORDER4__DX__KPM2) +#define FD_GRID__ORDER4__DX__COEFF_M1 (-FD_GRID__ORDER4__DX__KPM1) +#define FD_GRID__ORDER4__DX__COEFF_0 0.0 +#define FD_GRID__ORDER4__DX__COEFF_P1 (+FD_GRID__ORDER4__DX__KPM1) +#define FD_GRID__ORDER4__DX__COEFF_P2 (-FD_GRID__ORDER4__DX__KPM2) + + //************************************** + +#define FD_GRID__ORDER4__DXX__KPM2 (1.0 / 12.0) +#define FD_GRID__ORDER4__DXX__KPM1 (16.0 / 12.0) +#define FD_GRID__ORDER4__DXX__K0 (30.0 / 12.0) +#define FD_GRID__ORDER4__DXX(inv_delta_x_, data_, \ + irho_plus_m_, isigma_plus_m_) \ + const fp data_p2 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +2), \ + isigma_plus_m_(isigma, +2)); \ + const fp data_p1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, +1), \ + isigma_plus_m_(isigma, +1)); \ + const fp data_0 = data_(ghosted_gfn, \ + irho_plus_m_(irho, 0), \ + isigma_plus_m_(isigma, 0)); \ + const fp data_m1 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -1), \ + isigma_plus_m_(isigma, -1)); \ + const fp data_m2 = data_(ghosted_gfn, \ + irho_plus_m_(irho, -2), \ + isigma_plus_m_(isigma, -2)); \ + const fp sum = -FD_GRID__ORDER4__DXX__K0 * data_0 + FD_GRID__ORDER4__DXX__KPM1 * (data_m1 + data_p1) - FD_GRID__ORDER4__DXX__KPM2 * (data_m2 + data_p2); \ + return jtutil::pow2(inv_delta_x_) * sum; /* end macro */ +#define FD_GRID__ORDER4__DXX__COEFF_M2 (-FD_GRID__ORDER4__DXX__KPM2) +#define FD_GRID__ORDER4__DXX__COEFF_M1 (+FD_GRID__ORDER4__DXX__KPM1) +#define FD_GRID__ORDER4__DXX__COEFF_0 (-FD_GRID__ORDER4__DXX__K0) +#define FD_GRID__ORDER4__DXX__COEFF_P1 (+FD_GRID__ORDER4__DXX__KPM1) +#define FD_GRID__ORDER4__DXX__COEFF_P2 (-FD_GRID__ORDER4__DXX__KPM2) + + //****************************************************************************** +#define FD_GRID__MOL_RADIUS FD_GRID__ORDER4__MOL_RADIUS +#define FD_GRID__MOL_DIAMETER FD_GRID__ORDER4__MOL_DIAMETER +#define FD_GRID__DX FD_GRID__ORDER4__DX +#define FD_GRID__DXX FD_GRID__ORDER4__DXX + +#define FD_GRID__MOL_AREA (FD_GRID__MOL_DIAMETER * FD_GRID__MOL_DIAMETER) + + //****************************************************************************** + + // + // ***** fd_grid - grid with finite differencing operations ***** + // + // An fd_grid is identical to a grid except that it also defines + // (rho,sigma)-coordinate finite differencing operations on gridfns. + // + + class fd_grid + : public grid + { + // + // molecule sizes + // + public: + // n.b. this interface implicitly assumes that all molecules + // are centered and are the same order and size + static int finite_diff_order() { return 4; } + static int molecule_radius() { return FD_GRID__MOL_RADIUS; } + static int molecule_diameter() { return FD_GRID__MOL_DIAMETER; } + static int molecule_min_m() { return -FD_GRID__MOL_RADIUS; } + static int molecule_max_m() { return FD_GRID__MOL_RADIUS; } + + // + // helper functions to compute (irho,isigma) + [m] + // along each axis + // + private: + static int rho_axis__irho_plus_m(int irho, int m) { return irho + m; } + static int rho_axis__isigma_plus_m(int isigma, int m) { return isigma; } + static int sigma_axis__irho_plus_m(int irho, int m) { return irho; } + static int sigma_axis__isigma_plus_m(int isigma, int m) { return isigma + m; } + + // + // ***** finite differencing ***** + // + public: + // 1st derivatives + fp partial_rho(int ghosted_gfn, int irho, int isigma) + const + { + FD_GRID__DX(inverse_delta_rho(), + ghosted_gridfn, + rho_axis__irho_plus_m, + rho_axis__isigma_plus_m); + } + fp partial_sigma(int ghosted_gfn, int irho, int isigma) + const + { + FD_GRID__DX(inverse_delta_sigma(), + ghosted_gridfn, + sigma_axis__irho_plus_m, + sigma_axis__isigma_plus_m); + } + + // "pure" 2nd derivatives + fp partial_rho_rho(int ghosted_gfn, int irho, int isigma) + const + { + FD_GRID__DXX(inverse_delta_rho(), + ghosted_gridfn, + rho_axis__irho_plus_m, + rho_axis__isigma_plus_m); + } + fp partial_sigma_sigma(int ghosted_gfn, int irho, int isigma) + const + { + FD_GRID__DXX(inverse_delta_sigma(), + ghosted_gridfn, + sigma_axis__irho_plus_m, + sigma_axis__isigma_plus_m); + } + + // mixed 2nd partial derivative + fp partial_rho_sigma(int ghosted_gfn, int irho, int isigma) + const + { + FD_GRID__DX(inverse_delta_rho(), + partial_sigma, + rho_axis__irho_plus_m, + rho_axis__isigma_plus_m); + } + + // + // ***** molecule coefficients ***** + // + public: + // molecule coefficients + // n.b. this interface implicitly assumes that all molecules + // are position-independent + fp partial_rho_coeff(int m) const + { + return inverse_delta_rho() * dx_coeff(m); + } + fp partial_sigma_coeff(int m) const + { + return inverse_delta_sigma() * dx_coeff(m); + } + fp partial_rho_rho_coeff(int m) const + { + return jtutil::pow2(inverse_delta_rho()) * dxx_coeff(m); + } + fp partial_sigma_sigma_coeff(int m) const + { + return jtutil::pow2(inverse_delta_sigma()) * dxx_coeff(m); + } + fp partial_rho_sigma_coeff(int m_rho, int m_sigma) const + { + return partial_rho_coeff(m_rho) * partial_sigma_coeff(m_sigma); + } + + // worker functions: molecule coefficients for unit grid spacing + private: + static fp dx_coeff(int m); + static fp dxx_coeff(int m); + + // + // ***** constructor, destructor ***** + // + public: + // constructor: pass through to grid:: constructor + fd_grid(const grid_array_pars &grid_array_pars_in, + const grid_pars &grid_pars_in) + : grid(grid_array_pars_in, grid_pars_in) + { + } + // compiler-generated default destructor is ok + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + fd_grid(const fd_grid &rhs); + fd_grid &operator=(const fd_grid &rhs); + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* FD_GRID_H */ diff --git a/AMSS_NCKU_source/find_horizons.C b/AMSS_NCKU_source/find_horizons.C new file mode 100644 index 0000000..fb5f014 --- /dev/null +++ b/AMSS_NCKU_source/find_horizons.C @@ -0,0 +1,137 @@ + + +#include "macrodef.h" +#ifdef With_AHF + +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" +#include "myglobal.h" + +namespace AHFinderDirect +{ + void recentering(patch_system &ps, double max_x, double max_y, double max_z, + double min_x, double min_y, double min_z, + double centroid_x, double centroid_y, double centroid_z); + extern struct state state; + + void AHFinderDirect_find_horizons(int HN, int *dumpid, + double *xc, double *yc, double *zc, double *xr, double *yr, double *zr, + bool *trigger, double *dT) + { + const int my_proc = state.my_proc; + horizon_sequence &hs = *state.my_hs; + if (my_proc == 0 && hs.N_horizons() != HN) + { + cout << "input number " << HN << " != " << "number of wanted horizons " << hs.N_horizons() << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + state.ADM->AH_Prepare_derivatives(); + + for (int hn = hs.init_hn(); hs.is_genuine(); hn = hs.next_hn()) + { + int ihn = hs.get_hn(); + assert(ihn > 0 && ihn <= HN); + ihn = ihn - 1; + + struct AH_data &AH_data = *state.AH_data_array[hn]; + + AH_data.find_trigger = trigger[ihn]; + if (AH_data.find_trigger) + { + if (AH_data.found_flag) + AH_data.initial_find_flag = false; + else if (AH_data.recentering_flag == false) + { + patch_system &ps = *AH_data.ps_ptr; + recentering(ps, xc[ihn] + xr[ihn] / 2, yc[ihn] + yr[ihn] / 2, zc[ihn] + zr[ihn] / 2, + xc[ihn] - xr[ihn] / 2, yc[ihn] - yr[ihn] / 2, zc[ihn] - zr[ihn] / 2, + xc[ihn], yc[ihn], zc[ihn]); + setup_initial_guess(ps, xc[ihn], yc[ihn], zc[ihn], xr[ihn], yr[ihn], zr[ihn]); + AH_data.initial_find_flag = true; + } + else + AH_data.stop_finding == true; + } + + } // end for hn + + Newton(state.N_procs, state.N_active_procs, my_proc, + *state.my_hs, state.AH_data_array, + state.isb, dumpid, dT); + } + + void AHFinderDirect_enforcefind(int HN, + double *xc, double *yc, double *zc, double *xr, double *yr, double *zr) + { + const int my_proc = state.my_proc; + horizon_sequence &hs = *state.my_hs; + if (my_proc == 0 && hs.N_horizons() != HN) + { + cout << "input number " << HN << " != " << "number of wanted horizons " << hs.N_horizons() << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + bool *trigger; + int *dumpid; + double *dTT; + trigger = new bool[HN]; + dumpid = new int[HN]; + dTT = new double[HN]; + for (int ihn = 0; ihn < HN; ihn++) + { + trigger[ihn] = true; + dumpid[ihn] = 1; + dTT[ihn] = 1; + } + + for (int hn = hs.init_hn(); hs.is_genuine(); hn = hs.next_hn()) + { + int ihn = hs.get_hn(); + assert(ihn > 0 && ihn <= HN); + + struct AH_data &AH_data = *state.AH_data_array[hn]; + + AH_data.find_trigger = true; + AH_data.stop_finding = false; + AH_data.found_flag = false; + AH_data.recentering_flag = false; + AH_data.initial_find_flag = true; + + } // end for hn + + AHFinderDirect_find_horizons(HN, dumpid, xc, yc, zc, xr, yr, zr, trigger, dTT); + + delete[] trigger; + delete[] dumpid; + delete[] dTT; + } +} // namespace AHFinderDirect +#endif diff --git a/AMSS_NCKU_source/fmisc.f90 b/AMSS_NCKU_source/fmisc.f90 new file mode 100644 index 0000000..81c5a62 --- /dev/null +++ b/AMSS_NCKU_source/fmisc.f90 @@ -0,0 +1,2274 @@ + + +#include "macrodef.fh" + +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!--------------------------------------------------------------------------------------------------- +! copy a point of data into data target for vertext center code +!--------------------------------------------------------------------------------------------------- + subroutine pointcopy(wei,llbout,uubout,ext_out,data_out,xx,yy,zz,dv) + implicit none + integer,intent(in) :: wei + integer,dimension(3),intent(in) ::ext_out + real*8,dimension(3) :: llbout,uubout + real*8,dimension(ext_out(1),ext_out(2),ext_out(3)),intent(inout)::data_out + real*8,intent(in) :: xx,yy,zz,dv + + real*8,dimension(3) :: ho + integer :: i,j,k + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::pointcopy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +!!! + if(any(ext_out == 1))then + write(*,*)"fmisc.f90::pointcopy: meets iolated points for out data" + write(*,*) llbout,uubout + stop + else + ho = (uubout-llbout)/(ext_out-1) + endif + i = idint((xx-llbout(1))/ho(1)+0.4)+1 + j = idint((yy-llbout(2))/ho(2)+0.4)+1 + k = idint((zz-llbout(3))/ho(3)+0.4)+1 + + if(i<1 .or. i>ext_out(1) .or. & + j<1 .or. j>ext_out(2) .or. & + k<1 .or. k>ext_out(3) )then + write(*,*)"i,j,k = ",i,j,k + write(*,*)"ext = ",ext_out + stop + endif + if(dabs(llbout(1)+(i-1)*ho(1)-xx)>ho(1)/2 .or. & + dabs(llbout(2)+(j-1)*ho(2)-yy)>ho(2)/2 .or. & + dabs(llbout(3)+(k-1)*ho(3)-zz)>ho(3)/2 )then + write(*,*)"fmisc.f90::pointcopy: llbout = ",llbout + write(*,*)"fmisc.f90::pointcopy: ho = ",ho + write(*,*)"fmisc.f90::pointcopy: x,y,z = ",llbout(1)+(i-1)*ho(1),llbout(2)+(j-1)*ho(2),llbout(3)+(k-1)*ho(3) + write(*,*)"fmisc.f90::pointcopy: point = ",xx,yy,zz + stop + endif + + data_out(i,j,k)=dv + + return + + end subroutine pointcopy +!--------------------------------------------------------------------------------------------------- +! copy a part of data from data source, for vertex center code +!--------------------------------------------------------------------------------------------------- + subroutine copy(wei,llbout,uubout,ext_out,data_out,llbin,uubin,ext_in,data_in,lcopy,ucopy) + implicit none + integer,intent(in) :: wei + integer,dimension(3),intent(in) ::ext_out,ext_in + real*8,dimension(3),intent(in) :: lcopy,ucopy + real*8,dimension(3) :: llbout,uubout,llbin,uubin + real*8,dimension(ext_out(1),ext_out(2),ext_out(3)),intent(inout)::data_out + real*8,dimension(ext_in(1),ext_in(2),ext_in(3)),intent(in)::data_in + + real*8,dimension(3) :: ho,hi + integer,dimension(3) :: illo,iuuo,illi,iuui + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::copy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +!!! + if(any(ext_out == 1))then + if(any(ext_in == 1))then + write(*,*)"fmisc.f90::copy: meets iolated points for both in and out data" + write(*,*) llbin,uubin + write(*,*) llbout,uubout + stop + else + hi = (uubin-llbin)/(ext_in-1) + ho = hi + endif + else + ho = (uubout-llbout)/(ext_out-1) + if(any(ext_in == 1))then + hi = ho + else + hi = (uubin-llbin)/(ext_in-1) + if(any(abs(hi-ho) > min(hi,ho)/2))then + write(*,*)"fmisc.f90::copy: meets copy reqest for different numerical grid" + write(*,*)hi,ho + stop + endif + endif + endif + illo = idint((lcopy-llbout)/ho+0.4)+1 + iuuo = ext_out - idint((uubout-ucopy)/ho+0.4) + illi = idint((lcopy-llbin)/hi+0.4)+1 + iuui = ext_in - idint((uubin-ucopy)/hi+0.4) + + if(any(llbout-lcopy>ho/2) .or. any(ucopy-uubout>ho/2))then + write(*,*)"fmisc.f90::copy: llbout = ",llbout + write(*,*)"fmisc.f90::copy: uubout = ",uubout + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + write(*,*)"fmisc.f90::copy: ho = ",ho + write(*,*)llbout-lcopy,ucopy-uubout + stop + elseif(any(llbin -lcopy>hi/2) .or. any(ucopy-uubin >hi/2))then + write(*,*)"fmisc.f90::copy: llbin = ",llbin + write(*,*)"fmisc.f90::copy: uubin = ",uubin + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + stop + elseif(any(illo<1) .or. any(illi<1) .or. any(illo-iuuo>0) .or. any(illi-iuui>0) .or. & + any(iuui-ext_in>0) .or. any(iuuo-ext_out>0))then + write(*,*)"fmisc.f90::copy: illi = ",illi + write(*,*)"fmisc.f90::copy: iuui = ",iuui + write(*,*)"fmisc.f90::copy: illo = ",illo + write(*,*)"fmisc.f90::copy: iuuo = ",iuuo + write(*,*)"fmisc.f90::copy: llbout = ",llbout + write(*,*)"fmisc.f90::copy: uubout = ",uubout + write(*,*)"fmisc.f90::copy: llbin = ",llbin + write(*,*)"fmisc.f90::copy: uubin = ",uubin + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + stop + endif + + data_out(illo(1):iuuo(1),illo(2):iuuo(2),illo(3):iuuo(3))=data_in(illi(1):iuui(1),illi(2):iuui(2),illi(3):iuui(3)) + + return + + end subroutine copy +!----------------------------------------------------------------------------------------------------------------- +! three dimensional interpolation for vertex center grid structure + subroutine global_interp(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry,ORDN + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + +!~~~~~~> Other parameters: + + integer :: j,m,imin,jmin,kmin + integer,dimension(3) :: cxB,cxT,cxI,cmin,cmax + real*8,dimension(3) :: cx + real*8, dimension(1:ORDN) :: x1a + real*8, dimension(1:ORDN,1:ORDN,1:ORDN) :: ya + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8 :: dX,dY,dZ,ddy + real*8, parameter :: ONE=1.d0 + logical::decide3d + + imin = lbound(f,1) + jmin = lbound(f,2) + kmin = lbound(f,3) + + dX = X(imin+1)-X(imin) + dY = Y(jmin+1)-Y(jmin) + dZ = Z(kmin+1)-Z(kmin) + + forall( j = 1:ordn ) x1a(j) = ( j - 1 )* ONE + + cxI(1) = idint((x1-X(1))/dX+0.4)+1 + cxI(2) = idint((y1-Y(1))/dY+0.4)+1 + cxI(3) = idint((z1-Z(1))/dZ+0.4)+1 + + cxB = cxI - ORDN/2+1 + cxT = cxB + ORDN - 1 + + cmin = 1 + cmax = ex + if(Symmetry == OCTANT .and.dabs(X(1)) cmax(m))then + cxT(m) = cmax(m) + cxB(m) = cxT(m) + 1 - ORDN + endif + enddo + if(cxB(1)>0)then + cx(1) = (x1 - X(cxB(1)))/dX + else + cx(1) = (x1 + X(2-cxB(1)))/dX + endif + if(cxB(2)>0)then + cx(2) = (y1 - Y(cxB(2)))/dY + else + cx(2) = (y1 + Y(2-cxB(2)))/dY + endif + if(cxB(3)>0)then + cx(3) = (z1 - Z(cxB(3)))/dZ + else + cx(3) = (z1 + Z(2-cxB(3)))/dZ + endif + + if(decide3d(ex,f,f,cxB,cxT,SoA,ya,ORDN,Symmetry))then + write(*,*)"global_interp position: ",x1,y1,z1 + write(*,*)"data range: ",X(1),X(ex(1)),Y(1),Y(ex(2)),Z(1),Z(ex(3)) + stop + endif + call polin3(x1a,x1a,x1a,ya,cx(1),cx(2),cx(3),f_int,ddy,ORDN) + + return + + end subroutine global_interp +!---------------------------------------------------------------- +! decide which 3d data to be used does not surport PI-Symmetry yet +!---------------------------------------------------------------- + function decide3d(ex,f,fpi,cxB,cxT,SoA,ya,ORDN,Symmetry) result(gont) + implicit none + + integer, intent(in) :: ORDN,Symmetry + integer,dimension(1:3) , intent(in) :: ex,cxB,cxT + real*8, dimension(1:3) , intent(in) :: SoA + real*8, dimension(ex(1),ex(2),ex(3)) , intent(in) :: f,fpi + real*8, dimension(cxB(1):cxT(1),cxB(2):cxT(2),cxB(3):cxT(3)), intent(out):: ya + logical::gont + + integer,dimension(1:3) :: fmin1,fmin2,fmax1,fmax2 + integer::i,j,k,m + + gont=.false. + do m=1,3 +! check cxB and cxT are NaN or not + if(.not.(iabs(cxB(m)).ge.0)) gont=.true. + if(.not.(iabs(cxT(m)).ge.0)) gont=.true. + fmin1(m) = max(1,cxB(m)) + fmax1(m) = cxT(m) + fmin2(m) = cxB(m) + fmax2(m) = min(0,cxT(m)) + if((fmin1(m).le.fmax1(m)).and.( fmin1(m)<1.or. fmax1(m)>ex(m)))gont=.true. + if((fmin2(m).le.fmax2(m)).and.(2-fmax2(m)<1.or.2-fmin2(m)>ex(m)))gont=.true. + enddo +!sanity check + if(gont)then + write(*,*)"error in decide3d" + write(*,*)((fmin1.le.fmax1).and.( fmin1<1.or. fmax1>ex)) + write(*,*)((fmin2.le.fmax2).and.(2-fmax2<1.or.2-fmin2>ex)) + write(*,*)"cxB, cxT and data shape:" + write(*,*)cxB,cxT,ex + write(*,*)"resulted fmin1, fmax1 and fmin2, fmax2:" + write(*,*)fmin1,fmax1,fmin2,fmax2 + else + + do k=fmin1(3),fmax1(3) + do j=fmin1(2),fmax1(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,j,k) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(2-i,j,k)*SoA(1) + enddo + enddo + do j=fmin2(2),fmax2(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,2-j,k)*SoA(2) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(2-i,2-j,k)*SoA(1)*SoA(2) + enddo + enddo + enddo + + do k=fmin2(3),fmax2(3) + do j=fmin1(2),fmax1(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,j,2-k)*SoA(3) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(2-i,j,2-k)*SoA(1)*SoA(3) + enddo + enddo + do j=fmin2(2),fmax2(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,2-j,2-k)*SoA(2)*SoA(3) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(2-i,2-j,2-k)*SoA(1)*SoA(2)*SoA(3) + enddo + enddo + enddo + + endif + + end function decide3d + +!--------------------------------------------------------------------------------------- +subroutine symmetry_bd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1),-ord+1:extc(2),-ord+1:extc(3)),intent(out):: funcc + real*8, dimension(1:3), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+2,1:extc(3))*SoA(2) + enddo + do i=0,ord-1 + funcc(:,:,-i) = funcc(:,:,i+2)*SoA(3) + enddo + +end subroutine symmetry_bd + +subroutine symmetry_tbd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,-ord+1:extc(3)+ord),intent(out):: funcc + real*8, dimension(1:3), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1) + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-1-i,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+2,1:extc(3))*SoA(2) + funcc(:,extc(2)+1+i,1:extc(3)) = funcc(:,extc(2)-1-i,1:extc(3))*SoA(2) + enddo + do i=0,ord-1 + funcc(:,:,-i) = funcc(:,:,i+2)*SoA(3) + funcc(:,:,extc(3)+1+i) = funcc(:,:,extc(3)-1-i)*SoA(3) + enddo + +end subroutine symmetry_tbd + +subroutine symmetry_stbd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,extc(3)),intent(out):: funcc + real*8, dimension(2), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1) + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-1-i,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+2,1:extc(3))*SoA(2) + funcc(:,extc(2)+1+i,1:extc(3)) = funcc(:,extc(2)-1-i,1:extc(3))*SoA(2) + enddo + +end subroutine symmetry_stbd + +subroutine symmetry_sntbd(ord,extc,func,funcc,SoA,actd) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord,actd + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,extc(3)),intent(out):: funcc + real*8, intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + if(actd==0)then + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-1-i,1:extc(2),1:extc(3))*SoA + enddo + elseif(actd==1)then + do i=0,ord-1 + funcc(1:extc(1),-i,1:extc(3)) = funcc(1:extc(1),i+2,1:extc(3))*SoA + funcc(1:extc(1),extc(2)+1+i,1:extc(3)) = funcc(1:extc(1),extc(2)-1-i,1:extc(3))*SoA + enddo + else + write(*,*)"symmetry_sntbd: not recognized actd = ",actd + endif + +end subroutine symmetry_sntbd + + +subroutine d2dump(wei,llb,uub,ext,data_in,data_out,gord,SoA) + implicit none + integer, intent(in) :: wei,gord + integer,dimension(3),intent(in) :: ext + real*8, dimension(3),intent(in) :: SoA + real*8, dimension(3) :: llb,uub + real*8, dimension(ext(1),ext(2),ext(3)),intent(in) ::data_in + real*8, dimension(ext(1),ext(2)), intent(inout)::data_out + + real*8 :: dZ + integer :: i,j,k + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::copy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + dZ = (uub(3)-llb(3))/(ext(3)-1) + k = idint((0-llb(3))/dZ+0.4)+1 + + if(k < 1)then + write(*,*) "d2dump: something must be wrong" + return + endif + + data_out(i,j) = data_in(i,j,k) + +end subroutine d2dump + +#else +#ifdef Cell +!subroutine interp_2 support cell center only +!----------------------------------------------------------------------------- +! +! Interpolate function f using weights Delx, Dely and Delz +! +!----------------------------------------------------------------------------- + + subroutine interp_2(ex,f,f_int,il,iu,jl,ju,kl,ku,Dx,Dy,Dz,& + ordn,SoA,symmetry) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + integer, intent(in) :: il,iu,jl,ju,kl,ku,ordn + real*8, intent(in) :: Dx,Dy,Dz,SoA(3) + +!~~~~~~> Other parameters: + + integer :: j,imin,jmin,kmin + real*8, dimension(1:ordn) :: x1a + real*8, dimension(1:ordn,1:ordn,1:ordn) :: ya + real*8, parameter :: ONE=1.d0 + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8 :: ddy,symX,symY,symZ + + symX = SoA(1) + symY = SoA(2) + symZ = SoA(3) + + imin = lbound(f,1) + jmin = lbound(f,2) + kmin = lbound(f,3) + + forall( j = 1:ordn ) x1a(j) = ( j - 1 )* ONE + + ya(2:ordn,2:ordn,2:ordn) = f(il+1:iu,jl+1:ju,kl+1:ku) + + if( il < imin .and. symmetry < OCTANT ) then + write(*,*) 'Error in interp_2!!!' + stop + endif + if( il < imin ) then + ya(1,2:ordn,2:ordn) = f(imin,jl+1:ju,kl+1:ku)* symX + else + ya(1,2:ordn,2:ordn) = f(il ,jl+1:ju,kl+1:ku) + endif + + if( jl < jmin .and. symmetry < OCTANT ) then + write(*,*) 'Error in interp_2!!!' + stop + endif + + if( jl < jmin ) then + ya(2:ordn,1,2:ordn) = f(il+1:iu,jmin,kl+1:ku)* symY + else + ya(2:ordn,1,2:ordn) = f(il+1:iu,jl,kl+1:ku) + endif + + if( kl < kmin .and. symmetry < EQUATORIAL ) then + write(*,*) 'Error in interp_2!!!' + stop + endif + + if( kl < kmin ) then + ya(2:ordn,2:ordn,1) = f(il+1:iu,jl+1:ju,kmin)* symZ + else + ya(2:ordn,2:ordn,1) = f(il+1:iu,jl+1:ju,kl ) + endif + + if( il < imin .and. jl < jmin ) then + ya(1,1,2:ordn) = f(imin,jmin,kl+1:ku)* symX * symY + else if( il >= imin .and. jl < jmin ) then + ya(1,1,2:ordn) = f(il,jmin,kl+1:ku)* symY + else if( il < imin .and. jl >= jmin ) then + ya(1,1,2:ordn) = f(imin,jl,kl+1:ku)* symX + else + ya(1,1,2:ordn) = f(il,jl,kl+1:ku) + endif + + if( il < imin .and. kl < kmin ) then + ya(1,2:ordn,1) = f(imin,jl+1:ju,kmin)* symX * symZ + else if( il >= imin .and. kl < kmin ) then + ya(1,2:ordn,1) = f(il,jl+1:ju,kmin)* symZ + else if( il < imin .and. kl >= kmin ) then + ya(1,2:ordn,1) = f(imin,jl+1:ju,kl)* symX + else + ya(1,2:ordn,1) = f(il,jl+1:ju,kl) + endif + + if( jl < jmin .and. kl < kmin ) then + ya(2:ordn,1,1) = f(il+1:iu,jmin,kmin)* symY * symZ + else if( jl >= jmin .and. kl < kmin ) then + ya(2:ordn,1,1) = f(il+1:iu,jl,kmin)* symZ + else if( jl < jmin .and. kl >= kmin ) then + ya(2:ordn,1,1) = f(il+1:iu,jmin,kl)* symY + else + ya(2:ordn,1,1) = f(il+1:iu,jl,kl) + endif + + if( il < imin ) then + if( jl < jmin .and. kl < kmin) then + ya(1,1,1) = f(imin,jmin,kmin)* symX * symY * symZ + else if( jl >= jmin .and. kl < kmin ) then + ya(1,1,1) = f(imin,jl,kmin)* symX * symZ + else if( jl < jmin .and. kl >= kmin ) then + ya(1,1,1) = f(imin,jmin,kl)* symX * symY + else + ya(1,1,1) = f(imin,jl,kl)* symX + endif + else + if( jl < jmin .and. kl < kmin) then + ya(1,1,1) = f(il,jmin,kmin)* symY * symZ + else if( jl >= jmin .and. kl < kmin ) then + ya(1,1,1) = f(il,jl,kmin)* symZ + else if( jl < jmin .and. kl >= kmin ) then + ya(1,1,1) = f(il,jmin,kl)* symY + else + ya(1,1,1) = f(il,jl,kl) + endif + endif + + call polin3(x1a,x1a,x1a,ya,Dx,Dy,Dz,f_int,ddy,ordn) + + if(.not.(dabs(f_int).ge.0))then + write(*,*)"find nan in interp_2:",f_int,"inputs are:" +! write(*,*)ya +! write(*,*)"-----------------------------------------" +! write(*,*)f(il:iu,jl:ju,kl:ku) + write(*,*)Dx,Dy,Dz,symx,symy,symz,ordn + write(*,*)il,iu,jl,ju,kl,ku,ex,symmetry + endif + + return + + end subroutine interp_2 +!--------------------------------------------------------------------------------------------------- +! copy a point of data into data target for vertext center code +!--------------------------------------------------------------------------------------------------- + subroutine pointcopy(wei,llbout,uubout,ext_out,data_out,xx,yy,zz,dv) + implicit none + integer,intent(in) :: wei + integer,dimension(3),intent(in) ::ext_out + real*8,dimension(3) :: llbout,uubout + real*8,dimension(ext_out(1),ext_out(2),ext_out(3)),intent(inout)::data_out + real*8,intent(in) :: xx,yy,zz,dv + + real*8,dimension(3) :: ho + integer :: i,j,k + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::pointcopy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +!!! + ho = (uubout-llbout)/ext_out + i = idint((xx-llbout(1))/ho(1)+0.4)+1 + j = idint((yy-llbout(2))/ho(2)+0.4)+1 + k = idint((zz-llbout(3))/ho(3)+0.4)+1 + + if(i<1 .or. i>ext_out(1) .or. & + j<1 .or. j>ext_out(2) .or. & + k<1 .or. k>ext_out(3) )then + write(*,*)"i,j,k = ",i,j,k + write(*,*)"ext = ",ext_out + stop + endif + if(dabs(llbout(1)+(i-0.5)*ho(1)-xx)>ho(1)/2 .or. & + dabs(llbout(2)+(j-0.5)*ho(2)-yy)>ho(2)/2 .or. & + dabs(llbout(3)+(k-0.5)*ho(3)-zz)>ho(3)/2 )then + write(*,*)"fmisc.f90::pointcopy: llbout = ",llbout + write(*,*)"fmisc.f90::pointcopy: ho = ",ho + write(*,*)"fmisc.f90::pointcopy: x,y,z = ",llbout(1)+(i-0.5)*ho(1),llbout(2)+(j-0.5)*ho(2),llbout(3)+(k-0.5)*ho(3) + write(*,*)"fmisc.f90::pointcopy: point = ",xx,yy,zz + stop + endif + + data_out(i,j,k)=dv + + return + + end subroutine pointcopy +!--------------------------------------------------------------------------------------------------- +! copy a part of data from data source, for cell center code +!--------------------------------------------------------------------------------------------------- + subroutine copy(wei,llbout,uubout,ext_out,data_out,llbin,uubin,ext_in,data_in,lcopy,ucopy) + implicit none + integer,intent(in) :: wei + integer,dimension(3),intent(in) ::ext_out,ext_in + real*8,dimension(3),intent(in) :: lcopy,ucopy + real*8,dimension(3) :: llbout,uubout,llbin,uubin + real*8,dimension(ext_out(1),ext_out(2),ext_out(3)),intent(inout)::data_out + real*8,dimension(ext_in(1),ext_in(2),ext_in(3)),intent(in)::data_in + + real*8,dimension(3) :: ho,hi + integer,dimension(3) :: illo,iuuo,illi,iuui + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::copy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +!!! + ho = (uubout-llbout)/ext_out + hi = (uubin-llbin)/ext_in + illo = idint((lcopy-llbout)/ho+0.4)+1 + iuuo = ext_out - idint((uubout-ucopy)/ho+0.4) + illi = idint((lcopy-llbin)/hi+0.4)+1 + iuui = ext_in - idint((uubin-ucopy)/hi+0.4) + + if(any(llbout-lcopy>ho/2) .or. any(ucopy-uubout>ho/2))then + write(*,*)"fmisc.f90::copy: llbout = ",llbout + write(*,*)"fmisc.f90::copy: uubout = ",uubout + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + write(*,*)"fmisc.f90::copy: ho = ",ho + write(*,*)llbout-lcopy,ucopy-uubout + stop + elseif(any(llbin -lcopy>hi/2) .or. any(ucopy-uubin >hi/2))then + write(*,*)"fmisc.f90::copy: llbin = ",llbin + write(*,*)"fmisc.f90::copy: uubin = ",uubin + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + stop + elseif(any(illo<1) .or. any(illi<1) .or. any(illo-iuuo>0) .or. any(illi-iuui>0) .or. & + any(iuui-ext_in>0) .or. any(iuuo-ext_out>0))then + write(*,*)"fmisc.f90::copy: illi = ",illi + write(*,*)"fmisc.f90::copy: iuui = ",iuui + write(*,*)"fmisc.f90::copy: illo = ",illo + write(*,*)"fmisc.f90::copy: iuuo = ",iuuo + write(*,*)"fmisc.f90::copy: llbout = ",llbout + write(*,*)"fmisc.f90::copy: uubout = ",uubout + write(*,*)"fmisc.f90::copy: llbin = ",llbin + write(*,*)"fmisc.f90::copy: uubin = ",uubin + write(*,*)"fmisc.f90::copy: llbcopy = ",lcopy + write(*,*)"fmisc.f90::copy: uubcopy = ",ucopy + stop + endif + + data_out(illo(1):iuuo(1),illo(2):iuuo(2),illo(3):iuuo(3))=data_in(illi(1):iuui(1),illi(2):iuui(2),illi(3):iuui(3)) + + return + + end subroutine copy +!-------------------------------------------------------------------------- +! three dimensional interpolation for cell center grid structure + subroutine global_interp(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry,ORDN + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + +!~~~~~~> Other parameters: + + integer :: j,m,imin,jmin,kmin + integer,dimension(3) :: cxB,cxT,cxI,cmin,cmax + real*8,dimension(3) :: cx + real*8, dimension(1:ORDN) :: x1a + real*8, dimension(1:ORDN,1:ORDN,1:ORDN) :: ya + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8 :: dX,dY,dZ,ddy + real*8, parameter :: ONE=1.d0 + logical::decide3d + + imin = lbound(f,1) + jmin = lbound(f,2) + kmin = lbound(f,3) + + dX = X(imin+1)-X(imin) + dY = Y(jmin+1)-Y(jmin) + dZ = Z(kmin+1)-Z(kmin) + + forall( j = 1:ordn ) x1a(j) = ( j - 1 )* ONE + + cxI(1) = idint((x1-X(1))/dX+0.4)+1 + cxI(2) = idint((y1-Y(1))/dY+0.4)+1 + cxI(3) = idint((z1-Z(1))/dZ+0.4)+1 + + cxB = cxI - ORDN/2+1 + cxT = cxB + ORDN - 1 + + cmin = 1 + cmax = ex + if(Symmetry == OCTANT .and.dabs(X(1)) cmax(m))then + cxT(m) = cmax(m) + cxB(m) = cxT(m) + 1 - ORDN + endif + enddo + if(cxB(1)>0)then + cx(1) = (x1 - X(cxB(1)))/dX + else + cx(1) = (x1 + X(1-cxB(1)))/dX + endif + if(cxB(2)>0)then + cx(2) = (y1 - Y(cxB(2)))/dY + else + cx(2) = (y1 + Y(1-cxB(2)))/dY + endif + if(cxB(3)>0)then + cx(3) = (z1 - Z(cxB(3)))/dZ + else + cx(3) = (z1 + Z(1-cxB(3)))/dZ + endif + + if(decide3d(ex,f,f,cxB,cxT,SoA,ya,ORDN,Symmetry))then + write(*,*)"global_interp position: ",x1,y1,z1 + write(*,*)"data range: ",X(1),X(ex(1)),Y(1),Y(ex(2)),Z(1),Z(ex(3)) + stop + endif + call polin3(x1a,x1a,x1a,ya,cx(1),cx(2),cx(3),f_int,ddy,ORDN) + + return + + end subroutine global_interp +!---------------------------------------------------------------- +! decide which 3d data to be used does not surport PI-Symmetry yet +!---------------------------------------------------------------- + function decide3d(ex,f,fpi,cxB,cxT,SoA,ya,ORDN,Symmetry) result(gont) + implicit none + + integer, intent(in) :: ORDN,Symmetry + integer,dimension(1:3) , intent(in) :: ex,cxB,cxT + real*8, dimension(1:3) , intent(in) :: SoA + real*8, dimension(ex(1),ex(2),ex(3)) , intent(in) :: f,fpi + real*8, dimension(cxB(1):cxT(1),cxB(2):cxT(2),cxB(3):cxT(3)), intent(out):: ya + logical::gont + + integer,dimension(1:3) :: fmin1,fmin2,fmax1,fmax2 + integer::i,j,k,m + + gont=.false. + do m=1,3 +! check cxB and cxT are NaN or not + if(.not.(iabs(cxB(m)).ge.0)) gont=.true. + if(.not.(iabs(cxT(m)).ge.0)) gont=.true. + fmin1(m) = max(1,cxB(m)) + fmax1(m) = cxT(m) + fmin2(m) = cxB(m) + fmax2(m) = min(0,cxT(m)) + if((fmin1(m).le.fmax1(m)).and.( fmin1(m)<1.or. fmax1(m)>ex(m)))gont=.true. + if((fmin2(m).le.fmax2(m)).and.(1-fmax2(m)<1.or.1-fmin2(m)>ex(m)))gont=.true. + enddo +!sanity check + if(gont)then + write(*,*)"error in decide3d" + write(*,*)((fmin1.le.fmax1).and.( fmin1<1.or. fmax1>ex)) + write(*,*)((fmin2.le.fmax2).and.(1-fmax2<1.or.1-fmin2>ex)) + write(*,*)"cxB, cxT and data shape:" + write(*,*)cxB,cxT,ex + write(*,*)"resulted fmin1, fmax1 and fmin2, fmax2:" + write(*,*)fmin1,fmax1,fmin2,fmax2 + else + + do k=fmin1(3),fmax1(3) + do j=fmin1(2),fmax1(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,j,k) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(1-i,j,k)*SoA(1) + enddo + enddo + do j=fmin2(2),fmax2(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,1-j,k)*SoA(2) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(1-i,1-j,k)*SoA(1)*SoA(2) + enddo + enddo + enddo + + do k=fmin2(3),fmax2(3) + do j=fmin1(2),fmax1(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,j,1-k)*SoA(3) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(1-i,j,1-k)*SoA(1)*SoA(3) + enddo + enddo + do j=fmin2(2),fmax2(2) + do i=fmin1(1),fmax1(1) + ya(i,j,k) = f(i,1-j,1-k)*SoA(2)*SoA(3) + enddo + do i=fmin2(1),fmax2(1) + ya(i,j,k) = f(1-i,1-j,1-k)*SoA(1)*SoA(2)*SoA(3) + enddo + enddo + enddo + + endif + + end function decide3d + +!--------------------------------------------------------------------------------------- +subroutine symmetry_bd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1),-ord+1:extc(2),-ord+1:extc(3)),intent(out):: funcc + real*8, dimension(1:3), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+1,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+1,1:extc(3))*SoA(2) + enddo + do i=0,ord-1 + funcc(:,:,-i) = funcc(:,:,i+1)*SoA(3) + enddo + +end subroutine symmetry_bd + +subroutine symmetry_tbd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,-ord+1:extc(3)+ord),intent(out):: funcc + real*8, dimension(1:3), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+1,1:extc(2),1:extc(3))*SoA(1) + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-i,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+1,1:extc(3))*SoA(2) + funcc(:,extc(2)+1+i,1:extc(3)) = funcc(:,extc(2)-i,1:extc(3))*SoA(2) + enddo + do i=0,ord-1 + funcc(:,:,-i) = funcc(:,:,i+1)*SoA(3) + funcc(:,:,extc(3)+1+i) = funcc(:,:,extc(3)-i)*SoA(3) + enddo + +end subroutine symmetry_tbd + +subroutine symmetry_stbd(ord,extc,func,funcc,SoA) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,extc(3)),intent(out):: funcc + real*8, dimension(2), intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+1,1:extc(2),1:extc(3))*SoA(1) + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-i,1:extc(2),1:extc(3))*SoA(1) + enddo + do i=0,ord-1 + funcc(:,-i,1:extc(3)) = funcc(:,i+1,1:extc(3))*SoA(2) + funcc(:,extc(2)+1+i,1:extc(3)) = funcc(:,extc(2)-i,1:extc(3))*SoA(2) + enddo + +end subroutine symmetry_stbd + +subroutine symmetry_sntbd(ord,extc,func,funcc,SoA,actd) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: ord,actd + integer,dimension(3), intent(in) :: extc + real*8, dimension(extc(1),extc(2),extc(3)),intent(in ):: func + real*8, dimension(-ord+1:extc(1)+ord,-ord+1:extc(2)+ord,extc(3)),intent(out):: funcc + real*8, intent(in) :: SoA + + integer::i + + funcc = 0.d0 + funcc(1:extc(1),1:extc(2),1:extc(3)) = func + if(actd==0)then + do i=0,ord-1 + funcc(-i,1:extc(2),1:extc(3)) = funcc(i+1,1:extc(2),1:extc(3))*SoA + funcc(extc(1)+1+i,1:extc(2),1:extc(3)) = funcc(extc(1)-i,1:extc(2),1:extc(3))*SoA + enddo + elseif(actd==1)then + do i=0,ord-1 + funcc(1:extc(1),-i,1:extc(3)) = funcc(1:extc(1),i+1,1:extc(3))*SoA + funcc(1:extc(1),extc(2)+1+i,1:extc(3)) = funcc(1:extc(1),extc(2)-i,1:extc(3))*SoA + enddo + else + write(*,*)"symmetry_sntbd: not recognized actd = ",actd + endif + +end subroutine symmetry_sntbd + +subroutine d2dump(wei,llb,uub,ext,data_in,data_out,gord,SoA) + implicit none + integer,intent(in) :: wei,gord + integer,dimension(3),intent(in) ::ext + real*8,dimension(3),intent(in) :: SoA + real*8,dimension(3) :: llb,uub + real*8,dimension(ext(1),ext(2),ext(3)),intent(in)::data_in + real*8,dimension(ext(1),ext(2)),intent(inout)::data_out + + real*8 :: dZ + integer :: i,j,k + +!sanity check + if(wei.ne.3)then + write(*,*)"fmisc.f90::copy: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + dZ = (uub(3)-llb(3))/ext(3) + k = idint((0-llb(3))/dZ+0.4)+1 + + select case (gord) + case (2) + if(k > 2)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5625d0*(data_in(i,j,k)+data_in(i,j,k-1))-0.0625d0*(data_in(i,j,k+1)+data_in(i,j,k-2)) + enddo + enddo + else if(k == 1)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5625d0*(data_in(i,j,k)+SoA(3)*data_in(i,j,k))-0.0625d0*(data_in(i,j,k+1)+SoA(3)*data_in(i,j,k+1)) + enddo + enddo + else + write(*,*) "d2dump: something must be wrong, k = ",k + return + endif + case (3) + if(k > 3)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5859375d0*(data_in(i,j,k)+data_in(i,j,k-1)) & + -0.9765625d-1*(data_in(i,j,k+1)+data_in(i,j,k-2)) & + +0.1171875d-1*(data_in(i,j,k+2)+data_in(i,j,k-3)) + enddo + enddo + else if(k == 1)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5859375d0*(data_in(i,j,k)+SoA(3)*data_in(i,j,k)) & + -0.9765625d-1*(data_in(i,j,k+1)+SoA(3)*data_in(i,j,k+1)) & + +0.1171875d-1*(data_in(i,j,k+2)+SoA(3)*data_in(i,j,k+2)) + enddo + enddo + else + write(*,*) "d2dump: something must be wrong, k = ",k + return + endif + case (4) + if(k > 4)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5981445312d0*(data_in(i,j,k)+data_in(i,j,k-1)) & + -0.1196289063d0*(data_in(i,j,k+1)+data_in(i,j,k-2)) & + +0.2392578125d-1*(data_in(i,j,k+2)+data_in(i,j,k-3)) & + -0.2441406250d-2*(data_in(i,j,k+3)+data_in(i,j,k-4)) + enddo + enddo + else if(k == 1)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.5981445312d0*(data_in(i,j,k)+SoA(3)*data_in(i,j,k)) & + -0.1196289063d0*(data_in(i,j,k+1)+SoA(3)*data_in(i,j,k+1)) & + +0.2392578125d-1*(data_in(i,j,k+2)+SoA(3)*data_in(i,j,k+2)) & + -0.2441406250d-2*(data_in(i,j,k+3)+SoA(3)*data_in(i,j,k+3)) + enddo + enddo + else + write(*,*) "d2dump: something must be wrong, k = ",k + return + endif + case (5) + if(k > 5)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.6056213378d0*(data_in(i,j,k)+data_in(i,j,k-1)) & + -0.1345825196d0*(data_in(i,j,k+1)+data_in(i,j,k-2)) & + +0.3460693359d-1*(data_in(i,j,k+2)+data_in(i,j,k-3)) & + -0.6179809571d-2*(data_in(i,j,k+3)+data_in(i,j,k-4)) & + +0.5340576171d-3*(data_in(i,j,k+4)+data_in(i,j,k-5)) + enddo + enddo + else if(k == 1)then + do i=1,ext(1) + do j=1,ext(2) + data_out(i,j) = 0.6056213378d0*(data_in(i,j,k)+SoA(3)*data_in(i,j,k)) & + -0.1345825196d0*(data_in(i,j,k+1)+SoA(3)*data_in(i,j,k+1)) & + +0.3460693359d-1*(data_in(i,j,k+2)+SoA(3)*data_in(i,j,k+2)) & + -0.6179809571d-2*(data_in(i,j,k+3)+SoA(3)*data_in(i,j,k+3)) & + +0.5340576171d-3*(data_in(i,j,k+4)+SoA(3)*data_in(i,j,k+4)) + enddo + enddo + else + write(*,*) "d2dump: something must be wrong, k = ",k + return + endif + case default + write(*,*) "d2dump: not recognized ord = ",gord + return + end select + +end subroutine d2dump + +#else +#error Not define Vertex nor Cell +#endif +#endif +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! common code for cell and vertex +!------------------------------------------------------------------------------ +! Lagrangian polynomial interpolation +!------------------------------------------------------------------------------ + + subroutine polint(xa,ya,x,y,dy,ordn) + + implicit none + +!~~~~~~> Input Parameter: + integer,intent(in) :: ordn + real*8, dimension(ordn), intent(in) :: xa,ya + real*8, intent(in) :: x + real*8, intent(out) :: y,dy + +!~~~~~~> Other parameter: + + integer :: m,n,ns + real*8, dimension(ordn) :: c,d,den,ho + real*8 :: dif,dift + +!~~~~~~> + + n=ordn + m=ordn + + c=ya + d=ya + ho=xa-x + + ns=1 + dif=abs(x-xa(1)) + do m=1,n + dift=abs(x-xa(m)) + if(dift < dif) then + ns=m + dif=dift + end if + end do + + y=ya(ns) + ns=ns-1 + do m=1,n-1 + den(1:n-m)=ho(1:n-m)-ho(1+m:n) + if (any(den(1:n-m) == 0.0))then + write(*,*) 'failure in polint for point',x + write(*,*) 'with input points: ',xa + stop + endif + den(1:n-m)=(c(2:n-m+1)-d(1:n-m))/den(1:n-m) + d(1:n-m)=ho(1+m:n)*den(1:n-m) + c(1:n-m)=ho(1:n-m)*den(1:n-m) + if (2*ns < n-m) then + dy=c(ns+1) + else + dy=d(ns) + ns=ns-1 + end if + y=y+dy + end do + + return + + end subroutine polint +!------------------------------------------------------------------------------ +! +! interpolation in 2 dimensions, follow yx order +! +!------------------------------------------------------------------------------ + subroutine polin2(x1a,x2a,ya,x1,x2,y,dy,ordn) + + implicit none + +!~~~~~~> Input parameters: + integer,intent(in) :: ordn + real*8, dimension(1:ordn), intent(in) :: x1a,x2a + real*8, dimension(1:ordn,1:ordn), intent(in) :: ya + real*8, intent(in) :: x1,x2 + real*8, intent(out) :: y,dy + +!~~~~~~> Other parameters: + + integer :: i,m + real*8, dimension(ordn) :: ymtmp + real*8, dimension(ordn) :: yntmp + + m=size(x1a) + + do i=1,m + + yntmp=ya(i,:) + call polint(x2a,yntmp,x2,ymtmp(i),dy,ordn) + + end do + + call polint(x1a,ymtmp,x1,y,dy,ordn) + + return + + end subroutine polin2 +!------------------------------------------------------------------------------ +! +! interpolation in 3 dimensions, follow zyx order +! +!------------------------------------------------------------------------------ + subroutine polin3(x1a,x2a,x3a,ya,x1,x2,x3,y,dy,ordn) + + implicit none + +!~~~~~~> Input parameters: + integer,intent(in) :: ordn + real*8, dimension(1:ordn), intent(in) :: x1a,x2a,x3a + real*8, dimension(1:ordn,1:ordn,1:ordn), intent(in) :: ya + real*8, intent(in) :: x1,x2,x3 + real*8, intent(out) :: y,dy + +!~~~~~~> Other parameters: + + integer :: i,j,m,n + real*8, dimension(ordn,ordn) :: yatmp + real*8, dimension(ordn) :: ymtmp + real*8, dimension(ordn) :: yntmp + real*8, dimension(ordn) :: yqtmp + + m=size(x1a) + n=size(x2a) + + do i=1,m + do j=1,n + + yqtmp=ya(i,j,:) + call polint(x3a,yqtmp,x3,yatmp(i,j),dy,ordn) + + end do + + yntmp=yatmp(i,:) + call polint(x2a,yntmp,x2,ymtmp(i),dy,ordn) + + end do + + call polint(x1a,ymtmp,x1,y,dy,ordn) + + return + + end subroutine polin3 +!-------------------------------------------------------------------------------------- +! calculate L2norm + subroutine l2normhelper(ex, X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,& + f,f_out,gw) + + implicit none +!~~~~~~> Input parameters: + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)),xmin,ymin,zmin,xmax,ymax,zmax + integer,intent(in)::gw + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out) :: f_out +!~~~~~~> Other variables: + + real*8, parameter :: ZEO = 0.D0 + real*8 :: dX, dY, dZ + integer::imin,jmin,kmin + integer::imax,jmax,kmax + integer::i,j,k + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + +! for ghost zone + imin = gw+1 + jmin = gw+1 + kmin = gw+1 + + imax = ex(1) - gw + jmax = ex(2) - gw + kmax = ex(3) - gw + +!for patch boundary (i.e., not ghost boundary) + +if(dabs(X(ex(1))-xmax) < dX) imax = ex(1) +if(dabs(Y(ex(2))-ymax) < dY) jmax = ex(2) +if(dabs(Z(ex(3))-zmax) < dZ) kmax = ex(3) +if(dabs(X(1)-xmin) < dX) imin = 1 +if(dabs(Y(1)-ymin) < dY) jmin = 1 +if(dabs(Z(1)-zmin) < dZ) kmin = 1 + +f_out = sum(f(imin:imax,jmin:jmax,kmin:kmax)*f(imin:imax,jmin:jmax,kmin:kmax)) + +f_out = f_out*dX*dY*dZ + + return + + end subroutine l2normhelper +!-------------------------------------------------------------------------------------- +! calculate L2norm especially for shell Blocks + subroutine l2normhelper_sh(ex, X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,& + f,f_out,gw,ogw,Symmetry) + + implicit none +!~~~~~~> Input parameters: + integer,intent(in ):: ex(1:3),Symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)),xmin,ymin,zmin,xmax,ymax,zmax + integer,intent(in)::gw,ogw + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out) :: f_out +!~~~~~~> Other variables: + + real*8, parameter :: ZEO = 0.D0 + real*8 :: dX, dY, dZ + integer::imin,jmin,kmin + integer::imax,jmax,kmax + integer::i,j,k + + real*8 :: PIo4 + + PIo4 = dacos(-1.d0)/4.d0 + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + +! for ghost zone + imin = gw+1 + jmin = gw+1 + kmin = gw+1 + + imax = ex(1) - gw + jmax = ex(2) - gw + kmax = ex(3) - gw + +!for patch boundary (i.e., not ghost boundary) + +if(dabs(X(ex(1))-xmax) < dX)then + if(X(ex(1))-PIo4 > dX)then + imax = ex(1)-ogw ! for overlap zone + else + imax = ex(1) + endif +endif +if(dabs(Y(ex(2))-ymax) < dY)then + if(Y(ex(2))-PIo4 > dY)then + jmax = ex(2)-ogw ! for overlap zone + else + jmax = ex(2) + endif +endif +if(dabs(Z(ex(3))-zmax) < dZ) kmax = ex(3) + +if(dabs(X(1)-xmin) < dX)then + if(X(1)+PIo4 < dX)then + imin = 1+ogw ! for overlap zone + else + imin = 1 + endif +endif +if(dabs(Y(1)-ymin) < dY)then + if(Y(1)+PIo4 < dY)then + jmin = 1+ogw ! for overlap zone + else + jmin = 1 + endif +endif +if(dabs(Z(1)-zmin) < dZ) kmin = 1 + +!for Symmetry ghost points +if(Symmetry==1)then + if(dabs(ymin+gw*dY)0.d0) jmax = ex(2)-gw +endif +if(Symmetry==2)then + if(dabs(xmin+gw*dX) Input parameters: + integer,intent(in ):: ex(1:3),Symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)),xmin,ymin,zmin,xmax,ymax,zmax + integer,intent(in)::gw,ogw + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out) :: f_out + integer,intent(out) :: Nout +!~~~~~~> Other variables: + + real*8, parameter :: ZEO = 0.D0 + real*8 :: dX, dY, dZ + integer::imin,jmin,kmin + integer::imax,jmax,kmax + integer::i,j,k + + real*8 :: PIo4 + + PIo4 = dacos(-1.d0)/4.d0 + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + +! for ghost zone + imin = gw+1 + jmin = gw+1 + kmin = gw+1 + + imax = ex(1) - gw + jmax = ex(2) - gw + kmax = ex(3) - gw + +!for patch boundary (i.e., not ghost boundary) + +if(dabs(X(ex(1))-xmax) < dX)then + if(X(ex(1))-PIo4 > dX)then + imax = ex(1)-ogw ! for overlap zone + else + imax = ex(1) + endif +endif +if(dabs(Y(ex(2))-ymax) < dY)then + if(Y(ex(2))-PIo4 > dY)then + jmax = ex(2)-ogw ! for overlap zone + else + jmax = ex(2) + endif +endif +if(dabs(Z(ex(3))-zmax) < dZ) kmax = ex(3) + +if(dabs(X(1)-xmin) < dX)then + if(X(1)+PIo4 < dX)then + imin = 1+ogw ! for overlap zone + else + imin = 1 + endif +endif +if(dabs(Y(1)-ymin) < dY)then + if(Y(1)+PIo4 < dY)then + jmin = 1+ogw ! for overlap zone + else + jmin = 1 + endif +endif +if(dabs(Z(1)-zmin) < dZ) kmin = 1 + +!for Symmetry ghost points +if(Symmetry==1)then + if(dabs(ymin+gw*dY)0.d0) jmax = ex(2)-gw +endif +if(Symmetry==2)then + if(dabs(xmin+gw*dX) t +! ^ +! f=3/4*f_1 + 1/4*f_2 + + real*8,parameter::C1=0.75d0,C2=0.25d0 + + fout = C1*f1+C2*f2 + + return + + end subroutine average3 +!----------------------------------------------------------------------------- + subroutine average2(ext,f1,f2,f3,fout) + implicit none + integer,dimension(3), intent(in) :: ext + real*8, dimension(ext(1),ext(2),ext(3)),intent(in):: f1,f2,f3 + real*8, dimension(ext(1),ext(2),ext(3)),intent(out):: fout +! f1 ---------- ^ +! fout ------ | +! f2 ---------- | t +! | +! f3 ---------- | +! 3 points, 2nd order interpolation +! 1 2 3 +! f3 f2 f1 +! *---*---*--> t +! ^ +! f=3/8*f_1 + 3/4*f_2 - 1/8*f_3 + + real*8,parameter::C1=3.d0/8.d0,C2=3.d0/4.d0,C3=-1.d0/8.d0 + + fout = C1*f1+C2*f2+C3*f3 + + return + + end subroutine average2 +!----------------------------------------------------------------------------- + subroutine average2p(ext,f1,f2,f3,fout) + implicit none + integer,dimension(3), intent(in) :: ext + real*8, dimension(ext(1),ext(2),ext(3)),intent(in):: f1,f2,f3 + real*8, dimension(ext(1),ext(2),ext(3)),intent(out):: fout +! f1 ---------- ^ +! fout ------p | +! f2 ---------- | t +! | +! f3 ---------- | +! 3 points, 2nd order interpolation +! 1 2 3 +! f3 f2 f1 +! *---*---*--> t +! ^ +! f=21/32*f_1 + 7/16*f_2 - 3/32*f_3 + + real*8,parameter::C1=5.d0/3.2d1,C2=1.5d1/1.6d1,C3=-3.d0/3.2d1 + + fout = C1*f1+C2*f2+C3*f3 + + return + + end subroutine average2p +!----------------------------------------------------------------------------- + subroutine average2m(ext,f1,f2,f3,fout) + implicit none + integer,dimension(3), intent(in) :: ext + real*8, dimension(ext(1),ext(2),ext(3)),intent(in):: f1,f2,f3 + real*8, dimension(ext(1),ext(2),ext(3)),intent(out):: fout +! f1 ---------- ^ +! fout ------m | +! f2 ---------- | t +! | +! f3 ---------- | +! 3 points, 2nd order interpolation +! 1 2 3 +! f3 f2 f1 +! *---*---*--> t +! ^ +! f=5/32*f_1 + 15/16*f_2 - 3/32*f_3 + + real*8,parameter::C1=5.d0/3.2d1,C2=1.5d1/1.6d1,C3=-3.d0/3.2d1 + + fout = C1*f1+C2*f2+C3*f3 + + return + + end subroutine average2m +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + subroutine lowerboundset(ex,chi0,TINNY) + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: ex(1:3) + real*8 ,intent(in):: TINNY + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::chi0 + + where(chi0 < TINNY) chi0 = TINNY + + return + + end subroutine lowerboundset +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!global interpolation with given index and coeffients + subroutine global_interpind(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry,inds,coef,sst) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry,ORDN,sst + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + integer,dimension(3), intent(in) :: inds + real*8, dimension(3*ORDN), intent(in) :: coef + +!~~~~~~> Other parameters: + + real*8, dimension(-ORDN+1:ex(1)+ORDN,-ORDN+1:ex(2)+ORDN,-ORDN+1:ex(3)+ORDN) :: fh + integer :: m + integer,dimension(3) :: cxB,cxT + real*8, dimension(ORDN,ORDN,ORDN) :: ya + real*8, dimension(ORDN,ORDN) :: tmp2 + real*8, dimension(ORDN) :: tmp1 + real*8, dimension(3) :: SoAh + +! +1 because c++ gives 0 for first point + cxB = inds+1 + cxT = cxB + ORDN - 1 + + if(all(cxB>0).and.all(cxTex+ORDN))then + write(*,*)"error in global_interpind, cxB = ",cxB + write(*,*)" cxT = ",cxT + write(*,*)" ext = ",ex + stop + else + if(sst==-1)then + SoAh = SoA + if(any(cxT>ex)) write(*,*)"error global_interpind sst =",sst + elseif(sst==0.or.sst==1)then + SoAh = SoA + SoAh(3) = 0 + if(cxB(3)<1.or.cxT(3)>ex(3)) write(*,*)"error global_interpind sst =",sst + elseif(sst==2.or.sst==3)then + SoAh(1) = SoA(2) + SoAh(2) = SoA(3) + SoAh(3) = 0 + if(cxB(3)<1.or.cxT(3)>ex(3)) write(*,*)"error global_interpind sst =",sst + elseif(sst==4.or.sst==5)then + SoAh(1) = SoA(1) + SoAh(2) = SoA(3) + SoAh(3) = 0 + if(cxB(3)<1.or.cxT(3)>ex(3)) write(*,*)"error global_interpind sst =",sst,cxB(3),cxT(3) + endif + call symmetry_tbd(ORDN,ex,f,fh,SoAh) + ya=fh(cxB(1):cxT(1),cxB(2):cxT(2),cxB(3):cxT(3)) + endif + + tmp2=0 + do m=1,ORDN + tmp2 = tmp2 + coef(2*ORDN+m)*ya(:,:,m) + enddo + + tmp1=0 + do m=1,ORDN + tmp1 = tmp1 + coef(ORDN+m)*tmp2(:,m) + enddo + + f_int=0 + do m=1,ORDN + f_int = f_int + coef(m)*tmp1(m) + enddo + + return + + end subroutine global_interpind +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!global interpolation with given index and coeffients +! special for shell to shell + subroutine global_interpind2d(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry,inds,coef,sst) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry,ORDN,sst + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + integer,dimension(3), intent(in) :: inds + real*8, dimension(2*ORDN), intent(in) :: coef + +!~~~~~~> Other parameters: + + real*8, dimension(-ORDN+1:ex(1)+ORDN,-ORDN+1:ex(2)+ORDN,ex(3)) :: fh + integer :: m + integer,dimension(2) :: cxB,cxT + real*8, dimension(ORDN,ORDN) :: ya + real*8, dimension(ORDN) :: tmp1 + real*8, dimension(2) :: SoAh + +! +1 because c++ gives 0 for first point + cxB = inds(1:2)+1 + cxT = cxB + ORDN - 1 + + if(all(cxB>0).and.all(cxTex(1:2)+ORDN))then + write(*,*)"error in global_interpind2d, cxB = ",cxB + write(*,*)" cxT = ",cxT + write(*,*)" ext = ",ex(1:2) + stop + else + if(sst==-1)then + write(*,*)"error in global_interpind2d, sst = ",sst + stop + elseif(sst==0.or.sst==1)then + SoAh = SoA(1:2) + elseif(sst==2.or.sst==3)then + SoAh(1) = SoA(2) + SoAh(2) = SoA(3) + elseif(sst==4.or.sst==5)then + SoAh(1) = SoA(1) + SoAh(2) = SoA(3) + endif + call symmetry_stbd(ORDN,ex,f,fh,SoAh) + ya=fh(cxB(1):cxT(1),cxB(2):cxT(2),inds(3)) + endif + + tmp1=0 + do m=1,ORDN + tmp1 = tmp1 + coef(ORDN+m)*ya(:,m) + enddo + + f_int=0 + do m=1,ORDN + f_int = f_int + coef(m)*tmp1(m) + enddo + + return + + end subroutine global_interpind2d +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!global interpolation with given index and coeffients +! special for shell to shell +! dumyd refer to source + subroutine global_interpind1d(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry,indsi,coef,sst,dumyd) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),symmetry,ORDN,sst,dumyd + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + integer,dimension(3), intent(in) :: indsi + real*8, dimension(ORDN), intent(in) :: coef + +!~~~~~~> Other parameters: + + real*8, dimension(-ORDN+1:ex(1)+ORDN,-ORDN+1:ex(2)+ORDN,ex(3)) :: fh + integer :: m + integer :: cxB,cxT + real*8, dimension(ORDN) :: ya + real*8 :: SoAh + integer,dimension(3) :: inds + +! +1 because c++ gives 0 for first point + inds = indsi + 1 + cxB = inds(1) + cxT = cxB + ORDN - 1 + +! active is rho + if(dumyd==1)then + + if(cxB>0.and.cxTex(1)+ORDN)then + write(*,*)"error in global_interpind1d, cxB = ",cxB + write(*,*)" cxT = ",cxT + write(*,*)" ext = ",ex(1) + stop + else + if(sst==-1)then + write(*,*)"error in global_interpind1d, sst = ",sst + stop + elseif(sst==0.or.sst==1)then + SoAh = SoA(1) + elseif(sst==2.or.sst==3)then + SoAh = SoA(2) + elseif(sst==4.or.sst==5)then + SoAh = SoA(1) + endif + call symmetry_sntbd(ORDN,ex,f,fh,SoAh,1-dumyd) + ya=fh(cxB:cxT,inds(2),inds(3)) + endif + +! active is sigma + elseif(dumyd==0)then + + if(cxB>0.and.cxTex(2)+ORDN)then + write(*,*)"error in global_interpind1d, cxB = ",cxB + write(*,*)" cxT = ",cxT + write(*,*)" ext = ",ex(2) + stop + else + if(sst==-1)then + write(*,*)"error in global_interpind1d, sst = ",sst + stop + elseif(sst==0.or.sst==1)then + SoAh = SoA(2) + elseif(sst==2.or.sst==3)then + SoAh = SoA(3) + elseif(sst==4.or.sst==5)then + SoAh = SoA(3) + endif + call symmetry_sntbd(ORDN,ex,f,fh,SoAh,1-dumyd) + ya=fh(inds(2),cxB:cxT,inds(3)) + endif + + else + write(*,*)"error in global_interpind1d, not recognized dumyd = ",dumyd + endif + + f_int=0 + do m=1,ORDN + f_int = f_int + coef(m)*ya(m) + enddo + + return + + end subroutine global_interpind1d +!----------------------------------------------------------------------------------------------------------------- +! three dimensional interpolation for both vertex and cell center grid structure +! for distinguishing shell and Cartesian + subroutine global_interp_ss(ex,X,Y,Z,f,f_int,x1,y1,z1,ORDN,SoA,symmetry,sst) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3), symmetry,ORDN,sst + real*8,intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1,z1 + real*8, dimension(3), intent(in) :: SoA + +!~~~~~~> Other parameters: + + real*8, dimension(-ORDN+1:ex(1)+ORDN,-ORDN+1:ex(2)+ORDN,-ORDN+1:ex(3)+ORDN) :: fh + real*8, dimension(3) :: SoAh + integer :: j,m,imin,jmin,kmin + integer,dimension(3) :: cxB,cxT,cxI,cmin,cmax + real*8,dimension(3) :: cx + real*8, dimension(1:ORDN) :: x1a + real*8, dimension(1:ORDN,1:ORDN,1:ORDN) :: ya + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8 :: dX,dY,dZ,ddy + real*8, parameter :: ONE=1.d0 + + imin = lbound(f,1) + jmin = lbound(f,2) + kmin = lbound(f,3) + + dX = X(imin+1)-X(imin) + dY = Y(jmin+1)-Y(jmin) + dZ = Z(kmin+1)-Z(kmin) + + forall( j = 1:ordn ) x1a(j) = ( j - 1 )* ONE + + cxI(1) = idint((x1-X(1))/dX+0.4)+1 + cxI(2) = idint((y1-Y(1))/dY+0.4)+1 + cxI(3) = idint((z1-Z(1))/dZ+0.4)+1 + + cxB = cxI - ORDN/2+1 + cxT = cxB + ORDN - 1 + + cmin = 1 + cmax = ex + + if(sst==-1)then + SoAh = SoA + cmin = -ORDN+1 + elseif(sst==0.or.sst==1)then + SoAh = SoA + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + elseif(sst==2.or.sst==3)then + SoAh(1) = SoA(2) + SoAh(2) = SoA(3) + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + elseif(sst==4.or.sst==5)then + SoAh(1) = SoA(1) + SoAh(2) = SoA(3) + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + endif + do m =1,3 + if(cxB(m) < cmin(m))then + cxB(m) = cmin(m) + cxT(m) = cxB(m) + ORDN - 1 + endif + if(cxT(m) > cmax(m))then + cxT(m) = cmax(m) + cxB(m) = cxT(m) + 1 - ORDN + endif + enddo + cx(1) = (x1 - X(1))/dX-cxB(1)+1 + cx(2) = (y1 - Y(1))/dY-cxB(2)+1 + cx(3) = (z1 - Z(1))/dZ-cxB(3)+1 + + call symmetry_tbd(ORDN,ex,f,fh,SoAh) + ya=fh(cxB(1):cxT(1),cxB(2):cxT(2),cxB(3):cxT(3)) + + call polin3(x1a,x1a,x1a,ya,cx(1),cx(2),cx(3),f_int,ddy,ORDN) + + return + + end subroutine global_interp_ss +!----------------------------------------------------------------------------------------------------------------- +! two dimensional interpolation for both vertex and cell center grid structure +! for distinguishing shell and Cartesian + subroutine global_interp_ss_2d(ex,X,Y,indZ,f,f_int,x1,y1,ORDN,SoA,symmetry,sst) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),indZ,symmetry,ORDN,sst + real*8,intent(in) :: X(ex(1)),Y(ex(2)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: f + real*8, intent(out):: f_int + real*8, intent(in) :: x1,y1 + real*8, dimension(3), intent(in) :: SoA + +!~~~~~~> Other parameters: + + real*8, dimension(-ORDN+1:ex(1)+ORDN,-ORDN+1:ex(2)+ORDN,-ORDN+1:ex(3)+ORDN) :: fh + real*8, dimension(3) :: SoAh + integer :: j,m,imin,jmin,kmin + integer,dimension(2) :: cxB,cxT,cxI,cmin,cmax + real*8,dimension(2) :: cx + real*8, dimension(1:ORDN) :: x1a + real*8, dimension(1:ORDN,1:ORDN) :: ya + integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2 + real*8 :: dX,dY,ddy + real*8, parameter :: ONE=1.d0 + +! sanity check + if(indZ < 1 .or. indZ > ex(3))then + write(*,*)"error in global_interp_ss_2d, ext = ",ex(3),"ind = ",indZ + return + endif + + imin = lbound(f,1) + jmin = lbound(f,2) + kmin = lbound(f,3) + + dX = X(imin+1)-X(imin) + dY = Y(jmin+1)-Y(jmin) + + forall( j = 1:ordn ) x1a(j) = ( j - 1 )* ONE + + cxI(1) = idint((x1-X(1))/dX+0.4)+1 + cxI(2) = idint((y1-Y(1))/dY+0.4)+1 + + cxB = cxI - ORDN/2+1 + cxT = cxB + ORDN - 1 + + cmin = 1 + cmax = ex(1:2) + + if(sst==-1)then + SoAh = SoA + cmin = -ORDN+1 + elseif(sst==0.or.sst==1)then + SoAh = SoA + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + elseif(sst==2.or.sst==3)then + SoAh(1) = SoA(2) + SoAh(2) = SoA(3) + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + elseif(sst==4.or.sst==5)then + SoAh(1) = SoA(1) + SoAh(2) = SoA(3) + SoAh(3) = 0 + cmin(1:2) = -ORDN+1 + cmax(1:2) = ex(1:2)+ORDN + endif + do m =1,2 + if(cxB(m) < cmin(m))then + cxB(m) = cmin(m) + cxT(m) = cxB(m) + ORDN - 1 + endif + if(cxT(m) > cmax(m))then + cxT(m) = cmax(m) + cxB(m) = cxT(m) + 1 - ORDN + endif + enddo + cx(1) = (x1 - X(1))/dX-cxB(1)+1 + cx(2) = (y1 - Y(1))/dY-cxB(2)+1 + + call symmetry_tbd(ORDN,ex,f,fh,SoAh) + ya=fh(cxB(1):cxT(1),cxB(2):cxT(2),indZ) + + call polin2(x1a,x1a,ya,cx(1),cx(2),f_int,ddy,ORDN) + + return + + end subroutine global_interp_ss_2d +!------------------------------------------ +!fortran version of Wigner d function +!Eq.(42) of PRD 77, 024027 (2008) +!we consider only theta in [0,pi] +!------------------------------------------ + function fWigner_d_function(l,m,s,costheta) result(gont) + implicit none + integer,intent(in) :: l,m,s + real*8,intent(in) :: costheta + + real*8 :: gont + + integer :: t,C1,C2 + real*8 :: ffact,vv,sinht,cosht + + C1=max(0,m-s) + C2=min(l+m,l-s) + vv=0 + sinht=dsqrt((1.d0-costheta)/2.d0) + cosht=dsqrt((1.d0+costheta)/2.d0); + if(C1/2*2==C1)then + do t=C1,C2,2 + vv=vv+cosht**(2*l+m-s-2*t)*sinht**(2*t+s-m)/(ffact(l+m-t)*ffact(l-s-t)*ffact(t)*ffact(t+s-m)) + enddo + do t=C1+1,C2,2 + vv=vv-cosht**(2*l+m-s-2*t)*sinht**(2*t+s-m)/(ffact(l+m-t)*ffact(l-s-t)*ffact(t)*ffact(t+s-m)) + enddo + else + do t=C1,C2,2 + vv=vv-cosht**(2*l+m-s-2*t)*sinht**(2*t+s-m)/(ffact(l+m-t)*ffact(l-s-t)*ffact(t)*ffact(t+s-m)) + enddo + do t=C1+1,C2,2 + vv=vv+cosht**(2*l+m-s-2*t)*sinht**(2*t+s-m)/(ffact(l+m-t)*ffact(l-s-t)*ffact(t)*ffact(t+s-m)) + enddo + endif + + gont = vv*dsqrt(ffact(l+m)*ffact(l-m)*ffact(l+s)*ffact(l-s)) + + return + + end function fWigner_d_function +!---------------------------------- + function ffact(N) result(gont) + implicit none + integer,intent(in) :: N + + real*8 :: gont + + integer :: i + +! sanity check + if(N < 0)then + write(*,*) "ffact: error input for factorial" + return + endif + + gont = 1.d0 + do i=1,N + gont = gont*i + enddo + + return + + end function ffact +!--------------------------- +!Eq.(41) of PRD 77, 024027 (2008) +!---------------------------------- + function Yslm(s,l,m,the,phi) result(gont) + implicit none + integer,intent(in) :: s,l,m + real*8,intent(in) :: the,phi + + double complex :: gont + + real*8 :: fWigner_d_function,PI,rp + + PI = dacos(-1.d0) + + rp = fWigner_d_function(l,m,s,dcos(the)) + rp = rp*dsqrt((2*l+1.d0)/4.d0/PI) + if(s/2*2.ne.s) rp = -rp + + gont = dcmplx(dcos(m*phi),dsin(m*phi)) + + gont = rp*gont + + return + + end function Yslm +!------------------------------------------------------------------------------------ +subroutine set_value(ext,data_out,rr) + + IMPLICIT NONE + + integer, intent(in) :: ext(3) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(out) :: data_out + REAL*8, intent(in) :: rr + + data_out = rr + + return +end subroutine set_value +subroutine add_value(ext,data_out,rr) + + IMPLICIT NONE + + integer, intent(in) :: ext(3) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(inout) :: data_out + REAL*8, intent(in) :: rr + + data_out = data_out + rr + + return +end subroutine add_value +! copy array2 to array1 +subroutine array_copy(ext,data1,data2) + + IMPLICIT NONE + + integer, intent(in) :: ext(3) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(out) :: data1 + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(in) :: data2 + + data1 = data2 + + return + end subroutine array_copy +! add array2 to array1 +subroutine array_add(ext,data1,data2) + + IMPLICIT NONE + + integer, intent(in) :: ext(3) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(inout) :: data1 + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(in) :: data2 + + data1 = data1 + data2 + + return + end subroutine array_add +! subtract array2 from array1 +subroutine array_subtract(ext,data1,data2) + + IMPLICIT NONE + + integer, intent(in) :: ext(3) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(inout) :: data1 + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(in) :: data2 + + data1 = data1 - data2 + + return + end subroutine array_subtract +! find out the maximum +subroutine find_maximum(ext,X,Y,Z,fun,val,pos,llb,uub) + + implicit none + + integer,intent(in) :: ext(3),llb(3),uub(3) + real*8 :: X(ext(1)),Y(ext(2)),Z(ext(3)) + REAL*8, DIMENSION(ext(1),ext(2),ext(3)), intent(in) :: fun + real*8,intent(out) :: val,pos(3) + + integer :: i,j,k,ii,jj,kk + real*8 :: tmp + + tmp = 0.d0 + + ii=1 + jj=1 + kk=1 + + do k=llb(3)+1,ext(3)-uub(3) + do j=llb(2)+1,ext(2)-uub(2) + do i=llb(1)+1,ext(1)-uub(1) + if(dabs(fun(i,j,k)) > tmp)then + tmp = dabs(fun(i,j,k)) + ii = i + jj = j + kk = k + endif + enddo + enddo + enddo + + pos(1) = X(ii) + pos(2) = Y(jj) + pos(3) = Z(kk) + val = tmp + + return + +end subroutine diff --git a/AMSS_NCKU_source/fmisc.h b/AMSS_NCKU_source/fmisc.h new file mode 100644 index 0000000..1a0b6d6 --- /dev/null +++ b/AMSS_NCKU_source/fmisc.h @@ -0,0 +1,264 @@ + +#ifndef FMISC_H +#define FMISC_H + +#ifdef fortran1 +#define f_interp_2 interp_2 +#define f_pointcopy pointcopy +#define f_copy copy +#define f_global_interp global_interp +#define f_global_interp_ss global_interp_ss +#define f_global_interp_ss_2d global_interp_ss_2d +#define f_global_interpind global_interpind +#define f_global_interpind2d global_interpind2d +#define f_global_interpind1d global_interpind1d +#define f_l2normhelper l2normhelper +#define f_l2normhelper_sh l2normhelper_sh +#define f_l2normhelper_sh_rms l2normhelper_sh_rms +#define f_average average +#define f_average3 average3 +#define f_average2 average2 +#define f_average2p average2p +#define f_average2m average2m +#define f_lowerboundset lowerboundset +#define f_set_value set_value +#define f_add_value add_value +#define f_array_add array_add +#define f_array_copy array_copy +#define f_array_subtract array_subtract +#define f_fft four1 +#define f_find_maximum find_maximum +#define f_polint polint +#define f_d2dump d2dump +#endif +#ifdef fortran2 +#define f_interp_2 INTERP_2 +#define f_pointcopy POINTCOPY +#define f_copy COPY +#define f_global_interp GLOBAL_INTERP +#define f_global_interp_ss GLOBAL_INTERP_SS +#define f_global_interp_ss_2d GLOBAL_INTERP_SS_2D +#define f_global_interpind GLOBAL_INTERPIND +#define f_global_interpind2d GLOBAL_INTERPIND2D +#define f_global_interpind1d GLOBAL_INTERPIND1D +#define f_l2normhelper L2NORMHELPER +#define f_l2normhelper_sh L2NORMHELPER_SH +#define f_l2normhelper_sh_rms L2NORMHELPER_SH_RMS +#define f_average AVERAGE +#define f_average3 AVERAGE3 +#define f_average2 AVERAGE2 +#define f_average2p AVERAGE2P +#define f_average2m AVERAGE2M +#define f_lowerboundset LOWERBOUNDSET +#define f_set_value SET_VALU +#define f_add_value ADD_VALUE +#define f_array_add ARRAY_ADD +#define f_array_copy ARRAY_COPY +#define f_array_subtract ARRAY_SUBTRACT +#define f_fft FOUR1 +#define f_find_maximum FIND_MAXIMUM +#define f_polint POLINT +#define f_d2dump D2DUMP +#endif +#ifdef fortran3 +#define f_interp_2 interp_2_ +#define f_pointcopy pointcopy_ +#define f_copy copy_ +#define f_global_interp global_interp_ +#define f_global_interp_ss global_interp_ss_ +#define f_global_interp_ss_2d global_interp_ss_2d_ +#define f_global_interpind global_interpind_ +#define f_global_interpind2d global_interpind2d_ +#define f_global_interpind1d global_interpind1d_ +#define f_l2normhelper l2normhelper_ +#define f_l2normhelper_sh l2normhelper_sh_ +#define f_l2normhelper_sh_rms l2normhelper_sh_rms_ +#define f_average average_ +#define f_average3 average3_ +#define f_average2 average2_ +#define f_average2p average2p_ +#define f_average2m average2m_ +#define f_lowerboundset lowerboundset_ +#define f_set_value set_value_ +#define f_add_value add_value_ +#define f_array_add array_add_ +#define f_array_copy array_copy_ +#define f_array_subtract array_subtract_ +#define f_fft four1_ +#define f_find_maximum find_maximum_ +#define f_polint polint_ +#define f_d2dump d2dump_ +#endif + +extern "C" +{ + void f_pointcopy(int &, + double *, double *, int *, double *, + double &, double &, double &, double &); +} + +extern "C" +{ + void f_copy(int &, + double *, double *, int *, double *, + double *, double *, int *, double *, + double *, double *); +} + +extern "C" +{ + void f_global_interp(int *, double *, double *, double *, + double *, double &, + double &, double &, double &, + int &, double *, int &); +} + +extern "C" +{ + void f_global_interp_ss(int *, double *, double *, double *, + double *, double &, + double &, double &, double &, + int &, double *, int &, int &); +} + +extern "C" +{ + void f_global_interp_ss_2d(int *, double *, double *, int &, + double *, double &, + double &, double &, + int &, double *, int &, int &); +} + +extern "C" +{ + void f_global_interpind(int *, double *, double *, double *, + double *, double &, + double &, double &, double &, + int &, double *, int &, + int *, double *, int &); +} + +extern "C" +{ + void f_global_interpind2d(int *, double *, double *, double *, + double *, double &, + double &, double &, double &, + int &, double *, int &, + int *, double *, int &); +} + +extern "C" +{ + void f_global_interpind1d(int *, double *, double *, double *, + double *, double &, + double &, double &, double &, + int &, double *, int &, + int *, double *, int &, int &); +} + +extern "C" +{ + void f_l2normhelper(int *, double *, double *, double *, + double &, double &, double &, + double &, double &, double &, + double *, double &, int &); +} + +extern "C" +{ + void f_l2normhelper_sh(int *, double *, double *, double *, + double &, double &, double &, + double &, double &, double &, + double *, double &, int &, int &, int &); +} + +extern "C" +{ + void f_l2normhelper_sh_rms(int *, double *, double *, double *, + double &, double &, double &, + double &, double &, double &, + double *, double &, int &, int &, int &, int &); +} + +extern "C" +{ + void f_average(int *, double *, double *, double *); +} + +extern "C" +{ + void f_average3(int *, double *, double *, double *); +} + +extern "C" +{ + void f_average2(int *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_average2p(int *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_average2m(int *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_lowerboundset(int *, double *, double &); +} + +#if 0 +extern "C" { void f_interp_2( int *, double *, + double &, int &,int &,int &,int &,int &,int &, + double &,double &,double &, + int &, double *, + int & + );} +#endif + +extern "C" +{ + void f_set_value(int *, double *, double &); +} +extern "C" +{ + void f_add_value(int *, double *, double &); +} +extern "C" +{ + void f_array_add(int *, double *, double *); +} +extern "C" +{ + void f_array_copy(int *, double *, double *); +} +extern "C" +{ + void f_array_subtract(int *, double *, double *); +} + +extern "C" +{ + void f_fft(double *, int &, int &); +} + +extern "C" +{ + void f_find_maximum(int *, + double *, double *, double *, double *, + double &, double *, int *, int *); +} + +extern "C" +{ + void f_polint(double *, double *, double &, double &, double &, int &); +} + +extern "C" +{ + void f_d2dump(int &, double *, double *, int *, double *, double *, int &, double *); +} +#endif /* FMISC_H */ diff --git a/AMSS_NCKU_source/fourdcurvature.f90 b/AMSS_NCKU_source/fourdcurvature.f90 new file mode 100644 index 0000000..0b1b5ff --- /dev/null +++ b/AMSS_NCKU_source/fourdcurvature.f90 @@ -0,0 +1,91 @@ + + +#include "macrodef.fh" + +!----------------------------------------------------------------------------- +! +! compute 4 dimensional Ricci scalar +! this routine is valid for both box and shell +! +!----------------------------------------------------------------------------- + + subroutine get4ricciscalar(ex, X, Y, Z, & + chi, trK, rho, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Sxx,Sxy,Sxz,Syy,Syz,Szz,& + RR) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,rho +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz +! matter + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: Sxx,Sxy,Sxz,Syy,Syz,Szz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: RR + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,chipn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, parameter :: ONE = 1.d0, TWO = 2.d0, THR = 3.d0, F8 = 8.d0, F2o3 = 2.d0/3.d0 + real*8 :: PI + + PI = dacos(-ONE) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + RR =(gupxx * ( & + gupxx * Axx * Axx + gupyy * Axy * Axy + gupzz * Axz * Axz + & + TWO * (gupxy * Axx * Axy + gupxz * Axx * Axz + gupyz * Axy * Axz) ) + & + gupyy * ( & + gupxx * Axy * Axy + gupyy * Ayy * Ayy + gupzz * Ayz * Ayz + & + TWO * (gupxy * Axy * Ayy + gupxz * Axy * Ayz + gupyz * Ayy * Ayz) ) + & + gupzz * ( & + gupxx * Axz * Axz + gupyy * Ayz * Ayz + gupzz * Azz * Azz + & + TWO * (gupxy * Axz * Ayz + gupxz * Axz * Azz + gupyz * Ayz * Azz) ) + & + TWO * ( & + gupxy * ( & + gupxx * Axx * Axy + gupyy * Axy * Ayy + gupzz * Axz * Ayz + & + gupxy * (Axx * Ayy + Axy * Axy) + & + gupxz * (Axx * Ayz + Axz * Axy) + & + gupyz * (Axy * Ayz + Axz * Ayy) ) + & + gupxz * ( & + gupxx * Axx * Axz + gupyy * Axy * Ayz + gupzz * Axz * Azz + & + gupxy * (Axx * Ayz + Axy * Axz) + & + gupxz * (Axx * Azz + Axz * Axz) + & + gupyz * (Axy * Azz + Axz * Ayz) ) + & + gupyz * ( & + gupxx * Axy * Axz + gupyy * Ayy * Ayz + gupzz * Ayz * Azz + & + gupxy * (Axy * Ayz + Ayy * Axz) + & + gupxz * (Axy * Azz + Ayz * Axz) + & + gupyz * (Ayy * Azz + Ayz * Ayz) ) )) - F2o3*trK*trK & + -(gupxx*Rxx+gupyy*Ryy+gupzz*Rzz+TWO*(gupxy*Rxy+gupxz*Rxz+gupyz*Ryz))*chipn1 & + -F8*PI*(THR*rho- & + (gupxx*Sxx+gupyy*Syy+gupzz*Szz+TWO*(gupxy*Sxy+gupxz*Sxz+gupyz*Syz))*chipn1) + + return + + end subroutine get4ricciscalar diff --git a/AMSS_NCKU_source/fuzzy.C b/AMSS_NCKU_source/fuzzy.C new file mode 100644 index 0000000..a1f1672 --- /dev/null +++ b/AMSS_NCKU_source/fuzzy.C @@ -0,0 +1,63 @@ +#include +#include + +#include "stdc.h" +#include "util.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + template + bool fuzzy::EQ(fp_t x, fp_t y) + { + fp_t max_abs = jtutil::tmax(jtutil::abs(x), jtutil::abs(y)); + fp_t epsilon = jtutil::tmax(tolerance_, tolerance_ * max_abs); + + return jtutil::abs(x - y) <= epsilon; + } + + //****************************************************************************** + + template + bool fuzzy::is_integer(fp_t x) + { + int i = round::to_integer(x); + return EQ(x, fp_t(i)); + } + + //****************************************************************************** + + template + int fuzzy::floor(fp_t x) + { + return fuzzy::is_integer(x) + ? round::to_integer(x) + : round::floor(x); + } + + //****************************************************************************** + + template + int fuzzy::ceiling(fp_t x) + { + return fuzzy::is_integer(x) + ? round::to_integer(x) + : round::ceiling(x); + } + template <> + float fuzzy::tolerance_ = 1.0e-5; // about 100 * FLT_EPSILON + + template <> + double fuzzy::tolerance_ = 1.0e-12; // about 1e4 * DBL_EPSILON + + // template instantiations + template class fuzzy; + template class fuzzy; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/gaussj.C b/AMSS_NCKU_source/gaussj.C new file mode 100644 index 0000000..f2a5e21 --- /dev/null +++ b/AMSS_NCKU_source/gaussj.C @@ -0,0 +1,155 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif +/* Linear equation solution by Gauss-Jordan elimination. +a[0..n-1][0..n-1] is the input matrix. b[0..n-1] is input +containing the right-hand side vectors. On output a is +replaced by its matrix inverse, and b is replaced by the +corresponding set of solution vectors */ + +int gaussj(double *a, double *b, int n) +{ + double swap; + + int *indxc, *indxr, *ipiv; + indxc = new int[n]; + indxr = new int[n]; + ipiv = new int[n]; + + int i, icol, irow, j, k, l, ll; + double big, dum, pivinv, temp; + + for (j = 0; j < n; j++) + ipiv[j] = 0; + for (i = 0; i < n; i++) + { + big = 0.0; + for (j = 0; j < n; j++) + if (ipiv[j] != 1) + for (k = 0; k < n; k++) + { + if (ipiv[k] == 0) + { + if (fabs(a[j * n + k]) >= big) + { + big = fabs(a[j * n + k]); + irow = j; + icol = k; + } + } + else if (ipiv[k] > 1) + { + cout << "gaussj: Singular Matrix-1" << endl; + for (int ii = 0; ii < n; ii++) + { + for (int jj = 0; jj < n; jj++) + cout << a[ii * n + jj] << " "; + cout << endl; + } + return 1; // error return + } + } + + ipiv[icol] = ipiv[icol] + 1; + if (irow != icol) + { + for (l = 0; l < n; l++) + { + swap = a[irow * n + l]; + a[irow * n + l] = a[icol * n + l]; + a[icol * n + l] = swap; + } + + swap = b[irow]; + b[irow] = b[icol]; + b[icol] = swap; + } + + indxr[i] = irow; + indxc[i] = icol; + + if (a[icol * n + icol] == 0.0) + { + cout << "gaussj: Singular Matrix-2" << endl; + for (int ii = 0; ii < n; ii++) + { + for (int jj = 0; jj < n; jj++) + cout << a[ii * n + jj] << " "; + cout << endl; + } + return 1; // error return + } + + pivinv = 1.0 / a[icol * n + icol]; + a[icol * n + icol] = 1.0; + for (l = 0; l < n; l++) + a[icol * n + l] *= pivinv; + b[icol] *= pivinv; + for (ll = 0; ll < n; ll++) + if (ll != icol) + { + dum = a[ll * n + icol]; + a[ll * n + icol] = 0.0; + for (l = 0; l < n; l++) + a[ll * n + l] -= a[icol * n + l] * dum; + b[ll] -= b[icol] * dum; + } + } + + for (l = n - 1; l >= 0; l--) + { + if (indxr[l] != indxc[l]) + for (k = 0; k < n; k++) + { + swap = a[k * n + indxr[l]]; + a[k * n + indxr[l]] = a[k * n + indxc[l]]; + a[k * n + indxc[l]] = swap; + } + } + + delete[] indxc; + delete[] indxr; + delete[] ipiv; + + return 0; +} +// for check usage +/* +int main() +{ + double *A,*b; + A=new double[9]; + b=new double[3]; + + A[0]=0.5; A[1]=1.0/3; A[2]=1; + A[3]=1; A[4]=5.0/3; A[5]=3; + A[6]=2; A[7]=4.0/3; A[8]=5; + + b[0]=1; b[1]=3; b[2]=2; + + cout<<"initial data:"< Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chipn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Exx,Exy,Exz,Eyy,Eyz,Ezz + real*8, dimension(ex(1),ex(2),ex(3)) :: Bxx,Bxy,Bxz,Byy,Byz,Bzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Azzx,Azzy,Azzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz + + real*8, dimension(ex(1),ex(2),ex(3)) :: adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: dX, dY, dZ + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + +#if (ABV == 1) + call bssn2adm(ex,chipn1,trK,gxx,gxy,gxz,gyy,gyz,gzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz) + adm_dxx = adm_dxx - ONE + adm_dyy = adm_dyy - ONE + adm_dzz = adm_dzz - ONE + call adm_ricci_gamma(ex, X, Y, Z, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) +#endif + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +#if (tetradtype == 0) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + + call fderivs(ex,Axx,Axxx,Axxy,Axxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axy,Axyx,Axyy,Axyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Axz,Axzx,Axzy,Axzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Ayy,Ayyx,Ayyy,Ayyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Ayz,Ayzx,Ayzy,Ayzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Azz,Azzx,Azzy,Azzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,symmetry,0) + call fderivs(ex,trK,fx,fy,fz,X,Y,Z,SYM,SYM,SYM,symmetry,0) +! compute D_k K_ij up to chi^-1 + Axxx = Axxx - (Gamxxx*Axx + Gamyxx*Axy + Gamzxx*Axz)*TWO - chix/chipn1*Axx + F1o3*gxx*fx + Axxy = Axxy - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz)*TWO - chiy/chipn1*Axx + F1o3*gxx*fy + Axxz = Axxz - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz)*TWO - chiz/chipn1*Axx + F1o3*gxx*fz + Ayyx = Ayyx - (Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz)*TWO - chix/chipn1*Ayy + F1o3*gyy*fx + Ayyy = Ayyy - (Gamxyy*Axy + Gamyyy*Ayy + Gamzyy*Ayz)*TWO - chiy/chipn1*Ayy + F1o3*gyy*fy + Ayyz = Ayyz - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz)*TWO - chiz/chipn1*Ayy + F1o3*gyy*fz + Azzx = Azzx - (Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz)*TWO - chix/chipn1*Azz + F1o3*gzz*fx + Azzy = Azzy - (Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz)*TWO - chiy/chipn1*Azz + F1o3*gzz*fy + Azzz = Azzz - (Gamxzz*Axz + Gamyzz*Ayz + Gamzzz*Azz)*TWO - chiz/chipn1*Azz + F1o3*gzz*fz + Axyx = Axyx - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz + & + Gamxxx*Axy + Gamyxx*Ayy + Gamzxx*Ayz) - chix/chipn1*Axy + F1o3*gxy*fx + Axyy = Axyy - (Gamxyy*Axx + Gamyyy*Axy + Gamzyy*Axz + & + Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz) - chiy/chipn1*Axy + F1o3*gxy*fy + Axyz = Axyz - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz) - chiz/chipn1*Axy + F1o3*gxy*fz + Axzx = Axzx - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz + & + Gamxxx*Axz + Gamyxx*Ayz + Gamzxx*Azz) - chix/chipn1*Axz + F1o3*gxz*fx + Axzy = Axzy - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chiy/chipn1*Axz + F1o3*gxz*fy + Axzz = Axzz - (Gamxzz*Axx + Gamyzz*Axy + Gamzzz*Axz + & + Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz) - chiz/chipn1*Axz + F1o3*gxz*fz + Ayzx = Ayzx - (Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chix/chipn1*Ayz + F1o3*gyz*fx + Ayzy = Ayzy - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz + & + Gamxyy*Axz + Gamyyy*Ayz + Gamzyy*Azz) - chiy/chipn1*Ayz + F1o3*gyz*fy + Ayzz = Ayzz - (Gamxzz*Axy + Gamyzz*Ayy + Gamzzz*Ayz + & + Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz) - chiz/chipn1*Ayz + F1o3*gyz*fz +! symmetrize B_ij = v^k (D_k K_ij -D_j K_ik) + Bxx =(vy*(Axxy - Axyx) + vz*(Axxz - Axzx))*f + Byy =(vx*(Ayyx - Axyy) + vz*(Ayyz - Ayzy))*f + Bzz =(vx*(Azzx - Axzz) + vy*(Azzy - Ayzz))*f + Bxy =(vx*(Axyx - (Axxy+Axyx)/TWO) + vy*(Axyy-Ayyx)/TWO + vz*(Axyz - (Axzy+Ayzx)/TWO))*f + Bxz =(vx*(Axzx - (Axxz+Axzx)/TWO) + vy*(Axzy - (Axyz+Ayzx)/TWO) + vz*(Axzz-Azzx)/TWO)*f + Byz =(vx*(Ayzx - (Axyz+Axzy)/TWO) + vy*(Ayzy - (Ayyz+Ayzy)/TWO) + vz*(Ayzz-Azzy)/TWO)*f +! E_ij = R_ij - K_ik * K^k_j + K * K_ij + +! K_ij up to chi^-1 + Axxx = Axx + F1o3*trK*gxx + Axyx = Axy + F1o3*trK*gxy + Axzx = Axz + F1o3*trK*gxz + Ayyx = Ayy + F1o3*trK*gyy + Ayzx = Ayz + F1o3*trK*gyz + Azzx = Azz + F1o3*trK*gzz +! gup and A_ijk cancel a chi^-1 + Exx = gupxx * Axxx * Axxx + gupyy * Axyx * Axyx + gupzz * Axzx * Axzx + & + TWO * (gupxy * Axxx * Axyx + gupxz * Axxx * Axzx + gupyz * Axyx * Axzx) + Eyy = gupxx * Axyx * Axyx + gupyy * Ayyx * Ayyx + gupzz * Ayzx * Ayzx + & + TWO * (gupxy * Axyx * Ayyx + gupxz * Axyx * Ayzx + gupyz * Ayyx * Ayzx) + Ezz = gupxx * Axzx * Axzx + gupyy * Ayzx * Ayzx + gupzz * Azzx * Azzx + & + TWO * (gupxy * Axzx * Ayzx + gupxz * Axzx * Azzx + gupyz * Ayzx * Azzx) + Exy = gupxx * Axxx * Axyx + gupyy * Axyx * Ayyx + gupzz * Axzx * Ayzx + & + gupxy *(Axxx * Ayyx + Axyx * Axyx) + & + gupxz *(Axxx * Ayzx + Axzx * Axyx) + & + gupyz *(Axyx * Ayzx + Axzx * Ayyx) + Exz = gupxx * Axxx * Axzx + gupyy * Axyx * Ayzx + gupzz * Axzx * Azzx + & + gupxy *(Axxx * Ayzx + Axyx * Axzx) + & + gupxz *(Axxx * Azzx + Axzx * Axzx) + & + gupyz *(Axyx * Azzx + Axzx * Ayzx) + Eyz = gupxx * Axyx * Axzx + gupyy * Ayyx * Ayzx + gupzz * Ayzx * Azzx + & + gupxy *(Axyx * Ayzx + Ayyx * Axzx) + & + gupxz *(Axyx * Azzx + Ayzx * Axzx) + & + gupyz *(Ayyx * Azzx + Ayzx * Ayzx) + + Exx = Rxx - (Exx - Axxx*trK)*f - Bxx + Exy = Rxy - (Exy - Axyx*trK)*f - Bxy + Exz = Rxz - (Exz - Axzx*trK)*f - Bxz + Eyy = Ryy - (Eyy - Ayyx*trK)*f - Byy + Eyz = Ryz - (Eyz - Ayzx*trK)*f - Byz + Ezz = Rzz - (Ezz - Azzx*trK)*f - Bzz +!set m = (u - iw)/sqrt(2) following Frans, PRD 75, 124018(2007) +! compute uuww^ij = u^i * u^j - w^i * w^j + uuwwxx = ux * ux - wx * wx + uuwwxy = ux * uy - wx * wy + uuwwxz = ux * uz - wx * wz + uuwwyy = uy * uy - wy * wy + uuwwyz = uy * uz - wy * wz + uuwwzz = uz * uz - wz * wz + +! compute uw^ij = u^i * w^j + w^i * u^j + uwxx = ux * wx + wx * ux + uwxy = ux * wy + wx * uy + uwxz = ux * wz + wx * uz + uwyy = uy * wy + wy * uy + uwyz = uy * wz + wy * uz + uwzz = uz * wz + wz * uz +!the real part of Psi4 + Rpsi4 = Exx * uuwwxx + Eyy * uuwwyy + Ezz * uuwwzz & + + (Exy * uuwwxy + Exz * uuwwxz + Eyz * uuwwyz) * TWO + +!the imaginary part of Psi4 + Ipsi4 = Exx * uwxx + Eyy * uwyy + Ezz * uwzz & + + (Exy * uwxy + Exz * uwxz + Eyz * uwyz) * TWO + +!multiply with -1/2 + Rpsi4 = - Rpsi4/TWO + Ipsi4 = - Ipsi4/TWO + + return + + end subroutine getnp4 +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables for shell +! +!----------------------------------------------------------------------------- + + subroutine getnp4_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4, & + symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chipn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Exx,Exy,Exz,Eyy,Eyz,Ezz + real*8, dimension(ex(1),ex(2),ex(3)) :: Bxx,Bxy,Bxz,Byy,Byz,Bzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Azzx,Azzy,Azzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz + + real*8, dimension(ex(1),ex(2),ex(3)) :: adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + +#if (ABV == 1) + call bssn2adm(ex,chipn1,trK,gxx,gxy,gxz,gyy,gyz,gzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz, & + Kxx,Kxy,Kxz,Kyy,Kyz,Kzz) + adm_dxx = adm_dxx - ONE + adm_dyy = adm_dyy - ONE + adm_dzz = adm_dzz - ONE + call adm_ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + adm_dxx,adm_gxy,adm_gxz,adm_dyy,adm_gyz,adm_dzz,& + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,0,sst) +#endif + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +#if (tetradtype == 0) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + + call fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,trK,fx,fy,fz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) +! compute D_k K_ij up to chi^-1 + Axxx = Axxx - (Gamxxx*Axx + Gamyxx*Axy + Gamzxx*Axz)*TWO - chix/chipn1*Axx + F1o3*gxx*fx + Axxy = Axxy - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz)*TWO - chiy/chipn1*Axx + F1o3*gxx*fy + Axxz = Axxz - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz)*TWO - chiz/chipn1*Axx + F1o3*gxx*fz + Ayyx = Ayyx - (Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz)*TWO - chix/chipn1*Ayy + F1o3*gyy*fx + Ayyy = Ayyy - (Gamxyy*Axy + Gamyyy*Ayy + Gamzyy*Ayz)*TWO - chiy/chipn1*Ayy + F1o3*gyy*fy + Ayyz = Ayyz - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz)*TWO - chiz/chipn1*Ayy + F1o3*gyy*fz + Azzx = Azzx - (Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz)*TWO - chix/chipn1*Azz + F1o3*gzz*fx + Azzy = Azzy - (Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz)*TWO - chiy/chipn1*Azz + F1o3*gzz*fy + Azzz = Azzz - (Gamxzz*Axz + Gamyzz*Ayz + Gamzzz*Azz)*TWO - chiz/chipn1*Azz + F1o3*gzz*fz + Axyx = Axyx - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz + & + Gamxxx*Axy + Gamyxx*Ayy + Gamzxx*Ayz) - chix/chipn1*Axy + F1o3*gxy*fx + Axyy = Axyy - (Gamxyy*Axx + Gamyyy*Axy + Gamzyy*Axz + & + Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz) - chiy/chipn1*Axy + F1o3*gxy*fy + Axyz = Axyz - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz) - chiz/chipn1*Axy + F1o3*gxy*fz + Axzx = Axzx - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz + & + Gamxxx*Axz + Gamyxx*Ayz + Gamzxx*Azz) - chix/chipn1*Axz + F1o3*gxz*fx + Axzy = Axzy - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chiy/chipn1*Axz + F1o3*gxz*fy + Axzz = Axzz - (Gamxzz*Axx + Gamyzz*Axy + Gamzzz*Axz + & + Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz) - chiz/chipn1*Axz + F1o3*gxz*fz + Ayzx = Ayzx - (Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chix/chipn1*Ayz + F1o3*gyz*fx + Ayzy = Ayzy - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz + & + Gamxyy*Axz + Gamyyy*Ayz + Gamzyy*Azz) - chiy/chipn1*Ayz + F1o3*gyz*fy + Ayzz = Ayzz - (Gamxzz*Axy + Gamyzz*Ayy + Gamzzz*Ayz + & + Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz) - chiz/chipn1*Ayz + F1o3*gyz*fz +! symmetrize B_ij = v^k (D_k K_ij -D_j K_ik) + Bxx =(vy*(Axxy - Axyx) + vz*(Axxz - Axzx))*f + Byy =(vx*(Ayyx - Axyy) + vz*(Ayyz - Ayzy))*f + Bzz =(vx*(Azzx - Axzz) + vy*(Azzy - Ayzz))*f + Bxy =(vx*(Axyx - (Axxy+Axyx)/TWO) + vy*(Axyy-Ayyx)/TWO + vz*(Axyz - (Axzy+Ayzx)/TWO))*f + Bxz =(vx*(Axzx - (Axxz+Axzx)/TWO) + vy*(Axzy - (Axyz+Ayzx)/TWO) + vz*(Axzz-Azzx)/TWO)*f + Byz =(vx*(Ayzx - (Axyz+Axzy)/TWO) + vy*(Ayzy - (Ayyz+Ayzy)/TWO) + vz*(Ayzz-Azzy)/TWO)*f +! E_ij = R_ij - K_ik * K^k_j + K * K_ij + +! K_ij up to chi^-1 + Axxx = Axx + F1o3*trK*gxx + Axyx = Axy + F1o3*trK*gxy + Axzx = Axz + F1o3*trK*gxz + Ayyx = Ayy + F1o3*trK*gyy + Ayzx = Ayz + F1o3*trK*gyz + Azzx = Azz + F1o3*trK*gzz +! gup and A_ijk cancel a chi^-1 + Exx = gupxx * Axxx * Axxx + gupyy * Axyx * Axyx + gupzz * Axzx * Axzx + & + TWO * (gupxy * Axxx * Axyx + gupxz * Axxx * Axzx + gupyz * Axyx * Axzx) + Eyy = gupxx * Axyx * Axyx + gupyy * Ayyx * Ayyx + gupzz * Ayzx * Ayzx + & + TWO * (gupxy * Axyx * Ayyx + gupxz * Axyx * Ayzx + gupyz * Ayyx * Ayzx) + Ezz = gupxx * Axzx * Axzx + gupyy * Ayzx * Ayzx + gupzz * Azzx * Azzx + & + TWO * (gupxy * Axzx * Ayzx + gupxz * Axzx * Azzx + gupyz * Ayzx * Azzx) + Exy = gupxx * Axxx * Axyx + gupyy * Axyx * Ayyx + gupzz * Axzx * Ayzx + & + gupxy *(Axxx * Ayyx + Axyx * Axyx) + & + gupxz *(Axxx * Ayzx + Axzx * Axyx) + & + gupyz *(Axyx * Ayzx + Axzx * Ayyx) + Exz = gupxx * Axxx * Axzx + gupyy * Axyx * Ayzx + gupzz * Axzx * Azzx + & + gupxy *(Axxx * Ayzx + Axyx * Axzx) + & + gupxz *(Axxx * Azzx + Axzx * Axzx) + & + gupyz *(Axyx * Azzx + Axzx * Ayzx) + Eyz = gupxx * Axyx * Axzx + gupyy * Ayyx * Ayzx + gupzz * Ayzx * Azzx + & + gupxy *(Axyx * Ayzx + Ayyx * Axzx) + & + gupxz *(Axyx * Azzx + Ayzx * Axzx) + & + gupyz *(Ayyx * Azzx + Ayzx * Ayzx) + + Exx = Rxx - (Exx - Axxx*trK)*f - Bxx + Exy = Rxy - (Exy - Axyx*trK)*f - Bxy + Exz = Rxz - (Exz - Axzx*trK)*f - Bxz + Eyy = Ryy - (Eyy - Ayyx*trK)*f - Byy + Eyz = Ryz - (Eyz - Ayzx*trK)*f - Byz + Ezz = Rzz - (Ezz - Azzx*trK)*f - Bzz +!set m = (u - iw)/sqrt(2) following Frans, PRD 75, 124018(2007) +! compute uuww^ij = u^i * u^j - w^i * w^j + uuwwxx = ux * ux - wx * wx + uuwwxy = ux * uy - wx * wy + uuwwxz = ux * uz - wx * wz + uuwwyy = uy * uy - wy * wy + uuwwyz = uy * uz - wy * wz + uuwwzz = uz * uz - wz * wz + +! compute uw^ij = u^i * w^j + w^i * u^j + uwxx = ux * wx + wx * ux + uwxy = ux * wy + wx * uy + uwxz = ux * wz + wx * uz + uwyy = uy * wy + wy * uy + uwyz = uy * wz + wy * uz + uwzz = uz * wz + wz * uz +!the real part of Psi4 + Rpsi4 = Exx * uuwwxx + Eyy * uuwwyy + Ezz * uuwwzz & + + (Exy * uuwwxy + Exz * uuwwxz + Eyz * uuwwyz) * TWO + +!the imaginary part of Psi4 + Ipsi4 = Exx * uwxx + Eyy * uwyy + Ezz * uwzz & + + (Exy * uwxy + Exz * uwxz + Eyz * uwyz) * TWO + +!multiply with -1/2 + Rpsi4 = - Rpsi4/TWO + Ipsi4 = - Ipsi4/TWO + + return + + end subroutine getnp4_ss +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! for single point +!----------------------------------------------------------------------------- + + subroutine getnp4_point(X, Y, Z, & + chi, trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + chix,chiy,chiz, & + trKx,trKy,trKz, & + Axxx,Axxy,Axxz, & + Axyx,Axyy,Axyz, & + Axzx,Axzy,Axzz, & + Ayyx,Ayyy,Ayyz, & + Ayzx,Ayzy,Ayzz, & + Azzx,Azzy,Azzz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4) + + implicit none + +!~~~~~~> Input parameters: + + real*8, intent(in ) :: X,Y,Z + real*8,intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8,intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8,intent(in ) :: chi,trK + real*8,intent(in ) :: chix,chiy,chiz + real*8,intent(in ) :: trKx,trKy,trKz +! covariant derivatives when out + real*8,intent(inout) :: Axxx,Axxy,Axxz + real*8,intent(inout) :: Axyx,Axyy,Axyz + real*8,intent(inout) :: Axzx,Axzy,Axzz + real*8,intent(inout) :: Ayyx,Ayyy,Ayyz + real*8,intent(inout) :: Ayzx,Ayzy,Ayzz + real*8,intent(inout) :: Azzx,Azzy,Azzz +! physical second kind of connection + real*8,intent(in) :: Gamxxx, Gamxxy, Gamxxz + real*8,intent(in) :: Gamxyy, Gamxyz, Gamxzz + real*8,intent(in) :: Gamyxx, Gamyxy, Gamyxz + real*8,intent(in) :: Gamyyy, Gamyyz, Gamyzz + real*8,intent(in) :: Gamzxx, Gamzxy, Gamzxz + real*8,intent(in) :: Gamzyy, Gamzyz, Gamzzz +! physical Ricci tensor + real*8,intent(in) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, intent(out):: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8 :: f,fx,fy,fz + real*8 :: gxx,gyy,gzz,chipn1 + real*8 :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8 :: Exx,Exy,Exz,Eyy,Eyz,Ezz + real*8 :: Bxx,Bxy,Bxz,Byy,Byz,Bzz + real*8 :: gupxx,gupxy,gupxz + real*8 :: gupyy,gupyz,gupzz + real*8 :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz + real*8 :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + +! compute D_k K_ij up to chi^-1 + Axxx = Axxx - (Gamxxx*Axx + Gamyxx*Axy + Gamzxx*Axz)*TWO - chix/chipn1*Axx + F1o3*gxx*trKx + Axxy = Axxy - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz)*TWO - chiy/chipn1*Axx + F1o3*gxx*trKy + Axxz = Axxz - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz)*TWO - chiz/chipn1*Axx + F1o3*gxx*trKz + Ayyx = Ayyx - (Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz)*TWO - chix/chipn1*Ayy + F1o3*gyy*trKx + Ayyy = Ayyy - (Gamxyy*Axy + Gamyyy*Ayy + Gamzyy*Ayz)*TWO - chiy/chipn1*Ayy + F1o3*gyy*trKy + Ayyz = Ayyz - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz)*TWO - chiz/chipn1*Ayy + F1o3*gyy*trKz + Azzx = Azzx - (Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz)*TWO - chix/chipn1*Azz + F1o3*gzz*trKx + Azzy = Azzy - (Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz)*TWO - chiy/chipn1*Azz + F1o3*gzz*trKy + Azzz = Azzz - (Gamxzz*Axz + Gamyzz*Ayz + Gamzzz*Azz)*TWO - chiz/chipn1*Azz + F1o3*gzz*trKz + Axyx = Axyx - (Gamxxy*Axx + Gamyxy*Axy + Gamzxy*Axz + & + Gamxxx*Axy + Gamyxx*Ayy + Gamzxx*Ayz) - chix/chipn1*Axy + F1o3*gxy*trKx + Axyy = Axyy - (Gamxyy*Axx + Gamyyy*Axy + Gamzyy*Axz + & + Gamxxy*Axy + Gamyxy*Ayy + Gamzxy*Ayz) - chiy/chipn1*Axy + F1o3*gxy*trKy + Axyz = Axyz - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz) - chiz/chipn1*Axy + F1o3*gxy*trKz + Axzx = Axzx - (Gamxxz*Axx + Gamyxz*Axy + Gamzxz*Axz + & + Gamxxx*Axz + Gamyxx*Ayz + Gamzxx*Azz) - chix/chipn1*Axz + F1o3*gxz*trKx + Axzy = Axzy - (Gamxyz*Axx + Gamyyz*Axy + Gamzyz*Axz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chiy/chipn1*Axz + F1o3*gxz*trKy + Axzz = Axzz - (Gamxzz*Axx + Gamyzz*Axy + Gamzzz*Axz + & + Gamxxz*Axz + Gamyxz*Ayz + Gamzxz*Azz) - chiz/chipn1*Axz + F1o3*gxz*trKz + Ayzx = Ayzx - (Gamxxz*Axy + Gamyxz*Ayy + Gamzxz*Ayz + & + Gamxxy*Axz + Gamyxy*Ayz + Gamzxy*Azz) - chix/chipn1*Ayz + F1o3*gyz*trKx + Ayzy = Ayzy - (Gamxyz*Axy + Gamyyz*Ayy + Gamzyz*Ayz + & + Gamxyy*Axz + Gamyyy*Ayz + Gamzyy*Azz) - chiy/chipn1*Ayz + F1o3*gyz*trKy + Ayzz = Ayzz - (Gamxzz*Axy + Gamyzz*Ayy + Gamzzz*Ayz + & + Gamxyz*Axz + Gamyyz*Ayz + Gamzyz*Azz) - chiz/chipn1*Ayz + F1o3*gyz*trKz +! symmetrize B_ij = v^k (D_k K_ij -D_j K_ik) + Bxx =(vy*(Axxy - Axyx) + vz*(Axxz - Axzx))*f + Byy =(vx*(Ayyx - Axyy) + vz*(Ayyz - Ayzy))*f + Bzz =(vx*(Azzx - Axzz) + vy*(Azzy - Ayzz))*f + Bxy =(vx*(Axyx - (Axxy+Axyx)/TWO) + vy*(Axyy-Ayyx)/TWO + vz*(Axyz - (Axzy+Ayzx)/TWO))*f + Bxz =(vx*(Axzx - (Axxz+Axzx)/TWO) + vy*(Axzy - (Axyz+Ayzx)/TWO) + vz*(Axzz-Azzx)/TWO)*f + Byz =(vx*(Ayzx - (Axyz+Axzy)/TWO) + vy*(Ayzy - (Ayyz+Ayzy)/TWO) + vz*(Ayzz-Azzy)/TWO)*f +! E_ij = R_ij - K_ik * K^k_j + K * K_ij + +! K_ij up to chi^-1 + Axxx = Axx + F1o3*trK*gxx + Axyx = Axy + F1o3*trK*gxy + Axzx = Axz + F1o3*trK*gxz + Ayyx = Ayy + F1o3*trK*gyy + Ayzx = Ayz + F1o3*trK*gyz + Azzx = Azz + F1o3*trK*gzz +! gup and A_ijk cancel a chi^-1 + Exx = gupxx * Axxx * Axxx + gupyy * Axyx * Axyx + gupzz * Axzx * Axzx + & + TWO * (gupxy * Axxx * Axyx + gupxz * Axxx * Axzx + gupyz * Axyx * Axzx) + Eyy = gupxx * Axyx * Axyx + gupyy * Ayyx * Ayyx + gupzz * Ayzx * Ayzx + & + TWO * (gupxy * Axyx * Ayyx + gupxz * Axyx * Ayzx + gupyz * Ayyx * Ayzx) + Ezz = gupxx * Axzx * Axzx + gupyy * Ayzx * Ayzx + gupzz * Azzx * Azzx + & + TWO * (gupxy * Axzx * Ayzx + gupxz * Axzx * Azzx + gupyz * Ayzx * Azzx) + Exy = gupxx * Axxx * Axyx + gupyy * Axyx * Ayyx + gupzz * Axzx * Ayzx + & + gupxy *(Axxx * Ayyx + Axyx * Axyx) + & + gupxz *(Axxx * Ayzx + Axzx * Axyx) + & + gupyz *(Axyx * Ayzx + Axzx * Ayyx) + Exz = gupxx * Axxx * Axzx + gupyy * Axyx * Ayzx + gupzz * Axzx * Azzx + & + gupxy *(Axxx * Ayzx + Axyx * Axzx) + & + gupxz *(Axxx * Azzx + Axzx * Axzx) + & + gupyz *(Axyx * Azzx + Axzx * Ayzx) + Eyz = gupxx * Axyx * Axzx + gupyy * Ayyx * Ayzx + gupzz * Ayzx * Azzx + & + gupxy *(Axyx * Ayzx + Ayyx * Axzx) + & + gupxz *(Axyx * Azzx + Ayzx * Axzx) + & + gupyz *(Ayyx * Azzx + Ayzx * Ayzx) + + Exx = Rxx - (Exx - Axxx*trK)*f - Bxx + Exy = Rxy - (Exy - Axyx*trK)*f - Bxy + Exz = Rxz - (Exz - Axzx*trK)*f - Bxz + Eyy = Ryy - (Eyy - Ayyx*trK)*f - Byy + Eyz = Ryz - (Eyz - Ayzx*trK)*f - Byz + Ezz = Rzz - (Ezz - Azzx*trK)*f - Bzz +!set m = (u - iw)/sqrt(2) following Frans, PRD 75, 124018(2007) +! compute uuww^ij = u^i * u^j - w^i * w^j + uuwwxx = ux * ux - wx * wx + uuwwxy = ux * uy - wx * wy + uuwwxz = ux * uz - wx * wz + uuwwyy = uy * uy - wy * wy + uuwwyz = uy * uz - wy * wz + uuwwzz = uz * uz - wz * wz + +! compute uw^ij = u^i * w^j + w^i * u^j + uwxx = ux * wx + wx * ux + uwxy = ux * wy + wx * uy + uwxz = ux * wz + wx * uz + uwyy = uy * wy + wy * uy + uwyz = uy * wz + wy * uz + uwzz = uz * wz + wz * uz +!the real part of Psi4 + Rpsi4 = Exx * uuwwxx + Eyy * uuwwyy + Ezz * uuwwzz & + + (Exy * uuwwxy + Exz * uuwwxz + Eyz * uuwwyz) * TWO + +!the imaginary part of Psi4 + Ipsi4 = Exx * uwxx + Eyy * uwyy + Ezz * uwzz & + + (Exy * uwxy + Exz * uwxz + Eyz * uwyz) * TWO + +!multiply with -1/2 + Rpsi4 = - Rpsi4/TWO + Ipsi4 = - Ipsi4/TWO + + return + + end subroutine getnp4_point diff --git a/AMSS_NCKU_source/getnp4.h b/AMSS_NCKU_source/getnp4.h new file mode 100644 index 0000000..eb7ea5c --- /dev/null +++ b/AMSS_NCKU_source/getnp4.h @@ -0,0 +1,180 @@ + +#ifndef GETNP4_H +#define GETNP4_H + +#ifdef fortran1 +#define f_getnp4old getnp4old +#define f_getnp4oldscalar getnp4oldscalar +#define f_getnp4oldscalar_ss getnp4oldscalar_ss +#define f_getnp4 getnp4 +#define f_getnp4_point getnp4_point +#define f_getnp4_ss getnp4_ss +#define f_getnp4old_ss getnp4old_ss +#define f_getnp4scalar getnp4scalar +#define f_getnp4scalar_ss getnp4scalar_ss +#endif +#ifdef fortran2 +#define f_getnp4 GETNP4 +#define f_getnp4_point GETNP4_POINT +#define f_getnp4 GETNP4OLD +#define f_getnp4scalar GETNP4OLDSCALAR +#define f_getnp4_ss GETNP4_SS +#define f_getnp4old_ss GETNP4OLD_SS +#define f_getnp4oldscalar_ss GETNP4OLDSCALAR_SS +#define f_getnp4scalar GETNP4SCALAR +#define f_getnp4scalar_ss GETNP4SCALAR_SS +#endif +#ifdef fortran3 +#define f_getnp4old getnp4old_ +#define f_getnp4_point getnp4_point_ +#define f_getnp4oldscalar getnp4oldscalar_ +#define f_getnp4oldscalar_ss getnp4oldscalar_ss_ +#define f_getnp4 getnp4_ +#define f_getnp4_ss getnp4_ss_ +#define f_getnp4old_ss getnp4old_ss_ +#define f_getnp4scalar getnp4scalar_ +#define f_getnp4scalar_ss getnp4scalar_ss_ +#endif + +extern "C" +{ + void f_getnp4old(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnp4old_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, int &, int &); +} + +extern "C" +{ + void f_getnp4oldscalar(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnp4oldscalar_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, int &, int &); +} + +extern "C" +{ + void f_getnp4(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnp4_point(double &, double &, double &, // XYZ + double &, double &, // chi,trK + double &, double &, double &, double &, double &, double &, // gamma_ij + double &, double &, double &, double &, double &, double &, // A_ij + double &, double &, double &, // chi_i + double &, double &, double &, // trK_i + double &, double &, double &, // A_ijk + double &, double &, double &, + double &, double &, double &, + double &, double &, double &, + double &, double &, double &, + double &, double &, double &, + double &, double &, double &, double &, double &, double &, // Gam_ijk + double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, // R_ij + double &, double &); +} + +extern "C" +{ + void f_getnp4_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &, int &); +} + +extern "C" +{ + void f_getnp4scalar(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnp4scalar_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &, int &); +} + +#endif /* GETNP4_H */ diff --git a/AMSS_NCKU_source/getnp4EScalar.f90 b/AMSS_NCKU_source/getnp4EScalar.f90 new file mode 100644 index 0000000..bb4c2ca --- /dev/null +++ b/AMSS_NCKU_source/getnp4EScalar.f90 @@ -0,0 +1,290 @@ + + +#include "macrodef.fh" + +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! +!----------------------------------------------------------------------------- + + subroutine getnp4scalar(ex, X, Y, Z, & + chi, trK, Sphi,& + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4, & + symmetry) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,Sphi +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chipn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Exx,Exy,Exz,Eyy,Eyz,Ezz + real*8, dimension(ex(1),ex(2),ex(3)) :: Bxx,Bxy,Bxz,Byy,Byz,Bzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Azzx,Azzy,Azzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: dX, dY, dZ + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + real*8 :: PI + + PI = dacos(-ONE) + + call getnp4(ex, X, Y, Z, & + chi, trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4, & + symmetry) + + Rpsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Rpsi4 + Ipsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Ipsi4 + + return + + end subroutine getnp4scalar +! 4D method + subroutine getnp4oldscalar(ex, X, Y, Z, chi, trK,Sphi, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,Sphi + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rpsi4,Ipsi4 + + real*8 :: PI + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + + PI = dacos(-ONE) + + call getnp4old(ex, X, Y, Z, chi, trK, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry) + + Rpsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Rpsi4 + Ipsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Ipsi4 + + return + + end subroutine getnp4oldscalar +!----------------------------------------------------------------------------- +! for shell +!----------------------------------------------------------------------------- + + subroutine getnp4scalar_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, Sphi,& + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4, & + symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,Sphi +! physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Gamzyy, Gamzyz, Gamzzz +! physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz,chipn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Exx,Exy,Exz,Eyy,Eyz,Ezz + real*8, dimension(ex(1),ex(2),ex(3)) :: Bxx,Bxy,Bxz,Byy,Byz,Bzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Azzx,Azzy,Azzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz + real*8, dimension(ex(1),ex(2),ex(3)) :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + real*8 :: PI + + PI = dacos(-ONE) + + call getnp4_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, & + dxx,gxy,gxz,dyy,gyz,dzz, & + Axx,Axy,Axz,Ayy,Ayz,Azz, & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Rpsi4, Ipsi4, & + symmetry,sst) + + Rpsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Rpsi4 + Ipsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Ipsi4 + + return + + end subroutine getnp4scalar_ss +! 4D method + subroutine getnp4oldscalar_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, Sphi, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK,Sphi + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rpsi4,Ipsi4 + + real*8 :: PI + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + + PI = dacos(-ONE) + + call getnp4old_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry,sst) + + Rpsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Rpsi4 + Ipsi4 = dexp(-FOUR*dsqrt(PI/3)*Sphi)*Ipsi4 + + return + + end subroutine getnp4oldscalar_ss diff --git a/AMSS_NCKU_source/getnp4old.f90 b/AMSS_NCKU_source/getnp4old.f90 new file mode 100644 index 0000000..c760337 --- /dev/null +++ b/AMSS_NCKU_source/getnp4old.f90 @@ -0,0 +1,2422 @@ + + +#include "macrodef.fh" + +!----------------------------------------------------------------------------- +! +! compute rhw Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! +!----------------------------------------------------------------------------- + + subroutine getnp4old(ex, X, Y, Z, chi, trK, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ep4phi,alpn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: phi,phix,phiy,phiz + real*8, dimension(ex(1),ex(2),ex(3)) :: phixx,phixy,phixz,phiyy,phiyz,phizz + real*8, dimension(ex(1),ex(2),ex(3)) :: tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: tRxx,tRxy,tRxz,tRyy,tRyz,tRzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxx, Rxy, Rxz, Ryy, Ryz, Rzz + + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz +!D_i K_jk ---> DKijk + real*8, dimension(ex(1),ex(2),ex(3)) :: DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz +! Aij,k --> stored as Aijk + real*8, dimension(ex(1),ex(2),ex(3))::Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3))::Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3))::Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3))::Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3))::Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3))::Azzx,Azzy,Azzz +! trK,i + real*8, dimension(ex(1),ex(2),ex(3))::Kx,Ky,Kz + + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz +! first order partial derivative of metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxxy,gxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyx,gxyy,gxyz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzx,gxzy,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyyy,gyyz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzx,gyzy,gyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzx,gzzy,gzzz +! second order partial derivative of metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + + real*8, parameter :: F1o4=2.5d-1,ONE=1.d0,TWO=2.d0,FOUR=4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + phi = -0.25d0*dlog(chi+ONE) +!~~~~~~ + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + alpn1 = Lap + ONE + + ep4phi = dexp( FOUR * Phi ) + +!~~~~~~> + + call d1metric(ex,X,Y,Z, & + dxx ,gxy ,gxz ,dyy ,gyz ,dzz , & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, symmetry) + + call d2metric(ex,X,Y,Z, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, symmetry) + + call kind1_connection(ex, gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz,& + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz,& + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz,& + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz,& + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz,& + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz) + + call kind2_connection(ex, gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, & + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, & + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, & + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + +!~~~~~~> derivs of conformal factor + + call fderivs(ex,phi,phix,phiy,phiz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + + call fdderivs(ex,phi,phixx,phixy,phixz,phiyy,phiyz,phizz,X,Y,Z, & + SYM,SYM,SYM,symmetry,0) + + call xcov_deriv(ex, phix, phiy, phiz, & + phixx, phixy, phixz, phiyy, phiyz, phizz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + +!~~~~~~> get spatial Riemann curvature + + call adm_riemann(ex, gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + ass_Gamxxx,ass_Gamxxy,ass_Gamxxz, & + ass_Gamxyy,ass_Gamxyz,ass_Gamxzz, & + ass_Gamyxx,ass_Gamyxy,ass_Gamyxz, & + ass_Gamyyy,ass_Gamyyz,ass_Gamyzz, & + ass_Gamzxx,ass_Gamzxy,ass_Gamzxz, & + ass_Gamzyy,ass_Gamzyz,ass_Gamzzz, & + tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz) + + call get_physical_riemann(ex, ep4phi, & + dxx , gxy , gxz , dyy , gyz , dzz , & + gupxx , gupxy , gupxz , gupyy , gupyz , gupzz , & + phix , phiy , phiz , & + phixx , phixy , phixz , phiyy , phiyz , phizz , & + tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + +!~~~~~~> get spatial Ricci tensor + + call adm_ricci(ex, gupxx, gupxy, gupxz, gupyy, gupyz, gupzz, & + tRxyxy,tRxyxz,tRxyyz,tRxzxz,tRxzyz,tRyzyz, & + tRxx, tRxy, tRxz, tRyy, tRyz, tRzz) + + call get_physical_ricci(ex,dxx,gxy,gxz,dyy,gyz,dzz,phix,phiy,phiz, & + phixx,phixy,phixz,phiyy,phiyz,phizz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + tRxx, tRxy, tRxz, tRyy, tRyz, tRzz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz) + +!~~~~~~> get the real spatial extrinsic curvature + + call get_physical_k(ex, phi, trK, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz) + +!~~~~~~> derivs of trace of extrinsic curvature + + call fderivs(ex,trK, Kx, Ky, Kz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + +!~~~~~~> derivs of tilde extrinsic curvature + + call fderivs(ex,Axx,Axxx,Axxy,Axxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Axy,Axyx,Axyy,Axyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Axz,Axzx,Axzy,Axzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,Ayy,Ayyx,Ayyy,Ayyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Ayz,Ayzx,Ayzy,Ayzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,Azz,Azzx,Azzy,Azzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + +!~~~~~~> derivs of extrinsic curvature, Kij + + call get_diff_physical_k(ex, phi, trK, Kx, Ky, Kz, phix, phiy, phiz, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Axxx, Axxy, Axxz, Axyx, Axyy, Axyz, & + Axzx, Axzy, Axzz, Ayyx, Ayyy, Ayyz, & + Ayzx, Ayzy, Ayzz, Azzx, Azzy, Azzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz, & + DKxxx, DKxxy, DKxxz, DKxyy, DKxyz, DKxzz, & + DKyxx, DKyxy, DKyxz, DKyyy, DKyyz, DKyzz, & + DKzxx, DKzxy, DKzxz, DKzyy, DKzyz, DKzzz) + +!~~~~~~> get the Gram-Schmidt orthonormalize triad coordinate +#if (tetradtype == 0) + call get_triad0(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#elif (tetradtype == 1) + call get_triad1(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#elif (tetradtype == 2) + call get_triad2(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#endif + +!~~~~~~> compute the Newnamm-Penrose psi4 which split real and image part + + ep4phi = ONE / ep4phi + + call bssn_compute_psi4(ex,ep4phi, alpn1, Sfx, Sfy, Sfz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz, & + trK,Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Rxyxy,Rxyxz,Rxyyz,Rxzxz,Rxzyz,Ryzyz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz, & + DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz, & + DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz, & + DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz, Rpsi4, Ipsi4) + + return + + end subroutine getnp4old +!----------------------------------------------------------------------------------- +! for shell +! + + subroutine getnp4old_ss(ex,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, trK, & + dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,Rpsi4,Ipsi4, symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),symmetry,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rpsi4,Ipsi4 + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ep4phi,alpn1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: phi,phix,phiy,phiz + real*8, dimension(ex(1),ex(2),ex(3)) :: phixx,phixy,phixz,phiyy,phiyz,phizz + real*8, dimension(ex(1),ex(2),ex(3)) :: tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + real*8, dimension(ex(1),ex(2),ex(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: tRxx,tRxy,tRxz,tRyy,tRyz,tRzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Rxx, Rxy, Rxz, Ryy, Ryz, Rzz + + real*8, dimension(ex(1),ex(2),ex(3)) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz +!D_i K_jk ---> DKijk + real*8, dimension(ex(1),ex(2),ex(3)) :: DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz +! Aij,k --> stored as Aijk + real*8, dimension(ex(1),ex(2),ex(3))::Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3))::Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3))::Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3))::Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3))::Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3))::Azzx,Azzy,Azzz +! trK,i + real*8, dimension(ex(1),ex(2),ex(3))::Kx,Ky,Kz + + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz +! first order partial derivative of metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxxy,gxxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyx,gxyy,gxyz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzx,gxzy,gxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyyy,gyyz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzx,gyzy,gyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzx,gzzy,gzzz +! second order partial derivative of metric + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + + real*8, parameter :: F1o4=2.5d-1,ONE=1.d0,TWO=2.d0,FOUR=4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8,parameter::TINYRR=1.d-14 + + phi = -0.25d0*dlog(chi+ONE) +!~~~~~~ + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + + alpn1 = Lap + ONE + + ep4phi = dexp( FOUR * Phi ) + +!~~~~~~> + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fdderivs_shc(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + call fdderivs_shc(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call kind1_connection(ex, gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz,& + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz,& + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz,& + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz,& + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz,& + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz) + + call kind2_connection(ex, gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, & + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, & + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, & + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + +!~~~~~~> derivs of conformal factor + call fderivs_shc(ex,phi,phix,phiy,phiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fdderivs_shc(ex,phi,phixx,phixy,phixz,phiyy,phiyz,phizz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + call xcov_deriv(ex, phix, phiy, phiz, & + phixx, phixy, phixz, phiyy, phiyz, phizz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + +!~~~~~~> get spatial Riemann curvature + + call adm_riemann(ex, gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + ass_Gamxxx,ass_Gamxxy,ass_Gamxxz, & + ass_Gamxyy,ass_Gamxyz,ass_Gamxzz, & + ass_Gamyxx,ass_Gamyxy,ass_Gamyxz, & + ass_Gamyyy,ass_Gamyyz,ass_Gamyzz, & + ass_Gamzxx,ass_Gamzxy,ass_Gamzxz, & + ass_Gamzyy,ass_Gamzyz,ass_Gamzzz, & + tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz) + + call get_physical_riemann(ex, ep4phi, & + dxx , gxy , gxz , dyy , gyz , dzz , & + gupxx , gupxy , gupxz , gupyy , gupyz , gupzz , & + phix , phiy , phiz , & + phixx , phixy , phixz , phiyy , phiyz , phizz , & + tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + +!~~~~~~> get spatial Ricci tensor + + call adm_ricci(ex, gupxx, gupxy, gupxz, gupyy, gupyz, gupzz, & + tRxyxy,tRxyxz,tRxyyz,tRxzxz,tRxzyz,tRyzyz, & + tRxx, tRxy, tRxz, tRyy, tRyz, tRzz) + + call get_physical_ricci(ex,dxx,gxy,gxz,dyy,gyz,dzz,phix,phiy,phiz, & + phixx,phixy,phixz,phiyy,phiyz,phizz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + tRxx, tRxy, tRxz, tRyy, tRyz, tRzz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz) + +!~~~~~~> get the real spatial extrinsic curvature + + call get_physical_k(ex, phi, trK, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz) + +!~~~~~~> derivs of trace of extrinsic curvature + call fderivs_shc(ex,trK,Kx,Ky,Kz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +!~~~~~~> derivs of tilde extrinsic curvature + + call fderivs_shc(ex,Axx,Axxx,Axxy,Axxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axy,Axyx,Axyy,Axyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Axz,Axzx,Axzy,Axzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayy,Ayyx,Ayyy,Ayyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Ayz,Ayzx,Ayzy,Ayzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Azz,Azzx,Azzy,Azzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,0,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +!~~~~~~> derivs of extrinsic curvature, Kij + + call get_diff_physical_k(ex, phi, trK, Kx, Ky, Kz, phix, phiy, phiz, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Axxx, Axxy, Axxz, Axyx, Axyy, Axyz, & + Axzx, Axzy, Axzz, Ayyx, Ayyy, Ayyz, & + Ayzx, Ayzy, Ayzz, Azzx, Azzy, Azzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz, & + DKxxx, DKxxy, DKxxz, DKxyy, DKxyz, DKxzz, & + DKyxx, DKyxy, DKyxz, DKyyy, DKyyz, DKyzz, & + DKzxx, DKzxy, DKzxz, DKzyy, DKzyz, DKzzz) + +!~~~~~~> get the Gram-Schmidt orthonormalize triad coordinate + +#if (tetradtype == 0) + call get_triad0_ss(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#elif (tetradtype == 1) + call get_triad1_ss(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#elif (tetradtype == 2) + call get_triad2_ss(ex, X, Y, Z, ep4phi, gxx, gxy, gxz, gyy, gyz, gzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) +#endif + +!~~~~~~> compute the Newnamm-Penrose psi4 which split real and image part + + ep4phi = ONE / ep4phi + + call bssn_compute_psi4(ex,ep4phi, alpn1, Sfx, Sfy, Sfz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz, & + trK,Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Rxyxy,Rxyxz,Rxyyz,Rxzxz,Rxzyz,Ryzyz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz, & + DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz, & + DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz, & + DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz, Rpsi4, Ipsi4) + + return + + end subroutine getnp4old_ss +!----------------------------------------------------------! +! ! +! derivatives related to 3-dimensional Riemann slice ! +! ! +!----------------------------------------------------------! + +!----------------------------------------------------------------------------- +! Interface to compute the first order derivative of metric +!----------------------------------------------------------------------------- + + subroutine d1metric(ex,X,Y,Z, & + dxx ,gxy ,gxz ,dyy ,gyz ,dzz , & + gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, symmetry) + + implicit none + +!~~~~~~ Input parameters: + + integer, intent(in ) :: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + +!~~~~~~ local variables + + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + +!~~~~~~ 1st derivs of matric + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,0) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,symmetry,0) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,symmetry,0) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,0) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,symmetry,0) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,symmetry,0) + + return + + end subroutine d1metric + +!----------------------------------------------------------------------------- +! Interface to compute the second order derivative of metric +!----------------------------------------------------------------------------- + + subroutine d2metric(ex,X,Y,Z, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, symmetry) + + implicit none + +!~~~~~~ Input parameters: + + integer, intent(in ) :: ex(1:3),symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + +!~~~~~~ local variables + + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + +!~~~~~~ 2nd derivs of matric + + call fdderivs(ex,dxx,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz,X,Y,Z, & + SYM ,SYM ,SYM ,symmetry,0) + call fdderivs(ex,gxy,gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz,X,Y,Z, & + ANTI,ANTI,SYM ,symmetry,0) + call fdderivs(ex,gxz,gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz,X,Y,Z, & + ANTI,SYM ,ANTI,symmetry,0) + call fdderivs(ex,dyy,gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz,X,Y,Z, & + SYM, SYM ,SYM ,symmetry,0) + call fdderivs(ex,gyz,gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz,X,Y,Z, & + SYM ,ANTI,ANTI,symmetry,0) + call fdderivs(ex,dzz,gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz,X,Y,Z, & + SYM ,SYM ,SYM ,symmetry,0) + + return + + end subroutine d2metric +!----------------------------------------------------------! +! ! +! algebraic computation based on geometric quantites ! +! and their partial derivatives related to 3-dimensional ! +! Riemann slice ! +! ! +!----------------------------------------------------------! + +!----------------------------------------------------------------------------- +! Get first kind of connection coefficients +! based on first order derivative of metric +! ass_Gam_ijk = 1/2 *(g_ij,k + g_ki,j - g_jk,i) +!----------------------------------------------------------------------------- + + subroutine kind1_connection(ex,gxxx,gxyx,gxzx,gyyx,gyzx,gzzx, & + gxxy,gxyy,gxzy,gyyy,gyzy,gzzy, & + gxxz,gxyz,gxzz,gyyz,gyzz,gzzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, & + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, & + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, & + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gxxx,gxyx,gxzx + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gxxy,gxyy,gxzy + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gxxz,gxyz,gxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz + +!~~~~~~> Other variables: + + real*8, parameter :: HLF=0.5d0 + +!~~~~~~= Get Connection coefficients +! ass_Gam_ijk = 1/2 *(g_ij,k + g_ki,j - g_jk,i) + + ass_Gamxxx = HLF * ( gxxx ) + ass_Gamyxx = HLF * ( gxyx + gxyx - gxxy ) + ass_Gamzxx = HLF * ( gxzx + gxzx - gxxz ) + ass_Gamxyy = HLF * ( gxyy + gxyy - gyyx ) + ass_Gamyyy = HLF * ( gyyy ) + ass_Gamzyy = HLF * ( gyzy + gyzy - gyyz ) + ass_Gamxzz = HLF * ( gxzz + gxzz - gzzx ) + ass_Gamyzz = HLF * ( gyzz + gyzz - gzzy ) + ass_Gamzzz = HLF * ( gzzz ) + ass_Gamxxy = HLF * ( gxxy + gxyx - gxyx ) + ass_Gamyxy = HLF * ( gxyy + gyyx - gxyy ) + ass_Gamzxy = HLF * ( gxzy + gyzx - gxyz ) + ass_Gamxxz = HLF * ( gxxz + gxzx - gxzx ) + ass_Gamyxz = HLF * ( gxyz + gyzx - gxzy ) + ass_Gamzxz = HLF * ( gxzz + gzzx - gxzz ) + ass_Gamxyz = HLF * ( gxyz + gxzy - gyzx ) + ass_Gamyyz = HLF * ( gyyz + gyzy - gyzy ) + ass_Gamzyz = HLF * ( gyzz + gzzy - gyzz ) + + return + + end subroutine kind1_connection + +!----------------------------------------------------------------------------- +! Get second kind of connection coefficients +! based on first kind of connection coefficients +! and gup +!----------------------------------------------------------------------------- + + subroutine kind2_connection(ex,gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + ass_Gamxxx, ass_Gamxxy, ass_Gamxxz, & + ass_Gamxyy, ass_Gamxyz, ass_Gamxzz, & + ass_Gamyxx, ass_Gamyxy, ass_Gamyxz, & + ass_Gamyyy, ass_Gamyyz, ass_Gamyzz, & + ass_Gamzxx, ass_Gamzxy, ass_Gamzxz, & + ass_Gamzyy, ass_Gamzyz, ass_Gamzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gamzyy, Gamzyz, Gamzzz + +!~~~~~~> Other variables: + + Gamxxx = gupxx * ass_Gamxxx + gupxy * ass_Gamyxx + gupxz * ass_Gamzxx + Gamxxy = gupxx * ass_Gamxxy + gupxy * ass_Gamyxy + gupxz * ass_Gamzxy + Gamxxz = gupxx * ass_Gamxxz + gupxy * ass_Gamyxz + gupxz * ass_Gamzxz + Gamxyy = gupxx * ass_Gamxyy + gupxy * ass_Gamyyy + gupxz * ass_Gamzyy + Gamxyz = gupxx * ass_Gamxyz + gupxy * ass_Gamyyz + gupxz * ass_Gamzyz + Gamxzz = gupxx * ass_Gamxzz + gupxy * ass_Gamyzz + gupxz * ass_Gamzzz + + Gamyxx = gupxy * ass_Gamxxx + gupyy * ass_Gamyxx + gupyz * ass_Gamzxx + Gamyxy = gupxy * ass_Gamxxy + gupyy * ass_Gamyxy + gupyz * ass_Gamzxy + Gamyxz = gupxy * ass_Gamxxz + gupyy * ass_Gamyxz + gupyz * ass_Gamzxz + Gamyyy = gupxy * ass_Gamxyy + gupyy * ass_Gamyyy + gupyz * ass_Gamzyy + Gamyyz = gupxy * ass_Gamxyz + gupyy * ass_Gamyyz + gupyz * ass_Gamzyz + Gamyzz = gupxy * ass_Gamxzz + gupyy * ass_Gamyzz + gupyz * ass_Gamzzz + + Gamzxx = gupxz * ass_Gamxxx + gupyz * ass_Gamyxx + gupzz * ass_Gamzxx + Gamzxy = gupxz * ass_Gamxxy + gupyz * ass_Gamyxy + gupzz * ass_Gamzxy + Gamzxz = gupxz * ass_Gamxxz + gupyz * ass_Gamyxz + gupzz * ass_Gamzxz + Gamzyy = gupxz * ass_Gamxyy + gupyz * ass_Gamyyy + gupzz * ass_Gamzyy + Gamzyz = gupxz * ass_Gamxyz + gupyz * ass_Gamyyz + gupzz * ass_Gamzyz + Gamzzz = gupxz * ass_Gamxzz + gupyz * ass_Gamyzz + gupzz * ass_Gamzzz + + return + + end subroutine kind2_connection + +!---------------------------------------------------------------------- +! compute Riemann tensor for three dimensional space +! based on second derivatives of metric +! and first knid and second kind of connection +!---------------------------------------------------------------------- + + subroutine adm_riemann(ex,gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz, & + gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz, & + gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz, & + gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz, & + gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz, & + gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz, & + ass_Gamxxx,ass_Gamxxy,ass_Gamxxz, & + ass_Gamxyy,ass_Gamxyz,ass_Gamxzz, & + ass_Gamyxx,ass_Gamyxy,ass_Gamyxz, & + ass_Gamyyy,ass_Gamyyz,ass_Gamyzz, & + ass_Gamzxx,ass_Gamzxy,ass_Gamzxz, & + ass_Gamzyy,ass_Gamzyz,ass_Gamzzz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxxx,gxxxy,gxxxz,gxxyy,gxxyz,gxxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxyxx,gxyxy,gxyxz,gxyyy,gxyyz,gxyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxzxx,gxzxy,gxzxz,gxzyy,gxzyz,gxzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gyyxx,gyyxy,gyyxz,gyyyy,gyyyz,gyyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gyzxx,gyzxy,gyzxz,gyzyy,gyzyz,gyzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gzzxx,gzzxy,gzzxz,gzzyy,gzzyz,gzzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamzyy, Gamzyz, Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamxxx,ass_Gamxxy,ass_Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamxyy,ass_Gamxyz,ass_Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamyxx,ass_Gamyxy,ass_Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamyyy,ass_Gamyyz,ass_Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamzxx,ass_Gamzxy,ass_Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ass_Gamzyy,ass_Gamzyz,ass_Gamzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + +!~~~~~~local variables + + real*8, parameter :: HLF=0.5d0 + +!R_ijkl = HLF *(@_jk g_il + @_il g_jk - @_jl g_ik - @_ik g_jl) +! + Gam_rjk Gam^r_il - Gam_rjl Gam^r_ik + + Rxyxy = HLF *( gxyxy + gxyxy - gxxyy - gyyxx ) + & + (ass_Gamxxy * Gamxxy + ass_Gamyxy * Gamyxy + ass_Gamzxy * Gamzxy) - & + (ass_Gamxyy * Gamxxx + ass_Gamyyy * Gamyxx + ass_Gamzyy * Gamzxx) + + Rxyxz = HLF *( gxzxy + gxyxz - gxxyz - gyzxx ) + & + (ass_Gamxxy * Gamxxz + ass_Gamyxy * Gamyxz + ass_Gamzxy * Gamzxz) - & + (ass_Gamxyz * Gamxxx + ass_Gamyyz * Gamyxx + ass_Gamzyz * Gamzxx) + + Rxyyz = HLF *( gxzyy + gyyxz - gxyyz - gyzxy ) + & + (ass_Gamxyy * Gamxxz + ass_Gamyyy * Gamyxz + ass_Gamzyy * Gamzxz) - & + (ass_Gamxyz * Gamxxy + ass_Gamyyz * Gamyxy + ass_Gamzyz * Gamzxy) + + Rxzxz = HLF *( gxzxz + gxzxz - gxxzz - gzzxx ) + & + (ass_Gamxxz * Gamxxz + ass_Gamyxz * Gamyxz + ass_Gamzxz * Gamzxz) - & + (ass_Gamxzz * Gamxxx + ass_Gamyzz * Gamyxx + ass_Gamzzz * Gamzxx) + + Rxzyz = HLF *( gxzyz + gyzxz - gxyzz - gzzxy ) + & + (ass_Gamxyz * Gamxxz + ass_Gamyyz * Gamyxz + ass_Gamzyz * Gamzxz) - & + (ass_Gamxzz * Gamxxy + ass_Gamyzz * Gamyxy + ass_Gamzzz * Gamzxy) + + Ryzyz = HLF *( gyzyz + gyzyz - gyyzz - gzzyy ) + & + (ass_Gamxyz * Gamxyz + ass_Gamyyz * Gamyyz + ass_Gamzyz * Gamzyz) - & + (ass_Gamxzz * Gamxyy + ass_Gamyzz * Gamyyy + ass_Gamzzz * Gamzyy) + + return + + end subroutine adm_riemann + +!----------------------------------------------------------------------------- +! Get Ricci tensor of metric g from Riemann tensor +! for adm form +! R_ij = gup^kl * R_ikjl +!----------------------------------------------------------------------------- + + subroutine adm_ricci(ex, gupxx, gupxy, gupxz, gupyy, gupyz, gupzz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Rxyxy, Rxyxz, Rxyyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Rxzxz, Rxzyz, Ryzyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + + Rxx = gupyy * Rxyxy + gupyz * Rxyxz + gupyz * Rxyxz + gupzz * Rxzxz + Rxy = - gupxy * Rxyxy + gupyz * Rxyyz - gupxz * Rxyxz + gupzz * Rxzyz + Rxz = - gupxy * Rxyxz - gupyy * Rxyyz - gupxz * Rxzxz - gupyz * Rxzyz + Ryy = gupxx * Rxyxy - gupxz * Rxyyz - gupxz * Rxyyz + gupzz * Ryzyz + Ryz = gupxx * Rxyxz + gupxy * Rxyyz - gupxz * Rxzyz - gupyz * Ryzyz + Rzz = gupxx * Rxzxz + gupxy * Rxzyz + gupxy * Rxzyz + gupyy * Ryzyz + + return + + end subroutine adm_ricci + +!----------------------------------------------------------------------------- +! raise index +!----------------------------------------------------------------------------- + + subroutine raise(ex,fx,fy,fz,fupx,fupy,fupz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) + implicit none + +!~~~~~~ Input parameters: + + integer, intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupxx, gupxy, gupxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupyy, gupyz, gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: fupx,fupy,fupz + + fupx = gupxx * fx + gupxy * fy + gupxz * fz + fupy = gupxy * fx + gupyy * fy + gupyz * fz + fupz = gupxz * fx + gupyz * fy + gupzz * fz + + return + + end subroutine raise + +!----------------------------------------------------------------------------- +! lower index +!----------------------------------------------------------------------------- + + subroutine lower(ex,fx,fy,fz,Lfx,Lfy,Lfz,gxx,gxy,gxz,gyy,gyz,gzz) + implicit none + +!~~~~~~ Input parameters: + + integer, intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Lfx,Lfy,Lfz + + Lfx = gxx * fx + gxy * fy + gxz * fz + Lfy = gxy * fx + gyy * fy + gyz * fz + Lfz = gxz * fx + gyz * fy + gzz * fz + + return + + end subroutine lower + +!---------------------------------------------------------------------------------- +! inner product of two three dimensional vectors with metric g_ij +! metric here do not upto ONE +!---------------------------------------------------------------------------------- + + subroutine InnerProd(ex,norm,ux,uy,uz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in)::ux,uy,uz,vx,vy,vz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in)::gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out)::norm + + norm = gxx * ux * vx + gxy * ux * vy + gxz * ux * vz & + + gxy * uy * vx + gyy * uy * vy + gyz * uy * vz & + + gxz * uz * vx + gyz * uz * vy + gzz * uz * vz + + return + + end subroutine InnerProd +!----------------------------------------------------------! +! ! +! algebraic computation based on geometric quantites ! +! and their partial derivatives related to 3-dimensional ! +! Riemann slice ! +! ! +! * for BSSN form * ! +!----------------------------------------------------------! + +!----------------------------------------------------------------------------- +! second order covariant derivatives w.r.t. *untilded* (i.e. physical) metric +! of *symmetric* variable of scalar field +!----------------------------------------------------------------------------- + + subroutine fnt_cov_s_dderiv(ex, fx, fy, fz, & + fxx, fxy, fxz, fyy, fyz, fzz, & + phix, phiy, phiz, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + Gmxxx,Gmxxy,Gmxxz,Gmxyy,Gmxyz,Gmxzz, & + Gmyxx,Gmyxy,Gmyxz,Gmyyy,Gmyyz,Gmyzz, & + Gmzxx,Gmzxy,Gmzxz,Gmzyy,Gmzyz,Gmzzz) + implicit none + +!~~~~~~ Input arguments + + integer, intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: phix,phiy,phiz +! tilted Christofel symble + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmxxx, Gmxxy, Gmxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmxyy, Gmxyz, Gmxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmyxx, Gmyxy, Gmyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmyyy, Gmyyz, Gmyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmzxx, Gmzxy, Gmzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gmzyy, Gmzyz, Gmzzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: gupyy,gupyz,gupzz +! input partial derivatives, output covariant derivative respect to physical metric + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: fxx,fxy,fxz,fyy,fyz,fzz + +!~~~~~~ Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: phiupx,phiupy,phiupz + real*8,parameter :: TWO = 2.d0 + +!~~~~~~ Make untilded Gamma's out of tilded ones - first raise index on phi_i... + + phiupx = gupxx * phix + gupxy * phiy + gupxz * phiz + phiupy = gupxy * phix + gupyy * phiy + gupyz * phiz + phiupz = gupxz * phix + gupyz * phiy + gupzz * phiz + +!~~~~~~ ... and then add reconstructed *untilded* Christofels... + + fxx = fxx - ( Gmxxx + TWO * ( phix + phix - dxx * phiupx - phiupx ))* fx - & + ( Gmyxx + TWO * ( - dxx * phiupy - phiupy ))* fy - & + ( Gmzxx + TWO * ( - dxx * phiupz - phiupz ))* fz + + fyy = fyy - ( Gmxyy + TWO * ( - dyy * phiupx - phiupx ))* fx - & + ( Gmyyy + TWO * ( phiy + phiy - dyy * phiupy - phiupy ))* fy - & + ( Gmzyy + TWO * ( - dyy * phiupz - phiupz ))* fz + + fzz = fzz - ( Gmxzz + TWO * ( - dzz * phiupx - phiupx ))* fx - & + ( Gmyzz + TWO * ( - dzz * phiupy - phiupy ))* fy - & + ( Gmzzz + TWO * ( phiz + phiz - dzz * phiupz - phiupz ))* fz + + fxy = fxy - ( Gmxxy + TWO * ( phiy - gxy * phiupx ))* fx - & + ( Gmyxy + TWO * ( phix - gxy * phiupy ))* fy - & + ( Gmzxy + TWO * ( - gxy * phiupz ))* fz + + fxz = fxz - ( Gmxxz + TWO * ( phiz - gxz * phiupx ))* fx - & + ( Gmyxz + TWO * ( - gxz * phiupy ))* fy - & + ( Gmzxz + TWO * ( phix - gxz * phiupz ))* fz + + fyz = fyz - ( Gmxyz + TWO * ( - gyz * phiupx ))* fx - & + ( Gmyyz + TWO * ( phiz - gyz * phiupy ))* fy - & + ( Gmzyz + TWO * ( phiy - gyz * phiupz ))* fz + + return + + end subroutine fnt_cov_s_dderiv + +!----------------------------------------------------------------------------- +! +! Get physical riemann tensor +! +!----------------------------------------------------------------------------- + + subroutine get_physical_riemann(ex, ep4phi, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gupxx, gupxy, gupxz, gupyy, gupyz, gupzz, & + phix, phiy, phiz, & + phixx, phixy, phixz, phiyy, phiyz, phizz, & + tRxyxy, tRxyxz, tRxyyz, tRxzxz, tRxzyz, tRyzyz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: ep4phi + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: phix,phiy,phiz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: phixx,phixy,phixz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: phiyy,phiyz,phizz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: tRxyxy,tRxyxz,tRxyyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: tRxzxz,tRxzyz,tRyzyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rxyxy, Rxyxz, Rxyyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Rxzxz, Rxzyz, Ryzyz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: tmp + real*8,parameter::ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + +!~~~~~~> R_ijkl = tilde R_ijkl + TWO *( gli * D_j D_k phi - glj * D_i D_k phi - +! gki * D_j D_l phi + gkj * D_i D_l phi ) +! + FOUR*( gjl * D_i phi * D_k phi - gil * D_j phi * D_k phi - +! gjk * D_i phi * D_l phi + gik * D_j phi * D_l phi ) +! + FOUR*( gjk * gil - gik * gjl )* g^mn * D_m phi * D_n phi + + tmp = gupxx * phix * phix + gupyy * phiy * phiy + gupzz * phiz * phiz + & + TWO *( gupxy * phix * phiy + gupxz * phix * phiz + gupyz * phiy * phiz ) + +!~~~~~~> R_ijkl = tilde R_ijkl + TWO *( gli * phi_jk - glj * phi_ik - +! gki * phi_jl + gkj * phi_il ) +! + FOUR*( gjl * phi_i * phi_k - gil * phi_j * phi_k - +! gjk * phi_i * phi_l + gik * phi_j * phi_l ) +! + FOUR*( gjk * gil - gik * gjl )* tmp + + Rxyxy = tRxyxy + TWO *( gxy * phixy - gyy * phixx - gxx * phiyy + gxy * phixy ) & + + FOUR*( gyy * phix * phix - gxy * phiy * phix - & + gxy * phix * phiy + gxx * phiy * phiy ) & + + FOUR*( gxy * gxy - gxx * gyy )* tmp + + Rxyxz = tRxyxz + TWO *( gxz * phixy - gyz * phixx - gxx * phiyz + gxy * phixz ) & + + FOUR*( gyz * phix * phix - gxz * phiy * phix - & + gxy * phix * phiz + gxx * phiy * phiz ) & + + FOUR*( gxy * gxz - gxx * gyz )* tmp + + Rxyyz = tRxyyz + TWO *( gxz * phiyy - gyz * phixy - gxy * phiyz + gyy * phixz ) & + + FOUR*( gyz * phix * phiy - gxz * phiy * phiy - & + gyy * phix * phiz + gxy * phiy * phiz ) & + + FOUR*( gyy * gxz - gxy * gyz )* tmp + + Rxzxz = tRxzxz + TWO *( gxz * phixz - gzz * phixx - gxx * phizz + gxz * phixz ) & + + FOUR*( gzz * phix * phix - gxz * phiz * phix - & + gxz * phix * phiz + gxx * phiz * phiz ) & + + FOUR*( gxz * gxz - gxx * gzz )* tmp + + Rxzyz = tRxzyz + TWO *( gxz * phiyz - gzz * phixy - gxy * phizz + gyz * phixz ) & + + FOUR*( gzz * phix * phiy - gxz * phiz * phiy - & + gyz * phix * phiz + gxy * phiz * phiz ) & + + FOUR*( gyz * gxz - gxy * gzz )* tmp + + Ryzyz = tRyzyz + TWO *( gyz * phiyz - gzz * phiyy - gyy * phizz + gyz * phiyz ) & + + FOUR*( gzz * phiy * phiy - gyz * phiz * phiy - & + gyz * phiy * phiz + gyy * phiz * phiz ) & + + FOUR*( gyz * gyz - gyy * gzz )* tmp + +!multipli with factor exp( 4 * phi) + + Rxyxy = Rxyxy * ep4phi + Rxyxz = Rxyxz * ep4phi + Rxyyz = Rxyyz * ep4phi + Rxzxz = Rxzxz * ep4phi + Rxzyz = Rxzyz * ep4phi + Ryzyz = Ryzyz * ep4phi + + return + + end subroutine get_physical_riemann + +!----------------------------------------------------------------------------- +! +! Get physical Ricci tensor +! +!----------------------------------------------------------------------------- + + subroutine get_physical_ricci(ex,dxx,gxy,gxz,dyy,gyz,dzz,phix,phiy,phiz, & + phixx,phixy,phixz,phiyy,phiyz,phizz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + tRxx, tRxy, tRxz, tRyy, tRyz, tRzz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz) + + implicit none + +!~~~~~~ argument variables + + integer, intent(in) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in):: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in):: phix,phiy,phiz +! covariant derivative respect to tilted metric + real*8, dimension(ex(1),ex(2),ex(3)), intent(in):: phixx,phixy,phixz,phiyy,phiyz,phizz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in):: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: tRxx,tRxy,tRxz,tRyy,tRyz,tRzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Rxx, Rxy, Rxz, Ryy, Ryz, Rzz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: tempf + real*8,parameter::TWO = 2.d0, FOUR = 4.d0 + +!~~~~~~ + + tempf = TWO * (gupxx * ( phixx + TWO * phix * phix ) + & + gupyy * ( phiyy + TWO * phiy * phiy ) + & + gupzz * ( phizz + TWO * phiz * phiz ) + & + TWO * gupxy * ( phixy + TWO * phix * phiy ) + & + TWO * gupxz * ( phixz + TWO * phix * phiz ) + & + TWO * gupyz * ( phiyz + TWO * phiy * phiz ) ) + +! Add phi part to Ricci tensor: + + Rxx = tRxx - TWO * phixx + FOUR * phix * phix - dxx * tempf - tempf + Ryy = tRyy - TWO * phiyy + FOUR * phiy * phiy - dyy * tempf - tempf + Rzz = tRzz - TWO * phizz + FOUR * phiz * phiz - dzz * tempf - tempf + Rxy = tRxy - TWO * phixy + FOUR * phix * phiy - gxy * tempf + Rxz = tRxz - TWO * phixz + FOUR * phix * phiz - gxz * tempf + Ryz = tRyz - TWO * phiyz + FOUR * phiy * phiz - gyz * tempf + + return + + end subroutine get_physical_ricci + +!----------------------------------------------------------------------------- +! +! compute physical extrinic curver: +! Kij = exp( 4 * phi ) ( tilde Aij + F1o3 * tilde gij * trK ) +! +!----------------------------------------------------------------------------- + + subroutine get_physical_k(ex, phi, trK, dxx, gxy, gxz, dyy, gyz, dzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz) + implicit none + +!~~~~~~> Input parameters: + + integer,dimension(3) , intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: phi, trK + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx, gyy, gzz + real*8, parameter :: F1o3 = 1.d0 / 3.d0, ONE = 1.d0, FOUR = 4.d0 + +!~~~~~~> + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + Kzz = exp( FOUR * phi ) + +!~~~~~~> + + Kxx = ( Axx + F1o3 * gxx * trK )* Kzz + Kxy = ( Axy + F1o3 * gxy * trK )* Kzz + Kxz = ( Axz + F1o3 * gxz * trK )* Kzz + Kyy = ( Ayy + F1o3 * gyy * trK )* Kzz + Kyz = ( Ayz + F1o3 * gyz * trK )* Kzz + Kzz = ( Azz + F1o3 * gzz * trK )* Kzz + + return + + end subroutine get_physical_k + +!------------------------------------------------------------------------------------------------------- +! +! compute covariant derivatives of extrinic curver +! +!D_i K_jk stored as DKijk +! +! DKijk = e^(4 phi) (A_jk,i - Gam^l_ij A_lk - Gam^l_ik A_jl + 1/3 g_jk trK,i) +! - 2 K_ik phi,j + 2 g_ij g^lm phi,m K_lk +! - 2 K_ij phi,k + 2 g_ik g^lm phi,m K_lj +!------------------------------------------------------------------------------------------------------- + + subroutine get_diff_physical_k(ex, phi, trK, Kx, Ky, Kz, phix, phiy, phiz, & + dxx, gxy, gxz, dyy, gyz, dzz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + Axx, Axy, Axz, Ayy, Ayz, Azz, & + Axxx, Axxy, Axxz, Axyx, Axyy, Axyz, & + Axzx, Axzy, Axzz, Ayyx, Ayyy, Ayyz, & + Ayzx, Ayzy, Ayzz, Azzx, Azzy, Azzz, & + Gmxxx,Gmxxy,Gmxxz,Gmxyy,Gmxyz,Gmxzz, & + Gmyxx,Gmyxy,Gmyxz,Gmyyy,Gmyyz,Gmyzz, & + Gmzxx,Gmzxy,Gmzxz,Gmzyy,Gmzyz,Gmzzz, & + Kxx, Kxy, Kxz, Kyy, Kyz, Kzz, & + DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz, & + DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz, & + DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz) + + implicit none + +!~~~~~~> Input parameters: + + integer,dimension(3), intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: phi,trK + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Kx,Ky,Kz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: phix,phiy,phiz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Axx,Axy,Axz,Ayy,Ayz,Azz +! Aij,k --> stored as Aijk + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Axxx,Axxy,Axxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Axyx,Axyy,Axyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Axzx,Axzy,Axzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Ayyx,Ayyy,Ayyz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Ayzx,Ayzy,Ayzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Azzx,Azzy,Azzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmxxx,Gmxxy,Gmxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmxyy,Gmxyz,Gmxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmyxx,Gmyxy,Gmyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmyyy,Gmyyz,Gmyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmzxx,Gmzxy,Gmzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Gmzyy,Gmzyz,Gmzzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz +! D_i K_jk --> stored as DKijk + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)):: phiupx,phiupy,phiupz + real*8, dimension(ex(1),ex(2),ex(3)):: phiupKx,phiupKy,phiupKz + real*8, dimension(ex(1),ex(2),ex(3)):: e4phi + real*8, dimension(ex(1),ex(2),ex(3)):: gxx,gyy,gzz + + real*8,parameter::ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0 + real*8,parameter::F1o3 = 1.d0/3.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + +!~~~~~~> Input translation + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + e4phi = dexp(FOUR * phi) + +!~~~~~~> + + phiupx = gupxx * phix + gupxy * phiy + gupxz * phiz + phiupy = gupxy * phix + gupyy * phiy + gupyz * phiz + phiupz = gupxz * phix + gupyz * phiy + gupzz * phiz + + phiupKx = phiupx * Kxx + phiupy * Kxy + phiupz * Kxz + phiupKy = phiupx * Kxy + phiupy * Kyy + phiupz * Kyz + phiupKz = phiupx * Kxz + phiupy * Kyz + phiupz * Kzz + +!~~~~~~> tmp = - Gam^l_ij A_lk - Gam^l_ik A_jl + + DKxxx = - Gmxxx * Axx - Gmyxx * Axy - Gmzxx * Axz & + - Gmxxx * Axx - Gmyxx * Axy - Gmzxx * Axz + + DKxxy = - Gmxxx * Axy - Gmyxx * Ayy - Gmzxx * Ayz & + - Gmxxy * Axx - Gmyxy * Axy - Gmzxy * Axz + + DKxxz = - Gmxxx * Axz - Gmyxx * Ayz - Gmzxx * Azz & + - Gmxxz * Axx - Gmyxz * Axy - Gmzxz * Axz + + DKxyy = - Gmxxy * Axy - Gmyxy * Ayy - Gmzxy * Ayz & + - Gmxxy * Axy - Gmyxy * Ayy - Gmzxy * Ayz + + DKxyz = - Gmxxy * Axz - Gmyxy * Ayz - Gmzxy * Azz & + - Gmxxz * Axy - Gmyxz * Ayy - Gmzxz * Ayz + + DKxzz = - Gmxxz * Axz - Gmyxz * Ayz - Gmzxz * Azz & + - Gmxxz * Axz - Gmyxz * Ayz - Gmzxz * Azz + + DKyxx = - Gmxxy * Axx - Gmyxy * Axy - Gmzxy * Axz & + - Gmxxy * Axx - Gmyxy * Axy - Gmzxy * Axz + + DKyxy = - Gmxxy * Axy - Gmyxy * Ayy - Gmzxy * Ayz & + - Gmxyy * Axx - Gmyyy * Axy - Gmzyy * Axz + + DKyxz = - Gmxxy * Axz - Gmyxy * Ayz - Gmzxy * Azz & + - Gmxyz * Axx - Gmyyz * Axy - Gmzyz * Axz + + DKyyy = - Gmxyy * Axy - Gmyyy * Ayy - Gmzyy * Ayz & + - Gmxyy * Axy - Gmyyy * Ayy - Gmzyy * Ayz + + DKyyz = - Gmxyy * Axz - Gmyyy * Ayz - Gmzyy * Azz & + - Gmxyz * Axy - Gmyyz * Ayy - Gmzyz * Ayz + + DKyzz = - Gmxyz * Axz - Gmyyz * Ayz - Gmzyz * Azz & + - Gmxyz * Axz - Gmyyz * Ayz - Gmzyz * Azz + + DKzxx = - Gmxxz * Axx - Gmyxz * Axy - Gmzxz * Axz & + - Gmxxz * Axx - Gmyxz * Axy - Gmzxz * Axz + + DKzxy = - Gmxxz * Axy - Gmyxz * Ayy - Gmzxz * Ayz & + - Gmxyz * Axx - Gmyyz * Axy - Gmzyz * Axz + + DKzxz = - Gmxxz * Axz - Gmyxz * Ayz - Gmzxz * Azz & + - Gmxzz * Axx - Gmyzz * Axy - Gmzzz * Axz + + DKzyy = - Gmxyz * Axy - Gmyyz * Ayy - Gmzyz * Ayz & + - Gmxyz * Axy - Gmyyz * Ayy - Gmzyz * Ayz + + DKzyz = - Gmxyz * Axz - Gmyyz * Ayz - Gmzyz * Azz & + - Gmxzz * Axy - Gmyzz * Ayy - Gmzzz * Ayz + + DKzzz = - Gmxzz * Axz - Gmyzz * Ayz - Gmzzz * Azz & + - Gmxzz * Axz - Gmyzz * Ayz - Gmzzz * Azz + +!~~~~~~> DKijk = e^(4 phi) (A_jk,i + tmp + 1/3 g_jk K_i) +! - 2 K_ik phi,j + 2 g_ij phiupK_k +! - 2 K_ij phi,k + 2 g_ik phiupK_j + + DKxxx = e4phi * (Axxx + DKxxx + F1o3 * gxx * Kx) & + - TWO * Kxx * phix + TWO * gxx * phiupKx & + - TWO * Kxx * phix + TWO * gxx * phiupKx + + DKxxy = e4phi * (Axyx + DKxxy + F1o3 * gxy * Kx) & + - TWO * Kxy * phix + TWO * gxx * phiupKy & + - TWO * Kxx * phiy + TWO * gxy * phiupKx + + DKxxz = e4phi * (Axzx + DKxxz + F1o3 * gxz * Kx) & + - TWO * Kxz * phix + TWO * gxx * phiupKz & + - TWO * Kxx * phiz + TWO * gxz * phiupKx + + DKxyy = e4phi * (Ayyx + DKxyy + F1o3 * gyy * Kx) & + - TWO * Kxy * phiy + TWO * gxy * phiupKy & + - TWO * Kxy * phiy + TWO * gxy * phiupKy + + DKxyz = e4phi * (Ayzx + DKxyz + F1o3 * gyz * Kx) & + - TWO * Kxz * phiy + TWO * gxy * phiupKz & + - TWO * Kxy * phiz + TWO * gxz * phiupKy + + DKxzz = e4phi * (Azzx + DKxzz + F1o3 * gzz * Kx) & + - TWO * Kxz * phiz + TWO * gxz * phiupKz & + - TWO * Kxz * phiz + TWO * gxz * phiupKz + +!~~~~~~> + + DKyxx = e4phi * (Axxy + DKyxx + F1o3 * gxx * Ky) & + - TWO * Kxy * phix + TWO * gxy * phiupKx & + - TWO * Kxy * phix + TWO * gxy * phiupKx + + DKyxy = e4phi * (Axyy + DKyxy + F1o3 * gxy * Ky) & + - TWO * Kyy * phix + TWO * gxy * phiupKy & + - TWO * Kxy * phiy + TWO * gyy * phiupKx + + DKyxz = e4phi * (Axzy + DKyxz + F1o3 * gxz * Ky) & + - TWO * Kyz * phix + TWO * gxy * phiupKz & + - TWO * Kxy * phiz + TWO * gyz * phiupKx + + DKyyy = e4phi * (Ayyy + DKyyy + F1o3 * gyy * Ky) & + - TWO * Kyy * phiy + TWO * gyy * phiupKy & + - TWO * Kyy * phiy + TWO * gyy * phiupKy + + DKyyz = e4phi * (Ayzy + DKyyz + F1o3 * gyz * Ky) & + - TWO * Kyz * phiy + TWO * gyy * phiupKz & + - TWO * Kyy * phiz + TWO * gyz * phiupKy + + DKyzz = e4phi * (Azzy + DKyzz + F1o3 * gzz * Ky) & + - TWO * Kyz * phiz + TWO * gyz * phiupKz & + - TWO * Kyz * phiz + TWO * gyz * phiupKz + +!~~~~~~> + + DKzxx = e4phi * (Axxz + DKzxx + F1o3 * gxx * Kz) & + - TWO * Kxz * phix + TWO * gxz * phiupKx & + - TWO * Kxz * phix + TWO * gxz * phiupKx + + DKzxy = e4phi * (Axyz + DKzxy + F1o3 * gxy * Kz) & + - TWO * Kyz * phix + TWO * gxz * phiupKy & + - TWO * Kxz * phiy + TWO * gyz * phiupKx + + DKzxz = e4phi * (Axzz + DKzxz + F1o3 * gxz * Kz) & + - TWO * Kzz * phix + TWO * gxz * phiupKz & + - TWO * Kxz * phiz + TWO * gzz * phiupKx + + DKzyy = e4phi * (Ayyz + DKzyy + F1o3 * gyy * Kz) & + - TWO * Kyz * phiy + TWO * gyz * phiupKy & + - TWO * Kyz * phiy + TWO * gyz * phiupKy + + DKzyz = e4phi * (Ayzz + DKzyz + F1o3 * gyz * Kz) & + - TWO * Kzz * phiy + TWO * gyz * phiupKz & + - TWO * Kyz * phiz + TWO * gzz * phiupKy + + DKzzz = e4phi * (Azzz + DKzzz + F1o3 * gzz * Kz) & + - TWO * Kzz * phiz + TWO * gzz * phiupKz & + - TWO * Kzz * phiz + TWO * gzz * phiupKz + + return + + end subroutine get_diff_physical_k + +!---------------------------------------------------------------------- +!------>Begin to compute Psi4 +!------>based on quantites: +!------>triad v^i, u^i, w^i +!------>lapse and shift vector beta^i +!------>extrinsic curvature K_ij and trK +!------>covariant derivative of extrinsic curvature D_i K_jk +!------>Ricci tensor: R_ij +!------>gup^ij +!------>Riemann tensor R_ijkl +!---------------------------------------------------------------------- + + subroutine bssn_compute_psi4(ex, em4phi,lapse, betax,betay,betaz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz, & + vx,vy,vz,ux,uy,uz,wx,wy,wz, & + trK,Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, & + Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz, & + Rxx, Rxy, Rxz, Ryy, Ryz, Rzz, & + DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz, & + DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz, & + DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz, Rpsi4, Ipsi4) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: em4phi + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: lapse + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: betax, betay, betaz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gupyy,gupyz,gupzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK,Kxx,Kxy,Kxz,Kyy,Kyz,Kzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxyxy, Rxyxz, Rxyyz, Rxzxz, Rxzyz, Ryzyz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Rxx, Rxy, Rxz, Ryy, Ryz, Rzz +!D_i K_jk ---> DKijk + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: DKxxx,DKxxy,DKxxz,DKxyy,DKxyz,DKxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: DKyxx,DKyxy,DKyxz,DKyyy,DKyyz,DKyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: DKzxx,DKzxy,DKzxz,DKzyy,DKzyz,DKzzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rpsi4,Ipsi4 + +!~~~~~~ local variables + +!n^i upto 1/sqrt(2) + real*8, dimension(ex(1),ex(2),ex(3)) :: nx,ny,nz +!n^i * n^k upto 1/2 + real*8, dimension(ex(1),ex(2),ex(3)) :: nnxx,nnxy,nnxz,nnyy,nnyz,nnzz +!u^j * u^l - w^j * w^l + real*8, dimension(ex(1),ex(2),ex(3)) :: uuwwxx,uuwwxy,uuwwxz,uuwwyy,uuwwyz,uuwwzz +!- u^j * w^l - w^j * u^l + real*8, dimension(ex(1),ex(2),ex(3)) :: uwxx,uwxy,uwxz,uwyy,uwyz,uwzz +! temp variables + real*8, dimension(ex(1),ex(2),ex(3)) ::temRxx, temRxy, temRxz, temRyy, temRyz, temRzz + real*8, dimension(ex(1),ex(2),ex(3)) ::temRxyxy,temRxyxz,temRxyyz,temRxzxz,temRxzyz,temRyzyz + real*8, dimension(ex(1),ex(2),ex(3)) ::lapse2 +! K^i_j + real*8, dimension(ex(1),ex(2),ex(3)) ::Kupxx,Kupxy,Kupxz,Kupyy,Kupyz,Kupzz + + real*8, parameter :: TWO = 2.d0, F1o4 = 1.d0/4.d0 + +!~~~~~~ + +! compute n^i = - beta^i/lapse - v^i + nx = - betax/lapse - vx + ny = - betay/lapse - vy + nz = - betaz/lapse - vz + +! compute nn^ij = n^i * n^j + nnxx = nx * nx + nnxy = nx * ny + nnxz = nx * nz + nnyy = ny * ny + nnyz = ny * nz + nnzz = nz * nz + +! compute uuww^ij = u^i * u^j - w^i * w^j + uuwwxx = ux * ux - wx * wx + uuwwxy = ux * uy - wx * wy + uuwwxz = ux * uz - wx * wz + uuwwyy = uy * uy - wy * wy + uuwwyz = uy * uz - wy * wz + uuwwzz = uz * uz - wz * wz + +! compute uw^ij = - u^i * w^j - w^i * u^j + uwxx = ux * wx + wx * ux + uwxy = ux * wy + wx * uy + uwxz = ux * wz + wx * uz + uwyy = uy * wy + wy * uy + uwyz = uy * wz + wy * uz + uwzz = uz * wz + wz * uz + +!Commonterm_jl = -1/4 * ( (R_ijkl + K_ik * K_jl - K_il * K_jk) * nn^ik +! - 2 * (D_l K_jk - D_k K_jl) * n^0 * n^k +! + (R_jl - K_jm * K^m_l + K * K_jl) * n^0 * n^0 +! ) + +!add trK * K_jl to R_jl + temRxx = Rxx + trK * Kxx + temRxy = Rxy + trK * Kxy + temRxz = Rxz + trK * Kxz + temRyy = Ryy + trK * Kyy + temRyz = Ryz + trK * Kyz + temRzz = Rzz + trK * Kzz + +!add - K_jm * K^m_l to R_jl + +! compute K^m_l + call raise(ex,Kxx,Kxy,Kxz,Kupxx,Kupxy,Kupxz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) + + call raise(ex,Kxy,Kyy,Kyz,Kupxy,Kupyy,Kupyz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) + + call raise(ex,Kxz,Kyz,Kzz,Kupxz,Kupyz,Kupzz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) + + temRxx = temRxx - em4phi * ( Kupxx * Kxx + Kupxy * Kxy + Kupxz * Kxz ) + + temRxy = temRxy - em4phi * ( Kupxx * Kxy + Kupxy * Kyy + Kupxz * Kyz ) + + temRxz = temRxz - em4phi * ( Kupxx * Kxz + Kupxy * Kyz + Kupxz * Kzz ) + + temRyy = temRyy - em4phi * ( Kupxy * Kxy + Kupyy * Kyy + Kupyz * Kyz ) + + temRyz = temRyz - em4phi * ( Kupxy * Kxz + Kupyy * Kyz + Kupyz * Kzz ) + + temRzz = temRzz - em4phi * ( Kupxz * Kxz + Kupyz * Kyz + Kupzz * Kzz ) + +! multiply with n^0 * n^0 upto 1/2 +! n^0 = 1/(sqrt(2) * lapse) + lapse2 = lapse * lapse + + temRxx = temRxx/lapse2 + temRxy = temRxy/lapse2 + temRxz = temRxz/lapse2 + temRyy = temRyy/lapse2 + temRyz = temRyz/lapse2 + temRzz = temRzz/lapse2 + +!add (K_ik * K_jl - K_il * K_jk) to R_ijkl, note they have the same symmetric index + + temRxyxy = Rxyxy + Kxx * Kyy - Kxy * Kxy + temRxyxz = Rxyxz + Kxx * Kyz - Kxz * Kxy + temRxyyz = Rxyyz + Kxy * Kyz - Kxz * Kyy + temRxzxz = Rxzxz + Kxx * Kzz - Kxz * Kxz + temRxzyz = Rxzyz + Kxy * Kzz - Kxz * Kyz + temRyzyz = Ryzyz + Kyy * Kzz - Kyz * Kyz + +!add (R_ijkl + K_ik * K_jl - K_il * K_jk) * nn^ik to R_jl, upto 1/2 +! note they have the same symmetric index + temRxx = temRxx + temRxyxy * nnyy + temRxyxz * nnyz + temRxyxz * nnyz + temRxzxz * nnzz + temRxy = temRxy - temRxyxy * nnxy + temRxyyz * nnyz - temRxyxz * nnxz + temRxzyz * nnzz + temRxz = temRxz - temRxyxz * nnxy - temRxyyz * nnyy - temRxzxz * nnxz - temRxzyz * nnyz + temRyy = temRyy + temRxyxy * nnxx - temRxyyz * nnxz - temRxyyz * nnxz + temRyzyz * nnzz + temRyz = temRyz + temRxyxz * nnxx + temRxyyz * nnxy - temRxzyz * nnxz - temRyzyz * nnyz + temRzz = temRzz + temRxzxz * nnxx + temRxzyz * nnxy + temRxzyz * nnxy + temRyzyz * nnyy + +!add 2 * (D_k K_jl * n^0 * n^k) to R_jl, upto 1/2 + temRxx = temRxx + TWO * ( DKxxx * nx + DKyxx * ny + DKzxx * nz)/lapse + temRxy = temRxy + TWO * ( DKxxy * nx + DKyxy * ny + DKzxy * nz)/lapse + temRxz = temRxz + TWO * ( DKxxz * nx + DKyxz * ny + DKzxz * nz)/lapse + temRyy = temRyy + TWO * ( DKxyy * nx + DKyyy * ny + DKzyy * nz)/lapse + temRyz = temRyz + TWO * ( DKxyz * nx + DKyyz * ny + DKzyz * nz)/lapse + temRzz = temRzz + TWO * ( DKxzz * nx + DKyzz * ny + DKzzz * nz)/lapse + +!add - (D_l K_jk + D_j K_lk) * n^0 * ^k to R_jl, upto 1/2 +! note we symmetrize the index here + temRxx = temRxx - ((DKxxx + DKxxx) * nx + (DKxxy + DKxxy) * ny + (DKxxz + DKxxz) * nz)/lapse + temRxy = temRxy - ((DKyxx + DKxxy) * nx + (DKyxy + DKxyy) * ny + (DKyxz + DKxyz) * nz)/lapse + temRxz = temRxz - ((DKzxx + DKxxz) * nx + (DKzxy + DKxyz) * ny + (DKzxz + DKxzz) * nz)/lapse + temRyy = temRyy - ((DKyxy + DKyxy) * nx + (DKyyy + DKyyy) * ny + (DKyyz + DKyyz) * nz)/lapse + temRyz = temRyz - ((DKzxy + DKyxz) * nx + (DKzyy + DKyyz) * ny + (DKzyz + DKyzz) * nz)/lapse + temRzz = temRzz - ((DKzxz + DKzxz) * nx + (DKzyz + DKzyz) * ny + (DKzzz + DKzzz) * nz)/lapse + +!the real part of Psi4 + Rpsi4 = temRxx * uuwwxx + temRyy * uuwwyy + temRzz * uuwwzz & + + (temRxy * uuwwxy + temRxz * uuwwxz + temRyz * uuwwyz) * TWO + +!the imaginary part of Psi4 + Ipsi4 = temRxx * uwxx + temRyy * uwyy + temRzz * uwzz & + + (temRxy * uwxy + temRxz * uwxz + temRyz * uwyz) * TWO + +!multiply with -1/4 + Rpsi4 = - F1o4 * Rpsi4 + Ipsi4 = - F1o4 * Ipsi4 + + return + + end subroutine bssn_compute_psi4 +!----------------------------------------------------------------------------- +! covariant derivatives w.r.t *tilded metric* of *symmetric* variable +!----------------------------------------------------------------------------- + + subroutine xcov_deriv(ex,fx,fy,fz,fxx,fxy,fxz,fyy,fyz,fzz, & + Gamxxx, Gamxxy, Gamxxz, Gamxyy, Gamxyz, Gamxzz, & + Gamyxx, Gamyxy, Gamyxz, Gamyyy, Gamyyz, Gamyzz, & + Gamzxx, Gamzxy, Gamzxz, Gamzyy, Gamzyz, Gamzzz) + implicit none + +!~~~~~~ Input arguments + + integer, intent(in ) :: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: fx, fy, fz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ) :: Gamzyy, Gamzyz, Gamzzz + +!~~~~~~ Add Connection terms + + fxx = fxx - Gamxxx * fx - Gamyxx * fy - Gamzxx * fz + fxy = fxy - Gamxxy * fx - Gamyxy * fy - Gamzxy * fz + fxz = fxz - Gamxxz * fx - Gamyxz * fy - Gamzxz * fz + fyy = fyy - Gamxyy * fx - Gamyyy * fy - Gamzyy * fz + fyz = fyz - Gamxyz * fx - Gamyyz * fy - Gamzyz * fz + fzz = fzz - Gamxzz * fx - Gamyzz * fy - Gamzzz * fz + + return + + end subroutine xcov_deriv + +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! V1 first +!-------------------------------------------------------------------- + + subroutine get_triad0(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi + +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + + enddo + enddo + enddo + +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,ux,uy,uz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux - norm*vx + uy = uy - norm*vy + uz = uz - norm*vz + + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad0 +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! V2 first +!-------------------------------------------------------------------- + + subroutine get_triad1(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi + +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + + enddo + enddo + enddo + +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,vx,vy,vz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx - norm*ux + vy = vy - norm*uy + vz = vz - norm*uz + + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad1 +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! raise V1, then V1 first +!-------------------------------------------------------------------- + + subroutine get_triad2(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + call raise(ex,fx,fy,fz,vx,vy,vz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,ux,uy,uz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux - norm*vx + uy = uy - norm*vy + uz = uz - norm*vz + + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad2 +!***********for shell********************* +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! V1 first +!-------------------------------------------------------------------- + + subroutine get_triad0_ss(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi + +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + + enddo + enddo + enddo + +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,ux,uy,uz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux - norm*vx + uy = uy - norm*vy + uz = uz - norm*vz + + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad0_ss +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! V2 first +!-------------------------------------------------------------------- + + subroutine get_triad1_ss(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi + +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + + enddo + enddo + enddo + +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,vx,vy,vz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx - norm*ux + vy = vy - norm*uy + vz = vz - norm*uz + + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad1_ss +!-------------------------------------------------------------------- +! Gram-Schmidt orthonormal in Cartesin coordinate +! V1 = [ x, y, z ] +! V2 = [-y, x, ZEO] +! V3 = [xz,yz,-(x^2+y^2)] +! V1 -> V1 / sqrt(W11) +! V2 -> ( V2 - V1 * W12 ) / sqrt(W22) +! V3 -> ( V3 - V1 * W13 - V2 * W23 ) / sqrt(W33) +! W_ij = g_ab * Vi^a * Vj^b +! it is metric, not tilde metric +! raise V1, then V1 first +!-------------------------------------------------------------------- + + subroutine get_triad2_ss(ex, X, Y, Z, ep4phi, & + gxxi,gxyi,gxzi,gyyi,gyzi,gzzi, & + vx,vy,vz,ux,uy,uz,wx,wy,wz) + + implicit none + +!~~~~~~ argument variables + + integer,intent(in ):: ex(1:3) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: ep4phi !exp(4 * phi) +! tilted metric + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxxi,gxyi,gxzi,gyyi,gyzi,gzzi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + +!~~~~~~ local variables + + real*8, dimension(ex(1),ex(2),ex(3)) :: norm,fx,fy,fz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz,gupyy,gupyz,gupzz + + real*8,parameter:: ZEO = 0.d0, ONE = 1.d0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + +!~~~~~~ + + gxx = gxxi * ep4phi + gxy = gxyi * ep4phi + gxz = gxzi * ep4phi + gyy = gyyi * ep4phi + gyz = gyzi * ep4phi + gzz = gzzi * ep4phi +! invert metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz +! initialize U, V, W vetors + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + call raise(ex,fx,fy,fz,vx,vy,vz, & + gupxx,gupxy,gupxz,gupyy,gupyz,gupzz) +! Gram-Schmidt orthonormalization + call InnerProd(ex,norm,vx,vy,vz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + vx = vx/dsqrt(norm) + vy = vy/dsqrt(norm) + vz = vz/dsqrt(norm) + + call InnerProd(ex,norm,ux,uy,uz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux - norm*vx + uy = uy - norm*vy + uz = uz - norm*vz + + call InnerProd(ex,norm,ux,uy,uz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + ux = ux/dsqrt(norm) + uy = uy/dsqrt(norm) + uz = uz/dsqrt(norm) + + call InnerProd(ex,norm,wx,wy,wz,vx,vy,vz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*vx + wy = wy - norm*vy + wz = wz - norm*vz + + call InnerProd(ex,norm,wx,wy,wz,ux,uy,uz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx - norm*ux + wy = wy - norm*uy + wz = wz - norm*uz + + call InnerProd(ex,norm,wx,wy,wz,wx,wy,wz,gxx,gxy,gxz,gyy,gyz,gzz) + wx = wx/dsqrt(norm) + wy = wy/dsqrt(norm) + wz = wz/dsqrt(norm) + + return + + end subroutine get_triad2_ss diff --git a/AMSS_NCKU_source/getnpem2.f90 b/AMSS_NCKU_source/getnpem2.f90 new file mode 100644 index 0000000..d762a67 --- /dev/null +++ b/AMSS_NCKU_source/getnpem2.f90 @@ -0,0 +1,1910 @@ + + +#include "macrodef.fh" + +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! +!----------------------------------------------------------------------------- + + subroutine getnpem2(ext, X, Y, Z, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi2, Iphi2, & + symmetry) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3),symmetry + real*8, intent(in ):: X(1:ext(1)),Y(1:ext(2)),Z(1:ext(3)) + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out):: Rphi2,Iphi2 + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: f,fx,fy,fz + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz + real*8, dimension(ext(1),ext(2),ext(3)) :: chipn1,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ext(1),ext(2),ext(3)) :: HEx,HEy,HEz,HBx,HBy,HBz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + f = dsqrt(f)**3 +! \sqrt(gamma)r x B + HBx = (vy*Bz - vz*By)*f + HBy = (vz*Bx - vx*Bz)*f + HBz = (vx*By - vy*Bx)*f + +#if (tetradtype == 1) +!set m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) +! m = (w + i u )/sqrt(2) +!the real part of Phi2 + Rphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +!the imaginary part of Phi2 + Iphi2 = -(HEx-HBx)*ux-(HEy-HBy)*uy-(HEz-HBz)*uz + +#else +!set m = (phi - i theta)/sqrt(2) following Frans,Eq.(8) of PRD 75, 124018(2007) +! m = (u - i w )/sqrt(2) + +!the real part of Phi2 + Rphi2 = (HEx-HBx)*ux+(HEy-HBy)*uy+(HEz-HBz)*uz +!the imaginary part of Phi2 + Iphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +#endif + + Rphi2 = Rphi2/2.d0 + Iphi2 = Iphi2/2.d0 + + return + + end subroutine getnpem2 +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! for shell +! +!----------------------------------------------------------------------------- + + subroutine getnpem2_ss(ext,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi2, Iphi2, & + symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3),symmetry,sst + double precision,intent(in),dimension(ext(1))::crho + double precision,intent(in),dimension(ext(2))::sigma + double precision,intent(in),dimension(ext(3))::R + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out):: Rphi2,Iphi2 + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: f,fx,fy,fz + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz + real*8, dimension(ext(1),ext(2),ext(3)) :: chipn1,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ext(1),ext(2),ext(3)) :: HEx,HEy,HEz,HBx,HBy,HBz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + f = dsqrt(f)**3 +!set m = (u + iw)/sqrt(2) following Frans, PRD 75, 124018(2007) + +! \sqrt(gamma)r x B + HBx = (vy*Bz - vz*By)*f + HBy = (vz*Bx - vx*Bz)*f + HBz = (vx*By - vy*Bx)*f + +#if (tetradtype == 1) +!set m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) +! m = (w + i u )/sqrt(2) +!the real part of Phi2 + Rphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +!the imaginary part of Phi2 + Iphi2 = -(HEx-HBx)*ux-(HEy-HBy)*uy-(HEz-HBz)*uz + +#else +!set m = (phi - i theta)/sqrt(2) following Frans,Eq.(8) of PRD 75, 124018(2007) +! m = (u - i w )/sqrt(2) + +!the real part of Phi2 + Rphi2 = (HEx-HBx)*ux+(HEy-HBy)*uy+(HEz-HBz)*uz +!the imaginary part of Phi2 + Iphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +#endif + + Rphi2 = Rphi2/2.d0 + Iphi2 = Iphi2/2.d0 + + return + + end subroutine getnpem2_ss +!----------------------------------------------------------------------------- +! +! compute the EM wave phi2 +! for BSSN dynamical variables +! for single point +!----------------------------------------------------------------------------- + + subroutine getnpem2_point(X, Y, Z, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi2, Iphi2) + + implicit none + +!~~~~~~> Input parameters: + real*8, intent(in ) :: X,Y,Z + real*8, intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, intent(out):: Rphi2,Iphi2 + +!~~~~~~> Other variables: + + real*8 :: f,fx,fy,fz + real*8 :: gxx,gyy,gzz + real*8 :: chipn1,chi3o2 + real*8 :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8 :: HEx,HEy,HEz,HBx,HBy,HBz + real*8 :: gupxx,gupxy,gupxz + real*8 :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + f = dsqrt(f)**3 +!set m = (u + iw)/sqrt(2) following Frans, PRD 75, 124018(2007) + +! \sqrt(gamma)r x B + HBx = (vy*Bz - vz*By)*f + HBy = (vz*Bx - vx*Bz)*f + HBz = (vx*By - vy*Bx)*f + +#if (tetradtype == 1) +!set m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) +! m = (w + i u )/sqrt(2) +!the real part of Phi2 + Rphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +!the imaginary part of Phi2 + Iphi2 = -(HEx-HBx)*ux-(HEy-HBy)*uy-(HEz-HBz)*uz + +#else +!set m = (phi - i theta)/sqrt(2) following Frans,Eq.(8) of PRD 75, 124018(2007) +! m = (u - i w )/sqrt(2) + +!the real part of Phi2 + Rphi2 = (HEx-HBx)*ux+(HEy-HBy)*uy+(HEz-HBz)*uz +!the imaginary part of Phi2 + Iphi2 = (HEx-HBx)*wx+(HEy-HBy)*wy+(HEz-HBz)*wz +#endif + + Rphi2 = Rphi2/2.d0 + Iphi2 = Iphi2/2.d0 + + return + + end subroutine getnpem2_point +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! +!----------------------------------------------------------------------------- + + subroutine getnpem1(ext, X, Y, Z, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi1, Iphi1, & + symmetry) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3),symmetry + real*8, intent(in ):: X(1:ext(1)),Y(1:ext(2)),Z(1:ext(3)) + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out):: Rphi1,Iphi1 + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: f,fx,fy,fz + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz + real*8, dimension(ext(1),ext(2),ext(3)) :: chipn1,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ext(1),ext(2),ext(3)) :: HEx,HEy,HEz,HBx,HBy,HBz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: sqr2 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + sqr2 = dsqrt(2.d0) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +#if (tetradtype == 0) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR .and. abs(Z(k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i) + vy(i,j,k) = Y(j) + vz(i,j,k) = Z(k) + endif + if(abs(X(i)) < TINYRR .and. abs(Y(j)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(k) + wy(i,j,k) = TINYRR*Z(k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(j) + uy(i,j,k) = X(i) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i)*Z(k) + wy(i,j,k) = Y(j)*Z(k) + wz(i,j,k) = -(X(i)*X(i) + Y(j)*Y(j)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + + f = dsqrt(f)**3 +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + Rphi1 = HEx*vx+HEy*vy+HEz*vz + +! \sqrt(gamma)u x w (theta x phi) + HBx = (uy*wz - uz*wy)*f + HBy = (uz*wx - ux*wz)*f + HBz = (ux*wy - uy*wx)*f + Iphi1 = HBx*Bx+HBy*By+HBz*Bz + + Rphi1 = Rphi1/2.d0 + Iphi1 = Iphi1/2.d0 + + return + + end subroutine getnpem1 +!----------------------------------------------------------------------------- +! +! compute the Newman-Penrose Weyl scalar Psi4 +! for BSSN dynamical variables +! for shell +! +!----------------------------------------------------------------------------- + + subroutine getnpem1_ss(ext,crho,sigma,R, X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi1, Iphi1, & + symmetry,sst) + + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ext(1:3),symmetry,sst + double precision,intent(in),dimension(ext(1))::crho + double precision,intent(in),dimension(ext(2))::sigma + double precision,intent(in),dimension(ext(3))::R + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: X,Y,Z + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ext(1),ext(2),ext(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ext(1),ext(2),ext(3)),intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out):: Rphi1,Iphi1 + +!~~~~~~> Other variables: + + real*8, dimension(ext(1),ext(2),ext(3)) :: f,fx,fy,fz + real*8, dimension(ext(1),ext(2),ext(3)) :: gxx,gyy,gzz + real*8, dimension(ext(1),ext(2),ext(3)) :: chipn1,chi3o2 + real*8, dimension(ext(1),ext(2),ext(3)) :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8, dimension(ext(1),ext(2),ext(3)) :: HEx,HEy,HEz,HBx,HBy,HBz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ext(1),ext(2),ext(3)) :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: sqr2 + integer::i,j,k + real*8,parameter::TINYRR=1.d-14 + + sqr2 = dsqrt(2.d0) + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + do i=1,ext(1) + do j=1,ext(2) + do k=1,ext(3) + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR .and. abs(Z(i,j,k)) < TINYRR)then + vx(i,j,k) = TINYRR + vy(i,j,k) = TINYRR + vz(i,j,k) = TINYRR + else + vx(i,j,k) = X(i,j,k) + vy(i,j,k) = Y(i,j,k) + vz(i,j,k) = Z(i,j,k) + endif + if(abs(X(i,j,k)) < TINYRR .and. abs(Y(i,j,k)) < TINYRR)then + ux(i,j,k) = - TINYRR + uy(i,j,k) = TINYRR + uz(i,j,k) = ZEO + wx(i,j,k) = TINYRR*Z(i,j,k) + wy(i,j,k) = TINYRR*Z(i,j,k) + wz(i,j,k) = -2*TINYRR*TINYRR + else + ux(i,j,k) = - Y(i,j,k) + uy(i,j,k) = X(i,j,k) + uz(i,j,k) = ZEO + wx(i,j,k) = X(i,j,k)*Z(i,j,k) + wy(i,j,k) = Y(i,j,k)*Z(i,j,k) + wz(i,j,k) = -(X(i,j,k)*X(i,j,k) + Y(i,j,k)*Y(i,j,k)) + endif + enddo + enddo + enddo + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + + f = dsqrt(f)**3 +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + Rphi1 = HEx*vx+HEy*vy+HEz*vz +! \sqrt(gamma)u x w (theta x phi) + HBx = (uy*wz - uz*wy)*f + HBy = (uz*wx - ux*wz)*f + HBz = (ux*wy - uy*wx)*f + Iphi1 = HBx*Bx+HBy*By+HBz*Bz + + Rphi1 = Rphi1/2.d0 + Iphi1 = Iphi1/2.d0 + + return + + end subroutine getnpem1_ss +!----------------------------------------------------------------------------- +! +! compute the EM wave phi1 +! for BSSN dynamical variables +! for single point +!----------------------------------------------------------------------------- + + subroutine getnpem1_point(X, Y, Z, & + chi,dxx,gxy,gxz,dyy,gyz,dzz, & + Ex,Ey,Ez,Bx,By,Bz, & + Rphi1, Iphi1) + + implicit none + +!~~~~~~> Input parameters: + real*8, intent(in ) :: X,Y,Z + real*8, intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, intent(in ) :: chi,Ex,Ey,Ez,Bx,By,Bz + real*8, intent(out):: Rphi1,Iphi1 + +!~~~~~~> Other variables: + + real*8 :: f,fx,fy,fz + real*8 :: gxx,gyy,gzz + real*8 :: chipn1,chi3o2 + real*8 :: vx,vy,vz,ux,uy,uz,wx,wy,wz + real*8 :: HEx,HEy,HEz,HBx,HBy,HBz + real*8 :: gupxx,gupxy,gupxz + real*8 :: gupyy,gupyz,gupzz + + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO = 2.d0 + real*8, parameter :: F1o3 = 1.d0/3.d0, FOUR = 4.d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8,parameter::TINYRR=1.d-14 + + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + chipn1= chi + ONE + chi3o2 = dsqrt(chipn1)**3 + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! initialize U, V, W vetors +! v:r; u: phi; w: theta +#if (tetradtype == 0) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#elif (tetradtype == 1) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + f = 1.d0/chipn1 + + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx + + fx = gxx*wx*ux + gxy*wx*uy + gxz*wx*uz + & + gxy*wy*ux + gyy*wy*uy + gyz*wy*uz + & + gxz*wz*ux + gyz*wz*uy + gzz*wz*uz + fx = fx*f + ux = ux - fx*wx + uy = uy - fx*wy + uz = uz - fx*wz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + vx = vx - fx*wx + vy = vy - fx*wy + vz = vz - fx*wz + fx = gxx*ux*vx + gxy*ux*vy + gxz*ux*vz + & + gxy*uy*vx + gyy*uy*vy + gyz*uy*vz + & + gxz*uz*vx + gyz*uz*vy + gzz*uz*vz + fx = fx*f + vx = vx - fx*ux + vy = vy - fx*uy + vz = vz - fx*uz + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx +#elif (tetradtype == 2) + if(abs(X) < TINYRR .and. abs(Y) < TINYRR .and. abs(Z) < TINYRR)then + vx = TINYRR + vy = TINYRR + vz = TINYRR + else + vx = X + vy = Y + vz = Z + endif + if(abs(X) < TINYRR .and. abs(Y) < TINYRR)then + ux = - TINYRR + uy = TINYRR + uz = ZEO + wx = TINYRR*Z + wy = TINYRR*Z + wz = -2*TINYRR*TINYRR + else + ux = - Y + uy = X + uz = ZEO + wx = X*Z + wy = Y*Z + wz = -(X*X + Y*Y) + endif + + fx = vx + fy = vy + fz = vz + vx = gupxx*fx + gupxy*fy + gupxz*fz + vy = gupxy*fx + gupyy*fy + gupyz*fz + vz = gupxz*fx + gupyz*fy + gupzz*fz + + f = 1.d0/chipn1 + + fx = gxx*vx*vx + gyy*vy*vy + gzz*vz*vz & + +(gxy*vx*vy + gxz*vx*vz + gyz*vy*vz)*TWO + fx = dsqrt(fx*f) + vx = vx/fx + vy = vy/fx + vz = vz/fx + + fx = gxx*vx*ux + gxy*vx*uy + gxz*vx*uz + & + gxy*vy*ux + gyy*vy*uy + gyz*vy*uz + & + gxz*vz*ux + gyz*vz*uy + gzz*vz*uz + fx = fx*f + ux = ux - fx*vx + uy = uy - fx*vy + uz = uz - fx*vz + fx = gxx*ux*ux + gyy*uy*uy + gzz*uz*uz & + +(gxy*ux*uy + gxz*ux*uz + gyz*uy*uz)*TWO + fx = dsqrt(fx*f) + ux = ux/fx + uy = uy/fx + uz = uz/fx + + fx = gxx*vx*wx + gxy*vx*wy + gxz*vx*wz + & + gxy*vy*wx + gyy*vy*wy + gyz*vy*wz + & + gxz*vz*wx + gyz*vz*wy + gzz*vz*wz + fx = fx*f + wx = wx - fx*vx + wy = wy - fx*vy + wz = wz - fx*vz + fx = gxx*ux*wx + gxy*ux*wy + gxz*ux*wz + & + gxy*uy*wx + gyy*uy*wy + gyz*uy*wz + & + gxz*uz*wx + gyz*uz*wy + gzz*uz*wz + fx = fx*f + wx = wx - fx*ux + wy = wy - fx*uy + wz = wz - fx*uz + fx = gxx*wx*wx + gyy*wy*wy + gzz*wz*wz & + +(gxy*wx*wy + gxz*wx*wz + gyz*wy*wz)*TWO + fx = dsqrt(fx*f) + wx = wx/fx + wy = wy/fx + wz = wz/fx +#endif + + f = dsqrt(f)**3 +! E_i + HEx = (gxx*Ex+gxy*Ey+gxz*Ez)*chipn1 + HEy = (gxy*Ex+gyy*Ey+gyz*Ez)*chipn1 + HEz = (gxz*Ex+gyz*Ey+gzz*Ez)*chipn1 + + Rphi1 = HEx*vx+HEy*vy+HEz*vz +! \sqrt(gamma)u x w (theta x phi) + HBx = (uy*wz - uz*wy)*f + HBy = (uz*wx - ux*wz)*f + HBz = (ux*wy - uy*wx)*f + Iphi1 = HBx*Bx+HBy*By+HBz*Bz + + Rphi1 = Rphi1/2.d0 + Iphi1 = Iphi1/2.d0 + + return + + end subroutine getnpem1_point diff --git a/AMSS_NCKU_source/getnpem2.h b/AMSS_NCKU_source/getnpem2.h new file mode 100644 index 0000000..54057cd --- /dev/null +++ b/AMSS_NCKU_source/getnpem2.h @@ -0,0 +1,90 @@ + +#ifndef GETNPEM2_H +#define GETNPEM2_H + +#ifdef fortran1 +#define f_getnpem2 getnpem2 +#define f_getnpem2_point getnpem2_point +#define f_getnpem1_point getnpem1_point +#define f_getnpem2_ss getnpem2_ss +#define f_getnpem1 getnpem1 +#define f_getnpem1_ss getnpem1_ss +#endif +#ifdef fortran2 +#define f_getnpem2 GETNPEM2 +#define f_getnpem2_point GETNPEM2_POINT +#define f_getnpem1_point GETNPEM1_POINT +#define f_getnpem2_ss GETNPEM2_SS +#define f_getnpem1 GETNPEM1 +#define f_getnpem1_ss GETNPEM1_SS +#endif +#ifdef fortran3 +#define f_getnpem2 getnpem2_ +#define f_getnpem2_point getnpem2_point_ +#define f_getnpem1_point getnpem1_point_ +#define f_getnpem2_ss getnpem2_ss_ +#define f_getnpem1 getnpem1_ +#define f_getnpem1_ss getnpem1_ss_ +#endif + +extern "C" +{ + void f_getnpem2(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnpem2_point(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &); +} + +extern "C" +{ + void f_getnpem2_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &, int &); +} + +extern "C" +{ + void f_getnpem1(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &); +} + +extern "C" +{ + void f_getnpem1_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, int &, int &); +} + +extern "C" +{ + void f_getnpem1_point(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &); +} + +#endif /* GETNPEM2_H */ diff --git a/AMSS_NCKU_source/gfns.h b/AMSS_NCKU_source/gfns.h new file mode 100644 index 0000000..d11af68 --- /dev/null +++ b/AMSS_NCKU_source/gfns.h @@ -0,0 +1,98 @@ +#ifndef GFNS_H +#define GFNS_H +namespace AHFinderDirect +{ + + namespace gfns + { + + // ghosted gridfns + enum + { + ghosted_min_gfn = -1, // must set this by hand so + // ghosted_max_gfn is still < 0 + gfn__h = ghosted_min_gfn, + ghosted_max_gfn = gfn__h + }; + + // nominal gridfns + enum + { + nominal_min_gfn = 1, + + // + // for a skeletal patch system we don't need any nominal gridfns + // + skeletal_nominal_max_gfn = nominal_min_gfn - 1, + + // + // most of these gridfns have access macros in "cg.hh"; + // the ones that don't are marked explicitly + // + gfn__global_x = nominal_min_gfn, // no access macro + gfn__global_y, // no access macro + gfn__global_z, // no access macro + + gfn__global_xx, // no access macro + gfn__global_xy, // no access macro + gfn__global_xz, // no access macro + gfn__global_yy, // no access macro + gfn__global_yz, // no access macro + gfn__global_zz, // no access macro + + gfn__g_dd_11, + gfn__g_dd_12, + gfn__g_dd_13, + gfn__g_dd_22, + gfn__g_dd_23, + gfn__g_dd_33, + gfn__partial_d_g_dd_111, + gfn__partial_d_g_dd_112, + gfn__partial_d_g_dd_113, + gfn__partial_d_g_dd_122, + gfn__partial_d_g_dd_123, + gfn__partial_d_g_dd_133, + gfn__partial_d_g_dd_211, + gfn__partial_d_g_dd_212, + gfn__partial_d_g_dd_213, + gfn__partial_d_g_dd_222, + gfn__partial_d_g_dd_223, + gfn__partial_d_g_dd_233, + gfn__partial_d_g_dd_311, + gfn__partial_d_g_dd_312, + gfn__partial_d_g_dd_313, + gfn__partial_d_g_dd_322, + gfn__partial_d_g_dd_323, + gfn__partial_d_g_dd_333, + gfn__K_dd_11, + gfn__K_dd_12, + gfn__K_dd_13, + gfn__K_dd_22, + gfn__K_dd_23, + gfn__K_dd_33, + gfn__trK, + + gfn__psi, // no access macro + gfn__partial_d_psi_1, // no access macro + gfn__partial_d_psi_2, // no access macro + gfn__partial_d_psi_3, // no access macro + + gfn__Theta, + gfn__partial_Theta_wrt_partial_d_h_1, + gfn__partial_Theta_wrt_partial_d_h_2, + gfn__partial_Theta_wrt_partial_dd_h_11, + gfn__partial_Theta_wrt_partial_dd_h_12, + gfn__partial_Theta_wrt_partial_dd_h_22, + gfn__Delta_h, + gfn__save_Theta, + gfn__oldh, // used for dh/dt + gfn__one, + nominal_max_gfn = gfn__one // no comma + }; + + } // namespace gfns:: + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* GFNS_H */ diff --git a/AMSS_NCKU_source/ghost_zone.C b/AMSS_NCKU_source/ghost_zone.C new file mode 100644 index 0000000..c56de2d --- /dev/null +++ b/AMSS_NCKU_source/ghost_zone.C @@ -0,0 +1,604 @@ +#include +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" + +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // These functions verify (assert()) that a ghost zone is indeed of + // the specified type, then static_cast to the appropriate derived class. + // + + const symmetry_ghost_zone &ghost_zone::cast_to_symmetry_ghost_zone() + const + { + assert(is_symmetry()); + return static_cast(*this); + } + + symmetry_ghost_zone &ghost_zone::cast_to_symmetry_ghost_zone() + { + assert(is_symmetry()); + return static_cast(*this); + } + + //************************************** + + const interpatch_ghost_zone &ghost_zone::cast_to_interpatch_ghost_zone() + const + { + assert(is_interpatch()); + return static_cast(*this); + } + + interpatch_ghost_zone &ghost_zone::cast_to_interpatch_ghost_zone() + { + assert(is_interpatch()); + return static_cast(*this); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function constructs a mirror-symmetry ghost zone object + // + symmetry_ghost_zone::symmetry_ghost_zone(const patch_edge &my_edge_in) + : ghost_zone(my_edge_in, + my_edge_in, // other edge == my edge + ghost_zone_is_symmetry) + { + // iperp_map: i --> (i of ghost zone) - i + iperp_map_ = new jtutil::cpm_map(min_iperp(), max_iperp(), + my_edge_in.fp_grid_outer_iperp()); + + // ipar_map_: identity map + ipar_map_ = new jtutil::cpm_map(extreme_min_ipar(), extreme_max_ipar()); + } + + //****************************************************************************** + + // + // This function constructs a periodic-symmetry ghost zone object. + // + symmetry_ghost_zone::symmetry_ghost_zone(const patch_edge &my_edge_in, const patch_edge &other_edge_in, + int my_edge_sample_ipar, int other_edge_sample_ipar, + bool ipar_map_is_plus) + : ghost_zone(my_edge_in, + other_edge_in, + ghost_zone_is_symmetry) + { + // + // perpendicular map + // + const fp fp_my_period_plane_iperp = my_edge().fp_grid_outer_iperp(); + const fp fp_other_period_plane_iperp = other_edge().fp_grid_outer_iperp(); + + // iperp mapping must be outside --> inside + // i.e. if both edges have iperp as the same min/max "direction", + // then the mapping is iperp increasing --> iperp decreasing + // (i.e. the map's sign is -1) + const bool is_iperp_map_plus = !(my_edge().is_min() == other_edge().is_min()); + iperp_map_ = new jtutil::cpm_map(min_iperp(), max_iperp(), + fp_my_period_plane_iperp, + fp_other_period_plane_iperp, + is_iperp_map_plus); + + // + // parallel map + // + ipar_map_ = new jtutil::cpm_map(extreme_min_ipar(), extreme_max_ipar(), + my_edge_sample_ipar, other_edge_sample_ipar, + ipar_map_is_plus); + } + + //****************************************************************************** + + // + // This function destroys a symmetry_ghost_zone object. + // + symmetry_ghost_zone::~symmetry_ghost_zone() + { + delete ipar_map_; + delete iperp_map_; + } + + //****************************************************************************** + + // + // This function "synchronizes" a ghost zone, i.e. it updates the + // ghost-zone values of the specified gridfns via the appropriate + // symmetry operations.The flags specify which part(s) of the ghost zone + // we want. + // + void symmetry_ghost_zone::synchronize(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners /* = true */, + bool want_noncorner /* = true */) + { + // printf("*Sync sym ghost zone in %s patch\n", my_patch().name()); + + for (int gfn = ghosted_min_gfn; gfn <= ghosted_max_gfn; ++gfn) + { + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + for (int ipar = min_ipar(iperp); ipar <= max_ipar(iperp); ++ipar) + { + // do we want to do this point? + if (!my_edge().ipar_is_in_selected_part(want_corners, want_noncorner, + ipar)) + then continue; // *** LOOP CONTROL *** + + const int sym_iperp = iperp_map_of_iperp(iperp); + const int sym_ipar = ipar_map_of_ipar(ipar); + const int sym_irho = other_edge() + .irho_of_iperp_ipar(sym_iperp, sym_ipar); + const int sym_isigma = other_edge() + .isigma_of_iperp_ipar(sym_iperp, sym_ipar); + const fp sym_gridfn = other_patch() + .ghosted_gridfn(gfn, sym_irho, sym_isigma); + + const int irho = my_edge().irho_of_iperp_ipar(iperp, ipar); + const int isigma = my_edge().isigma_of_iperp_ipar(iperp, ipar); + my_patch().ghosted_gridfn(gfn, irho, isigma) = sym_gridfn; + } + } + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function constructs an interpatch_ghost_zone object. + // + interpatch_ghost_zone::interpatch_ghost_zone(const patch_edge &my_edge_in, + const patch_edge &other_edge_in, + int patch_overlap_width) + : ghost_zone(my_edge_in, + other_edge_in, + ghost_zone_is_interpatch), + // remaining pointers are all set up properly by finish_setup() + other_patch_interp_(NULL), + other_iperp_(NULL), + min_ipar_used_(NULL), max_ipar_used_(NULL), + other_par_(NULL), + interp_result_buffer_(NULL), + Jacobian_y_ipar_posn_(NULL), Jacobian_buffer_(NULL) // no comma + { + // + // verify that we have the expected relationships between + // this and the other patch's (mu,nu,phi) coordinates: + // + + // perp coordinate is common to us and the other patch, so + // ghost zone must be min in one patch, max in the other + if (my_edge().is_min() == other_edge().is_min()) + then error_exit(ERROR_EXIT, + "***** interpatch_ghost_zone::interpatch_ghost_zone:\n" + " my_patch().name()=\"%s\" my_edge().name()=%s\n" + " other_patch().name()=\"%s\" other_edge().name()=%s\n" + " ghost zone must be min in one patch, max in the other!\n", + my_patch().name(), my_edge().name(), + other_patch().name(), other_edge().name()); /*NOTREACHED*/ + + // coord in common between the two patches must be perp coord in both patches + // and this patch's tau coordinate must be other edge's parallel coordinate + const local_coords::coords_set common_coords_set = local_coords::coords_set_not(my_patch().coords_set_rho_sigma() ^ + other_patch().coords_set_rho_sigma()); + if (!((common_coords_set == my_edge().coords_set_perp()) && (common_coords_set == other_edge().coords_set_perp()) && (my_patch().coords_set_tau() == other_edge().coords_set_par()))) + then error_exit(PANIC_EXIT, + "***** interpatch_ghost_zone::interpatch_ghost_zone:\n" + " (rho,sigma,tau) coordinates don't match up properly\n" + " between this patch/edge and the other patch/edge!\n" + " my_patch().name()=\"%s\" my_edge().name()=%s\n" + " other_patch().name()=\"%s\" other_edge().name()=%s\n" + " my_patch().coords_set_{rho,sigma,tau}={%s,%s,%s}\n" + " my_edge().coords_set_{perp,par}={%s,%s}\n" + " other_patch().coords_set_{rho,sigma,tau}={%s,%s,%s}\n" + " other_edge().coords_set_{perp,par}={%s,%s}\n", + my_patch().name(), my_edge().name(), + other_patch().name(), other_edge().name(), + local_coords::name_of_coords_set(my_patch().coords_set_rho()), + local_coords::name_of_coords_set(my_patch().coords_set_sigma()), + local_coords::name_of_coords_set(my_patch().coords_set_tau()), + local_coords::name_of_coords_set(my_edge().coords_set_perp()), + local_coords::name_of_coords_set(my_edge().coords_set_par()), + local_coords::name_of_coords_set(other_patch().coords_set_rho()), + local_coords::name_of_coords_set(other_patch().coords_set_sigma()), + local_coords::name_of_coords_set(other_patch().coords_set_tau()), + local_coords::name_of_coords_set(other_edge().coords_set_perp()), + local_coords::name_of_coords_set(other_edge().coords_set_par())); + /*NOTREACHED*/ + + // perp coordinate must match (mod 2*pi) across the two patches + // after taking into account any overlap + // ... eg patch_overlap_width = 3 would be + // p p p p p + // q q q q q + // so the overlap would be (patch_overlap_width-1) * delta + const fp other_overlap = (patch_overlap_width - 1) * other_edge().perp_map().delta_fp(); + const fp other_outer_perp_minus_overlap // move back inwards into other patch + // by overlap distance, to get a value + // that should match our own + // grid_outer_perp() value + = other_edge().grid_outer_perp() + (other_edge().is_min() ? +other_overlap : -other_overlap); + if (!local_coords::fuzzy_EQ_ang(my_edge().grid_outer_perp(), + other_outer_perp_minus_overlap)) + then error_exit(ERROR_EXIT, + "***** interpatch_ghost_zone::interpatch_ghost_zone:\n" + " my_patch().name()=\"%s\" my_edge().name()=%s\n" + " other_patch().name()=\"%s\" other_edge().name()=%s\n" + " perp coordinate doesn't match (mod 2*pi) across the two patches!\n" + " my_edge().grid_outer_perp()=%g <--(compare this)\n" + " patch_overlap_width=%d other_overlap=%g\n" + " other_edge.grid_outer_perp()=%g\n" + " other_outer_perp_minus_overlap=%g <--(against this)\n", + my_patch().name(), my_edge().name(), + other_patch().name(), other_edge().name(), + double(my_edge().grid_outer_perp()), + patch_overlap_width, double(other_overlap), + double(other_edge().grid_outer_perp()), + double(other_outer_perp_minus_overlap)); /*NOTREACHED*/ + + // + // set up the iperp interpatch coordinate mapping + // (gives other patch's iperp coordinate for interpolation) + // + + // compute the iperp --> other_iperp mapping for a sample point; + // ... if the ghost zone is empty, then the sample point will necessarily + // be out-of-range in the ghost zone, so we use the *unchecked* + // conversions to avoid errors in this case + // ... we do the computation using the fact that perp is the same + // coordinate in both patches (modulo 2*pi radians = 360 degrees) + const int sample_iperp = outer_iperp(); + const fp sample_perp = my_edge().perp_map().fp_of_int_unchecked(sample_iperp); + // unchecked conversion here! + const fp other_sample_perp = other_patch() + .modulo_reduce_ang(other_edge().perp_is_rho(), + sample_perp); + const fp fp_other_sample_iperp = other_edge() + .fp_iperp_of_perp(other_sample_perp); + + // verify that this is fuzzily a grid point + if (!jtutil::fuzzy::is_integer(fp_other_sample_iperp)) + then error_exit(ERROR_EXIT, + "***** interpatch_ghost_zone::interpatch_ghost_zone:\n" + " my_patch().name()=\"%s\" my_edge().name()=%s\n" + " other_patch().name()=\"%s\" other_edge().name()=%s\n" + " sample_iperp=%d sample_perp=%g\n" + " other_sample_perp=%g fp_other_sample_iperp=%g\n" + " ==> fp_other_sample_iperp isn't fuzzily an integer!\n" + " ==> patches aren't commensurate in the perpendicular coordinate!\n", + my_patch().name(), my_edge().name(), + other_patch().name(), other_edge().name(), + sample_iperp, double(sample_perp), + double(other_sample_perp), + double(fp_other_sample_iperp)); /*NOTREACHED*/ + const int other_sample_iperp = jtutil::round::to_integer(fp_other_sample_iperp); + + // compute the +/- sign (direction) of the iperp --> other_iperp mapping + // + // Since perp is the same in both patches (mod 2*pi radians = 360 degrees), + // the overall +/- sign is just the product of the signs of the two individual + // iperp <--> perp mappings. + // + // ... signs encoded as (floating-point) +/- 1.0 + const double iperp_map_sign_pm1 = jtutil::signum(my_edge().perp_map().delta_fp()) * jtutil::signum(other_edge().perp_map().delta_fp()); + // ... signs encoded as is_plus bool flag + const bool is_iperp_map_plus = (iperp_map_sign_pm1 > 0.0); + + // now we finally know enough to set up the other_iperp(iperp) + // coordinate mapping + other_iperp_ = new jtutil::cpm_map(min_iperp(), max_iperp(), + sample_iperp, other_sample_iperp, + is_iperp_map_plus); + } + + //****************************************************************************** + + // + // this function destroys an interpatch_ghost_zone object. + // + interpatch_ghost_zone::~interpatch_ghost_zone() + { + delete Jacobian_buffer_; + delete Jacobian_y_ipar_posn_; + delete interp_result_buffer_; + delete other_par_; + delete max_ipar_used_; + delete min_ipar_used_; + delete other_iperp_; + delete other_patch_interp_; + } + + //****************************************************************************** + + // + // These functions compute the [min,max] ipar of the ghost zone for + // a given iperp, taking into account how we treat the corners + // (cf. the example in the header comments in "ghost_zone.hh"): + // + // If an adjacent ghost zone is symmetry, + // we do not include that corner; + // If an adjacent ghost zone is interpatch, + // we include up to the diagonal line, and if we are a rho ghost zone, + // then also the diagonal line itself. E.g. For the example in the + // header comments "ghost_zone.hh", the +x ghost zone includes (6,6), + // (7,6), and (7,7), while the +y ghost zone includes (6,7) + // + // ... in the following 2 functions, + // the iabs() term includes the diagonal, + // so we must remove the diagonal for !is_rho, + // i.e. add 1 to min_ipar and subtract 1 from max_ipar + // + int interpatch_ghost_zone::min_ipar(int iperp) const + { + return min_par_adjacent_ghost_zone().is_symmetry() + ? my_edge().min_ipar_without_corners() + : my_edge().min_ipar_without_corners() - iabs(iperp - my_edge().nominal_grid_outer_iperp()) + (is_rho() ? 0 : 1); + } + + int interpatch_ghost_zone::max_ipar(int iperp) const + { + return max_par_adjacent_ghost_zone().is_symmetry() + ? my_edge().max_ipar_without_corners() + : my_edge().max_ipar_without_corners() + iabs(iperp - my_edge().nominal_grid_outer_iperp()) - (is_rho() ? 0 : 1); + } + + //****************************************************************************** + + // + // This function finishes the construction/setup of an interpatch_ghost_zone + // object. It + // - sets up the par coordinate mapping information + // - sets up the interpatch interpolator data pointer and result arrays + // - constructs the patch_interp object to interpolate from the *other* patch + // + // We use our ipar as the patch_interp's parindex. + // + void interpatch_ghost_zone::finish_setup(int interp_handle, + int interp_par_table_handle) + { + min_other_iperp_ = min(other_iperp(min_iperp()), + other_iperp(max_iperp())); + max_other_iperp_ = max(other_iperp(min_iperp()), + other_iperp(max_iperp())); + + // + // set up arrays giving actual [min,max] ipar that we'll use + // at each other_iperp (later on we will pass these arrays to the + // other patch's patch_interp object, with ipar being parindex there + // + min_ipar_used_ = new jtutil::array1d(min_other_iperp_, max_other_iperp_); + max_ipar_used_ = new jtutil::array1d(min_other_iperp_, max_other_iperp_); + { + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + (*min_ipar_used_)(other_iperp(iperp)) = min_ipar(iperp); + (*max_ipar_used_)(other_iperp(iperp)) = max_ipar(iperp); + } + } + + // + // set up array giving other patch's par coordinate for interpolation + // + + other_par_ = new jtutil::array2d(min_other_iperp_, max_other_iperp_, + extreme_min_ipar(), extreme_max_ipar()); + + { + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + for (int ipar = min_ipar(iperp); ipar <= max_ipar(iperp); ++ipar) + { + // compute the other_par corresponding to (iperp,ipar) + // ... here we use the fact (which we verified in our constructor) + // that other edge's parallel coordinate == our tau coordinate + // (at least modulo 2*pi radians = 360 degrees) + const fp perp = my_edge().perp_of_iperp(iperp); + const fp par = my_edge().par_of_ipar(ipar); + + const fp rho = my_edge().rho_of_perp_par(perp, par); + const fp sigma = my_edge().sigma_of_perp_par(perp, par); + + const fp tau = my_patch().tau_of_rho_sigma(rho, sigma); + const fp other_par = other_patch() + .modulo_reduce_ang(other_edge().par_is_rho(), tau); + + (*other_par_)(other_iperp(iperp), ipar) = other_par; + } + } + } + + // + // set up interpolation result buffer + // + interp_result_buffer_ = new jtutil::array3d(my_patch().ghosted_min_gfn(), + my_patch().ghosted_max_gfn(), + min_other_iperp_, max_other_iperp_, + extreme_min_ipar(), extreme_max_ipar()); + + // + // construct the patch_interp object to interpolate from the *other* patch + // ... the patch_interp should use gridfn data from it's (the other patch's) + // min/max par ghost zones if those (adjacent) adjacent ghost zones + // are symmetry, but not if they're interpatch, + // cf the header comments in "ghost_zone.hh" + // + const ghost_zone &other_ghost_zone = other_patch() + .ghost_zone_on_edge(other_edge()); + const bool ok_to_use_min_par_ghost_zone = other_ghost_zone.min_par_adjacent_ghost_zone() + .is_symmetry() + ? true + : false; + const bool ok_to_use_max_par_ghost_zone = other_ghost_zone.max_par_adjacent_ghost_zone() + .is_symmetry() + ? true + : false; + other_patch_interp_ = new patch_interp(other_edge(), + min_other_iperp_, max_other_iperp_, + *min_ipar_used_, *max_ipar_used_, + *other_par_, + ok_to_use_min_par_ghost_zone, + ok_to_use_max_par_ghost_zone, + interp_handle, interp_par_table_handle); + } + + //****************************************************************************** + + // + // This function asserts() that + // - we have a patch_interp object + // - our and the patch_interp object's notions of the "other patch" agree + // - the other patch has an interpatch ghost zone on this edge + // - the other patch's interpatch ghost zone on this edge, + // points back to our patch + // + void interpatch_ghost_zone::assert_fully_setup() const + { + assert(other_patch_interp_ != NULL); + assert(other_patch() == other_patch_interp_->my_patch()); + assert(other_patch() + .ghost_zone_on_edge(other_edge()) + .is_interpatch()); + assert(my_patch() == other_patch() + .ghost_zone_on_edge(other_edge()) + .other_patch()); + } + + //****************************************************************************** + + // + // This function "synchronizes" a ghost zone, i.e. it updates the + // ghost-zone values of the specified gridfns via the appropriate + // interpatch interpolations. + // + // The flags specify which part(s) of the ghost zone we want, but + // the present implementation only supports the case where all the + // flags are true , i.e. we want the entire ghost zone. + // + void interpatch_ghost_zone::synchronize(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners /* = true */, + bool want_noncorner /* = true */) + { +#ifdef DEBUG_AHFD + printf("*Sync interpatch ghost zone in %s\n", my_patch().name()); +#endif + + // make sure the caller wants the entire ghost zone + if (!(want_corners && want_noncorner)) + then error_exit(ERROR_EXIT, + "***** interpatch_ghost_zone::synchronize():\n" + " we only support operating on the *entire* ghost zone,\n" + " but we were passed flags specifying a proper subset!\n" + " want_corners=(int)%d want_noncorner=(int)%d\n", + want_corners, want_noncorner); /*NOTREACHED*/ + + // + // move from 'Compute_Jacobian' below + // + assert(other_patch_interp_ != NULL); + other_patch_interp_->molecule_minmax_ipar_m(Jacobian_min_y_ipar_m_, + Jacobian_max_y_ipar_m_); +#ifdef DEBUG_AHFD + printf("%d %d %d %d %d %d \n", Jacobian_min_y_ipar_m_, Jacobian_max_y_ipar_m_, + min_other_iperp_, max_other_iperp_, extreme_min_ipar(), extreme_max_ipar()); + getchar(); +#endif + + // /* + if (Jacobian_y_ipar_posn_ == NULL) + Jacobian_y_ipar_posn_ = new jtutil::array2d(min_other_iperp_, max_other_iperp_, + extreme_min_ipar(), extreme_max_ipar()); + if (Jacobian_buffer_ == NULL) + Jacobian_buffer_ = new jtutil::array3d(min_other_iperp_, max_other_iperp_, + extreme_min_ipar(), extreme_max_ipar(), + Jacobian_min_y_ipar_m_, Jacobian_max_y_ipar_m_); + + // do the interpolation into our result buffer + other_patch_interp_->interpolate(ghosted_min_gfn, ghosted_max_gfn, + *interp_result_buffer_, //); + *Jacobian_y_ipar_posn_, + *Jacobian_buffer_); + + // other_patch_interp_->molecule_posn(*Jacobian_y_ipar_posn_); + + // store the results back into our gridfns + for (int gfn = ghosted_min_gfn; gfn <= ghosted_max_gfn; ++gfn) + { + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + const int oiperp = other_iperp(iperp); + + for (int ipar = min_ipar(iperp); ipar <= max_ipar(iperp); ++ipar) + { + int irho = my_edge().irho_of_iperp_ipar(iperp, ipar); + int isigma = my_edge().isigma_of_iperp_ipar(iperp, ipar); + my_patch().ghosted_gridfn(gfn, irho, isigma) = (*interp_result_buffer_)(gfn, oiperp, ipar); + } + } + } + } + + //****************************************************************************** + + // + // This function allocates the internal buffers for the Jacobian, and + // computes that Jacobian + // partial synchronize gridfn(ghosted_gfn, iperp, ipar) + // ------------------------------------------------------------ + // partial other patch gridfn(ghosted_gfn, oiperp, posn+ipar_m) + // where + // oiperp = Jacobian_oiperp(iperp) + // posn = Jacobian_oipar_posn(iperp, ipar) + // into the internal buffers. + // + void interpatch_ghost_zone::compute_Jacobian(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners /* = true */, + bool want_noncorner /* = true */) + const + { + // make sure the caller wants the entire ghost zone + if (!(want_corners && want_noncorner)) + then error_exit(ERROR_EXIT, + "***** interpatch_ghost_zone::compute_Jacobian():\n" + " we only support operating on the *entire* ghost zone,\n" + " but we were passed flags specifying a proper subset!\n" + " want_corners=(int)%d want_noncorner=(int)%d\n", + want_corners, want_noncorner); /*NOTREACHED*/ + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/ghost_zone.h b/AMSS_NCKU_source/ghost_zone.h new file mode 100644 index 0000000..3306d25 --- /dev/null +++ b/AMSS_NCKU_source/ghost_zone.h @@ -0,0 +1,796 @@ +#ifndef GHOST_ZONE_H +#define GHOST_ZONE_H +namespace AHFinderDirect +{ + + //***************************************************************************** + + // + // ***** design notes for ghost zones ***** + // + + // + // A ghost_zone object describes a patch's ghost zone, and knows how + // to compute gridfns there (we usually speak of "synchronizing" the + // ghost zone or zones) based on either the patch system's symmetry + // or interpolation from a neighboring patch. ghost_zone is an abstract + // base class, from which we derive two concrete classes: + // * A symmetry_ghost_zone object describes a ghost zone which is a + // (discrete) symmetry of spacetime, either mirror-image or periodic. + // Such an object knows how to fill in ghost-zone gridfn data from + // the "other side" of the symmetry. + // * An interpatch_ghost_zone object describes a ghost zone which + // overlaps another patch. Such an object knows how to get ghost + // zone gridfn data from the other patch. More accurately, it gets + // the data by asking (calling) the appropriate one of the other + // patch's patch_interp objects. + // Every patch has (points to) 4 ghost_zone objects, one for each of + // the patch's sides. See the comments in "patch.hh" for a "big picture" + // discussion of patches, patch edges, ghost zones, and patch interpolators. + // + + // + // There are some unobvious complications involved in synchronizing + // the ghost zone "corners", i.e. in ghost zone points that are outside + // the nominal grid in *both* coordinates. There are 3 basic cases here: + // * A corner between two symmetry ghost zones, for example the -x/-y + // corner in the example below. In this case it takes *two* sequential + // symmetry operations to get gridfn data in the corner from the + // nominal grid. Symmetry operations commute, so at each point we'll + // always get the same results independently of in which order we do + // the symmetry operations. Computationally, we actually do the operations + // in both orders, one order's results overwriting the other's, but + // this doesn't matter (because the results are the same). + // * A corner between two interpatch ghost zones, for example the +x/+y + // corner in the example below. In this case we could get the gridfn + // data by either of two distinct interpolation operations (presumably + // from two distinct patches), which would in general give slightly + // different results. In some ideal world we might do a centered + // interpolation using data from both patches, but this would be + // complicated: + // - it would require a 2-D interpolation + // - it would require bookkeeping for interpolating from multiple + // patches within the same ghost zone, indeed for the same ghost + // zone point + // At present, we follow a simpler approach: we split the corner down + // its diagonal, + // [for the points on the diagonal we make an arbitrary choice; + // at present this is that they belong to (and get their data via) + // the rho ghost zone.] + // and off-center the interpolation as necessary so each ghost-zone + // point gets data solely from the neighboring patch on its own side. + // * A corner between a symmetry and an interpatch ghost zone, for + // example the +x/-y or -x/+y corners in the example below. In this + // case we first do a symmetry operation in the neighboring patch, + // then a fully centered interpolation (using the data just obtained + // from a symmetry operation) to get data in the non-corner part of + // the interpatch ghost zone. After the interpatch interpolation, + // we do a final symmetry operation to get gridfn data in the corner. + // + // In general, then, a ghost zone is rhomboid-shaped: iperp lies in a + // fixed interval, while ipar lies in an interval which may depend on + // iperp. In general, this shape depends on the type (symmetry vs interpatch) + // of the adjacent ghost zones. + // + + // + // To properly handle all the symmetry/interpatch cases described above, + // we use a 3-phase algorithm to synchronize ghost zones: + // Phase 1: Fill in gridfn data at all the non-corner points of symmetry + // ghost zones, by using the symmetries to get this data from + // its "home patch" nominal grids. + // Phase 2: Fill in gridfn data in all the interpatch ghost zones, by + // interpatch interpolating from neighboring patches as described + // above. + // Phase 3: Fill in gridfn data at all the corner points of symmetry + // ghost zones, by using the symmetries to get this data from + // its "home patch" nominal grids or ghost zones. + // Here a given ghost zone corner may be either a full rectangle (so any + // given point is a member of both adjacent corners), or split down its + // diagonal (so any given point is a member of only one corner). This + // 3-phase algorithm is actually implemented by + // patch_system::synchronize() + // which in turn calls + // symmetry_ghost_zone::synchronize() + // interpatch_ghost_zone::synchronize() + // + + // + // For example, consider the +z patch in an octant patch system, with + // the ghost zones being 2 points wide. The following illustration is + // looking down the z axis, and uses (x,y) for the patch coordinates + // for simplicity: + // + // # // + // i+y i+y i+y i+y i+y i+y i+y // + // (-2,7) (-1,7) (0,7) (1,7) (2,7) (3,7) (4,7) (5,7) (6,7) (7,7) + // # /i+x + // # // + // i+y i+y i+y i+y i+y i+y // + // (-2,6) (-1,6) (0,6) (1,6) (2,6) (3,6) (4,6) (5,6) (6,6) (7,6) + // # /i+x i+x + // # // + // # // + // (-2,5) (-1,5) 2,5)--(1,5)--(2,5)--(3,5)--(4,5)--(5,5) (6,5) (7,5) + // s-x s-x # | i+x i+x + // # | + // # | + // (-2,4) (-1,4) (0,4) (1,4) (2,4) (3,4) (4,4) (5,4) (6,4) (7,4) + // s-x s-x # | i+x i+x + // # | + // # | + // (-2,3) (-1,3) (0,3) (1,3) (2,3) (3,3) (4,3) (5,3) (6,3) (7,3) + // s-x s-x # | i+x i+x + // # | + // # | + // (-2,2) (-1,2) (0,2) (1,2) (2,2) (3,2) (4,2) (5,2) (6,2) (7,2) + // s-x s-x # | i+x i+x + // # | + // # | + // (-2,1) (-1,1) (0,1) (1,1) (2,1) (3,1) (4,1) (5,1) (6,1) (7,1) + // s-x s-x # | i+x i+x + // # | + // # | + // #(-2,0)#(-1,0)##(0,0)##(1,0)##(2,0)##(3,0)##(4,0)##(5,0)##(6,0)##(7,0) + // s-x s-x # i+x i+x + // # + // s-y s-y s-y s-y s-y s-y + // (-2,-1)(-1,-1) (0,-1) (1,-1) (2,-1) (3,-1) (4,-1) (5,-1) (6,-1) (7,-1) + // # + // # + // s-y s-y s-y s-y s-y s-y + // (-2,-2)(-1,-2) (0,-2) (1,-2) (2,-2) (3,-2) (4,-2) (5,-2) (6,-2) (7,-2) + // # + // # + // + // For this example, + // * The xz plane and yz plane are marked with ### lines + // * The +z patch's nominal grid is ([0,5],[0,5]), i.e. 0 <= x,y <= 5; + // its boundary lines are shown with single lines --- and | . + // * The diagonal where we've split corners are marked with // lines. + // * The +z patch's ghost zones are + // -x: (-1,[-1,7]), (-2,[-2,7]) + // +x: (6,[-2,6]), (7,[-2,7]) + // -y: ([-2, 7],[-2,-1]) + // +y: ([-2,5],6), ([-2,6],7) + // * The regions where we will interpolate data from the +z patch are + // +x: ([ 3,4],[-2,7]) + // +y: ([-2,7],[ 3,4]) + // Note that in both cases the interpolation region includes the points + // computed by symmetry (in phase 1 of our 3-phase algorithm) on the + // adjacent edges! There are no interpolation regions inside the -x or + // -y boundaries, since no interpolation is needed across those boundaries + // of this patch. + // The diagonal *** line shows the boundary between the +x and +y ghost + // zones. + // + // Our 3-phase algorithm described above thus becomes: + // Phase 1: Fill in gridfn values at points marked with "s-x" below or + // "s-y" above via symmetry mirroring across the -x boundary + // (yz plane) or -y boundary (xz plane), as described by the + // +z patch's -x or -y symmetry_ghost_zone object respectively. + // Phase 2: Fill in gridfn values at points marked with "i+x" below or + // "i+y" above via interpatch interpolation from the neighboring + // patch across the +z patch's +x or +y boundary, as described + // by the +z patch's +x or +y interpatch_ghost_zone object + // respectively. + // Phase 3: Fill in gridfn values at points marked with "" below or + // "" above via symmetry mirroring across the -x boundary + // (yz plane) or -y boundary (xz plane), as described by the + // +z patch's -x or -y symmetry_ghost_zone object respectively. + // + + //***************************************************************************** + + // + // ghost_zone - abstract base class to describe ghost zone of patch + // + // This is an abstract base class describing a generic patch ghost zone. + // This might represent either of: + // - a discrete symmetry of spacetime (derived class symmetry_ghost_zone) + // - an overlap with another patch (derived class interpatch_ghost_zone) + // + + // + // N.b. const qualifiers in ghost_zone and its derived classes refer to + // the underlying gridfn data. + // + + // forward declarations + class symmetry_ghost_zone; + class interpatch_ghost_zone; + class patch_system; + + class ghost_zone + { + public: + // + // ***** main high-level client interface ***** + // + // "synchronize" a ghost zone, i.e. update the ghost-zone values + // of the specified gridfns via the appropriate sequence of + // symmetry operations and interpatch interpolations + // (flags specify which part(s) of the ghost zone we want) + // + virtual void synchronize(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true) = 0; + + public: + // + // ***** Jacobian of synchronize() ***** + // + // This function computes the Jacobian of the synchronize() + // operation into internal buffers; the following functions + // provide access to that Jacobian. + // + // FIXME: should these be moved out into a separate Jacobian + // object/class? + // + // Note that this function just computes the Jacobian of this + // ghost zone's synchronize() operation -- it does *NOT* take + // into account the 3-phase synchronization algorithm described + // in the header comments for this file. (That's done by + // patch_system::synchronize_Jacobian() and its subfunctions.) + // + // n.b. terminology is + // partial gridfn at x + // ------------------- + // partial gridfn at y + // + virtual void compute_Jacobian(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true) + const = 0; + + // + // The API in the remaining functions implicitly assumes that + // the Jacobian is independent of ghosted_gfn , and also that + // the structure of the Jacobian is such that the set of y points + // on which a single ghost-zone point depends, + // - has a single yiperp value (depending on our iperp, of course) + // - have a contiguous interval of yipar (depending on our iperp + // and ipar, of course), whose size is + // [or can be taken to be without an unreasonable + // amount of zero-padding] + // independent of our iperp and ipar; we parameterize this + // interval as yipar = posn+m where posn is determined by + // our iperp and ipar, and m has a fixed range independent + // of our iperp and ipar + // + + // what is the [min,max] range of m for this ghost zone? + virtual int Jacobian_min_y_ipar_m() const = 0; + virtual int Jacobian_max_y_ipar_m() const = 0; + + // what is the iperp of the Jacobian y points in their (y) patch? + virtual int Jacobian_y_iperp(int x_iperp) const = 0; + + // what is the posn value of the y points in this Jacobian row? + virtual int Jacobian_y_ipar_posn(int x_iperp, int x_ipar) const = 0; + + // what is the Jacobian + // partial synchronize() px.gridfn(ghosted_gfn, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial py.gridfn(ghosted_gfn, y_iperp, y_posn+y_ipar_m) + // where + // y_iperp = Jacobian_y_iperp(x_iperp) + // y_posn = Jacobian_y_ipar_posn(x_iperp, x_ipar) + virtual fp Jacobian(int x_iperp, int x_ipar, int y_ipar_m) const = 0; + + public: + // + // ***** low-level client interface ***** + // + + // to which patch/edge do we belong? + patch &my_patch() const { return my_patch_; } + const patch_edge &my_edge() const { return my_edge_; } + + // from which patch/edge do we get data? + patch &other_patch() const { return other_patch_; } + const patch_edge &other_edge() const { return other_edge_; } + + // what type of ghost zone are we? + bool is_interpatch() const { return is_interpatch_; } + bool is_symmetry() const { return !is_interpatch_; } + + // convenience forwarding functions down to patch_edge:: + bool is_min() const { return my_edge().is_min(); } + bool is_rho() const { return my_edge().is_rho(); } + + // min/max iperp of the ghost zone + int min_iperp() const + { + return my_patch() + .minmax_ang_ghost_zone__min_iperp(is_min(), is_rho()); + } + int max_iperp() const + { + return my_patch() + .minmax_ang_ghost_zone__max_iperp(is_min(), is_rho()); + } + + // inner/outer iperp of the ghost zone wrt our patch + int inner_iperp() const { return is_min() ? max_iperp() : min_iperp(); } + int outer_iperp() const { return is_min() ? min_iperp() : max_iperp(); } + + // extreme min/max ipar that might possibly be part of this ghost zone + // (derived classes may actually use a subset of this) + int extreme_min_ipar() const + { + return my_edge().min_ipar_with_corners(); + } + int extreme_max_ipar() const + { + return my_edge().max_ipar_with_corners(); + } + + // actual min/max ipar in the ghost zone at a particular iperp + // (may depend on type of the adjacent ghost zones) + virtual int min_ipar(int iperp) const = 0; + virtual int max_ipar(int iperp) const = 0; + + // point membership predicate + bool is_in_ghost_zone(int iperp, int ipar) + const + { + // n.b. don't test ipar until we're sure iperp is in range! + return (iperp >= min_iperp()) && (iperp <= max_iperp()) && (ipar >= min_ipar(iperp)) && (ipar <= max_ipar(iperp)); + } + + // adjacent ghost zones to our min/max corners + const ghost_zone &min_par_adjacent_ghost_zone() const + { + return my_patch() + .ghost_zone_on_edge(my_edge().min_par_adjacent_edge()); + } + const ghost_zone &max_par_adjacent_ghost_zone() const + { + return my_patch() + .ghost_zone_on_edge(my_edge().max_par_adjacent_edge()); + } + + // + // ***** safely cast to derived classes ***** + // + + // assert that gz is of specified type, + // then static_cast to derive type + const symmetry_ghost_zone &cast_to_symmetry_ghost_zone() const; + symmetry_ghost_zone &cast_to_symmetry_ghost_zone(); + const interpatch_ghost_zone &cast_to_interpatch_ghost_zone() const; + interpatch_ghost_zone &cast_to_interpatch_ghost_zone(); + + // + // ***** constructor, finish setup, destructor ***** + // + protected: + // ... values for is_interpatch_in constructor argument + // FIXME: these should really be bool, but then we couldn't + // use the "enum hack" for in-class constants + enum + { + ghost_zone_is_symmetry = false, + ghost_zone_is_interpatch = true // no comma + }; + + // constructor + // ... only used in implementing our derived classes; + // the rest of the world constructs our derived classes instead + ghost_zone(const patch_edge &my_edge_in, + const patch_edge &other_edge_in, + bool is_interpatch_in) + : my_patch_(my_edge_in.my_patch()), + my_edge_(my_edge_in), + other_patch_(other_edge_in.my_patch()), + other_edge_(other_edge_in), + is_interpatch_(is_interpatch_in) + { + } + + public: + // assert() that ghost zone is fully setup: + // defined here ==> no-op + // symmetry ghost zone ==> unchanged ==> no-op + // interpatch ghost zone ==> check consistency of this and the + // other patch's ghost zones and + // patch_interp objects + virtual void assert_fully_setup() const {} + + // destructor must be virtual to allow destruction + // of derived classes via ptr/ref to this class + virtual ~ghost_zone() {} + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them (either here or in derived classes) + ghost_zone(const ghost_zone &rhs); + ghost_zone &operator=(const ghost_zone &rhs); + + private: + patch &my_patch_; + const patch_edge &my_edge_; + patch &other_patch_; + const patch_edge &other_edge_; + const bool is_interpatch_; + }; + + //***************************************************************************** + + // + // symmetry_ghost_zone - derived class for spacetime-symmetry ghost zone + // + // In practice, there are two types of spacetime symmetry ghost zone: + // mirror symmetry and periodic symmetry. However, it turns out that the + // code needed to handle periodic BCs is basically a superset of that + // needed to handle mirror symmetries, so this class represents a generic + // symmetry ghost zone which may be of either type, and once constructed + // doesn't distinguish between the two. + // + // In general, a symmetry ghost zone implies that there's a 1-1 mapping + // between ghost zone points of this patch, and (a subset of the) interior + // points of this or another patch. If tensors are involved (this isn't + // used at present in the horizon finder), there's also a corresponding + // 1-1 mapping between (angular) tensor components. + // + // A mirror-symmetry ghost zone is specified by (the constructor arguments) + // - a patch edge + // - the (fp) perp coordinate of the mirror plane + // The mapping of ghost zone points is thus "just" the mirror imaging of + // iperp across the symmetry plane within this same patch. (The mapping + // leaves ipar invariant.) + // + // A periodic-symmetry ghost zone is specified by (the constructor arguments) + // - a patch edge (specifies the ghost zone) + // - the patch edge to which the ghost zone is to be mapped + // - a pair of ipar coordinates, one on this edge and one on the other edge, + // which map into each other + // - the sign of the ipar mapping (does increasing ipar on this edge map to + // increasing or decreasing ipar on the other edge?) + // The mapping of ghost zone points is the periodic mapping; this may map + // the ghost zone points to interior points of either this same patch or a + // different one. + // + // In general, the symmetry mapping of ghost zone points is of the form + // (iperp, ipar) --> (const +/- iperp, const +/- ipar) + // The iperp mapping is always in the direction + // outside the patch --> inside the patch + // while the ipar mapping might have either sign. + // If there are tensors, the corresponding mapping of tensor components is + // (index_perp, index_par) --> (+/-) (+/-) (index_perp, index_par) + // (that is, the two +/- signs are multiplied). + + // + // Since all the member functions are const , a symmetry_ghost_zone + // object is effectively always const . + // + class symmetry_ghost_zone + : public ghost_zone + { + public: + // + // ***** main high-level client interface ***** + // + // "synchronize" a ghost zone, i.e. update the ghost-zone values + // of the specified gridfns via the appropriate symmetry operations + // (flags specify which part(s) of the ghost zone we want) + // + void synchronize(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true); + + // + // ***** Jacobian of synchronize() ***** + // + // n.b. terminology is + // partial gridfn at x + // ------------------- + // partial gridfn at y + // + + // allocate internal buffers, compute Jacobian + // ... this function is a no-op in this class + void compute_Jacobian(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true) + const + { + } + + // what is the [min,max] range of m for this ghost zone? + int Jacobian_min_y_ipar_m() const { return 0; } + int Jacobian_max_y_ipar_m() const { return 0; } + + // what is the oiperp of the Jacobian points (= iperp in their patch)? + virtual int Jacobian_y_iperp(int x_iperp) const + { + return iperp_map_of_iperp(x_iperp); + } + + // what is the posn value of the points in this Jacobian row? + int Jacobian_y_ipar_posn(int x_iperp, int x_ipar) const + { + return ipar_map_of_ipar(x_ipar); + } + + // what is the Jacobian + // partial synchronize() px.gridfn(ghosted_gfn, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial py.gridfn(ghosted_gfn, y_iperp, y_posn+y_ipar_m) + // where + // y_iperp = Jacobian_y_iperp(x_iperp) + // y_posn = Jacobian_y_ipar_posn(x_iperp, x_ipar) + fp Jacobian(int x_iperp, int x_ipar, int y_ipar_m) const + { + return (y_ipar_m == 0) ? 1.0 : 0.0; + } + + // + // ***** low-level client interface ***** + // + + // symmetry-map coordinates + int iperp_map_of_iperp(int iperp) const + { + return iperp_map_->map(iperp); + } + int ipar_map_of_ipar(int ipar) const + { + return ipar_map_->map(ipar); + } + fp fp_sign_of_iperp_map() const + { + return iperp_map_->fp_sign(); + } + fp fp_sign_of_ipar_map() const + { + return ipar_map_->fp_sign(); + } + + // min/max ipar of the ghost zone + // ... we always include the corners + // (cf. the example at the start of this file) + int min_ipar(int iperp) const { return extreme_min_ipar(); } + int max_ipar(int iperp) const { return extreme_max_ipar(); } + + // + // ***** constructors, destructor ***** + // + public: + // constructor for mirror-symmetry ghost zone + symmetry_ghost_zone(const patch_edge &my_edge_in); + + // constructor for periodic-symmetry ghost zone + // ... ipar mapping specified by giving sample point and mapping sign + symmetry_ghost_zone(const patch_edge &my_edge_in, const patch_edge &other_edge_in, + int my_edge_sample_ipar, int other_edge_sample_ipar, + bool ipar_map_is_plus); + + ~symmetry_ghost_zone(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + symmetry_ghost_zone(const symmetry_ghost_zone &rhs); + symmetry_ghost_zone &operator=(const symmetry_ghost_zone &rhs); + + private: + // symmetry mappings for (iperp,ipar) + // ... we own these objects + const jtutil::cpm_map *iperp_map_; + const jtutil::cpm_map *ipar_map_; + }; + + //***************************************************************************** + + // + // interpatch_ghost_zone - derived class for interpatch ghost zone of a patch + // + // A ghost_zone object maps (my_iperp,my_ipar) coordinates to the other + // patch's (other_iperp,other_par) coordinates, then calls the other patch's + // patch_interp object to interpolate the other patch's data to those + // coordinates. + // + // Note that as described in the "design notes for ghost zones" + // comments above, interpatch_ghost_zone objects are constructed in + // the 2nd and 3rd phase of the overall construction process described + // at the comments at the start of "patch.hh" + // [done by our constructor] + // - set up the object itslf and its links to/from the patches and + // their edges + // [done by finish_setup()] + // - set up the interpatch mapping information, data pointers, and + // interpolation result buffer + // - construct the patch_interp object to interpolate from the other + // patch, and save a pointer to it + // + + class patch_interp; + + class interpatch_ghost_zone + : public ghost_zone + { + public: + // + // ***** main high-level client interface ***** + // + // "synchronize" a ghost zone, i.e. update the ghost-zone + // values of the specified gridfns via the appropriate + // interpatch interpolations + // (flags specify which part(s) of the ghost zone we want) + // + // ... the present implementation only supports the case where + // both flags are set + // + void synchronize(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true); + + // + // ***** Jacobian of synchronize() ***** + // + // n.b. terminology is + // partial gridfn at x + // ------------------- + // partial gridfn at y + // + + // allocate internal buffers, compute Jacobian + // + // ... the present implementation only supports the case where + // both flags are set + // + void compute_Jacobian(int ghosted_min_gfn, int ghosted_max_gfn, + bool want_corners = true, + bool want_noncorner = true) + const; + + // what is the [min,max] range of m for this ghost zone? + int Jacobian_min_y_ipar_m() const { return Jacobian_min_y_ipar_m_; } + int Jacobian_max_y_ipar_m() const { return Jacobian_max_y_ipar_m_; } + + // what is the iperp of the Jacobian y points in their (y) patch? + // ... the ipar row of grid points is actually the same, so + // we just have to translate x_iperp to the y patch's coordinates + int Jacobian_y_iperp(int x_iperp) const { return other_iperp(x_iperp); } + + // what is the posn value of the y points in this Jacobian row? + int Jacobian_y_ipar_posn(int x_iperp, int x_ipar) const + { + assert(Jacobian_y_ipar_posn_ != NULL); + const int y_iperp = Jacobian_y_iperp(x_iperp); + return (*Jacobian_y_ipar_posn_)(y_iperp, x_ipar); + } + + // what is the Jacobian + // partial synchronize() px.gridfn(ghosted_gfn, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial py.gridfn(ghosted_gfn, y_iperp, y_posn+y_ipar_m) + // where + // y_iperp = Jacobian_y_iperp(x_iperp) + // y_posn = Jacobian_y_ipar_posn(x_iperp, x_ipar) + fp Jacobian(int x_iperp, int x_ipar, int y_ipar_m) const + { + assert(Jacobian_buffer_ != NULL); + assert(y_ipar_m >= Jacobian_min_y_ipar_m_); + assert(y_ipar_m <= Jacobian_max_y_ipar_m_); + const int y_iperp = Jacobian_y_iperp(x_iperp); + return (*Jacobian_buffer_)(y_iperp, x_ipar, y_ipar_m); + } + + // + // ***** low-level client interface ***** + // + + public: + // check consistency of this and the other patch's ghost zones + // and patch_interp objects + void assert_fully_setup() const; + + // min/max ipar of the ghost zone for specified iperp + // with possibly "triangular" corners depending on the type + // (symmetry vs interpatch) of the adjacent ghost zones + // (cf. comments & example at the start of this file) + int min_ipar(int iperp) const; + int max_ipar(int iperp) const; + + // convert our iperp --> other patch's iperp + int other_iperp(int iperp) const + { + assert(other_iperp_ != NULL); + return other_iperp_->map(iperp); + } + + // + // ***** constructor, finish setup, destructor ***** + // + public: + interpatch_ghost_zone(const patch_edge &my_edge_in, + const patch_edge &other_edge_in, + int patch_overlap_width); + + // finish setup (requires adjacent-side ghost_zone objects + // to exist, though not to have finish_setup() called): + // - setup par coordinate mapping information + // - setup interpatch interpolator data pointers & result buffer + // - create patch_interp object to interpolate from *other* patch + void finish_setup(int interp_handle, int interp_par_table_handle); + + ~interpatch_ghost_zone(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + interpatch_ghost_zone(const interpatch_ghost_zone &rhs); + interpatch_ghost_zone &operator=(const interpatch_ghost_zone &rhs); + + private: + // + // all the remaining pointers are initialized to NULL pointers + // in our constructor, then finally allocated and set up by + // finish_setup() or compute_Jacobian() as appropriate + // + // FIXME: should these be moved out into a separate object/class + // for the interp stuff and/or another one for the Jacobian? + // + + // see comment in "patch_interp.hh" for why this is "const" + const patch_interp *other_patch_interp_; + + // other patch's iperp coordinates of our ghost zone points + // ... maps my_iperp --> other_iperp + jtutil::cpm_map *other_iperp_; + + // min/max values of other patch's iperp coordinates + // of our ghost zone points + int min_other_iperp_, max_other_iperp_; + + // [min,max]_ipar used at each other_iperp + // ... we will pass these arrays by reference + // to the other patch's patch_interp object + // ... index is (other_iperp) + jtutil::array1d *min_ipar_used_; + jtutil::array1d *max_ipar_used_; + + // other patch's (fp) parallel coordinates of our ghost zone points + // ... we will pass this array by reference + // to the other patch's patch_interp object + // using my_ipar as the patch_interp's parindex + // ... subscripts are (other_iperp, my_ipar) + jtutil::array2d *other_par_; + + // buffer into which the other patch's patch_interp object + // will store the interpolated gridfn values + // ... we will pass this array by reference + // to the other patch's patch_interp object + // using my_ipar as the patch_interp's parindex + // ... subscripts are (gfn, other_iperp,my_ipar) + jtutil::array3d *interp_result_buffer_; + + // + // stuff computed by compute_Jacobian() + // + // n.b. terminology is + // partial gridfn at x + // ------------------- + // partial gridfn at y + // + mutable int Jacobian_min_y_ipar_m_, Jacobian_max_y_ipar_m_; + + // other patch's y ipar posn for a Jacobian row + // ... subscripts are (oiperp, ipar) + mutable jtutil::array2d *Jacobian_y_ipar_posn_; + + // Jacobian values + // ... subscripts are (y_iperp, x_ipar, y_ipar_m) + mutable jtutil::array3d *Jacobian_buffer_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* GHOST_ZONE_H*/ diff --git a/AMSS_NCKU_source/gpu_mem.h b/AMSS_NCKU_source/gpu_mem.h new file mode 100644 index 0000000..ff649fd --- /dev/null +++ b/AMSS_NCKU_source/gpu_mem.h @@ -0,0 +1,146 @@ +#ifndef GPU_MEM_H_ +#define GPU_MEM_H_ +#include "macrodef.fh" +struct Meta +{ + //---------------in/out------------------- + // int * ex; + // int* Symmetry,Lev,co; //not array //in + // double * T; //not array //in + double *X, *Y, *Z; // in + double *chi, *dxx, *dyy, *dzz; // inout + double *trK; // in + double *gxy, *gxz, *gyz; // in + double *Axx, *Axy, *Axz, *Ayy, *Ayz, *Azz; // in + double *Gamx, *Gamy, *Gamz; // in + double *Lap, *betax, *betay, *betaz; // inout + double *dtSfx, *dtSfy, *dtSfz; // in + double *chi_rhs, *trK_rhs; // out + double *gxx_rhs, *gxy_rhs, *gxz_rhs; // out + double *gyy_rhs, *gyz_rhs, *gzz_rhs; // out + double *Axx_rhs, *Axy_rhs, *Axz_rhs; // out + double *Ayy_rhs, *Ayz_rhs, *Azz_rhs; // out + double *Gamx_rhs, *Gamy_rhs, *Gamz_rhs; // out + double *Lap_rhs, *betax_rhs, *betay_rhs, *betaz_rhs; // out + double *dtSfx_rhs, *dtSfy_rhs, *dtSfz_rhs; // out + double *rho, *Sx, *Sy, *Sz; // in + double *Sxx, *Sxy, *Sxz, *Syy, *Syz, *Szz; // in + + // when out, physical second kind of connection //out + double *Gamxxx, *Gamxxy, *Gamxxz; + double *Gamxyy, *Gamxyz, *Gamxzz; + double *Gamyxx, *Gamyxy, *Gamyxz; + double *Gamyyy, *Gamyyz, *Gamyzz; + double *Gamzxx, *Gamzxy, *Gamzxz; + double *Gamzyy, *Gamzyz, *Gamzzz; + + // when out, physical Ricci tensor + double *Rxx, *Rxy, *Rxz, *Ryy, *Ryz, *Rzz; // out + // double * eps; //in + double *ham_Res, *movx_Res, *movy_Res, *movz_Res; // inout + double *Gmx_Res, *Gmy_Res, *Gmz_Res; // inout + + //---------------local------------------- + + double *gxx, *gyy, *gzz, *chix, *chiy, *chiz, *gxxx, *gxyx, *gxzx, *gyyx, *gyzx, *gzzx, *gxxy, *gxyy, *gxzy, *gyyy, *gyzy, *gzzy, *gxxz, *gxyz, *gxzz, *gyyz, *gyzz, *gzzz, *Lapx, *Lapy, *Lapz, *betaxx, *betaxy, *betaxz, *betayx, *betayy, *betayz, *betazx, *betazy, *betazz, *Gamxx, *Gamxy, *Gamxz, *Gamyx, *Gamyy, *Gamyz, *Gamzx, *Gamzy, *Gamzz, *Kx, *Ky, *Kz, *div_beta, *S, *f, *fxx, *fxy, *fxz, *fyy, *fyz, *fzz, *Gamxa, *Gamya, *Gamza, *alpn1, *chin1, *gupxx, *gupxy, *gupxz, *gupyy, *gupyz, *gupzz; + + //---------------subroutine---------------- + double *fh; + double *fh2; + + /*double *SSS; + double *AAS; + double *ASA; + double *SAA; + double *ASS; + double *SAS; + double *SSA;*/ +//---------------GAUGE-------------- +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + double *reta; +#endif +}; + +//------init constant memory--------- + +// 1-----for compute_rhs_bssn--------- +__constant__ Meta metac; +__constant__ int ex_c[3]; +__constant__ double T_c; +__constant__ int Symmetry_c; +__constant__ int Lev_c; +__constant__ int co_c; +__constant__ double eps_c; +// local +__constant__ double dX; // dX,dY,dZ +__constant__ double dY; +__constant__ double dZ; +__constant__ double ZEO = 1.0; +__constant__ double ONE = 1.0; +__constant__ double TWO = 2.0; +__constant__ double FOUR = 4.0; +__constant__ double EIGHT = 8.0; +__constant__ double HALF = 0.5; +__constant__ double THR = 3.0; +__constant__ double SYM = 1.0; +__constant__ double ANTI = -1.0; +__constant__ double FF = 0.75; +__constant__ double eta = 2.0; +__constant__ double F1o3; +__constant__ double F2o3; +__constant__ double F3o2 = 1.5; +__constant__ double F1o6; +__constant__ double F8 = 8.0; +__constant__ double F16 = 16.0; +__constant__ double PI; +/*__constant__ double SSS[3] = {1,1,1}; +__constant__ double AAS[3] = {-1,-1,1}; +__constant__ double ASA[3] = {-1,1,-1}; +__constant__ double SAA[3] = {1,-1,-1}; +__constant__ double ASS[3] = {-1,1,1}; +__constant__ double SAS[3] = {1,-1,1}; +__constant__ double SSA[3] = {1,1,-1};*/ + +// 2--------for fderivs------------ +__constant__ int ijk_min[3]; +__constant__ int ijk_min2[3]; +__constant__ int ijk_min3[3]; +__constant__ int ijk_max[3]; +__constant__ double d12dxyz[3]; +__constant__ double d2dxyz[3]; + +// 3--------for fdderivs------------ +__constant__ double Sdxdx; +__constant__ double Sdydy; +__constant__ double Sdzdz; +__constant__ double Fdxdx; +__constant__ double Fdydy; +__constant__ double Fdzdz; +__constant__ double Sdxdy; +__constant__ double Sdxdz; +__constant__ double Sdydz; +__constant__ double Fdxdy; +__constant__ double Fdxdz; +__constant__ double Fdydz; + +// my own +__constant__ int STEP_SIZE; +/*__constant__ int MATRIX_SIZE; +__constant__ int MATRIX_SIZE_FH; +__constant__ int SQUARE_SIZE; +__constant__ int SQUARE_SIZE_FH; +__constant__ int LINE_SIZE_FH;*/ + +__constant__ int _1D_SIZE[4]; // start from 0 !! +__constant__ int _2D_SIZE[4]; ////start from 0 !! +__constant__ int _3D_SIZE[4]; ////start from 0 !! + +#if (GAUGE == 6 || GAUGE == 7) +__constant__ int BHN; +__constant__ double Porg[9]; +__constant__ double Mass[3]; +__constant__ double /*r1,r2*/, M, A, /*w1,w2 (== 12)*/, C1, C2; +#endif + +/**/ +#endif diff --git a/AMSS_NCKU_source/gpu_rhsSS_mem.h b/AMSS_NCKU_source/gpu_rhsSS_mem.h new file mode 100644 index 0000000..c2b4c2b --- /dev/null +++ b/AMSS_NCKU_source/gpu_rhsSS_mem.h @@ -0,0 +1,198 @@ +#ifndef GPU_MEM_H_ +#define GPU_MEM_H_ +#include "macrodef.fh" + +#ifdef WithShell +struct Metass +{ + double *crho,* sigma,* R,* + drhodx,* drhody,* drhodz,* + dsigmadx,* dsigmady,* dsigmadz,* + dRdx,* dRdy,* dRdz,* + drhodxx,* drhodxy,* drhodxz,* + drhodyy,* drhodyz,* drhodzz,* + dsigmadxx,* dsigmadxy,* dsigmadxz,* + dsigmadyy,* dsigmadyz,* dsigmadzz,* + dRdxx,* dRdxy,* dRdxz,* + dRdyy,* dRdyz,* dRdzz; + //local + double *gx,*gy,*gz,*gxx,*gxy,*gxz,*gyy,*gyz,*gzz; +}; + +__constant__ Metass metassc; +Metass * metass; + +#endif //WithShell + +struct Meta +{ + //SS + + //---------------in/out------------------- + //int * ex; + //int* Symmetry,Lev,co; //not array //in + //double * T; //not array //in + double * X,*Y,*Z; //in + double * chi,*dxx,*dyy,*dzz; //inout + double * trK ; //in + double * gxy,*gxz,*gyz; //in + double * Axx,*Axy,*Axz,*Ayy,*Ayz,*Azz; //in + double * Gamx,*Gamy,*Gamz ; //in + double * Lap, *betax, *betay, *betaz; //inout + double * dtSfx, *dtSfy, *dtSfz ; //in + double * chi_rhs,*trK_rhs ; //out + double * gxx_rhs,*gxy_rhs,*gxz_rhs; //out + double * gyy_rhs,*gyz_rhs,*gzz_rhs; //out + double * Axx_rhs,*Axy_rhs,*Axz_rhs; //out + double * Ayy_rhs,*Ayz_rhs,*Azz_rhs; //out + double * Gamx_rhs,*Gamy_rhs,*Gamz_rhs;//out + double * Lap_rhs, *betax_rhs, *betay_rhs, *betaz_rhs;//out + double * dtSfx_rhs,*dtSfy_rhs,*dtSfz_rhs;//out + double * rho,*Sx,*Sy,*Sz ; //in + double * Sxx,*Sxy,*Sxz,*Syy,*Syz,*Szz; //in + + // when out, physical second kind of connection //out + double * Gamxxx, *Gamxxy, *Gamxxz; + double * Gamxyy, *Gamxyz, *Gamxzz; + double * Gamyxx, *Gamyxy, *Gamyxz; + double * Gamyyy, *Gamyyz, *Gamyzz; + double * Gamzxx, *Gamzxy,* Gamzxz; + double * Gamzyy, *Gamzyz, *Gamzzz; + + //when out, physical Ricci tensor + double * Rxx,*Rxy,*Rxz,*Ryy,*Ryz,*Rzz; //out + //double * eps; //in + double * ham_Res, *movx_Res, *movy_Res, *movz_Res; //inout + double * Gmx_Res, *Gmy_Res, *Gmz_Res; //inout + + + //---------------local------------------- + + double * gxx,*gyy,*gzz + , *chix,*chiy,*chiz + , *gxxx,*gxyx,*gxzx,*gyyx,*gyzx,*gzzx + , *gxxy,*gxyy,*gxzy,*gyyy,*gyzy,*gzzy + , *gxxz,*gxyz,*gxzz,*gyyz,*gyzz,*gzzz + , *Lapx,*Lapy,*Lapz + , *betaxx,*betaxy,*betaxz + , *betayx,*betayy,*betayz + , *betazx,*betazy,*betazz + , *Gamxx,*Gamxy,*Gamxz + , *Gamyx,*Gamyy,*Gamyz + , *Gamzx,*Gamzy,*Gamzz + , *Kx,*Ky,*Kz,*div_beta,*S + , *f,*fxx,*fxy,*fxz,*fyy,*fyz,*fzz + , *Gamxa,*Gamya,*Gamza,*alpn1,*chin1 + , *gupxx,*gupxy,*gupxz + , *gupyy,*gupyz,*gupzz; + + //---------------subroutine---------------- + double * fh; + double * fh2; + + /*double *SSS; + double *AAS; + double *ASA; + double *SAA; + double *ASS; + double *SAS; + double *SSA;*/ + + //---------------GAUGE-------------- +#if (GAUGE == 2 || GAUGE == 3 || GAUGE == 4 || GAUGE == 5 || GAUGE == 6 || GAUGE == 7) + double * reta; +#endif + +}; + +//------init constant memory--------- + +//1-----for compute_rhs_bssn--------- +__constant__ Meta metac; + +__constant__ int ex_c[3]; +__constant__ double T_c; +__constant__ int Symmetry_c; +__constant__ int Lev_c; +__constant__ int co_c; +__constant__ double eps_c; +__constant__ int sst_c; +//local +__constant__ double dX; //dX,dY,dZ +__constant__ double dY; +__constant__ double dZ; +__constant__ double ZEO = 1.0; +__constant__ double ONE = 1.0; +__constant__ double TWO = 2.0; +__constant__ double FOUR = 4.0; +__constant__ double EIGHT = 8.0; +__constant__ double HALF = 0.5; +__constant__ double THR = 3.0; +__constant__ double SYM = 1.0; +__constant__ double ANTI = -1.0; +__constant__ double FF = 0.75; +__constant__ double eta = 2.0; +__constant__ double F1o3; +__constant__ double F2o3; +__constant__ double F3o2 = 1.5; +__constant__ double F1o6; +__constant__ double F8 = 8.0; +__constant__ double F16 = 16.0; +__constant__ double PI; +/*__constant__ double SSS[3] = {1,1,1}; +__constant__ double AAS[3] = {-1,-1,1}; +__constant__ double ASA[3] = {-1,1,-1}; +__constant__ double SAA[3] = {1,-1,-1}; +__constant__ double ASS[3] = {-1,1,1}; +__constant__ double SAS[3] = {1,-1,1}; +__constant__ double SSA[3] = {1,1,-1};*/ + +//2--------for fderivs------------ +__constant__ int ijk_min[3]; +__constant__ int ijk_min2[3]; +__constant__ int ijk_min3[3]; +__constant__ int ijk_max[3]; +__constant__ int ijk_max3[3]; +__constant__ double d12dxyz[3]; +__constant__ double d2dxyz[3]; + +//3--------for fdderivs------------ +__constant__ double Sdxdx; +__constant__ double Sdydy; +__constant__ double Sdzdz; +__constant__ double Fdxdx; +__constant__ double Fdydy; +__constant__ double Fdzdz; +__constant__ double Sdxdy; +__constant__ double Sdxdz; +__constant__ double Sdydz; +__constant__ double Fdxdy; +__constant__ double Fdxdz; +__constant__ double Fdydz; + + +//my own +__constant__ int STEP_SIZE; +/*__constant__ int MATRIX_SIZE; +__constant__ int MATRIX_SIZE_FH; +__constant__ int SQUARE_SIZE; +__constant__ int SQUARE_SIZE_FH; +__constant__ int LINE_SIZE_FH;*/ + +__constant__ int _1D_SIZE[4]; //start from 0 !! +__constant__ int _2D_SIZE[4]; ////start from 0 !! +__constant__ int _3D_SIZE[4]; ////start from 0 !! + +int h_1D_SIZE[4]; //start from 0 !! +int h_2D_SIZE[4]; ////start from 0 !! +int h_3D_SIZE[4]; ////start from 0 !! +Meta * meta; + +#if (GAUGE == 6 || GAUGE == 7) +__constant__ int BHN; +__constant__ double Porg[9]; +__constant__ double Mass[3]; +__constant__ double /*r1,r2*/,M,A,/*w1,w2 (== 12)*/,C1,C2; +#endif +/**/ +#endif diff --git a/AMSS_NCKU_source/gr.h b/AMSS_NCKU_source/gr.h new file mode 100644 index 0000000..156887d --- /dev/null +++ b/AMSS_NCKU_source/gr.h @@ -0,0 +1,40 @@ +#ifndef GR_H +#define GR_H +namespace AHFinderDirect +{ + + enum expansion_status + { + expansion_success, + + expansion_failure__surface_nonfinite, + + expansion_failure__surface_too_large, + + expansion_failure__surface_outside_grid, + + expansion_failure__surface_in_excised_region, + + expansion_failure__geometry_nonfinite, + + expansion_failure__gij_not_positive_definite // no comma + }; + + // expansion.cc + enum expansion_status + expansion(patch_system *ps_ptr, fp add_to_expansion, + bool initial_flag, + bool Jacobian_flag = false, + jtutil::norm *H_norms_ptr = NULL); + + // expansion_Jacobian.cc + enum expansion_status + expansion_Jacobian(patch_system *ps_ptr, Jacobian *Jac_ptr, + fp add_to_expansion, + bool initial_flag, + bool print_msg_flag = false); + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* GR_H */ diff --git a/AMSS_NCKU_source/horizon_sequence.C b/AMSS_NCKU_source/horizon_sequence.C new file mode 100644 index 0000000..76f3715 --- /dev/null +++ b/AMSS_NCKU_source/horizon_sequence.C @@ -0,0 +1,76 @@ +#include +#include + +#include "stdc.h" +#include "util.h" + +#include "horizon_sequence.h" + +namespace AHFinderDirect +{ + + horizon_sequence::horizon_sequence(int N_horizons_in) + : N_horizons_(N_horizons_in), + my_N_horizons_(0), // sequence starts out empty + posn_(-1), + my_hn_(new int[N_horizons_in]) + { + } + + horizon_sequence::~horizon_sequence() + { + delete[] my_hn_; + } + // + // This function appends hn to the sequence. It returns the new value + // of my_N_horizons(). + // + int horizon_sequence::append_hn(int hn) + { + assert(hn > 0); // can only append genuine horizons + assert(my_N_horizons_ < N_horizons_); // make sure there's space for it + my_hn_[my_N_horizons_++] = hn; + posn_ = 0; + return my_N_horizons_; + } + + //****************************************************************************** + + // + // This function computes the internal position immediately following + // a given internal position in the sequence. + // + // Arguments: + // p = (in) The current internal position, with posn_ semantics + // + // Results: + // This function returns the next internal position after p. + // + int horizon_sequence::next_posn(int pos) + const + { + return (pos < 0) ? pos - 1 + : (pos + 1 < my_N_horizons_) ? pos + 1 + : -1; + } + + //****************************************************************************** + + // + // This function determines whether or not a given hn is genuine. + // + bool horizon_sequence::is_hn_genuine(int hn) + const + { + for (int pos = 0; pos < my_N_horizons_; ++pos) + { + if (my_hn_[pos] == hn) + then return true; + } + + return false; + } + + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/horizon_sequence.h b/AMSS_NCKU_source/horizon_sequence.h new file mode 100644 index 0000000..5b0a825 --- /dev/null +++ b/AMSS_NCKU_source/horizon_sequence.h @@ -0,0 +1,72 @@ +#ifndef HORIZON_SEQUENCE_H +#define HORIZON_SEQUENCE_H +namespace AHFinderDirect +{ + class horizon_sequence + { + public: + int N_horizons() const { return N_horizons_; } + + int my_N_horizons() const { return my_N_horizons_; } + + bool has_genuine_horizons() const { return my_N_horizons_ > 0; } + + bool is_dummy() const { return posn_is_dummy(posn_); } + bool is_genuine() const { return posn_is_genuine(posn_); } + + bool is_next_genuine() const + { + return posn_is_genuine(next_posn(posn_)); + } + + int dummy_number() const { return is_genuine() ? 0 : -posn_; } + + int get_hn() const + { + return posn_is_genuine(posn_) ? my_hn_[posn_] : 0; + } + + bool is_hn_genuine(int hn) const; + + int init_hn() + { + posn_ = (my_N_horizons_ == 0) ? -1 : 0; + return get_hn(); + } + + int next_hn() + { + posn_ = next_posn(posn_); + return get_hn(); + } + + horizon_sequence(int N_horizons); + ~horizon_sequence(); + + int append_hn(int hn); + + private: + bool posn_is_genuine(int pos) const + { + return (pos >= 0) && (pos < my_N_horizons_); + } + bool posn_is_dummy(int pos) const + { + return !posn_is_genuine(pos); + } + + int next_posn(int pos) const; + + private: + const int N_horizons_; + int my_N_horizons_; + + int posn_; + + int *my_hn_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* HORIZON_SEQUENCE_H */ diff --git a/AMSS_NCKU_source/ilucg.f90 b/AMSS_NCKU_source/ilucg.f90 new file mode 100644 index 0000000..90c36f5 --- /dev/null +++ b/AMSS_NCKU_source/ilucg.f90 @@ -0,0 +1,522 @@ + +! adopted from J. THORNBURG's code dilucg.f + + subroutine ILUCG(N,IA,JA,A,B,X,ITEMP,RTEMP,EPS,MAXITER,ISTATUS) + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION IA(*),JA(*),A(*),B(*),X(*),ITEMP(*),RTEMP(*) +! +! INCOMPLETE LU DECOMPOSITION-CONJUGATE GRADIENT +! - -- - - +! WHERE: +! |N| IS THE NUMBER OF EQUATIONS. IF N < 0, ITEMP AND +! RTEMP CONTAIN THE ILU FROM A PREVIOUS CALL AND +! B AND X ARE THE NEW RHS AND INITIAL GUESS. +! IA IS AN INTEGER ARRAY DIMENSIONED |N|+1. IA(I) IS THE +! INDEX INTO ARRAYS JA AND A OF THE FIRST NON-ZERO +! ELEMENT IN ROW I. LET MAX=IA(|N|+1)-IA(1). +! JA IS AN INTEGER ARRAY DIMENSIONED MAX. JA(K) GIVES +! THE COLUMN NUMBER OF A(K). +! A IS A DOUBLE PRECISION ARRAY DIMENSIONED MAX. IT CONTAINS THE +! NONZERO ELEMENTS OF THE MATRIX STORED BY ROW. +! B CONTAINS THE RHS VECTOR. +! X IS A DOUBLE PRECISION ARRAY DIMENSIONED |N|. ON ENTRY, IT CONTAINS +! AN INITIAL ESTIMATE; ON EXIT, THE SOLUTION. +! ITEMP IS AN INTEGER SCRATCH ARRAY DIMENSIONED 3*(|N|+MAX)+2. +! RTEMP IS A DOUBLE PRECISION SCRATCH ARRAY DIMENSIONED 4*|N|+MAX. +! EPS IS THE CONVERGENCE CRITERIA. IT SPECIFIES THE RELATIVE +! ERROR ALLOWED IN THE SOLUTION. TO BE PRECISE, CONVERGENCE +! IS DEEMED TO HAVE OCCURED WHEN THE INFINITY-NORM OF THE +! CHANGE IN THE SOLUTION IN ONE ITERATION IS .LE. EPS * THE +! INFINITY-NORM OF THE CURRENT SOLUTION. HOWEVER, IF EPS +! .LT. 0.0D0, IT IS INTERNALLY SCALED BY THE MACHINE PRECISION, +! SO THAT, FOR EXAMPLE, EPS = -256.0D0 WILL ALLOW THE LAST 8 BITS +! OF THE SOLUTION TO BE IN ERROR. +! MAXITER GIVES THE REQUESTED NUMBER OF ITERATIONS, +! OR IS 0 FOR "NO LIMIT". +! ISTATUS IS AN INTEGER VARIABLE, WHICH IS SET TO: +! -I IF THERE IS AN ERROR IN THE MATRIX STRUCTURE IN ROW I +! (SUCH AS A ZERO ELEMENT ON THE DIAGONAL). +! 0 IF THE ITERATION FAILED TO REACH THE CONVERGENCE CRITERION +! IN ITER ITERATIONS. +! +I IF THE ITERATION CONVERGED IN I ITERATIONS. +! REFERENCE: +! D.S.KERSHAW,"THE INCOMPLETE CHOLESKY-CONJUGATE GRADIENT +! METHOD FOR INTERATIVE SOLUTION OF LINEAR EQUATIONS", +! J.COMPUT.PHYS. JAN 1978 PP 43-65 +! + LOGICAL DLU0 + NP=IABS(N) + ISTATUS=0 + IF (NP.EQ.0) GO TO 20 +! CALCULATE INDICES FOR BREAKING UP TEMPORARY ARRAYS. + N1=NP+1 + MAX=IA(N1)-IA(1) + ILU=1 + JLU=ILU+N1 + ID=JLU+MAX + IC=ID+NP + JC=IC+N1 + JCI=JC+MAX + IR=1 + IP=IR+NP + IS1=IP+NP + IS2=IS1+NP + IALU=IS2+NP + IF (N.LT.0) GO TO 10 +! DO INCOMPLETE LU DECOMPOSITION + IF (DLU0(NP,IA,JA,A,ITEMP(IC),ITEMP(JC),ITEMP(JCI),RTEMP(IALU), & + ITEMP(ILU),ITEMP(JLU),ITEMP(ID),RTEMP(IR),IERROR)) GOTO 20 +! AND DO CONJUGATE GRADIENT ITERATIONS +10 CALL DNCG0(NP,IA,JA,A,B,X,ITEMP(ILU),ITEMP(JLU),ITEMP(ID), & + RTEMP(IALU),RTEMP(IR),RTEMP(IP),RTEMP(IS1),RTEMP(IS2), & + EPS,MAXITER,ITER) +! ITER IS ACTUAL NUMBER OF ITERATIONS (NEGATIVE IF NO CONVERGENCE) + ISTATUS = ITER + IF (ITER .LT. 0) ISTATUS = 0 + RETURN +! ERROR RETURN FROM INCOMPLETE LU DECOMPOSITION +20 ISTATUS = -IERROR + RETURN + END +!------------------------------------------------------------------------------ + LOGICAL FUNCTION DLU0(N,IA,JA,A,IC,JC,JCI,ALU,ILU,JLU,ID,V,IE) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION IA(*),JA(*),A(*),IC(*),JC(*),JCI(*),ALU(*),ILU(*),JLU(*),ID(N),V(N) + LOGICAL NODIAG + COMMON /ICBD00/ ICBAD +! INCOMPLETE LU DECOMPOSITION +! WHERE: +! N,IA,JA, AND A ARE DESCRIBED IN SUBROUTINE ILUCG +! IC IS AN INTEGER ARRAY DIMENSIONED N+1, IC(J) GIVES THE +! INDEX OF THE FIRST NONZERO ELEMENT IN COLMN J IN +! ARRAY JC. +! JC IS AN INTEGER ARRAY WITH THE SAME DIMENSION AS A. +! JC(K) GIVES THE ROW NUMBER OF THE K'TH ELEMENT IN +! THE COLUMN STRUCTURE. +! JCI IS AN INTEGER ARRAY WITH THE SAME DIMENSION AS A. +! JCI(K) GIVES THE INDEX INTO ARRAY A OF THE K'TH ELEMENT +! OF THE COLUMN STRUCTURE. +! ALU HAS THE SAME DIMENSION AS A. ON EXIT, IT WILL +! CONTAIN THE INCOMPLETE LU DECOMPOSITION OF A WITH THE +! RECIPROCALS OF THE DIAGONAL ELEMENTS OF U. +! ILU AND JLU CORRESPONDS TO IA AND JA BUT FOR ALU. +! ID IS AN INTEGER ARRAY DIMENSIONED N. IT CONTAINS +! INDICES TO THE DIAGONAL ELEMENTS OF U. +! V IS A REAL SCRATCH VECTOR OF LENGTH N. +! IE GIVES THE ROW NUMBER IN ERROR IF AN ERROR OCCURED +! (RETURN VALUE .TRUE.), OR IS UNUSED IF ALL IS WELL +! (RETURN VALUE .FALSE.). +! +! RETURN VALUE = .FALSE. IF ALL IS WELL, .TRUE. IF ERROR. +! +! NOTE: DLU0 SETS ARGUMENTS IC THROUGH V. +! + ICBAD=0 +! ZERO COUNT OF ZERO DIAGONAL ELEMENTS IN U. +! +! FIRST CHECK STRUCTURE OF A AND BUILD COLUMN STRUCTURE + DO 10 I=1,N + IC(I)=0 +10 CONTINUE + DO 30 I=1,N + KS=IA(I) + KE=IA(I+1)-1 + NODIAG=.TRUE. + DO 20 K=KS,KE + J=JA(K) + IF (J.LT.1.OR.J.GT.N) GO TO 210 + IC(J)=IC(J)+1 + IF (J.EQ.I) NODIAG=.FALSE. +20 CONTINUE + IF (NODIAG) GO TO 210 +30 CONTINUE +! MAKE IC INTO INDICES + KOLD=IC(1) + IC(1)=1 + DO 40 I=1,N + KNEW=IC(I+1) + IF (KOLD.EQ.0) GO TO 210 + IC(I+1)=IC(I)+KOLD + KOLD=KNEW +40 CONTINUE +! SET JC AND JCI FOR COLUMN STRUCTURE + DO 60 I=1,N + KS=IA(I) + KE=IA(I+1)-1 + DO 50 K=KS,KE + J=JA(K) + L=IC(J) + IC(J)=L+1 + JC(L)=I + JCI(L)=K +50 CONTINUE +60 CONTINUE +! FIX UP IC + KOLD=IC(1) + IC(1)=1 + DO 70 I=1,N + KNEW=IC(I+1) + IC(I+1)=KOLD + KOLD=KNEW +70 CONTINUE +! FIND SORTED ROW STRUCTURE FROM SORTED COLUMN STRUCTURE + NP=N+1 + DO 80 I=1,NP + ILU(I)=IA(I) +80 CONTINUE +! MOVE ELEMENTS, SET JLU AND ID + DO 100 J=1,N + KS=IC(J) + KE=IC(J+1)-1 + DO 90 K=KS,KE + I=JC(K) + L=ILU(I) + ILU(I)=L+1 + JLU(L)=J + KK=JCI(K) + ALU(L)=A(KK) + IF (I.EQ.J) ID(J)=L +90 CONTINUE +100 CONTINUE +! RESET ILU (COULD JUST USE IA) + DO 110 I=1,NP + ILU(I)=IA(I) +110 CONTINUE +! FINISHED WITH SORTED COLUMN AND ROW STRUCTURE +! +! DO LU DECOMPOSITION USING GAUSSIAN ELIMINATION + DO 120 I=1,N + V(I)=0.0D0 +120 CONTINUE + DO 200 IROW=1,N + I=ID(IROW) + PIVOT=ALU(I) + IF (PIVOT.NE.0.0D0) GO TO 140 +! THIS CASE MAKES THE ILU LESS ACCURATE + ICBAD=ICBAD+1 + KS=ILU(IROW) + KE=ILU(IROW+1)-1 + DO 130 K=KS,KE + PIVOT=PIVOT+DABS(ALU(K)) +130 CONTINUE + IF (PIVOT.EQ.0.0D0) GO TO 220 +140 PIVOT=1.0D0/PIVOT + ALU(I)=PIVOT + KKS=I+1 + KKE=ILU(IROW+1)-1 + IF (KKS.GT.KKE) GO TO 160 + DO 150 K=KKS,KKE + J=JLU(K) + V(J)=ALU(K) +150 CONTINUE +! FIX L IN COLUMN IROW AND DO PARTIAL LU IN SUBMATRIX +160 KS=IC(IROW) + KE=IC(IROW+1)-1 + DO 190 K=KS,KE + I=JC(K) + IF (I.LE.IROW) GO TO 190 + LS=ILU(I) + LE=ILU(I+1)-1 + DO 180 L=LS,LE + J=JLU(L) + IF (J.LT.IROW) GO TO 180 + IF (J.GT.IROW) GO TO 170 + AMULT=ALU(L)*PIVOT + ALU(L)=AMULT + IF (AMULT.EQ.0.0) GO TO 190 + GO TO 180 +170 IF (V(J).EQ.0.0D0) GO TO 180 + ALU(L)=ALU(L)-AMULT*V(J) +180 CONTINUE +190 CONTINUE +! RESET V + IF (KKS.GT.KKE) GO TO 200 + DO 195 K=KKS,KKE + J=JLU(K) + V(J)=0.0D0 +195 CONTINUE +200 CONTINUE +! NORMAL RETURN + DLU0 = .FALSE. + RETURN +! ERROR RETURNS +210 IE=I + DLU0 = .TRUE. + RETURN +220 IE=IROW + DLU0 = .TRUE. + RETURN + END +!------------------------------------------------------------------------------------- + SUBROUTINE DNCG0(N,IA,JA,A,B,X,ILU,JLU,ID,ALU,R,P,S1,S2,EPS,ITER,IE) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION IA(*),JA(*),A(*),B(N),X(N),ILU(*),JLU(*),ALU(*),ID(N),R(N),P(N),S1(N),S2(N) +! NONSYMMETRIC CONJUGATE GRADIENT +! WHERE: +! N,IA,JA,A,B, AND X ARE DESCRIBED IN SUBROUTINE DILUCG. +! ILU GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW OF LU. +! JLU GIVES COLUMN NUMBER. +! ID GIVES INDEX OF DIAGONAL ELEMENT OF U. +! ALU HAS NONZERO ELEMENTS OF LU MATRIX STORED BY ROW +! WITH RECIPROCALS OF DIAGONAL ELEMENTS OF U. +! R,P,S1, AND S2 ARE VECTORS OF LENGTH N USED IN THE +! ITERATIONS. +! EPS IS CONVERGENCE CRITERIA. (DESCRIBED IN SUBROUTINE +! DILUCG). +! ITER IS MAX NUMBER OF ITERATIONS, OR 0 FOR "NO LIMIT". +! IE GIVES ACTUAL NUMBER OF ITERATIONS, NEGATIVE IF +! NO CONVERGENCE. +! +! R0=B-A*X0 + CALL DMUL10(N,IA,JA,A,X,R) + DO 10 I=1,N + R(I)=B(I)-R(I) +10 CONTINUE +! P0=(UT*U)(-1)*AT*(L*LT)(-1)*R0 +! FIRST SOLVE L*LT*S1=R0 + CALL DSUBL0(N,ILU,JLU,ID,ALU,R,S1) +! TIMES TRANSPOSE OF A + CALL DMUL20(N,IA,JA,A,S1,S2) +! THEN SOLVE UT*U*P=S2 + CALL DSUBU0(N,ILU,JLU,ID,ALU,S2,P) + IE=0 + RDOT = DGVV(R,S1,N) +! LOOP BEGINS HERE +20 CALL DMUL30(N,ILU,JLU,ID,ALU,P,S2) + + PDOT = DGVV(P,S2,N) + + IF (PDOT.EQ.0.0D0) RETURN + + ALPHA=RDOT/PDOT + XMAX=0.0D0 + XDIF=0.0D0 + DO 30 I=1,N + AP=ALPHA*P(I) + X(I)=X(I)+AP + AP=DABS(AP) + XX=DABS(X(I)) + IF (AP.GT.XDIF) XDIF=AP + IF (XX.GT.XMAX) XMAX=XX +30 CONTINUE + IE=IE+1 + IF ((EPS .GT. 0.0D0) .AND. (XDIF .LE. EPS * XMAX)) RETURN + IF ((EPS .LT. 0.0D0) .AND. (XMAX + XDIF/DABS(EPS) .EQ. XMAX)) RETURN +! +! EXCEEDED ITERATION LIMIT? +! + IF ((ITER .NE. 0) .AND. (IE .GE. ITER)) GO TO 60 + CALL DMUL10(N,IA,JA,A,P,S2) + DO 40 I=1,N + R(I)=R(I)-ALPHA*S2(I) +40 CONTINUE + CALL DSUBL0(N,ILU,JLU,ID,ALU,R,S1) + RRDOT = DGVV(R,S1,N) + BETA=RRDOT/RDOT + RDOT=RRDOT + CALL DMUL20(N,IA,JA,A,S1,S2) + CALL DSUBU0(N,ILU,JLU,ID,ALU,S2,S1) + DO 50 I=1,N + P(I)=S1(I)+BETA*P(I) +50 CONTINUE + GO TO 20 +60 IE=-IE + RETURN + END +!------------------------------------------------------------------------------------------------------ + SUBROUTINE DMUL10(N,IA,JA,A,B,X) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION IA(*),JA(*),A(*),B(N),X(N) +! MULTIPLY A TIMES B TO GET X +! WHERE: +! N IS THE ORDER OF THE MATRIX +! IA GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW +! JA GIVES COLUMN NUMBER +! A CONTAINS THE NONZERO ELEMENTS OF THE NONSYMMETRIC +! MATRIX STORED BY ROW +! B IS THE VECTOR +! X IS THE PRODUCT (MUST BE DIFFERENT FROM B) + + DO 20 I=1,N + KS=IA(I) + KE=IA(I+1)-1 + SUM=0.0D0 + DO 10 K=KS,KE + J=JA(K) + SUM=SUM+A(K)*B(J) +10 CONTINUE + X(I)=SUM +20 CONTINUE + RETURN + END +!-------------------------------------------------------------------------------------------------------- + SUBROUTINE DMUL20(N,IA,JA,A,B,X) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION IA(*),JA(*),A(*),B(N),X(N) +! MULTIPLY TRANSPOSE OF A TIMES B TO GET X +! WHERE: +! N IS THE ORDER OF THE MATRIX +! IA GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW +! JA GIVES COLUMN NUMBER +! A CONTAINS THE NONZERO ELEMENTS OF THE NONSYMMETRIC +! MATRIX STORED BY ROW +! B IS THE VECTOR +! X IS THE PRODUCT (MUST BE DIFFERENT FROM B) + + DO 10 I=1,N + X(I)=0.0D0 +10 CONTINUE + DO 30 I=1,N + KS=IA(I) + KE=IA(I+1)-1 + BB=B(I) + DO 20 K=KS,KE + J=JA(K) + X(J)=X(J)+A(K)*BB +20 CONTINUE +30 CONTINUE + RETURN + END +!--------------------------------------------------------------------------------------------------------- + SUBROUTINE DMUL30(N,ILU,JLU,ID,ALU,B,X) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION ILU(*),JLU(*),ID(*),ALU(*),B(N),X(N) +! MULTIPLY TRANSPOSE OF U TIMES U TIMES B TO GET X +! WHERE: +! N IS THE ORDER OF THE MATRIX +! ILU GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW OF LU +! JLU GIVES COLUMN NUMBER +! ID GIVES INDEX OF DIAGONAL ELEMENT OF U +! ALU HAS NONZERO ELEMENTS OF LU MATRIX STORED BY ROW +! WITH RECIPROCALS OF DIAGONAL ELEMENTS +! B IS THE VECTOR +! X IS THE PRODUCT UT*U*B (X MUST BE DIFFERENT FROM B) + + DO 10 I=1,N + X(I)=0.0D0 +10 CONTINUE + DO 50 I=1,N + KS=ID(I)+1 + KE=ILU(I+1)-1 + DIAG=1.0D0/ALU(KS-1) + XX=DIAG*B(I) + IF (KS.GT.KE) GO TO 30 + DO 20 K=KS,KE + J=JLU(K) + XX=XX+ALU(K)*B(J) +20 CONTINUE +30 X(I)=X(I)+DIAG*XX + IF (KS.GT.KE) GO TO 50 + DO 40 K=KS,KE + J=JLU(K) + X(J)=X(J)+ALU(K)*XX +40 CONTINUE +50 CONTINUE + RETURN + END +!---------------------------------------------------------------------------------------------------------- + SUBROUTINE DSUBU0(N,ILU,JLU,ID,ALU,B,X) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION ILU(*),JLU(*),ID(*),ALU(*),B(N),X(N) +! DO FORWARD AND BACK SUBSTITUTION TO SOLVE UT*U*X=B +! WHERE: +! N IS THE ORDER OF THE MATRIX +! ILU GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW OF LU +! JLU GIVES COLUMN NUMBER +! ID GIVES INDEX OF DIAGONAL ELEMENT OF U +! ALU HAS NONZERO ELMENTS OF LU MATRIX STORED BY ROW +! WITH RECIPROCALS OF DIAGONAL ELEMENTS OF U +! B IS THE RHS VECTOR +! X IS THE SOLUTION VECTOR + + NP=N+1 + DO 10 I=1,N + X(I)=B(I) +10 CONTINUE +! FORWARD SUBSTITUTION + DO 30 I=1,N + KS=ID(I)+1 + KE=ILU(I+1)-1 + XX=X(I)*ALU(KS-1) + X(I)=XX + IF (KS.GT.KE) GO TO 30 + DO 20 K=KS,KE + J=JLU(K) + X(J)=X(J)-ALU(K)*XX +20 CONTINUE +30 CONTINUE +! BACK SUBSTITUTION + DO 60 II=1,N + I=NP-II + KS=ID(I)+1 + KE=ILU(I+1)-1 + SUM=0.0D0 + IF (KS.GT.KE) GO TO 50 + DO 40 K=KS,KE + J=JLU(K) + SUM=SUM+ALU(K)*X(J) +40 CONTINUE +50 X(I)=(X(I)-SUM)*ALU(KS-1) +60 CONTINUE + RETURN + END +!-------------------------------------------------------------------------------------------------------------- + SUBROUTINE DSUBL0(N,ILU,JLU,ID,ALU,B,X) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION ILU(*),JLU(*),ID(*),ALU(*),B(N),X(N) +! DO FORWARD AND BACK SUBSTITUTION TO SOLVE L*LT*X=B +! WHERE: +! N IS THE ORDER OF THE MATRIX +! ILU GIVES INDEX OF FIRST NONZERO ELEMENT IN ROW LU +! JLU GIVES THE COLUMN NUMBER +! ID GIVES INDEX OF DIAGONAL ELEMENT OF U +! ALU HAS NONZERO ELEMENTS OF LU MATRIX STORED BY ROW +! DIAGONAL ELEMENTS OF L ARE 1.0 AND NOT STORED +! B IS THE RHS VECTOR +! X IS THE SOLUTION VECTOR + + NP=N+1 + DO 10 I=1,N + X(I)=B(I) +10 CONTINUE +! FORWARD SUBSTITUTION + DO 30 I=1,N + KS=ILU(I) + KE=ID(I)-1 + IF (KS.GT.KE) GO TO 30 + SUM=0.0D0 + DO 20 K=KS,KE + J=JLU(K) + SUM=SUM+ALU(K)*X(J) +20 CONTINUE + X(I)=X(I)-SUM +30 CONTINUE +! BACK SUBSTITUTION + DO 50 II=1,N + I=NP-II + KS=ILU(I) + KE=ID(I)-1 + IF (KS.GT.KE) GO TO 50 + XX=X(I) + IF (XX.EQ.0.0) GO TO 50 + DO 40 K=KS,KE + J=JLU(K) + X(J)=X(J)-ALU(K)*XX +40 CONTINUE +50 CONTINUE + RETURN + END +!------------------------------------------------------------------------------------------------------------------ + DOUBLE PRECISION FUNCTION DGVV(V,W,N) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION V(N),W(N) +! SUBROUTINE TO COMPUTE DOUBLE PRECISION VECTOR DOT PRODUCT. + + SUM = 0.0D0 + DO 10 I = 1,N + SUM = SUM + V(I)*W(I) +10 CONTINUE + DGVV = SUM + RETURN + END diff --git a/AMSS_NCKU_source/ilucg.h b/AMSS_NCKU_source/ilucg.h new file mode 100644 index 0000000..d4d41df --- /dev/null +++ b/AMSS_NCKU_source/ilucg.h @@ -0,0 +1,24 @@ + +#ifndef ILUCG_H +#define ILUCG_H + +#ifdef fortran1 +#define f_ilucg ilucg +#endif +#ifdef fortran2 +#define f_ilucg ILUCG +#endif +#ifdef fortran3 +#define f_ilucg ilucg_ +#endif + +extern "C" +{ + void f_ilucg(const int &N, + const int *IA, const int *JA, const double *A, + const double *B, double *X, + int *ITEMP, double *RTEMP, + const double &EPS, const int &ITER, int &ISTATUS); +} + +#endif /* ILUCG_H */ diff --git a/AMSS_NCKU_source/initial_guess.C b/AMSS_NCKU_source/initial_guess.C new file mode 100644 index 0000000..b39b37a --- /dev/null +++ b/AMSS_NCKU_source/initial_guess.C @@ -0,0 +1,132 @@ +#include +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" +#include "myglobal.h" + +namespace AHFinderDirect +{ + extern struct state state; + //****************************************************************************** + + // ellipsoid has global-coordinates center (A,B,C), radius (a,b,c) + // angular coordinate system has center (U,V,W) + // + // direction cosines wrt angular coordinate center are (xcos,ycos,zcos) + // i.e. a point has coordinates (U+xcos*r, V+ycos*r, W+zcos*r) + // + // then the equation of the ellipsoid is + // (U+xcos*r - A)^2 (V+ycos*r - B)^2 (W+zcos*r - C)^2 + // ----------------- + ---------------- + ----------------- = 1 + // a^2 b^2 c^2 + // + // to solve this, we introduce intermediate variables + // AU = A - U + // BV = B - V + // CW = C - W + // + void setup_initial_guess(patch_system &ps, + fp x_center, fp y_center, fp z_center, + fp x_radius, fp y_radius, fp z_radius) + { + for (int pn = 0; pn < ps.N_patches(); ++pn) + { + patch &p = ps.ith_patch(pn); + + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + fp xcos, ycos, zcos; + p.xyzcos_of_rho_sigma(rho, sigma, xcos, ycos, zcos); + + // set up variables used by Maple-generated code + const fp AU = x_center - ps.origin_x(); + const fp BV = y_center - ps.origin_y(); + const fp CW = z_center - ps.origin_z(); + const fp a = x_radius; + const fp b = y_radius; + const fp c = z_radius; + + // compute the solutions r_plus and r_minus + fp r_plus, r_minus; + { + fp t1, t2, t3, t5, t6, t7, t9, t10, t12, t28; + fp t30, t33, t35, t36, t40, t42, t43, t48, t49, t52; + fp t55; + t1 = a * a; + t2 = b * b; + t3 = t1 * t2; + t5 = t3 * zcos * CW; + t6 = c * c; + t7 = t1 * t6; + t9 = t7 * ycos * BV; + t10 = t2 * t6; + t12 = t10 * xcos * AU; + t28 = xcos * xcos; + t30 = CW * CW; + t33 = BV * BV; + t35 = t10 * t28; + t36 = ycos * ycos; + t40 = AU * AU; + t42 = t7 * t36; + t43 = zcos * zcos; + t48 = t3 * t43; + t49 = -2.0 * t1 * zcos * CW * ycos * BV - 2.0 * t2 * zcos * CW * xcos * AU - 2.0 * t6 * ycos * BV * xcos * AU + t2 * t28 * t30 + t6 * t28 * t33 - t35 + t1 * t36 * t30 + t6 * t36 * t40 - t42 + t1 * t43 * t33 + t2 * t43 * t40 - + t48; + t52 = sqrt(-t3 * t6 * t49); + t55 = 1 / (t35 + t42 + t48); + r_plus = (t5 + t9 + t12 + t52) * t55; + r_minus = (t5 + t9 + t12 - t52) * t55; + } + + // exactly one of the solutions (call it r) should be positive + fp r; + if ((r_plus > 0.0) && (r_minus < 0.0)) + then r = r_plus; + else if ((r_plus < 0.0) && (r_minus > 0.0)) + then r = r_minus; + else if (state.my_proc == 0) + printf("\nsetup_coord_ellipsoid():\nexpected exactly one r>0 solution to quadratic, got 0 or 2!\n%s patch (irho,isigma)=(%d,%d) ==> (rho,sigma)=(%g,%g)\ndirection cosines (xcos,ycos,zcos)=(%g,%g,%g)\nr_plus=%g r_minus=%g\n==> this probably means the initial guess surface doesn't contain\nthe local origin point, or more generally that the initial\nguess surface isn't a Strahlkoerper (\"star-shaped region\")\nwith respect to the local origin point\n", p.name(), irho, isigma, double(rho), double(sigma), double(xcos), double(ycos), double(zcos), double(r_plus), double(r_minus)); + + // r = horizon radius at this grid point + p.ghosted_gridfn(gfns::gfn__h, irho, isigma) = r; + } + } + } + } + + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/initial_maxwell.f90 b/AMSS_NCKU_source/initial_maxwell.f90 new file mode 100644 index 0000000..7ee6f0d --- /dev/null +++ b/AMSS_NCKU_source/initial_maxwell.f90 @@ -0,0 +1,977 @@ + +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n charged black holes +!PRD 80, 104022 +!----------------------------------------------------------------------------------- + + subroutine get_initial_nbhsem(ext,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,& + Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi,& + Mass,Qchar,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ext + real*8, dimension(ext(1)), intent(in) :: X + real*8, dimension(ext(2)), intent(in) :: Y + real*8, dimension(ext(3)), intent(in) :: Z + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: chi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass,Qchar + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ext(1),ext(2),ext(3))::psi,phi + integer :: i,j,k,bhi + real*8 :: M,Q,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0,FOUR=4.d0 + real*8,parameter::TINYRR=1.d-14 +!sanity check: M/Q = constant + M = mass(1) + Q = Qchar(1) + u1 = M/Q + u2 = M/Q + do bhi=2,N + M = mass(bhi) + Q = Qchar(bhi) + u1 = min(u1,M/Q) + u2 = max(u2,M/Q) + enddo + if(u2-u1.gt.TINYRR)then + write(*,*)"error in initial_punctureem.f90: get_initial_nbhsem; we need constant Mi/Qi, but" + write(*,*)"Mass = ",mass + write(*,*)"Qchar = ",Qchar + stop + endif + + do k = 1,ext(3) + do j = 1,ext(2) + do i = 1,ext(1) +! black hole 1 + M = mass(1) + Q = Qchar(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + phi(i,j,k) = Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Q*nx/rr/rr + Ey(i,j,k) = Q*ny/rr/rr + Ez(i,j,k) = Q*nz/rr/rr +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + Q = Qchar(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + phi(i,j,k) = phi(i,j,k) + Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Ex(i,j,k) + Q*nx/rr/rr + Ey(i,j,k) = Ey(i,j,k) + Q*ny/rr/rr + Ez(i,j,k) = Ez(i,j,k) + Q*nz/rr/rr + enddo + enddo + enddo + enddo + + psi = dsqrt(psi**2 - phi*phi/FOUR) + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + Ex = Ex / psi + Ey = Ey / psi + Ez = Ez / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Bx = ZEO + By = ZEO + Bz = ZEO + + Kpsi = ZEO + Kphi = ZEO + + return + + end subroutine get_initial_nbhsem +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n charged black holes +!PRD 80, 104022 +! for shell +!----------------------------------------------------------------------------------- + + subroutine get_initial_nbhsem_ss(ext,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,& + Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi,& + Mass,Qchar,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ext + real*8, dimension(ext(1),ext(2),ext(3)), intent(in) :: X,Y,Z + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: chi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass,Qchar + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ext(1),ext(2),ext(3))::psi,phi + integer :: i,j,k,bhi + real*8 :: M,Q,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0,FOUR=4.d0 + real*8,parameter::TINYRR=1.d-14 +!sanity check: M/Q = constant + M = mass(1) + Q = Qchar(1) + u1 = M/Q + u2 = M/Q + do bhi=2,N + M = mass(bhi) + Q = Qchar(bhi) + u1 = min(u1,M/Q) + u2 = max(u2,M/Q) + enddo + if(u2-u1.gt.TINYRR)then + write(*,*)"error in initial_punctureem.f90: get_initial_nbhsem; we need constant Mi/Qi, but" + write(*,*)"Mass = ",mass + write(*,*)"Qchar = ",Qchar + stop + endif + + do k = 1,ext(3) + do j = 1,ext(2) + do i = 1,ext(1) +! black hole 1 + M = mass(1) + Q = Qchar(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + phi(i,j,k) = Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Q*nx/rr/rr + Ey(i,j,k) = Q*ny/rr/rr + Ez(i,j,k) = Q*nz/rr/rr +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + Q = Qchar(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + phi(i,j,k) = phi(i,j,k) + Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Ex(i,j,k) + Q*nx/rr/rr + Ey(i,j,k) = Ey(i,j,k) + Q*ny/rr/rr + Ez(i,j,k) = Ez(i,j,k) + Q*nz/rr/rr + enddo + enddo + enddo + enddo + + psi = dsqrt(psi**2 - phi*phi/FOUR) + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + Ex = Ex / psi + Ey = Ey / psi + Ez = Ez / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Bx = ZEO + By = ZEO + Bz = ZEO + + Kpsi = ZEO + Kphi = ZEO + + return + + end subroutine get_initial_nbhsem_ss +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n charged black holes +!aided with Ansorg's solver +!----------------------------------------------------------------------------------- + + subroutine get_ansorg_nbhs_em(ext,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,& + Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi,& + Mass,Qchar,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ext + real*8, dimension(ext(1)), intent(in) :: X + real*8, dimension(ext(2)), intent(in) :: Y + real*8, dimension(ext(3)), intent(in) :: Z + real*8, dimension(ext(1),ext(2),ext(3)), intent(inout) :: chi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass,Qchar + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ext(1),ext(2),ext(3))::psi,phi + integer :: i,j,k,bhi + real*8 :: M,Q,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0,FOUR=4.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ext(3) + do j = 1,ext(2) + do i = 1,ext(1) +! black hole 1 + M = mass(1) + Q = Qchar(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + chi(i,j,k) + HLF*M/rr + phi(i,j,k) = Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Q*nx/rr/rr + Ey(i,j,k) = Q*ny/rr/rr + Ez(i,j,k) = Q*nz/rr/rr +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + Q = Qchar(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + phi(i,j,k) = phi(i,j,k) + Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Ex(i,j,k) + Q*nx/rr/rr + Ey(i,j,k) = Ey(i,j,k) + Q*ny/rr/rr + Ez(i,j,k) = Ez(i,j,k) + Q*nz/rr/rr + enddo + enddo + enddo + enddo + + psi = dsqrt(psi**2 - phi*phi/FOUR) + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + Ex = Ex / psi + Ey = Ey / psi + Ez = Ez / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Bx = ZEO + By = ZEO + Bz = ZEO + + Kpsi = ZEO + Kphi = ZEO + + return + + end subroutine get_ansorg_nbhs_em +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n charged black holes +!aided with Ansorg's solver +! for shell +!----------------------------------------------------------------------------------- + + subroutine get_ansorg_nbhs_ss_em(ext,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,& + Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi,& + Mass,Qchar,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ext + real*8, dimension(ext(1),ext(2),ext(3)), intent(in) :: X,Y,Z + real*8, dimension(ext(1),ext(2),ext(3)), intent(inout) :: chi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Ex,Ey,Ez,Bx,By,Bz,Kpsi,Kphi + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ext(1),ext(2),ext(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass,Qchar + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ext(1),ext(2),ext(3))::psi,phi + integer :: i,j,k,bhi + real*8 :: M,Q,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0,FOUR=4.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ext(3) + do j = 1,ext(2) + do i = 1,ext(1) +! black hole 1 + M = mass(1) + Q = Qchar(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + chi(i,j,k) + HLF*M/rr + phi(i,j,k) = Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Q*nx/rr/rr + Ey(i,j,k) = Q*ny/rr/rr + Ez(i,j,k) = Q*nz/rr/rr +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + Q = Qchar(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + phi(i,j,k) = phi(i,j,k) + Q/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Ex(i,j,k) = Ex(i,j,k) + Q*nx/rr/rr + Ey(i,j,k) = Ey(i,j,k) + Q*ny/rr/rr + Ez(i,j,k) = Ez(i,j,k) + Q*nz/rr/rr + enddo + enddo + enddo + enddo + + psi = dsqrt(psi**2 - phi*phi/FOUR) + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + Ex = Ex / psi + Ey = Ey / psi + Ez = Ez / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Bx = ZEO + By = ZEO + Bz = ZEO + + Kpsi = ZEO + Kphi = ZEO + + return + + end subroutine get_ansorg_nbhs_ss_em diff --git a/AMSS_NCKU_source/initial_maxwell.h b/AMSS_NCKU_source/initial_maxwell.h new file mode 100644 index 0000000..e00f8ee --- /dev/null +++ b/AMSS_NCKU_source/initial_maxwell.h @@ -0,0 +1,76 @@ + +#ifndef GET_INITIAL_MAXWELL_H +#define GET_INITIAL_MAXWELL_H + +#ifdef fortran1 +#define f_get_initial_nbhsem get_initial_nbhsem +#define f_get_initial_nbhsem_ss get_initial_nbhsem_ss +#define f_get_ansorg_nbhs_em get_ansorg_nbhs_em +#define f_get_ansorg_nbhs_ss_em get_ansorg_nbhs_ss_em +#endif +#ifdef fortran2 +#define f_get_initial_nbhsem GET_INITIAL_NBHSEM +#define f_get_initial_nbhsem_ss GET_INITIAL_NBHSEM_SS +#define f_get_ansorg_nbhs_em GET_ANSORG_NBHS_EM +#define f_get_ansorg_nbhs_ss_em GET_ANSORG_NBHS_SS_EM +#endif +#ifdef fortran3 +#define f_get_initial_nbhsem get_initial_nbhsem_ +#define f_get_initial_nbhsem_ss get_initial_nbhsem_ss_ +#define f_get_ansorg_nbhs_em get_ansorg_nbhs_em_ +#define f_get_ansorg_nbhs_ss_em get_ansorg_nbhs_ss_em_ +#endif + +extern "C" +{ + void f_get_initial_nbhsem(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_initial_nbhsem_ss(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_ansorg_nbhs_em(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_ansorg_nbhs_ss_em(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, int &); +} + +#endif /* GET_INITIAL_MAXWELL_H */ diff --git a/AMSS_NCKU_source/initial_null.f90 b/AMSS_NCKU_source/initial_null.f90 new file mode 100644 index 0000000..848191c --- /dev/null +++ b/AMSS_NCKU_source/initial_null.f90 @@ -0,0 +1,1869 @@ + + +#include "macrodef.fh" + + subroutine get_initial_nbhs_null(ex,crho,sigma,x,RJ,IJ,omega,sst,Rmin) + + implicit none +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3),sst + real*8,intent(in ) :: Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::x + double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::RJ,IJ,omega + +!~~~~~~> Other variables: + real*8 :: xe + real*8,dimension(ex(1),ex(2)) :: RJe,IJe + integer :: k + + xe = x(1) + RJe = RJ(:,:,1) + IJe = IJ(:,:,1) + + do k=1,ex(3) + RJ(:,:,k) = RJe*(1.d0-x(k))*xe/(1-xe)/x(k) + IJ(:,:,k) = IJe*(1.d0-x(k))*xe/(1-xe)/x(k) + enddo + + omega = 1.d0 + + return + + end subroutine get_initial_nbhs_null +!----------------------------------- +!Eq.(10) of CQG 24, S327 (2007) +!---------------------------------- + function Zslm(s,l,m,the,phi) result(gont) + implicit none + integer,intent(in) :: s,l,m + real*8,intent(in) :: the,phi + + double complex :: Yslm,gont,II + + II=dcmplx(0.d0,1.d0) + + if(m>0)then + gont = Yslm(s,l,m,the,phi) + if(m/2*2==m)then + gont = gont+Yslm(s,l,-m,the,phi) + else + gont = gont-Yslm(s,l,-m,the,phi) + endif + gont = gont/dsqrt(2.d0) + elseif(m<0)then + gont = -Yslm(s,l,-m,the,phi) + if(m/2*2==m)then + gont = gont+Yslm(s,l,m,the,phi) + else + gont = gont-Yslm(s,l,m,the,phi) + endif + gont = II*gont/dsqrt(2.d0) + else + gont = Yslm(s,l,m,the,phi) + endif + + return + + end function Zslm + +!#define SCH + +#ifdef SCH + +subroutine get_initial_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ + +RJ = 0.d0 +IJ = 0.d0 + +return + +end subroutine get_initial_null +!------------------------- + subroutine get_null_boundary(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + + integer :: k + k=1 + + beta(:,:,k) = 0.d0 + W(:,:,k) =-2.d0/R(k)**2/Rmin**2*(1.d0-R(k))**2 + + RQ(:,:,k) = 0.d0 + IQ(:,:,k) = 0.d0 + + RTheta(:,:,k) = 0.d0 + ITheta(:,:,k) = 0.d0 + + RU(:,:,k) = 0.d0 + IU(:,:,k) = 0.d0 + + return + + end subroutine get_null_boundary +!------------------------------------------------------------- +subroutine get_exact_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +RJ = 0.d0 +IJ = 0.d0 + +return + +end subroutine get_exact_null +!------------------------------------------------------------------------------------------- + subroutine get_null_boundary_c(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + + integer :: k + + do k=1,ex(3) + + beta(:,:,k) = 0.d0 + W(:,:,k) =-2.d0/R(k)**2/Rmin**2*(1.d0-R(k))**2 + + RQ(:,:,k) = 0.d0 + IQ(:,:,k) = 0.d0 + + RTheta(:,:,k) = 0.d0 + ITheta(:,:,k) = 0.d0 + + RU(:,:,k) = 0.d0 + IU(:,:,k) = 0.d0 + enddo + + return + + end subroutine get_null_boundary_c + +#else + +#if 0 +! for some trival check +#if 1 +!------------------------------------------------------------- +! Linear wave given in CQG 24S327 +!------------------------------------------------------------- +subroutine get_initial_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ + +integer :: i,j,k +real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma +double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + gr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*gr-C2/1.2d1*gr**3 + gr = dreal(Jr) + Jr = Yslm(0,2,m,gt,gp) + RJ(i,j,k) = gr*dreal(Jr) + IJ(i,j,k) = gr*dimag(Jr) + +#if 0 + RJ(i,j,k) = 0.25d0*dsqrt(5.d0/3.1415926)*(3/(1.d0+tgrho*tgrho+tgsigma*tgsigma)-1.d0) + IJ(i,j,k) = 0.d0 +#endif + enddo + enddo + enddo + +return + +end subroutine get_initial_null +#else +! for check usage +subroutine get_initial_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ + +real*8 :: thetac,thetas,sr,ss,cr,cs,srss,crcs,tcts,tcts2 +real*8 :: sr2,ss2,cr2,cs2,tc2,ts2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma + +real*8 :: PI + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + srss = sr*ss + crcs = cr*cs + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + thetac = dsqrt((1.d0-srss)/2.d0) + thetas = dsqrt((1.d0+srss)/2.d0) + tc2 = thetac*thetac + ts2 = thetas*thetas + tcts = thetac*thetas + tcts2 = tcts*tcts +! q^Aq^B@_A@_B Y20 + RJ(i,j,k) =-1.5d0*dsqrt(5.d0/PI)*sr*ss*(4.d0*cr2*cs2+cs2+cr2) + IJ(i,j,k) = 3.d0*dsqrt(5.d0/PI)*thetac*thetas*(cs2-cr2) + +! @_rho@_rho Y20 + RJ(i,j,k) = 1.5d0*dsqrt(5.d0/PI)*cs2*cs2*(-cr2*cs2+2*cr2*cr2*cs2-2*cr2*cr2-cs2+3*cr2) & + /(3*cr2*cs2*cs2*cs2-3*cr2*cr2*cr2*cs2*cs2-3*cr2*cr2*cs2*cs2*cs2+ & + cr2*cr2*cr2*cs2*cs2*cs2-3*cr2*cr2*cs2-cs2*cs2*cs2-cr2*cr2*cr2+ & + 3*cs2*cr2*cr2*cr2+6*cr2*cr2*cs2*cs2-3*cs2*cs2*cr2) + IJ(i,j,k) = 0.d0 +! q^Aq^B h_AB + RJ(i,j,k) = 0.d0 + IJ(i,j,k) = 0.d0 + enddo + enddo + enddo + +return + +end subroutine get_initial_null +#endif +#endif +!====================================================================================== +!------------------------------------------------------------- +! Linear wave given in CQG 24S327 +!------------------------------------------------------------- +subroutine get_initial_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ + +integer :: i,j,k +real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +double complex :: swtf,ff + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + gr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*gr-C2/1.2d1*gr**3 + gr = dreal(Jr) + Jr = Yslm(2,2,m,gt,gp) + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*gr*Jr*swtf**2 + RJ(i,j,k) = dreal(ff) + IJ(i,j,k) = dimag(ff) + + enddo + enddo + enddo + +return + +end subroutine get_initial_null +!============================================================================================== + +#if 0 +! for checking derivs_eth and dderivs_eth +!------------------------- + subroutine get_null_boundary(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + + double complex,dimension(ex(1),ex(2)) :: Y20,dY20,ddY20,f + integer :: i,j,k + real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma + double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + k=1 + do i=1,ex(1) + do j=1,ex(2) +! fake global coordinate is enough + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + RTheta(i,j,k) = dreal(Jr*nu*(II*dcos(nu*T)-dsin(nu*T))) + f(i,j) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0*hgr& + +C1/2.d0*hgr*hgr+II*nu*C2/3.d0*hgr**3+C2/4.d0*hgr**4 + RU(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + +! Re(r^2*Ul_,r*exp(i nu T)) of CQG 24S327, (12) indeed + Jr = -2.d0*beta0-C1*hgr-II*nu*C2*hgr**2-C2*hgr**3 + RQ(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0*hgr& + -nu*nu*C2*hgr*hgr+II*nu*C2*hgr**3+C2/2.d0*hgr**4 + W(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Y20(i,j) = Yslm(0,2,m,gt,gp) + + enddo + enddo + + call derivs_eth(ex(1:2),crho,sigma,Y20,dY20,0,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call dderivs_eth(ex(1:2),crho,sigma,Y20,ddY20,0,1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k),& + dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), & + bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), & + dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k)) + + beta(:,:,k) = dreal(beta0*(dcos(nu*T)+II*dsin(nu*T)))*dreal(Y20) + W(:,:,k) = W(:,:,k)*dreal(Y20) + + f = dexp(-2.d0*beta(:,:,k))*(f*ddY20*RQ(:,:,k)*dconjg(dY20)+dsqrt(1.d0+abs(f*ddY20))*RQ(:,:,k)*dY20) + RQ(:,:,k) = dreal(f) + IQ(:,:,k) = dimag(f) + + f = ddY20*RTheta(:,:,k) + RTheta(:,:,k) = dreal(f) + ITheta(:,:,k) = dimag(f) + + f = dY20*RU(:,:,k) + RU(:,:,k) = dreal(f) + IU(:,:,k) = dimag(f) + + return + + end subroutine get_null_boundary +#else +!------------------------- + subroutine get_null_boundary(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + k=1 + do i=1,ex(1) + do j=1,ex(2) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*nu*(II*dcos(nu*T)-dsin(nu*T))) + Jr = Yslm(2,2,m,gt,gp) + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr*swtf**2 + RTheta(i,j,k) = dreal(ff) + ITheta(i,j,k) = dimag(ff) + + rf = dreal(Yslm(0,2,m,gt,gp)) + beta(i,j,k) = rf*dreal(beta0*(dcos(nu*T)+II*dsin(nu*T))) + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0*hgr& + -nu*nu*C2*hgr*hgr+II*nu*C2*hgr**3+C2/2.d0*hgr**4 + W(i,j,k) = rf*dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0*hgr& + +C1/2.d0*hgr*hgr+II*nu*C2/3.d0*hgr**3+C2/4.d0*hgr**4 + rf = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + Jr = Yslm(1,2,m,gt,gp) + ff = dsqrt(dble(2*(2+1)))*rf*Jr*swtf + RU(i,j,k) = dreal(ff) + IU(i,j,k) = dimag(ff) + + Jr = -2.d0*beta0-C1*hgr-II*nu*C2*hgr**2-C2*hgr**3 + rf = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + Jr = Yslm(1,2,m,gt,gp) + ff = dsqrt(dble(2*(2+1)))*rf*Jr*swtf !! U_,r + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + Jr = Yslm(2,2,m,gt,gp) + Jr = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr*swtf**2 !! J + rf = dsqrt(1.d0+abs(Jr)**2) !! K + ff = dexp(-2.d0*beta(i,j,k))*(Jr*dconjg(ff)+rf*ff) + RQ(i,j,k) = dreal(ff) + IQ(i,j,k) = dimag(ff) + + enddo + enddo + + return + + end subroutine get_null_boundary + +#endif + +#if 0 +! for checking dderivs_eth +!------------------------------------------------------------- +! Linear wave given in CQG 24S327 +!------------------------------------------------------------- +subroutine get_exact_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +double complex,dimension(ex(1),ex(2)) :: Y20,ddY20,f +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma +double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_null: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + Y20(i,j) = Yslm(0,2,m,gt,gp) + RJ(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + IJ(i,j,k) = 0.d0 + + enddo + enddo + enddo + + k=1 + call dderivs_eth(ex(1:2),crho,sigma,Y20,ddY20,0,1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k),& + dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), & + bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), & + dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k)) + + do k=1,ex(3) + f = ddY20*RJ(:,:,k) + RJ(:,:,k) = dreal(f) + IJ(:,:,k) = dimag(f) + enddo + +return + +end subroutine get_exact_null + +#else +!------------------------------------------------------------- +! Linear wave given in CQG 24S327 +!------------------------------------------------------------- +subroutine get_exact_null(ex,crho,sigma,R,RJ,IJ,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RJ,IJ +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_null: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + hgr = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + Jr = Yslm(2,2,m,gt,gp) + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*hgr*Jr*swtf**2 + RJ(i,j,k) = dreal(ff) + IJ(i,j,k) = dimag(ff) + enddo + enddo + enddo + +return + +end subroutine get_exact_null + +#endif + +#if 0 +! for checking derivs_eth and dderivs_eth +!------------------------- + subroutine get_null_boundary_c(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + + double complex,dimension(ex(1),ex(2)) :: Y20,dY20,ddY20,f + integer :: i,j,k + real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma + double complex :: Yslm,II,Jr + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + +! write(*,*) abs(II) confirms abs == cabs + + do k=1,ex(3) + do i=1,ex(1) + do j=1,ex(2) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary_c: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + RTheta(i,j,k) = dreal(Jr*nu*(II*dcos(nu*T)-dsin(nu*T))) + f(i,j) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0*hgr& + +C1/2.d0*hgr*hgr+II*nu*C2/3.d0*hgr**3+C2/4.d0*hgr**4 + RU(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + +! Re(r^2*Ul_,r*exp(i nu T)) of CQG 24S327, (12) indeed + Jr = -2.d0*beta0-C1*hgr-II*nu*C2*hgr**2-C2*hgr**3 + RQ(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0*hgr& + -nu*nu*C2*hgr*hgr+II*nu*C2*hgr**3+C2/2.d0*hgr**4 + W(i,j,k) = dreal(Jr*(dcos(nu*T)+II*dsin(nu*T))) + + Y20(i,j) = Yslm(0,2,m,gt,gp) + + enddo + enddo + + call derivs_eth(ex(1:2),crho,sigma,Y20,dY20,0,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k)) + call dderivs_eth(ex(1:2),crho,sigma,Y20,ddY20,0,1,1, & + quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k),& + dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), & + bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), & + dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k)) + + beta(:,:,k) = dreal(beta0*cdexp(II*nu*T))*dreal(Y20) + W(:,:,k) = W(:,:,k)*dreal(Y20) + + f = dexp(-2.d0*beta(:,:,k))*(f*ddY20*RQ(:,:,k)*dconjg(dY20)+dsqrt(1.d0+abs(f*ddY20))*RQ(:,:,k)*dY20) + RQ(:,:,k) = dreal(f) + IQ(:,:,k) = dimag(f) + + f = ddY20*RTheta(:,:,k) + RTheta(:,:,k) = dreal(f) + ITheta(:,:,k) = dimag(f) + + f = dY20*RU(:,:,k) + RU(:,:,k) = dreal(f) + IU(:,:,k) = dimag(f) + enddo + + return + + end subroutine get_null_boundary_c + +#else + +!------------------------- + subroutine get_null_boundary_c(ex,crho,sigma,R,beta,RQ,IQ,RU,IU,W,RTheta,ITheta, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: beta,RQ,IQ,RU,IU + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: W,RTheta,ITheta + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + +#if 0 +real*8 :: betax,KK,KKx,Wx +double complex :: CJ,DCJ,CJx,CJxx,DCJx,CU,CUx,DCU,DCUx,bDCU,bDCUx,CB,DCB,bDCB,CBx +double complex :: Cnu,Cnux,Ck,fCTheta,fCThetax,Theta_rhs + + +T=0.25d0 + i=1 + j=1 + k=1 + hgr = 1.d0 + beta(i,j,k) = dreal(beta0*cdexp(II*nu*T)) + CB = beta(i,j,k) + DCB = CB + bDCB = CB + betax = 0.d0 + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0/hgr& + -nu*nu*C2/hgr/hgr+II*nu*C2/hgr**3+C2/2.d0/hgr**4 + W(i,j,k) = dreal(Jr*cdexp(II*nu*T)) + Jr = -(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0/hgr**2& + +2.d0*nu*nu*C2/hgr**3-3.d0*II*nu*C2/hgr**4-2.d0*C2/hgr**5 + Wx = dreal(Jr*cdexp(II*nu*T))*(Rmin+hgr)**2/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0/hgr-C2/1.2d1/hgr**3 + CJ = dreal(Jr*cdexp(II*nu*T)) + fCTheta = dreal(Jr*II*nu*cdexp(II*nu*T)) + DCJ=CJ + KK = dsqrt(1.d0+cdabs(CJ)**2) + Jr = -C1/4.d0/hgr**2+C2/4.d0/hgr**4 + rf = dreal(Jr*cdexp(II*nu*T)) + CJx = rf*(Rmin+hgr)**2/Rmin + fCThetax = dreal(Jr*II*nu*cdexp(II*nu*T))*(Rmin+hgr)**2/Rmin + Jr = C1/2.d0/hgr**3-C2/hgr**5 + rf = dreal(Jr*cdexp(II*nu*T)) + CJxx = rf*(Rmin+hgr)**4/Rmin**2+2.d0*(Rmin+hgr)/Rmin*CJx + DCJx = CJx + KKx = dreal(CJ*dconjg(CJx))/KK + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0/hgr& + +C1/2.d0/hgr/hgr+II*nu*C2/3.d0/hgr**3+C2/4.d0/hgr**4 + CU = dreal(Jr*cdexp(II*nu*T)) + bDCU = CU + DCU=CU + Jr = -2.d0*beta0/hgr/hgr-C1/hgr**3-II*nu*C2/hgr**4-C2/hgr**5 + rf = dreal(Jr*cdexp(II*nu*T)) + CUx = rf*(Rmin+hgr)**2/Rmin + DCUx=CUx + bDCUx=CUx + + Cnu = CJ + Cnux = CJx + Ck = 0.d0 + hgr = hgr/(Rmin+hgr) + + + call getndxs(T,crho(i),sigma(j),hgr,beta(i,j,k),KK,CU,bDCU,DCU, & + CB,DCB,W(i,j,k),CJ,DCJ,bDCB,Cnu,Ck,fCTheta,sst,Rmin) + call getdxs(T,crho(i),sigma(j),hgr,betax,KKx,CUx,DCUx,bDCUx, & + Wx,CJx,CJxx,DCJx,Cnux,fCThetax,sst,Rmin) +! write(*,*) 2.d0*hgr*(1.d0-hgr)*fCThetax-(-(hgr*(1-hgr)*DCUx+2.d0*DCU)+2.d0/hgr/Rmin*(1.d0-hgr)*DCB & +! +(1.d0-hgr)**3/Rmin*(2.d0*CJx+hgr*CJxx)-2.d0*fCTheta) +! stop + write(*,*) fCThetax-Theta_rhs(hgr,Rmin,beta(i,j,k),betax,KK,KKx,CU,CUx,DCUx,bDCU,bDCUx, & + DCU,CB,DCB,W(i,j,k),Wx,CJ,DCJ, & + CJx,CJxx,DCJx,bDCB,Cnu,Cnux,Ck,fCTheta) + stop +#endif + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*nu*II*cdexp(II*nu*T)) + Jr = Yslm(2,2,m,gt,gp)*swtf**2 + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr + RTheta(i,j,k) = dreal(ff) + ITheta(i,j,k) = dimag(ff) + + rf = dreal(Yslm(0,2,m,gt,gp)) + beta(i,j,k) = rf*dreal(beta0*cdexp(II*nu*T)) + Jr = (2.4d1*II*nu*beta0-3.d0*nu*nu*C1+nu**4*C2)/6.d0+(3.d0*II*nu*C1-6.d0*beta0-II*nu**3*C2)/3.d0*hgr& + -nu*nu*C2*hgr*hgr+II*nu*C2*hgr**3+C2/2.d0*hgr**4 + W(i,j,k) = rf*dreal(Jr*cdexp(II*nu*T)) + + Jr = (-2.4d1*II*nu*beta0+3.d0*nu*nu*C1-nu**4*C2)/36.d0+2.d0*beta0*hgr& + +C1/2.d0*hgr*hgr+II*nu*C2/3.d0*hgr**3+C2/4.d0*hgr**4 + rf = dreal(Jr*cdexp(II*nu*T)) + Jr = Yslm(1,2,m,gt,gp)*swtf + ff = dsqrt(dble(2*(2+1)))*rf*Jr + RU(i,j,k) = dreal(ff) + IU(i,j,k) = dimag(ff) + + Jr = -2.d0*beta0-C1*hgr-II*nu*C2*hgr**2-C2*hgr**3 + rf = dreal(Jr*cdexp(II*nu*T)) + Jr = Yslm(1,2,m,gt,gp)*swtf + ff = dsqrt(dble(2*(2+1)))*rf*Jr !! U_,r + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*cdexp(II*nu*T)) + Jr = Yslm(2,2,m,gt,gp)*swtf**2 + Jr = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr !! J + rf = dsqrt(1.d0+cdabs(Jr)**2) !! K + ff = dexp(-2.d0*beta(i,j,k))*(Jr*dconjg(ff)+rf*ff) + RQ(i,j,k) = dreal(ff) + IQ(i,j,k) = dimag(ff) + + enddo + enddo + enddo + + return + + end subroutine get_null_boundary_c +#endif + +!========================================================== +subroutine initial_null_paramter(beta0,C1,C2,nu,m) + +implicit none + +double complex,intent(out) :: beta0,C1,C2 +integer,intent(out) :: nu,m + +nu=1 +m=0 +beta0 = dcmplx(0.d0,1.d-6) +C1 = dcmplx(3.d-6,0.d0) +C2 = dcmplx(1.d-6,0.d0) + +end subroutine initial_null_paramter + +#if 1 +subroutine get_exact_null_theta(ex,crho,sigma,R,RTheta,ITheta,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RTheta,ITheta +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_null_theta: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + hgr = dreal(Jr*nu*(-dsin(nu*T)+II*dcos(nu*T))) + Jr = Yslm(2,2,m,gt,gp) + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*hgr*Jr*swtf**2 + RTheta(i,j,k) = dreal(ff) + ITheta(i,j,k) = dimag(ff) + + enddo + enddo + enddo + +return + +end subroutine get_exact_null_theta +!------------------------------------------------------------------------------------------------ +subroutine get_exact_null_theta_x(ex,crho,sigma,R,RThetax,IThetax,sst,Rmin,T, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin,T +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RThetax,IThetax +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 +real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +! fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_null_theta_x: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = C1/4.d0-C2/1.2d1*3*hgr**2 + Jr = -Jr/Rmin/R(k)/R(k) + hgr = dreal(Jr*nu*(-dsin(nu*T)+II*dcos(nu*T))) + Jr = Yslm(2,2,m,gt,gp) + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*hgr*Jr*swtf**2 + RThetax(i,j,k) = dreal(ff) + IThetax(i,j,k) = dimag(ff) + + enddo + enddo + enddo + +return + +end subroutine get_exact_null_theta_x +!------------------------- + subroutine get_exact_Jul(ex,crho,sigma,R,RJul,IJul, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: RJul,IJul + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_Jul: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = C1/4.d0-C2/4.d0*hgr**2 + rf = dreal(Jr*nu*II*cdexp(II*nu*T)) + Jr = Yslm(2,2,m,gt,gp)*swtf**2 + ff = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr + RJul(i,j,k) = dreal(ff) + IJul(i,j,k) = dimag(ff) + + enddo + enddo + enddo + + return + + end subroutine get_exact_Jul +!------------------------- + subroutine get_fake_Ju(ex,crho,sigma,R,RJul,IJul, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: RJul,IJul + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_fake_Ju: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*nu*II*cdexp(II*nu*T)) + ff = dcmplx(rf,0.d0) + RJul(i,j,k) = dreal(ff) + IJul(i,j,k) = dimag(ff) + + enddo + enddo + enddo + +if(sst == 0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then + write(*,*)"T=",T,"exp(i T)=",cdexp(II*nu*T) + write(*,*)RJul(ex(1)/2,ex(2)/2,ex(3)),RJul(ex(1)/2,ex(2)/2,ex(3)-1),R(2)-R(1) +endif + + return + + end subroutine get_fake_Ju +!------------------------- + subroutine get_exact_omegau(ex,crho,sigma,R,omegau, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: omegau + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_omegau: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*nu*II*cdexp(II*nu*T)) + Jr = Yslm(0,2,m,gt,gp) + ff = -dble(2*(2+1))/2.d0*rf*Jr + omegau(i,j,k) = dreal(ff) + + enddo + enddo + enddo + + return + + end subroutine get_exact_omegau +!------------------------- + subroutine get_exact_eth2omega(ex,crho,sigma,R,Reth2omega,Ieth2omega, & + quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, & + gR,gI, & + dquR1,dquR2,dquI1,dquI2, & + bdquR1,bdquR2,bdquI1,bdquI2, & + dgR,dgI,bdgR,bdgI,T,Rmin,sst) + + implicit none + +!~~~~~~% Input parameters: + integer,intent(in) :: ex(3),sst + real*8,intent(in) :: T,Rmin + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: Reth2omega,Ieth2omega + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: quR1,quR2,quI1,quI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: qlR1,qlR2,qlI1,qlI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: gR,gI + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dquR1,dquR2,dquI1,dquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: bdquR1,bdquR2,bdquI1,bdquI2 + real*8,intent(in),dimension(ex(1),ex(2),ex(3)) :: dgR,dgI,bdgR,bdgI + +integer :: i,j,k +real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf +double complex :: Yslm,II,Jr,swtf,ff + +double complex :: beta0,C1,C2 +integer :: nu,m + + call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) +!fake global coordinate is enough here + hgr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_exact_eth2omega: not recognized sst = ",sst + return + end select + gt = dacos(z/hgr) + gp = datan2(y,x) + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + hgr = (1.d0-R(k))/R(k)/Rmin + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*hgr-C2/1.2d1*hgr**3 + rf = dreal(Jr*cdexp(II*nu*T)) + Jr = Yslm(2,2,m,gt,gp) + ff = -dble(2*(2+1))/2.d0*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*rf*Jr + Reth2omega(i,j,k) = dreal(ff) + Ieth2omega(i,j,k) = dimag(ff) + + enddo + enddo + enddo + + return + + end subroutine get_exact_eth2omega +#endif +#endif diff --git a/AMSS_NCKU_source/initial_null.h b/AMSS_NCKU_source/initial_null.h new file mode 100644 index 0000000..36d11fd --- /dev/null +++ b/AMSS_NCKU_source/initial_null.h @@ -0,0 +1,100 @@ + +#ifndef INITIAL_NULL_H +#define INITIAL_NULL_H + +#ifdef fortran1 +#define f_get_initial_nbhs_null get_initial_nbhs_null +#define f_get_initial_null get_initial_null +#define f_get_exact_null get_exact_null +#define f_get_exact_null_theta get_exact_null_theta +#define f_get_null_boundary get_null_boundary +#define f_get_null_boundary_c get_null_boundary_c +#define f_get_exact_omegau get_exact_omegau +#endif +#ifdef fortran2 +#define f_get_initial_nbhs_null GET_INITIAL_NBHS_NULL +#define f_get_initial_null GET_INITIAL_NULL +#define f_get_exact_null GET_EXACT_NULL +#define f_get_exact_null_theta GET_EXACT_NULL_THETA +#define f_get_null_boundary GET_NULL_BOUNDARY +#define f_get_null_boundary_c GET_NULL_BOUNDARY_C +#define f_get_exact_omegau GET_EXACT_OMEGAU +#endif +#ifdef fortran3 +#define f_get_initial_nbhs_null get_initial_nbhs_null_ +#define f_get_initial_null get_initial_null_ +#define f_get_exact_null get_exact_null_ +#define f_get_exact_null_theta get_exact_null_theta_ +#define f_get_null_boundary get_null_boundary_ +#define f_get_null_boundary_c get_null_boundary_c_ +#define f_get_exact_omegau get_exact_omegau_ +#endif + +extern "C" +{ + void f_get_initial_nbhs_null(int *, double *, double *, double *, + double *, double *, double *, + int &, double &); +} + +extern "C" +{ + void f_get_initial_null(int *, double *, double *, double *, + double *, double *, + int &, double &); +} + +extern "C" +{ + void f_get_null_boundary(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double &, double &, int &); +} + +extern "C" +{ + void f_get_null_boundary_c(int *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double &, double &, int &); +} + +extern "C" +{ + void f_get_exact_null(int *, double *, double *, double *, + double *, double *, int &, double &, double &, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + void f_get_exact_null_theta(int *, double *, double *, double *, + double *, double *, int &, double &, double &, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + void f_get_exact_omegau(int *, double *, double *, double *, + double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, + double &, double &, int &); +} + +#endif /* INITIAL_NULL_H */ diff --git a/AMSS_NCKU_source/initial_null2.f90 b/AMSS_NCKU_source/initial_null2.f90 new file mode 100644 index 0000000..3489e3b --- /dev/null +++ b/AMSS_NCKU_source/initial_null2.f90 @@ -0,0 +1,1320 @@ + + +#include "macrodef.fh" + +subroutine get_RT_parameters(m0o,Pp0o,Pm0o,apo,amo,bpo,bmo,cpo,cmo,gamo) +implicit none +real*8,intent(out) :: m0o,Pp0o,Pm0o,apo,amo,bpo,bmo,cpo,cmo,gamo + +real*8,parameter::m0=1.d0,Pp0=1.d0,Pm0=1.d0,ap=1.d0,am=1.d0 +real*8,parameter::bp=0.d0,bm=0.d0,cp=0.d0,cm=0.d0 +real*8,parameter::gam=0.5d0 + +m0o = m0 +Pp0o = Pp0 +Pm0o = Pm0 +apo = ap +amo = am +bpo = bp +bmo = bm +cpo = cp +cmo = cm +gamo = gam +end subroutine get_RT_parameters +!!!--------------------------------------------------------------------------------------------- + function boostbhP(P0,gam,a,b,c,gt,gp) result(gont) + implicit none + +!~~~~~~> Input parameters: + + real*8, intent(in ):: P0,gam,a,b,c,gt,gp + + real*8::gont + + gont = dcosh(gam)+a*dsinh(gam)*dcos(gt)+dsinh(gam)*dsin(gt)*(b*dcos(gp)+c*dsin(gp)) + + gont = P0*gont + + end function boostbhP +!!!!------------------------------------------------------------------------------------------- +#if 1 +!! RT ID +subroutine get_initial_null2(ex,crho,sigma,XX,g22,g23,g33,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g22,g23,g33 + +double precision,dimension(ex(3))::R +real*8 :: sr,ss,cr,cs +real*8 :: sr2,ss2,cr2,cs2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma +real*8 ::x,y,z,gr,gt,gp +real*8,dimension(ex(1),ex(2),ex(3))::P + +real*8 :: PI + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +real*8::boostbhP + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = XX*Rmin/(1-XX) + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + g22(i,j,k) = 1-sr2*ss2 + g22(i,j,k) = 1/g22(i,j,k)/g22(i,j,k) + + g23(i,j,k) = -sr*cr*ss*cs*g22(i,j,k) + g33(i,j,k) = cr2*g22(i,j,k) + g22(i,j,k) = cs2*g22(i,j,k) + +! we want g_AB/r^2 instead of g_AB +! g22(i,j,k) = R(k)*R(k)*g22(i,j,k) +! g23(i,j,k) = R(k)*R(k)*g23(i,j,k) +! g33(i,j,k) = R(k)*R(k)*g33(i,j,k) + +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null2: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + P(i,j,k) = 1/(1/dsqrt(boostbhP(Pp0,gam,ap,bp,cp,gt,gp))+1/dsqrt(boostbhP(Pm0,gam,am,bm,cm,gt,gp)))**2 + + enddo + enddo + enddo + + g22 = g22/P**2 + g23 = g23/P**2 + g33 = g33/P**2 + +return + +end subroutine get_initial_null2 +#else +!! fake RT for test +subroutine get_initial_null2(ex,crho,sigma,XX,g22,g23,g33,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g22,g23,g33 + +double precision,dimension(ex(3))::R +real*8 :: sr,ss,cr,cs +real*8 :: sr2,ss2,cr2,cs2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma +real*8 ::x,y,z,gr,gt,gp +real*8,dimension(ex(1),ex(2),ex(3))::P + +real*8 :: PI + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +real*8::boostbhP + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = XX*Rmin/(1-XX) + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + g22(i,j,k) = 1-sr2*ss2 + g22(i,j,k) = 1/g22(i,j,k)/g22(i,j,k) + + g23(i,j,k) = -sr*cr*ss*cs*g22(i,j,k) + g33(i,j,k) = cr2*g22(i,j,k) + g22(i,j,k) = cs2*g22(i,j,k) + +! we want g_AB/r^2 instead of g_AB +! g22(i,j,k) = R(k)*R(k)*g22(i,j,k) +! g23(i,j,k) = R(k)*R(k)*g23(i,j,k) +! g33(i,j,k) = R(k)*R(k)*g33(i,j,k) + +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null2: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + P(i,j,k) = 1/(1/dsqrt(boostbhP(Pp0,gam,ap,bp,cp,gt,gp))+1/dsqrt(boostbhP(Pm0,gam,am,bm,cm,gt,gp)))**2 + + enddo + enddo + enddo + + g22 = P + +return + +end subroutine get_initial_null2 +#endif +!!------------------------------------------------------------------------------------------------------------ +subroutine std_covdiff(rho,sigma,fs,fr,fss,frr,frs,covf) +implicit none +! argument variables +real*8,intent(in) :: rho,sigma,fs,fr,fss,frr,frs +real*8,intent(out):: covf + +real*8 :: t1,t2,t3,t4,t5,t6,t7,t8,t11,t12,t13,t15,t16,t19,t20 +real*8 :: t27,t28,t29,t32,t33,t34,t38,t39,t51,t54,t55,t58,t59 +real*8 :: t62,t71,t72,t88,t90,t91,t92,t93,t94,t95,t97,t98,t99 +real*8 :: t100,t104,t107,t108,t109,t112,t113,t117,t118,t121,t128,t132,t133,t136,t137,t140,t141 +real*8 :: t144,t152,t153,t154,t155,t160,t166,t169,t172,t175,t178,t181,t187,t199,t204,t205,t208 +real*8 :: t209,t216,t217,t223,t226,t227,t243,t250,t256,t267,t276,t284,t287,t290,t301,t303,t306 +real*8 :: t307,t310,t313,t314,t316,t319,t323,t326,t329,t338,t346,t356,t359,t368,t371,t376,t377 +real*8 :: t380,t385,t387,t391,t394,t398,t401,t404,t407,t412,t415,t420,t427,t450,t451,t456,t459 +real*8 :: t486,t487,t511,t516,t522,t532,t537,t546,t575,t586,t591,t595,t599,t295,t298 + + t1 = cos(sigma); + t2 = t1*t1; + t3 = t2*t2; + t4 = t3*t2; + t5 = t4*fss; + t6 = 2.0*sigma; + t7 = cos(t6); + t8 = t7*t7; + t11 = cos(rho); + t12 = t11*t11; + t13 = t12*t11; + t15 = sin(rho); + t16 = fr*t15; + t19 = t12*t12; + t20 = t19*t13; + t27 = t19*t11; + t28 = t27*fr; + t29 = t15*t8; + t32 = 2.0*rho; + t33 = cos(t32); + t34 = t33*t33; + t38 = t11*fr; + t39 = t15*t3; + t51 = t19*frr; + t54 = t19*t12; + t55 = t54*frr; + t58 = -2.0*t5*t8-8.0*t2*t13*t16-64.0*t3*t20*t16+32.0*t4*t20*t16+4.0*t28*t29 & + +4.0*t28*t15*t34-4.0*t38*t39+8.0*t3*t13*t16+32.0*t4*t13*t16+8.0*t2*t27*t16 & + +4.0*t51*t2-2.0*t55*t34; + t59 = t3*fss; + t62 = t12*frr; + t71 = t19*t19; + t72 = t71*frr; + t88 = -32.0*t59*t54+2.0*t62*t3-2.0*t55*t8+64.0*t55*t4-2.0*t5*t34-32.0*t72*t2 & + +64.0*t72*t3-32.0*t72*t4-4.0*t55*t2-4.0*t51*t3-62.0*t55*t3+60.0*t3*t27*t16; + t90 = sin(t32); + t91 = sin(t6); + t92 = t90*t91; + t93 = t92*frs; + t94 = t3*t8; + t95 = t94*t34; + t97 = t3*t1; + t98 = t97*fs; + t99 = sin(sigma); + t100 = t98*t99; + t104 = t2*fss; + t107 = t54*fr; + t108 = t90*t33; + t109 = t108*t2; + t112 = t19*t8; + t113 = t112*t34; + t117 = t12*fr; + t118 = t108*t3; + t121 = t12*t3; + t128 = t19*t2; + t132 = t3*t3; + t133 = t132*fss; + t136 = t93*t95-4.0*t100-32.0*t51*t4+2.0*t104*t19+8.0*t107*t109+t93*t113-62.0*t5*t19 & + -4.0*t117*t118+2.0*t93*t121*t8+32.0*t2*t20*t16+2.0*t93*t128*t8-32.0*t133*t12; + t137 = t3*t19; + t140 = t2*t8; + t141 = t140*t34; + t144 = t8*t34; + t152 = t107*t91; + t153 = t90*t99; + t154 = t2*t1; + t155 = t153*t154; + t160 = t33*t3*t8; + t166 = frs*t19; + t169 = t19*fr; + t172 = frs*t3; + t175 = t107*t90; + t178 = -t93*t137*t8-4.0*t55*t141-2.0*t93*t128*t144+2.0*t62*t95+t93*t137*t144+16.0*t152*t155 & + +4.0*t117*t90*t160+4.0*t107*t108*t8-t92*t166*t8+8.0*t169*t118-t92*t172*t34+4.0*t175*t160; + t181 = t169*t90; + t187 = t33*t2*t8; + t199 = frs*t2; + t204 = fs*t3*t154; + t205 = t19*t99; + t208 = fs*t154; + t209 = t54*t99; + t216 = -8.0*t181*t160-4.0*t107*t118-8.0*t175*t187-t93*t137*t34+4.0*t51*t141+2.0*t93*t128*t34 & + -4.0*t51*t95+2.0*t92*t199*t12-64.0*t204*t205+32.0*t208*t209-64.0*t98*t209+32.0*t204*t209; + t217 = t99*t8; + t223 = t1*fs; + t226 = t4*fs; + t227 = t91*t7; + t243 = t12*t99; + t250 = 4.0*t98*t217+4.0*t98*t99*t34-4.0*t223*t205-4.0*t226*t227-64.0*t4*t27*t16+2.0*t93*t121*t34 & + -t92*t166*t34-2.0*t93*t121*t144+8.0*t208*t205+8.0*t98*t243+60.0*t98*t205+32.0*t204*t243; + t256 = t2*t34; + t267 = t3*t34; + t276 = -8.0*t208*t243+t92*t172+t92*t166-4.0*t51*t256-4.0*t51*t140+4.0*t51*t94+2.0*t55*t144 & + -2.0*t62*t94-2.0*t62*t267-2.0*t55*t94+4.0*t55*t140+4.0*t51*t267; + t284 = fs*t91*t33; + t287 = t243*t34; + t290 = t205*t34; + t295 = fs*t27*t15; + t298 = t92*t4; + t301 = t92*t3; + t303 = fs*t13*t15; + t306 = t208*t99; + t307 = t144*t12; + t310 = t227*t19; + t313 = t3*fs; + t314 = t313*t91; + t316 = t7*t19*t34; + t319 = 4.0*t55*t256-2.0*t55*t267+2.0*t55*t95-32.0*t137*t284-8.0*t98*t287+4.0*t98*t290 & + -8.0*t92*t2*t295-8.0*t298*t295-16.0*t301*t303-8.0*t306*t307-4.0*t226*t310-8.0*t314*t316; + t323 = t217*t12; + t326 = t227*t12; + t329 = t226*t91; + t338 = t7*t12*t34; + t346 = t2*fs; + t356 = 8.0*t208*t323+8.0*t226*t326+4.0*t329*t316+8.0*t208*t287+4.0*t226*t227*t34+8.0*t314*t338 & + -16.0*t92*t199*t54-8.0*t329*t338-4.0*t346*t310+8.0*t313*t310-8.0*t313*t326+4.0*t346*t91*t316; + t359 = t205*t8; + t368 = t153*t97; + t371 = t169*t91; + t376 = t13*fr; + t377 = t29*t2; + t380 = t376*t15; + t385 = t4*t12; + t387 = fr*t7*t90; + t391 = t15*t2*t34; + t394 = 8.0*t181*t187+4.0*t98*t359-8.0*t169*t109-8.0*t152*t153*t1-8.0*t117*t91*t368+16.0*t371*t368 & + -8.0*t152*t368+8.0*t376*t377-8.0*t380*t141-16.0*t371*t155-16.0*t385*t387+8.0*t376*t391; + t398 = t4*t54; + t401 = t3*t54; + t404 = t2*t54; + t407 = t4*t19; + t412 = t39*t8; + t415 = t28*t15; + t420 = t39*t34; + t427 = -32.0*t137*t387-16.0*t398*t387+32.0*t401*t387-16.0*t404*t387+32.0*t407*t387-8.0*t28*t377 & + -8.0*t376*t412-4.0*t415*t95+4.0*t28*t412+4.0*t38*t420+4.0*t28*t420-8.0*t28*t391; + t450 = t2*t12; + t451 = t450*t34; + t456 = -8.0*t376*t420+8.0*t415*t141+8.0*t380*t95-4.0*t28*t29*t34+4.0*t38*t412-8.0*t208*t290 & + +32.0*t92*t172*t54+32.0*t401*t284-4.0*t100*t113+4.0*t223*t290-2.0*t93*t451-16.0*t398*t284; + t459 = frs*t4; + t486 = -16.0*t92*t459*t12+32.0*t407*t284-4.0*t98*t217*t34+2.0*t55-16.0*t385*t284-16.0*t404*t284 & + -2.0*t104*t112-8.0*t208*t359-8.0*t98*t323-t92*t172*t8+4.0*t223*t359+32.0*t92*t459*t19; + t487 = t19*t34; + t511 = t140*t12; + t516 = 4.0*t59*t487+8.0*t306*t113+8.0*t100*t307-2.0*t5*t487-4.0*t223*t99*t113+16.0*t298*t303 & + -8.0*t298*fs*t11*t15+16.0*t301*t295+2.0*t104*t113+4.0*t59*t307-2.0*t93*t511-4.0*t59*t113; + t522 = t8*t12; + t532 = t144*t450; + t537 = t12*t34; + t546 = 2.0*t5*t113-4.0*t5*t307-4.0*t59*t522+2.0*t5-31.0*t92*t172*t19-2.0*t92*t199*t19+2.0*t93*t532 & + -2.0*t5*t112+4.0*t5*t537-4.0*t59*t537+2.0*t5*t144+4.0*t5*t522; + t575 = 4.0*t59*t112-2.0*t104*t487-4.0*t107*t108-4.0*t38*t15*t95-16.0*t92*t459*t54-2.0*t92*t172*t12 & + -4.0*t5*t12+4.0*t59*t12+64.0*t5*t54+64.0*t133*t19-32.0*t133*t54-4.0*t59*t19-4.0*t415; + t586 = t34*t34; + t591 = t8*t8; + t595 = 256.0*t137-32.0*t450+32.0*t451+32.0*t511-32.0*t532+1.0-2.0*t34+t586-2.0*t8+4.0*t144 & + -2.0*t8*t586+t591-2.0*t591*t34+t591*t586; + covf = -8.0*(t58+t88+t136+t178+t216+t250+t276+t319+t356+t394+t427+t456+t486+t516+t546+t575)/t595; + +return + +end subroutine std_covdiff +!!------------------------------------------------------------------------------------------------------------ +!! input g_AB and Theta_AB are divided by r^2 indeed +!! input g_00 is also divided by r^2 indeed +! the output g00 is K +#if 1 +subroutine get_gauge_g00_K(ex,crho,sigma,X,g22,g23,g33, & + Theta22,Theta23,Theta33, g00, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::Theta22,Theta23,Theta33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g00 + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) +det = g22*g33-g23*g23 +gup22 = g33/det +gup23 = -g23/det +gup33 = g22/det + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + tg22 = 1-sr2*ss2 + tg22 = 1/tg22/tg22 + + tg23 = -sr*cr*ss*cs*tg22 + tg33 = cr2*tg22 + tg22 = cs2*tg22 + +! ghat/(g/r^4) indeed + det(i,j,k) = (tg22*tg33-tg23*tg23)/det(i,j,k) + enddo + enddo + enddo + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + call rderivs_x_point(ex(1),crho,det(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,det(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,det(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,det(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,det(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + KK(i,j,k) = dsqrt(det(i,j,k))*(1-0.25*covf/R(k)**2) + enddo + enddo + enddo + + g00 = KK + + return + +end subroutine get_gauge_g00_K +! the input g00 is K +subroutine get_gauge_g00(ex,crho,sigma,X,g22,g23,g33, & + Theta22,Theta23,Theta33, g00, Rmin,fp) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),fp +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Theta22,Theta23,Theta33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g00 + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) +det = g22*g33-g23*g23 +gup22 = g33/det +gup23 = -g23/det +gup33 = g22/det + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + tg22 = 1-sr2*ss2 + tg22 = 1/tg22/tg22 + + tg23 = -sr*cr*ss*cs*tg22 + tg33 = cr2*tg22 + tg22 = cs2*tg22 + + Theta22(i,j,k) = tg22/6/m0 + Theta23(i,j,k) = tg23/6/m0 + Theta33(i,j,k) = tg33/6/m0 + enddo + enddo + enddo + + KK = g00 + + if(fp == 0)then + k = 1 + do i=1,ex(1) + do j=1,ex(2) + + call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + Theta22(i,j,k) = covf*Theta22(i,j,k) + Theta23(i,j,k) = covf*Theta23(i,j,k) + Theta33(i,j,k) = covf*Theta33(i,j,k) + enddo + enddo + else + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + Theta22(i,j,k) = covf*Theta22(i,j,k) + Theta23(i,j,k) = covf*Theta23(i,j,k) + Theta33(i,j,k) = covf*Theta33(i,j,k) + enddo + enddo + enddo + endif + + return + +end subroutine get_gauge_g00 +#else +subroutine get_gauge_g00_K(ex,crho,sigma,X,g22,g23,g33, & + Theta22,Theta23,Theta33, g00, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::Theta22,Theta23,Theta33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g00 + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) +! g22 is P +det = dlog(g22**2) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + call rderivs_x_point(ex(1),crho,det(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,det(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,det(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,det(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,det(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + KK(i,j,k) = covf + enddo + enddo + enddo + + g00 = g22**2*(1+0.5*KK) + + return + +end subroutine get_gauge_g00_K +! the input g00 is K +subroutine get_gauge_g00(ex,crho,sigma,X,g22,g23,g33, & + Theta22,Theta23,Theta33, g00, Rmin,fp) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),fp +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Theta22,Theta23,Theta33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g00 + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) + + KK = g00 + + if(fp == 0)then + k = 1 + do i=1,ex(1) + do j=1,ex(2) + + call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + Theta22(i,j,k) = covf + enddo + enddo + else + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + Theta22(i,j,k) = covf + enddo + enddo + enddo + endif + + Theta22 = -Theta22/12/m0*g22**3 + return + +end subroutine get_gauge_g00 +#endif +!!--------------------------------------------------------------------------- +subroutine get_gauge_g00_real(ex,crho,sigma,X,g22,g23,g33, & + Theta22,Theta23,Theta33, g00, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::Theta22,Theta23,Theta33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g00 + + +double precision,dimension(ex(3))::R +real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK + +real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33 +real*8 :: fr,fs,frr,fss,frs,covf + +integer :: i,j,k + +real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam + +call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam) + +R = X*Rmin/(1-X) +det = g22*g33-g23*g23 +gup22 = g33/det +gup23 = -g23/det +gup33 = g22/det + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + tg22 = 1-sr2*ss2 + tg22 = 1/tg22/tg22 + + tg23 = -sr*cr*ss*cs*tg22 + tg33 = cr2*tg22 + tg22 = cs2*tg22 + +! ghat/(g/r^4) indeed + det(i,j,k) = (tg22*tg33-tg23*tg23)/det(i,j,k) + enddo + enddo + enddo + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + + call rderivs_x_point(ex(1),crho,det(:,j,k),fr,i) + call rderivs_x_point(ex(2),sigma,det(i,:,k),fs,j) + call rdderivs_xy_point(ex(1),ex(2),crho,sigma,det(:,:,k),frs,i,j) + call rdderivs_x_point(ex(1),crho,det(:,j,k),frr,i) + call rdderivs_x_point(ex(2),sigma,det(i,:,k),fss,j) + + call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf) + + KK(i,j,k) = dsqrt(det(i,j,k))*(1-0.25*covf/R(k)**2) + + g00(i,j,k) = 2*m0/R(k)**3-KK(i,j,k)/R(k)**2 & + -(gup22(i,j,k)*Theta22(i,j,k)+2*gup23(i,j,k)*Theta23(i,j,k)+gup33(i,j,k)*Theta33(i,j,k))/2/R(k) + enddo + enddo + enddo + + return + +end subroutine get_gauge_g00_real +!!------------------------------------------------------------------------------------------------------------ +subroutine get_null_boundary2(ex,crho,sigma,X,g22,g23,g33, & + g01,p02,p03,g02,g03,Theta22,Theta23,Theta33, Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::X +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::g01,p02,p03,g02,g03 +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::Theta22,Theta23,Theta33 + +#if 1 +real*8 :: fact + +!fact = X(1)/X(2)*((1-X(2))/(1-X(1))) +!fact = fact**2 +! since we used gAB/r^2 instead of gAB, so fact = 1 +fact = 1.d0 + +g22(:,:,1) = g22(:,:,2)*fact +g23(:,:,1) = g23(:,:,2)*fact +g33(:,:,1) = g33(:,:,2)*fact + +g01(:,:,1) = -1.d0 + +p02(:,:,1) = 0.d0 +p03(:,:,1) = 0.d0 +g02(:,:,1) = 0.d0 +g03(:,:,1) = 0.d0 + +! have done in get_gauge_g00 +!Theta22(:,:,1) = Theta22(:,:,2)*fact +!Theta23(:,:,1) = Theta23(:,:,2)*fact +!Theta33(:,:,1) = Theta33(:,:,2)*fact +#else +g01 = -1 +g02 = 0 +g03 = 0 +#endif +return + +end subroutine get_null_boundary2 +!!!-------------------------------------------------------------------------------------------------------------- +subroutine get_initial_null3(ex,crho,sigma,XX,g22,g23,g33,sst,Rmin) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g22,g23,g33 + +double precision,dimension(ex(3))::R +real*8 :: sr,ss,cr,cs +real*8 :: sr2,ss2,cr2,cs2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma +real*8 ::x,y,z,gr,gt,gp + +real*8 :: gxx,gxy,gyy,tc,ts,PI + +double complex :: Zslm,II,Jr,ctp +double complex :: swtf,z220 + +double complex :: beta0,C1,C2,mx,my,mlx,mly +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + +R = XX*Rmin/(1-XX) + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + gxx = 1-sr2*ss2 + gxx = 1/gxx/gxx + + gxy = -sr*cr*ss*cs*gxx + gyy = cr2*gxx + gxx = cs2*gxx +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_initial_null2: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + z220 = Zslm(2,2,m,gt,gp)*swtf**2 + + if(sst==1 .or. sst==3 .or. sst==4)then + mx = 2*tc*ts*(ts-II*tc)/dcos(sigma(j)) + my = 2*tc*ts*(ts+II*tc)/dcos(crho(i)) + else + mx = 2*tc*ts*(ts+II*tc)/dcos(sigma(j)) + my = 2*tc*ts*(ts-II*tc)/dcos(crho(i)) + endif + mlx = gxx*mx+gxy*my + mly = gxy*mx+gyy*my + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0/R(k)-C2/1.2d1/R(k)**3 + Jr = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*dreal(Jr)*z220 + + ctp = Jr*mlx*mlx+dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mlx + g22(i,j,k) = dreal(ctp) + ctp = Jr*mlx*mly+dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mly + g23(i,j,k) = dreal(ctp) + ctp = Jr*mly*mly+dsqrt(1+abs(Jr)**2)*dconjg(mly)*mly + g33(i,j,k) = dreal(ctp) + + enddo + enddo + enddo + +return + +end subroutine get_initial_null3 +!!!-------------------------------------------------------------------------------------------------------------- +subroutine get_g00_with_t(time,ex,crho,sigma,XX,g00,Rmin,sst) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) :: time,Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::g00 + +double precision,dimension(ex(3))::R +real*8 :: sr,ss,cr,cs +real*8 :: sr2,ss2,cr2,cs2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma +real*8 ::x,y,z,gr,gt,gp + +real*8 :: tc,ts,PI + +double complex :: Zslm,II,Jr,Ur,Wr +double complex :: swtf,z020,z120,z220 + +double complex :: beta0,C1,C2 +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + +R = XX*Rmin/(1-XX) + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_g00_with_t: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + z020 = Zslm(0,2,m,gt,gp) + z120 = Zslm(1,2,m,gt,gp)*swtf + z220 = Zslm(2,2,m,gt,gp)*swtf**2 + + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0/R(k)-C2/1.2d1/R(k)**3 + Ur = (-24*II*nu*beta0+3*nu*nu*C1-nu**4*C2)/36+2*beta0/R(k)+C1/2/R(k)**2+ & + II*nu*C2/3/R(k)**3+C2/4/R(k)**4 + Wr = (24*II*nu*beta0-2*nu*C1+nu**4*C2)/6+ & + (3*II*nu*C1-6*beta0-II*nu**3*C2)/3/R(k) - & + nu**2*C2/R(k)**2+II*nu*C2/R(k)**3+C2/2/R(k)**4 + + Jr = Jr*exp(II*nu*time) + Ur = Ur*exp(II*nu*time) + Wr = Wr*exp(II*nu*time) + + g00(i,j,k) = 2*(2*(2+1)*dsqrt(dble((2-1)*2*(2+1)*(2+2)))*dreal(Ur)**2* & + dreal(Jr)*dreal(z120**2*dconjg(z220))+ & + 2*(2+1)*dsqrt(1+(2-1)*2*(2+1)*(2+2)*dreal(Jr)**2*abs(z220)**2)* & + dreal(Ur)**2*abs(z120)**2)-(1/R(k)**2+dreal(z020*Wr)/R(k))* & + exp(2*dreal(z020*beta0*exp(II*nu*time))) + + enddo + enddo + enddo + +!if(sst==0 .and. crho(1) <-0.9 .and. sigma(1) <-0.9 .and. XX(1)<0.18182)write(*,*)"time = ",time,g00(1,1,1) + +return + +end subroutine get_g00_with_t +!!------------------------------------------------------------------------------------------------------------ +subroutine get_null_boundary3(time,ex,crho,sigma,XX,g22,g23,g33, & + g01,p02,p03,g02,g03,Theta22,Theta23,Theta33, Rmin,sst) +implicit none +! argument variables +integer, intent(in ):: ex(1:3),sst +real*8,intent(in) ::time,Rmin +double precision,intent(in),dimension(ex(1))::crho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::XX +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::g22,g23,g33 +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::g01,p02,p03,g02,g03 +real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::Theta22,Theta23,Theta33 + +double precision,dimension(ex(3))::R +real*8 :: sr,ss,cr,cs +real*8 :: sr2,ss2,cr2,cs2 +integer :: i,j,k +real*8 :: ggr,tgrho,tgsigma +real*8 ::x,y,z,gr,gt,gp + +real*8 :: gxx,gxy,gyy,tc,ts,PI + +double complex :: Zslm,II,Jr,ctp,Jrp,Jrt,Ur,Urp,Wr +double complex :: swtf,z020,z120,z220 + +double complex :: beta0,C1,C2,mx,my,mlx,mly +integer :: nu,m + +call initial_null_paramter(beta0,C1,C2,nu,m) + + II = dcmplx(0.d0,1.d0) + +R = XX*Rmin/(1-XX) + +PI = dacos(-1.d0) + + do i=1,ex(1) + do j=1,ex(2) + do k=1,ex(3) + sr = dsin(crho(i)) + ss = dsin(sigma(j)) + cr = dcos(crho(i)) + cs = dcos(sigma(j)) + sr2 = sr*sr + ss2 = ss*ss + cr2 = cr*cr + cs2 = cs*cs + + gxx = 1-sr2*ss2 + gxx = 1/gxx/gxx + + gxy = -sr*cr*ss*cs*gxx + gyy = cr2*gxx + gxx = cs2*gxx +! here fake global coordinate is enough + gr = 1.d0 + tgrho = dtan(crho(i)) + tgsigma = dtan(sigma(j)) + tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0) + ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0) + select case (sst) + case (0) + z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (1) + z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = z*tgrho + y = z*tgsigma + case (2) + x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (3) + x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + y = x*tgrho + z = x*tgsigma + case (4) + y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case (5) + y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma) + x = y*tgrho + z = y*tgsigma + case default + write(*,*) "get_null_boundary3: not recognized sst = ",sst + return + end select + gt = dacos(z/gr) + gp = datan2(y,x) + + swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j)) + if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf) + select case (sst) + case (0,1) + swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2) + case (2,3) + swtf = II*swtf*dsin(gt) + case (4,5) + swtf = -II*swtf*dsin(gt) + end select + + z020 = Zslm(0,2,m,gt,gp) + z120 = Zslm(1,2,m,gt,gp)*swtf + z220 = Zslm(2,2,m,gt,gp)*swtf**2 + + if(sst==1 .or. sst==3 .or. sst==4)then + mx = 2*tc*ts*(ts-II*tc)/dcos(sigma(j)) + my = 2*tc*ts*(ts+II*tc)/dcos(crho(i)) + else + mx = 2*tc*ts*(ts+II*tc)/dcos(sigma(j)) + my = 2*tc*ts*(ts-II*tc)/dcos(crho(i)) + endif + mlx = gxx*mx+gxy*my + mly = gxy*mx+gyy*my + + Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0/R(k)-C2/1.2d1/R(k)**3 +! Jrp = d Jr/d X instead of d Jr/d r + Jrp = -C1/4.d0/Rmin/XX(k)**2+C2/1.2d1*3/R(k)**2/Rmin/XX(k)**2 + Ur = (-24*II*nu*beta0+3*nu*nu*C1-nu**4*C2)/36+2*beta0/R(k)+C1/2/R(k)**2+ & + II*nu*C2/3/R(k)**3+C2/4/R(k)**4 + Urp = -2*beta0/Rmin/XX(k)**2-C1/R(k)/Rmin/XX(k)**2- & + II*nu*C2/R(k)**2/Rmin/XX(k)**2-C2/R(k)**3/Rmin/XX(k)**2 + Wr = (24*II*nu*beta0-2*nu*C1+nu**4*C2)/6+ & + (3*II*nu*C1-6*beta0-II*nu**3*C2)/3/R(k) - & + nu**2*C2/R(k)**2+II*nu*C2/R(k)**3+C2/2/R(k)**4 + + Jr = Jr*exp(II*nu*time) + Jrp = Jrp*exp(II*nu*time) + Jrt = II*nu*Jr*exp(II*nu*time) + Ur = Ur*exp(II*nu*time) + Urp = Urp*exp(II*nu*time) + Wr = Wr*exp(II*nu*time) + + Jr = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*dreal(Jr)*z220 + Jrt = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*dreal(Jrt)*z220 + Jrp = dsqrt(dble((2-1)*2*(2+1)*(2+2)))*dreal(Jrp)*z220 + + g01(i,j,k) = -dexp(2*dreal(z020*beta0*exp(II*nu*time))) +#if 1 + g02(i,j,k) = -dsqrt(dble(2*(2+1)))*dreal(Ur)*dreal(mlx*(z120*dconjg(z220)* & + dconjg(Jr)+dsqrt(1+abs(Jr)**2)*dconjg(z120))) + g03(i,j,k) = -dsqrt(dble(2*(2+1)))*dreal(Ur)*dreal(mly*(z120*dconjg(z220)* & + dconjg(Jr)+dsqrt(1+abs(Jr)**2)*dconjg(z120))) +#elif 0 + mlx = mlx/swtf + mly = mly/swtf + g02(i,j,k) = dreal(mlx) + g03(i,j,k) = dreal(mly) + !if(sst==0 .and. crho(1) <-0.9 .and. sigma(1) <-0.9 .and. XX(1)<0.18182)write(*,*)g02(i,j,k),g03(i,j,k) + !if(crho(1) <-0.9 .and. sigma(1) <-0.9 .and. XX(1)<0.18182)write(*,*)g02(i,j,k),g03(i,j,k) +#else + select case (sst) + case (0,1) + tc =-dcos(gp)/(dcos(gt)**2*dcos(gp)**2-dcos(gt)**2-dcos(gp)**2) + ts = dsin(gp)/(1-dsin(gt)**2*dcos(gp)**2) + case (2,3) + tc = 0 + ts = dcos(gp)/(dcos(gt)**2*dcos(gp)**2-dcos(gt)**2-dcos(gp)**2) + case (4,5) + tc = 0 + ts =-dsin(gp)/(1-dsin(gt)**2*dcos(gp)**2) + end select + g02(i,j,k) = gxx*tc+gxy*ts + g03(i,j,k) = gxy*tc+gyy*ts + !if(sst==0 .and. crho(1) <-0.9 .and. sigma(1) <-0.9 .and. XX(1)<0.18182)write(*,*)g02(i,j,k),g03(i,j,k) + if(crho(1) <-0.9 .and. sigma(1) <-0.9 .and. XX(1)<0.18182)write(*,*)g02(i,j,k),g03(i,j,k),sst + stop +#endif + p02(i,j,k) = -dsqrt(dble(2*(2+1)))*dreal(Urp)*dreal(mlx*(z120*dconjg(Jr)+ & + dsqrt(1+abs(Jr)**2)*dconjg(z120))) & + -dsqrt(dble(2*(2+1)))*dreal(Ur)*dreal(mlx*(z120*dconjg(Jrp)+ & + abs(Jrp)*abs(Jr)/dsqrt(1+abs(Jr)**2)*dconjg(z120))) + p03(i,j,k) = -dsqrt(dble(2*(2+1)))*dreal(Urp)*dreal(mly*(z120*dconjg(Jr)+ & + dsqrt(1+abs(Jr)**2)*dconjg(z120))) & + -dsqrt(dble(2*(2+1)))*dreal(Ur)*dreal(mly*(z120*dconjg(Jrp)+ & + abs(Jrp)*abs(Jr)/dsqrt(1+abs(Jr)**2)*dconjg(z120))) + + ctp = dconjg(Jr)*mlx*mlx+dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mlx + g22(i,j,k) = dreal(ctp) + ctp = dconjg(Jr)*mlx*mly+dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mly + g23(i,j,k) = dreal(ctp) + ctp = dconjg(Jr)*mly*mly+dsqrt(1+abs(Jr)**2)*dconjg(mly)*mly + g33(i,j,k) = dreal(ctp) + + ctp = dconjg(Jrt)*mlx*mlx+abs(Jr)*abs(Jrt)/dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mlx + Theta22(i,j,k) = dreal(ctp) + ctp = dconjg(Jrt)*mlx*mly+abs(Jr)*abs(Jrt)/dsqrt(1+abs(Jr)**2)*dconjg(mlx)*mly + Theta23(i,j,k) = dreal(ctp) + ctp = dconjg(Jrt)*mly*mly+abs(Jr)*abs(Jrt)/dsqrt(1+abs(Jr)**2)*dconjg(mly)*mly + Theta33(i,j,k) = dreal(ctp) + + enddo + enddo + enddo + +return + +end subroutine get_null_boundary3 diff --git a/AMSS_NCKU_source/initial_null2.h b/AMSS_NCKU_source/initial_null2.h new file mode 100644 index 0000000..615dbff --- /dev/null +++ b/AMSS_NCKU_source/initial_null2.h @@ -0,0 +1,98 @@ + +#ifndef INITIAL_NULL2_H +#define INITIAL_NULL2_H + +#ifdef fortran1 +#define f_get_initial_null2 get_initial_null2 +#define f_get_initial_null3 get_initial_null3 +#define f_get_gauge_g00 get_gauge_g00 +#define f_get_gauge_g00_K get_gauge_g00_k +#define f_get_gauge_g00_real get_gauge_g00_real +#define f_get_null_boundary2 get_null_boundary2 +#define f_get_null_boundary3 get_null_boundary3 +#define f_get_g00_with_t get_g00_with_t +#endif +#ifdef fortran2 +#define f_get_initial_null2 GET_INITIAL_NULL2 +#define f_get_initial_null3 GET_INITIAL_NULL3 +#define f_get_gauge_g00 GET_GAUGE_G00 +#define f_get_gauge_g00_K GET_GAUGE_G00_K +#define f_get_gauge_g00_real GET_GAUGE_G00_REAL +#define f_get_null_boundary2 GET_NULL_BOUNDARY2 +#define f_get_null_boundary3 GET_NULL_BOUNDARY3 +#define f_get_g00_with_t GET_G00_WITH_T +#endif +#ifdef fortran3 +#define f_get_initial_null2 get_initial_null2_ +#define f_get_initial_null3 get_initial_null3_ +#define f_get_gauge_g00 get_gauge_g00_ +#define f_get_gauge_g00_K get_gauge_g00_k_ +#define f_get_gauge_g00_real get_gauge_g00_real_ +#define f_get_null_boundary2 get_null_boundary2_ +#define f_get_null_boundary3 get_null_boundary3_ +#define f_get_g00_with_t get_g00_with_t_ +#endif + +extern "C" +{ + void f_get_initial_null2(int *, double *, double *, double *, + double *, double *, double *, + int &, double &); +} + +extern "C" +{ + void f_get_gauge_g00(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double &, int &); +} + +extern "C" +{ + void f_get_gauge_g00_K(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double &); +} + +extern "C" +{ + void f_get_gauge_g00_real(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double &); +} + +extern "C" +{ + void f_get_null_boundary2(int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, + double *, double *, double *, + double &); +} + +extern "C" +{ + void f_get_g00_with_t(double &, int *, double *, double *, double *, + double *, double &, int &); +} + +extern "C" +{ + void f_get_null_boundary3(double &, int *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, + double *, double *, double *, + double &, int &); +} + +extern "C" +{ + void f_get_initial_null3(int *, double *, double *, double *, + double *, double *, double *, + int &, double &); +} + +#endif /* INITIAL_NULL2_H */ diff --git a/AMSS_NCKU_source/initial_puncture.f90 b/AMSS_NCKU_source/initial_puncture.f90 new file mode 100644 index 0000000..bab5520 --- /dev/null +++ b/AMSS_NCKU_source/initial_puncture.f90 @@ -0,0 +1,2597 @@ + +!------------------------------------------------------------- +! kerrschild for schwarzschild +!------------------------------------------------------------- +subroutine get_initial_kerrschild(ex,XX,YY,ZZ,& + chi,trK,& + dxx,gxy,gxz,dyy,gyz,dzz,& + Axx,Axy,Axz,Ayy,Ayz,Azz,& + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,dtSfx,dtSfy,dtSfz) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8, intent(in ):: XX(1:ex(1)),YY(1:ex(2)),ZZ(1:ex(3)) +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::chi,trK,dxx,gxy,gxz,dyy,gyz,dzz +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Axx,Axy,Axz,Ayy,Ayz,Azz +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Gmx,Gmy,Gmz,Lap,Sfx,Sfy,Sfz,dtSfx,dtSfy,dtSfz + +integer :: i,j,k +real*8 ::x,y,z +real*8,parameter :: M = 1.d0,ZEO=0.d0,mF1o3=-1.d0/3.d0 + +do i=1,ex(1) + x = XX(i) +do j=1,ex(2) + y = YY(j) +do k=1,ex(3) + z = ZZ(k) + chi(i,j,k) = ((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**mF1o3 - 1.d0 + + trK(i,j,k) = 2*(sqrt(x**2+y**2+z**2)+3*M)*M/(x**2+y**2+z**2)/(sqrt(x**2+y**2+z**2)+2*M)& + /sqrt((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2)) + + dxx(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)*z**2& + +2*x**2*M)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)/& + sqrt(x**2+y**2+z**2)**3 - 1.0 + gxy(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*x*y/& + sqrt(x**2+y**2+z**2)**3 + gxz(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*x*z/& + sqrt(x**2+y**2+z**2)**3 + dyy(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)& + *z**2+2*M*y**2)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)& + /sqrt(x**2+y**2+z**2)**3 - 1.0 + gyz(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*y*z/& + sqrt(x**2+y**2+z**2)**3 + dzz(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)*& + z**2+2*M*z**2)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)& + /sqrt(x**2+y**2+z**2)**3 - 1.0 + Axx(i,j,k) = -2.D0/3.D0*M*(4*x**4+2*x**2*y**2+12*x**2*M**2+2*x**2*z**2+14*x**2*sqrt(x**2+y**2+z**2)& + *M-4*y**2*z**2-2*z**4-2*y**4-3*sqrt(x**2+y**2+z**2)*M*y**2-3*sqrt(x**2+y**2+z**2)*M*z**2)& + /sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Axy(i,j,k) = -2.D0/3.D0*M*x*y*(6*x**2+12*M**2+6*z**2+6*y**2+17*sqrt(x**2+y**2+z**2)*M)/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Axz(i,j,k) = -2.D0/3.D0*z*M*x*(6*x**2+12*M**2+6*z**2+6*y**2+17*M*sqrt(x**2+y**2+z**2))/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Ayy(i,j,k) = 2.D0/3.D0*M*(2*x**4+3*x**2*sqrt(x**2+y**2+z**2)*M-2*x**2*y**2+4*x**2*z**2-2*y**2*z**2& + +2*z**4-4*y**4+3*sqrt(x**2+y**2+z**2)*M*z**2-14*sqrt(x**2+y**2+z**2)*M*y**2-12*M**2*y**2)& + /sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Ayz(i,j,k) = -2.D0/3.D0*z*y*M*(6*x**2+6*z**2+17*sqrt(x**2+y**2+z**2)*M+12*M**2+6*y**2)/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Azz(i,j,k) = 2.D0/3.D0*M*(2*x**4-2*x**2*z**2+4*x**2*y**2+3*x**2*sqrt(x**2+y**2+z**2)*M- & + 2*y**2*z**2-4*z**4+2*y**4-12*M**2*z**2-14*sqrt(x**2+y**2+z**2)*M*z**2+3*& + sqrt(x**2+y**2+z**2)*M*y**2)/sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/& + ((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Gmx(i,j,k) = 8.D0/3.D0*x*M*(x**2+6*M**2+z**2+5*M*sqrt(x**2+y**2+z**2)+y**2)/(sqrt(x**2+y**2+z**2) & + +2*M)**2/sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Gmy(i,j,k) = 8.D0/3.D0*M*y*(x**2+6*M**2+z**2+y**2+5*M*sqrt(x**2+y**2+z**2))/(sqrt(x**2+y**2+z**2)+2*M)**2/& + sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Gmz(i,j,k) = 8.D0/3.D0*M*z*(x**2+z**2+5*M*sqrt(x**2+y**2+z**2)+y**2+6*M**2)/(sqrt(x**2+y**2+z**2)+2*M)**2/& + sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Lap(i,j,k) = sqrt(sqrt(x**2+y**2+z**2)/(sqrt(x**2+y**2+z**2)+2*M)) - 1.0 + Sfx(i,j,k) = 2/sqrt(x**2+y**2+z**2)*x*M/(sqrt(x**2+y**2+z**2)+2*M) + Sfy(i,j,k) = 2/sqrt(x**2+y**2+z**2)*M*y/(sqrt(x**2+y**2+z**2)+2*M) + Sfz(i,j,k) = 2/sqrt(x**2+y**2+z**2)*z*M/(sqrt(x**2+y**2+z**2)+2*M) + +enddo +enddo +enddo +dtSfx = ZEO +dtSfy = ZEO +dtSfz = ZEO + +return + +end subroutine get_initial_kerrschild +!for shell +subroutine get_initial_kerrschild_ss(ex,XX,YY,ZZ,& + chi,trK,& + dxx,gxy,gxz,dyy,gyz,dzz,& + Axx,Axy,Axz,Ayy,Ayz,Azz,& + Gmx,Gmy,Gmz,& + Lap,Sfx,Sfy,Sfz,dtSfx,dtSfy,dtSfz) +implicit none +! argument variables +integer, intent(in ):: ex(1:3) +real*8,dimension(ex(1),ex(2),ex(3)),intent(in ):: XX,YY,ZZ +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::chi,trK,dxx,gxy,gxz,dyy,gyz,dzz +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Axx,Axy,Axz,Ayy,Ayz,Azz +real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::Gmx,Gmy,Gmz,Lap,Sfx,Sfy,Sfz,dtSfx,dtSfy,dtSfz + +integer :: i,j,k +real*8 ::x,y,z +real*8,parameter :: M = 1.d0,ZEO=0.d0,mF1o3=-1.d0/3.d0 + +do i=1,ex(1) +do j=1,ex(2) +do k=1,ex(3) + x = XX(i,j,k) + y = YY(i,j,k) + z = ZZ(i,j,k) + chi(i,j,k) = ((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**mF1o3 - 1.d0 + + trK(i,j,k) = 2*(sqrt(x**2+y**2+z**2)+3*M)*M/(x**2+y**2+z**2)/(sqrt(x**2+y**2+z**2)+2*M)& + /sqrt((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2)) + + dxx(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)*z**2& + +2*x**2*M)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)/& + sqrt(x**2+y**2+z**2)**3 - 1.0 + gxy(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*x*y/& + sqrt(x**2+y**2+z**2)**3 + gxz(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*x*z/& + sqrt(x**2+y**2+z**2)**3 + dyy(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)& + *z**2+2*M*y**2)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)& + /sqrt(x**2+y**2+z**2)**3 - 1.0 + gyz(i,j,k) = 2/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)*M*y*z/& + sqrt(x**2+y**2+z**2)**3 + dzz(i,j,k) = (sqrt(x**2+y**2+z**2)*x**2+sqrt(x**2+y**2+z**2)*y**2+sqrt(x**2+y**2+z**2)*& + z**2+2*M*z**2)/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(1.D0/3.D0)& + /sqrt(x**2+y**2+z**2)**3 - 1.0 + Axx(i,j,k) = -2.D0/3.D0*M*(4*x**4+2*x**2*y**2+12*x**2*M**2+2*x**2*z**2+14*x**2*sqrt(x**2+y**2+z**2)& + *M-4*y**2*z**2-2*z**4-2*y**4-3*sqrt(x**2+y**2+z**2)*M*y**2-3*sqrt(x**2+y**2+z**2)*M*z**2)& + /sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Axy(i,j,k) = -2.D0/3.D0*M*x*y*(6*x**2+12*M**2+6*z**2+6*y**2+17*sqrt(x**2+y**2+z**2)*M)/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Axz(i,j,k) = -2.D0/3.D0*z*M*x*(6*x**2+12*M**2+6*z**2+6*y**2+17*M*sqrt(x**2+y**2+z**2))/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Ayy(i,j,k) = 2.D0/3.D0*M*(2*x**4+3*x**2*sqrt(x**2+y**2+z**2)*M-2*x**2*y**2+4*x**2*z**2-2*y**2*z**2& + +2*z**4-4*y**4+3*sqrt(x**2+y**2+z**2)*M*z**2-14*sqrt(x**2+y**2+z**2)*M*y**2-12*M**2*y**2)& + /sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Ayz(i,j,k) = -2.D0/3.D0*z*y*M*(6*x**2+6*z**2+17*sqrt(x**2+y**2+z**2)*M+12*M**2+6*y**2)/& + sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/((sqrt(x**2+y**2+z**2)+2*M)/& + sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Azz(i,j,k) = 2.D0/3.D0*M*(2*x**4-2*x**2*z**2+4*x**2*y**2+3*x**2*sqrt(x**2+y**2+z**2)*M- & + 2*y**2*z**2-4*z**4+2*y**4-12*M**2*z**2-14*sqrt(x**2+y**2+z**2)*M*z**2+3*& + sqrt(x**2+y**2+z**2)*M*y**2)/sqrt(x**2+y**2+z**2)**5/(sqrt(x**2+y**2+z**2)+2*M)/& + ((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(5.D0/6.D0) + Gmx(i,j,k) = 8.D0/3.D0*x*M*(x**2+6*M**2+z**2+5*M*sqrt(x**2+y**2+z**2)+y**2)/(sqrt(x**2+y**2+z**2) & + +2*M)**2/sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Gmy(i,j,k) = 8.D0/3.D0*M*y*(x**2+6*M**2+z**2+y**2+5*M*sqrt(x**2+y**2+z**2))/(sqrt(x**2+y**2+z**2)+2*M)**2/& + sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Gmz(i,j,k) = 8.D0/3.D0*M*z*(x**2+z**2+5*M*sqrt(x**2+y**2+z**2)+y**2+6*M**2)/(sqrt(x**2+y**2+z**2)+2*M)**2/& + sqrt(x**2+y**2+z**2)**3/((sqrt(x**2+y**2+z**2)+2*M)/sqrt(x**2+y**2+z**2))**(2.D0/3.D0) + Lap(i,j,k) = sqrt(sqrt(x**2+y**2+z**2)/(sqrt(x**2+y**2+z**2)+2*M)) - 1.0 + Sfx(i,j,k) = 2/sqrt(x**2+y**2+z**2)*x*M/(sqrt(x**2+y**2+z**2)+2*M) + Sfy(i,j,k) = 2/sqrt(x**2+y**2+z**2)*M*y/(sqrt(x**2+y**2+z**2)+2*M) + Sfz(i,j,k) = 2/sqrt(x**2+y**2+z**2)*z*M/(sqrt(x**2+y**2+z**2)+2*M) + +enddo +enddo +enddo +dtSfx = ZEO +dtSfy = ZEO +dtSfz = ZEO + +return + +end subroutine get_initial_kerrschild_ss +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for single black hole with small P and +!S, my own formula +! +!----------------------------------------------------------------------------------- + + subroutine get_initial_bssn3(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,M,Porg,Pmom,Spin) + + implicit none + +!------= input arguments + + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, intent(in) :: M,Porg(3),Pmom(3),Spin(3) + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k + real*8 :: Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + PP = dsqrt(Px**2 + Py**2 + Pz**2) + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) + + nx = X(i)-Porg(1) + ny = Y(j)-Porg(2) + nz = Z(k)-Porg(3) + rr = dsqrt(nx**2+ny**2+nz**2) + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + nx = nx / rr + ny = ny / rr + nz = nz / rr + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / psi **2 - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_bssn3 +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for inspiral binary +! +!----------------------------------------------------------------------------------- + + subroutine get_initial_bssn6(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin) + + implicit none + +!------= input arguments + + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(2), intent(in) :: Mass + real*8, dimension(6), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k + real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 + M = Mass(2) + nx = x(i) - Porg(4) + ny = y(j) - Porg(5) + nz = z(k) - Porg(6) + Px = Pmom(4) + Py = Pmom(5) + Pz = Pmom(6) + Sx = Spin(4) + Sy = Spin(5) + Sz = Spin(6) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_bssn6 +!----------------------------------------------------------------------------------- +! +!post deal the initial data after reading from file +! +!----------------------------------------------------------------------------------- + subroutine get_initial_postdeal(ex,X,Y,Z, & + chi, trK, & + dxx, gxy, gxz, dyy, gyz, dzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz) + + implicit none + +!------= input arguments +! for chi: input phi, output chi + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi,trK + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: dtSfx,dtSfy,dtSfz + +!------= local variables + + real*8,parameter :: ZEO = 0.d0, ONE = 1.d0 + +! psi=exp(phi) + chi = dexp( chi ) +! Lap=exp(-2*phi) + Lap = ONE / ( chi * chi ) - ONE +! chi=exp(-4*phi) + chi = ONE / chi **4 - ONE + + dxx = ZEO + dyy = ZEO + dzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_postdeal +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for single black hole with the given solution u by +!Ansorg +! +!----------------------------------------------------------------------------------- + + subroutine get_ansorg_single(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,M,Porg,Pmom,Spin) + + implicit none + +!------= input arguments + + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z +! in u, out chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, intent(in) :: M,Porg(3),Pmom(3),Spin(3) + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k + real*8 :: Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) + + nx = X(i)-Porg(1) + ny = Y(j)-Porg(2) + nz = Z(k)-Porg(3) + rr = dsqrt(nx**2+ny**2+nz**2) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + chi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_ansorg_single +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for inspiral binary with the given solution u by +!Ansorg +! +!----------------------------------------------------------------------------------- + + subroutine get_ansorg_binary(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin) + + implicit none + +!------= input arguments + + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z +! in u, out chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(2), intent(in) :: Mass + real*8, dimension(6), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + chi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 + M = Mass(2) + nx = x(i) - Porg(4) + ny = y(j) - Porg(5) + nz = z(k) - Porg(6) + Px = Pmom(4) + Py = Pmom(5) + Pz = Pmom(6) + Sx = Spin(4) + Sy = Spin(5) + Sz = Spin(6) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_ansorg_binary + +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for black hole system with the given solution u by +!Ansorg +! +!----------------------------------------------------------------------------------- + subroutine get_ansorg_nbhs(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz, & + Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter :: TINYRR=1.d-14 + real*8,parameter :: phi0=1.d0,r0=120.d0,sigma=8.d0 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + psi = chi + psi + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_ansorg_nbhs +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for black hole system with the given solution u by +!Ansorg +! for shell part +!----------------------------------------------------------------------------------- + subroutine get_ansorg_nbhs_ss(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz, & + Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter :: TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + psi = chi + psi + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_ansorg_nbhs_ss +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n black holes +! +!----------------------------------------------------------------------------------- + + subroutine get_initial_nbhs(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_nbhs +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n black holes +! +!----------------------------------------------------------------------------------- + + subroutine get_initial_nbhs_ss(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell/2.d1*(1.d0+ell+ell**2-4.d0*ell**3+2.d0*ell**4) + u4 = ell**2/1.d1*(1.d1-2.5d1*ell+2.1d1*ell**2-6.d0*ell**3) + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 6.d0*u3/M**4*SS**2*(1.d0+mus**2) + u4/M**3*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_nbhs_ss +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for inspiral binary with the given solution u +! +!----------------------------------------------------------------------------------- + + subroutine get_pablo_nbhs(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z +! in u, out chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + chi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_pablo_nbhs +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n black holes with lousto's +!formula PRD 77, 024034 (2008) +! +!----------------------------------------------------------------------------------- + + subroutine get_lousto_nbhs(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4,u5 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5 + u4 = -b**2*ell**5 + u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1 + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + & + u5*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5 + u4 = -b**2*ell**5 + u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1 + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + & + u5*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_lousto_nbhs +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for black hole system coupled with scalar field +!with the given solution u by +!Ansorg +! +!----------------------------------------------------------------------------------- + subroutine get_ansorg_nbhs_escalar(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz, & + Sphi,Spi, & + Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1)), intent(in) :: X + real*8, dimension(ex(2)), intent(in) :: Y + real*8, dimension(ex(3)), intent(in) :: Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Sphi,Spi + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter :: TINYRR=1.d-14 + + real*8 :: phi0,r0,sigma,a2,l2 + + real*8 :: phi ! in Set_Rho_ADM.f90 + + call setparameters(a2,r0,phi0,sigma,l2) + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i) - Porg(1) + ny = y(j) - Porg(2) + nz = z(k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i) - Porg(3*(bhi-1)+1) + ny = y(j) - Porg(3*(bhi-1)+2) + nz = z(k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2)-X(1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo +! scalar field + Sphi(i,j,k) = phi(x(i),y(j),z(k)) ! this function locates in 'Set_Rho_ADM.f90' + enddo + enddo + enddo + + psi = chi + psi + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Spi = ZEO + + return + + end subroutine get_ansorg_nbhs_escalar +!----------------------------------------------------------------------------------- +! +!Set up puncture initial data for black hole system with the given solution u by +!Ansorg +! for shell part +!----------------------------------------------------------------------------------- + subroutine get_ansorg_nbhs_ss_escalar(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz, & + Sphi,Spi, & + Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(inout) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Sphi,Spi + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,Sx,Sy,Sz + real*8 :: nx,ny,nz,rr,tmp + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter :: TINYRR=1.d-14 + + real*8 :: phi0,r0,sigma,a2,l2 + + real*8 :: phi ! in Set_Rho_ADM.f90 + + call setparameters(a2,r0,phi0,sigma,l2) + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = ONE + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=TINYRR + nx = nx / rr + ny = ny / rr + nz = nz / rr + + psi(i,j,k) = psi(i,j,k) + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo +! scalar field + Sphi(i,j,k) = phi(x(i,j,k),y(i,j,k),z(i,j,k)) ! this function locates in 'Set_Rho_ADM.f90' + enddo + enddo + enddo + + psi = chi + psi + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + Spi = ZEO + + return + + end subroutine get_ansorg_nbhs_ss_escalar diff --git a/AMSS_NCKU_source/initial_puncture.h b/AMSS_NCKU_source/initial_puncture.h new file mode 100644 index 0000000..90f6df0 --- /dev/null +++ b/AMSS_NCKU_source/initial_puncture.h @@ -0,0 +1,249 @@ + +#ifndef GET_INITIAL_H +#define GET_INITIAL_H + +#ifdef fortran1 +#define f_get_initial_kerrschild get_initial_kerrschild +#define f_get_initial_kerrschild_ss get_initial_kerrschild_ss +#define f_get_initial_single get_initial_bssn3 +#define f_get_ansorg_single get_ansorg_single +#define f_get_initial_binary get_initial_bssn6 +#define f_get_ansorg_binary get_ansorg_binary +#define f_get_ansorg_nbhs get_ansorg_nbhs +#define f_get_ansorg_nbhs_escalar get_ansorg_nbhs_escalar +#define f_get_ansorg_nbhs_ss get_ansorg_nbhs_ss +#define f_get_ansorg_nbhs_ss_escalar get_ansorg_nbhs_ss_escalar +#define f_get_initial_postdeal get_initial_postdeal +#define f_get_initial_nbhs get_initial_nbhs +#define f_get_lousto_nbhs get_lousto_nbhs +#define f_get_pablo_nbhs get_pablo_nbhs +#define f_get_shapiro get_shapiro +#define f_get_niall_minkowski get_niall_minkowski +#endif +#ifdef fortran2 +#define f_get_initial_kerrschild GET_INITIAL_KERRSCHILD +#define f_get_initial_kerrschild_ss GET_INITIAL_KERRSCHILD_SS +#define f_get_initial_single GET_INITIAL_BSSN3 +#define f_get_ansorg_single GET_ANSORG_SINGLE +#define f_get_initial_binary GET_INITIAL_BSSN6 +#define f_get_ansorg_binary GET_ANSORG_BINARY +#define f_get_ansorg_nbhs GET_ANSORG_NBHS +#define f_get_ansorg_nbhs_escalar GET_ANSORG_NBHS_ESCALAR +#define f_get_ansorg_nbhs_ss GET_ANSORG_NBHS_SS +#define f_get_ansorg_nbhs_ss_escalar GET_ANSORG_NBHS_SS_ESCALAR +#define f_get_initial_postdeal GET_INITIAL_POSTDEAL +#define f_get_initial_nbhs GET_INITIAL_NBHS +#define f_get_lousto_nbhs GET_LOUSTO_NBHS +#define f_get_pablo_nbhs GET_PABLO_NBHS +#define f_get_shapiro GET_SHAPIRO +#define f_get_niall_minkowski GRT_NIALL_MINKOWSKI +#endif +#ifdef fortran3 +#define f_get_initial_kerrschild get_initial_kerrschild_ +#define f_get_initial_kerrschild_ss get_initial_kerrschild_ss_ +#define f_get_initial_single get_initial_bssn3_ +#define f_get_ansorg_single get_ansorg_single_ +#define f_get_initial_binary get_initial_bssn6_ +#define f_get_ansorg_binary get_ansorg_binary_ +#define f_get_ansorg_nbhs get_ansorg_nbhs_ +#define f_get_ansorg_nbhs_escalar get_ansorg_nbhs_escalar_ +#define f_get_ansorg_nbhs_ss get_ansorg_nbhs_ss_ +#define f_get_ansorg_nbhs_ss_escalar get_ansorg_nbhs_ss_escalar_ +#define f_get_initial_postdeal get_initial_postdeal_ +#define f_get_initial_nbhs get_initial_nbhs_ +#define f_get_lousto_nbhs get_lousto_nbhs_ +#define f_get_pablo_nbhs get_pablo_nbhs_ +#define f_get_shapiro get_shapiro_ +#define f_get_niall_minkowski get_niall_minkowski_ +#endif + +extern "C" +{ + void f_get_initial_kerrschild(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *); +} + +extern "C" +{ + void f_get_initial_kerrschild_ss(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *); +} + +extern "C" +{ + void f_get_initial_single(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double &, double *, double *, double *); +} + +extern "C" +{ + void f_get_initial_binary(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + void f_get_ansorg_single(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double &, double *, double *, double *); +} + +extern "C" +{ + void f_get_ansorg_binary(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *); +} + +extern "C" +{ + void f_get_ansorg_nbhs(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_ansorg_nbhs_ss(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_initial_postdeal(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *); +} + +extern "C" +{ + void f_get_lousto_nbhs(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_initial_nbhs(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_pablo_nbhs(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_shapiro(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_niall_minkowski(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *); +} + +extern "C" +{ + void f_get_ansorg_nbhs_escalar(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_get_ansorg_nbhs_ss_escalar(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, + double *, double *, double *, double *, int &); +} + +#endif /* GET_INITIAL_H */ diff --git a/AMSS_NCKU_source/initial_scalar.f90 b/AMSS_NCKU_source/initial_scalar.f90 new file mode 100644 index 0000000..f96f0e7 --- /dev/null +++ b/AMSS_NCKU_source/initial_scalar.f90 @@ -0,0 +1,68 @@ + +!----------------------------------------------------------------------------- +! +! Setting initial scalar with spherical Gauss profile centered at shell r=R0 +! with width WD and amplitude A +! +!----------------------------------------------------------------------------- + + subroutine get_initial_scalar(ex, X, Y, Z,Sphi,Spi,R0,WD,A) + implicit none + +!~~~~~~> Input parameters + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)),R0,WD,A + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Sphi,Spi + +!~~~~~~> Local variables + + real*8 :: rr + integer::i,j,k + real*8, parameter :: ZEO = 0.d0,TWO=2.d0 + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + rr = dsqrt(X(i)*X(i)+Y(j)*Y(j)+Z(k)*Z(k))-R0 + Sphi(i,j,k) = A*dexp(-rr*rr/TWO/WD/WD) + enddo + enddo + enddo + + Spi = ZEO + + return + + end subroutine get_initial_scalar +! for shell + subroutine get_initial_scalar_sh(ex, X, Y, Z,Sphi,Spi,R0,WD,A) + implicit none + +!~~~~~~> Input parameters + + integer,intent(in ):: ex(1:3) + real*8, intent(in ):: R0,WD,A + real*8, dimension(ex(1),ex(2),ex(3)), intent(in):: X, Y, Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out):: Sphi,Spi + +!~~~~~~> Local variables + + real*8 :: rr + integer::i,j,k + real*8, parameter :: ZEO = 0.d0,TWO=2.d0 + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + rr = dsqrt(X(i,j,k)*X(i,j,k)+Y(i,j,k)*Y(i,j,k)+Z(i,j,k)*Z(i,j,k))-R0 + Sphi(i,j,k) = A*dexp(-rr*rr/TWO/WD/WD) + enddo + enddo + enddo + + Spi = ZEO + + return + + end subroutine get_initial_scalar_sh diff --git a/AMSS_NCKU_source/initial_scalar.h b/AMSS_NCKU_source/initial_scalar.h new file mode 100644 index 0000000..96d8055 --- /dev/null +++ b/AMSS_NCKU_source/initial_scalar.h @@ -0,0 +1,31 @@ + +#ifndef GET_INITIAL_SCALAR_H +#define GET_INITIAL_SCALAR_H + +#ifdef fortran1 +#define f_get_initial_scalar get_initial_scalar +#define f_get_initial_scalar_sh get_initial_scalar_sh +#endif +#ifdef fortran2 +#define f_get_initial_scalar GET_INITIAL_SCALAR +#define f_get_initial_scalar_sh GET_INITIAL_SCALAR_SH +#endif +#ifdef fortran3 +#define f_get_initial_scalar get_initial_scalar_ +#define f_get_initial_scalar_sh get_initial_scalar_sh_ +#endif + +extern "C" +{ + void f_get_initial_scalar(int *, double *, double *, double *, + double *, double *, + double &, double &, double &); +} + +extern "C" +{ + void f_get_initial_scalar_sh(int *, double *, double *, double *, + double *, double *, + double &, double &, double &); +} +#endif /* GET_INITIAL_SCALAR_H */ diff --git a/AMSS_NCKU_source/kodiss.f90 b/AMSS_NCKU_source/kodiss.f90 new file mode 100644 index 0000000..a12ada4 --- /dev/null +++ b/AMSS_NCKU_source/kodiss.f90 @@ -0,0 +1,432 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! (D_+D_-)^2 = +! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2) +! ------------------------------------------------------ +! dx^4 +!------------------------------------------------------------------------------------------------------------------------------ +! do not add dissipation near boundary +subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps) + +implicit none +! argument variables +integer,intent(in) :: Symmetry +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoA +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 1.6d1 ! 2^4 + real*8, parameter :: F4=4.d0,F6=6.d0 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + call symmetry_bd(2,ex,f,fh,SoA) + +! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2) +! ------------------------------------------------------ +! dx^4 + +! note the sign (-1)^r-1, now r=2 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i-2 >= imin .and. i+2 <= imax .and. & + j-2 >= jmin .and. j+2 <= jmax .and. & + k-2 >= kmin .and. k+2 <= kmax) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( & + (fh(i-2,j,k)+fh(i+2,j,k)) & + - F4 * (fh(i-1,j,k)+fh(i+1,j,k)) & + + F6 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( & + (fh(i,j-2,k)+fh(i,j+2,k)) & + - F4 * (fh(i,j-1,k)+fh(i,j+1,k)) & + + F6 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-2)+fh(i,j,k+2)) & + - F4 * (fh(i,j,k-1)+fh(i,j,k+1)) & + + F6 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis + +#elif (ghost_width == 3) +! fourth order code + +!--------------------------------------------------------------------------------------------- +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time +! Dependent Problems and Difference Methods (Wiley, New York, 1995).] +! D_+ = (f(i+1) - f(i))/h +! D_- = (f(i) - f(i-1))/h +! then we have D_+D_- = D_-D_+ +! D_+^3D_-^3 = (D_+D_-)^3 = +! f(i-3) - 6 f(i-2) + 15 f(i-1) - 20 f(i) + 15 f(i+1) - 6 f(i+2) + f(i+3) +! ----------------------------------------------------------------------------- +! dx^6 +! this is for 4th order accurate finite difference scheme +!--------------------------------------------------------------------------------------------- +subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps) + +implicit none +! argument variables +integer,intent(in) :: Symmetry +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoA +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: ONE=1.d0,SIX=6.d0,FIT=1.5d1,TWT=2.d1 +real*8,parameter::cof=6.4d1 ! 2^6 +integer, parameter :: NO_SYMM=0, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry == OCTANT .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry == OCTANT .and. dabs(Y(1)) < dY) jmin = -2 + + call symmetry_bd(3,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i-3 >= imin .and. i+3 <= imax .and. & + j-3 >= jmin .and. j+3 <= jmax .and. & + k-3 >= kmin .and. k+3 <= kmax) then +#if 0 +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) ) +#else +! calculation order if important ? + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/cof *( ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) )/dX + & + ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) )/dY + & + ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) )/dZ ) +#endif + endif + + enddo + enddo + enddo + + return + + end subroutine kodis + +#elif (ghost_width == 4) +! sixth order code +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! (D_+D_-)^4 = +! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4) +! ---------------------------------------------------------------------------------------------------------- +! dx^8 +!------------------------------------------------------------------------------------------------------------------------------ +! do not add dissipation near boundary +subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps) + +implicit none +! argument variables +integer,intent(in) :: Symmetry +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoA +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 2.56d2 ! 2^8 + real*8, parameter :: F8=8.d0,F28=2.8d1,F56=5.6d1,F70=7.d1 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + call symmetry_bd(4,ex,f,fh,SoA) + +! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4) +! ---------------------------------------------------------------------------------------------------------- +! dx^8 + +! note the sign (-1)^r-1, now r=4 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i>imin+3 .and. i < imax-3 .and. & + j>jmin+3 .and. j < jmax-3 .and. & + k>kmin+3 .and. k < kmax-3) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( & + (fh(i-4,j,k)+fh(i+4,j,k)) & + - F8 * (fh(i-3,j,k)+fh(i+3,j,k)) & + +F28 * (fh(i-2,j,k)+fh(i+2,j,k)) & + -F56 * (fh(i-1,j,k)+fh(i+1,j,k)) & + +F70 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( & + (fh(i,j-4,k)+fh(i,j+4,k)) & + - F8 * (fh(i,j-3,k)+fh(i,j+3,k)) & + +F28 * (fh(i,j-2,k)+fh(i,j+2,k)) & + -F56 * (fh(i,j-1,k)+fh(i,j+1,k)) & + +F70 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-4)+fh(i,j,k+4)) & + - F8 * (fh(i,j,k-3)+fh(i,j,k+3)) & + +F28 * (fh(i,j,k-2)+fh(i,j,k+2)) & + -F56 * (fh(i,j,k-1)+fh(i,j,k+1)) & + +F70 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis + +#elif (ghost_width == 5) +! eighth order code +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time +! Dependent Problems and Difference Methods (Wiley, New York, 1995).] +! D_+ = (f(i+1) - f(i))/h +! D_- = (f(i) - f(i-1))/h +! then we have D_+D_- = D_-D_+ = (f(i+1) - 2f(i) + f(i-1))/h^2 +! for nth order accurate finite difference code, we need r =n/2+1 +! D_+^rD_-^r = (D_+D_-)^r +! following the tradiation of PRD 77, 024027 (BB's calibration paper, Eq.(64), +! correct some typo according to above book) : +! + eps*(-1)^(r-1)*h^(2r-1)/2^(2r)*(D_+D_-)^r +! +! +! this is for 8th order accurate finite difference scheme +! (D_+D_-)^5 = +! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5) +! ------------------------------------------------------------------------------------------------------------------------------- +! dx^10 +!--------------------------------------------------------------------------------------------------------------------------------- +! do not add dissipation near boundary +subroutine kodis(ex,X,Y,Z,f,f_rhs,SoA,Symmetry,eps) + +implicit none +! argument variables +integer,intent(in) :: Symmetry +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoA +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-4:ex(1),-4:ex(2),-4:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 1.024d3 ! 2^2r = 2^10 + real*8, parameter :: F10=1.d1,F45=4.5d1,F120=1.2d2,F210=2.1d2,F252=2.52d2 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -4 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -4 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -4 + + call symmetry_bd(5,ex,f,fh,SoA) + +! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5) +! ------------------------------------------------------------------------------------------------------------------------------- +! dx^10 + +! note the sign (-1)^r-1, now r=5 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i>imin+4 .and. i < imax-4 .and. & + j>jmin+4 .and. j < jmax-4 .and. & + k>kmin+4 .and. k < kmax-4) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-5,j,k)+fh(i+5,j,k)) & + - F10 * (fh(i-4,j,k)+fh(i+4,j,k)) & + + F45 * (fh(i-3,j,k)+fh(i+3,j,k)) & + - F120* (fh(i-2,j,k)+fh(i+2,j,k)) & + + F210* (fh(i-1,j,k)+fh(i+1,j,k)) & + - F252 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-5,k)+fh(i,j+5,k)) & + - F10 * (fh(i,j-4,k)+fh(i,j+4,k)) & + + F45 * (fh(i,j-3,k)+fh(i,j+3,k)) & + - F120* (fh(i,j-2,k)+fh(i,j+2,k)) & + + F210* (fh(i,j-1,k)+fh(i,j+1,k)) & + - F252 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-5)+fh(i,j,k+5)) & + - F10 * (fh(i,j,k-4)+fh(i,j,k+4)) & + + F45 * (fh(i,j,k-3)+fh(i,j,k+3)) & + - F120* (fh(i,j,k-2)+fh(i,j,k+2)) & + + F210* (fh(i,j,k-1)+fh(i,j,k+1)) & + - F252 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis + +#endif diff --git a/AMSS_NCKU_source/kodiss.h b/AMSS_NCKU_source/kodiss.h new file mode 100644 index 0000000..32dd5e1 --- /dev/null +++ b/AMSS_NCKU_source/kodiss.h @@ -0,0 +1,42 @@ + +#ifndef KODISS_H +#define KODISS_H + +#ifdef fortran1 +#define f_kodis_sh kodis_sh +#define f_kodis_shcr kodis_shcr +#define f_kodis_shor kodis_shor +#endif +#ifdef fortran2 +#define f_kodis_sh KODIS_SH +#define f_kodis_shcr KODIS_SHCR +#define f_kodis_shor KODIS_SHOR +#endif +#ifdef fortran3 +#define f_kodis_sh kodis_sh_ +#define f_kodis_shcr kodis_shcr_ +#define f_kodis_shor kodis_shor_ +#endif + +extern "C" +{ + void f_kodis_sh(int *, double *, double *, double *, + double *, double *, + double *, int &, double &, int &); +} + +extern "C" +{ + void f_kodis_shcr(int *, double *, double *, double *, + double *, double *, + double *, int &, double &, int &); +} + +extern "C" +{ + void f_kodis_shor(int *, double *, double *, double *, + double *, double *, + double *, int &, double &, int &); +} + +#endif /* KODISS_H */ diff --git a/AMSS_NCKU_source/kodiss_sh.f90 b/AMSS_NCKU_source/kodiss_sh.f90 new file mode 100644 index 0000000..c166995 --- /dev/null +++ b/AMSS_NCKU_source/kodiss_sh.f90 @@ -0,0 +1,1033 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! (D_+D_-)^2 = +! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2) +! ------------------------------------------------------ +! dx^4 +!------------------------------------------------------------------------------------------------------------------------------ +! do not add dissipation near boundary +subroutine kodis_sh(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8, dimension(2) :: SoA + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 1.6d1 ! 2^4 + real*8, parameter :: F4=4.d0,F6=6.d0 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2) +! ------------------------------------------------------ +! dx^4 + +! note the sign (-1)^r-1, now r=2 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i-2 >= imin .and. i+2 <= imax .and. & + j-2 >= jmin .and. j+2 <= jmax .and. & + k-2 >= kmin .and. k+2 <= kmax) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( & + (fh(i-2,j,k)+fh(i+2,j,k)) & + - F4 * (fh(i-1,j,k)+fh(i+1,j,k)) & + + F6 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( & + (fh(i,j-2,k)+fh(i,j+2,k)) & + - F4 * (fh(i,j-1,k)+fh(i,j+1,k)) & + + F6 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-2)+fh(i,j,k+2)) & + - F4 * (fh(i,j,k-1)+fh(i,j,k+1)) & + + F6 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_sh + +! add dissipation near boundary for tangiential direction +subroutine kodis_sh_new(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8, dimension(2) :: SoA + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 1.6d1 ! 2^4 + real*8, parameter :: F4=4.d0,F6=6.d0 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! f(i-2) - 4 f(i-1) + 6 f(i) - 4 f(i+1) + f(i+2) +! ------------------------------------------------------ +! dx^4 + +! note the sign (-1)^r-1, now r=2 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i-2 >= imin .and. i+2 <= imax)then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( & + (fh(i-2,j,k)+fh(i+2,j,k)) & + - F4 * (fh(i-1,j,k)+fh(i+1,j,k)) & + + F6 * fh(i,j,k) ) + endif + if(j-2 >= jmin .and. j+2 <= jmax)then +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( & + (fh(i,j-2,k)+fh(i,j+2,k)) & + - F4 * (fh(i,j-1,k)+fh(i,j+1,k)) & + + F6 * fh(i,j,k) ) + endif + if(k-2 >= kmin .and. k+2 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-2)+fh(i,j,k+2)) & + - F4 * (fh(i,j,k-1)+fh(i,j,k+1)) & + + F6 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_sh_new + + +subroutine kodis_shor(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8, dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: cof = 1.6d1 ! 2^4 +real*8, parameter :: F4=4.d0,F6=6.d0 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(k-2 >= kmin .and. k+2 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-2)+fh(i,j,k+2)) & + - F4 * (fh(i,j,k-1)+fh(i,j,k+1)) & + + F6 * fh(i,j,k) ) + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_shor + + +#elif (ghost_width == 3) +! fourth order code + +!--------------------------------------------------------------------------------------------- +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time +! Dependent Problems and Difference Methods (Wiley, New York, 1995).] +! D_+ = (f(i+1) - f(i))/h +! D_- = (f(i) - f(i-1))/h +! then we have D_+D_- = D_-D_+ +! D_+^3D_-^3 = (D_+D_-)^3 = +! f(i-3) - 6 f(i-2) + 15 f(i-1) - 20 f(i) + 15 f(i+1) - 6 f(i+2) + f(i+3) +! ----------------------------------------------------------------------------- +! dx^6 +! this is for 4th order accurate finite difference scheme +!--------------------------------------------------------------------------------------------- +subroutine kodis_sh(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: ONE=1.d0,SIX=6.d0,FIT=1.5d1,TWT=2.d1 +real*8,parameter::cof=6.4d1 ! 2^6 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + +#if 1 + if(i-3 >= imin .and. i+3 <= imax .and. & + j-3 >= jmin .and. j+3 <= jmax .and. & + k-3 >= kmin .and. k+3 <= kmax) then +#if 0 +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) ) +#else +! calculation order if important ? + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/cof *( ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) )/dX + & + ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) )/dY + & + ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) )/dZ ) +#endif + endif +#else + if(i-3 >= imin .and. i+3 <= imax) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) ) + endif + if(j-3 >= jmin .and. j+3 <= jmax) then +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) ) + endif + if(k-3 >= kmin .and. k+3 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) ) + endif +#endif + enddo + enddo + enddo + + return + + end subroutine kodis_sh +! only on constant r sphere +subroutine kodis_shcr(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: ONE=1.d0,SIX=6.d0,FIT=1.5d1,TWT=2.d1 +real*8,parameter::cof=6.4d1 ! 2^6 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i-3 >= imin .and. i+3 <= imax .and. & + j-3 >= jmin .and. j+3 <= jmax) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-3,j,k)+fh(i+3,j,k)) - & + SIX*(fh(i-2,j,k)+fh(i+2,j,k)) + & + FIT*(fh(i-1,j,k)+fh(i+1,j,k)) - & + TWT* fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-3,k)+fh(i,j+3,k)) - & + SIX*(fh(i,j-2,k)+fh(i,j+2,k)) + & + FIT*(fh(i,j-1,k)+fh(i,j+1,k)) - & + TWT* fh(i,j,k) ) + endif + + enddo + enddo + enddo + + return + + end subroutine kodis_shcr + +! only in r direction + +subroutine kodis_shor(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8, dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: ONE=1.d0,SIX=6.d0,FIT=1.5d1,TWT=2.d1 +real*8,parameter::cof=6.4d1 ! 2^6 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(k-3 >= kmin .and. k+3 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-3)+fh(i,j,k+3)) - & + SIX*(fh(i,j,k-2)+fh(i,j,k+2)) + & + FIT*(fh(i,j,k-1)+fh(i,j,k+1)) - & + TWT* fh(i,j,k) ) + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_shor + + +#elif (ghost_width == 4) +! sixth order code +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! (D_+D_-)^4 = +! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4) +! ---------------------------------------------------------------------------------------------------------- +! dx^8 +!------------------------------------------------------------------------------------------------------------------------------ +! do not add dissipation near boundary +subroutine kodis_sh(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8, dimension(2) :: SoA + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: cof = 2.56d2 ! 2^8 + real*8, parameter :: F8=8.d0,F28=2.8d1,F56=5.6d1,F70=7.d1 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +! f(i-4) - 8 f(i-3) + 28 f(i-2) - 56 f(i-1) + 70 f(i) - 56 f(i+1) + 28 f(i+2) - 8 f(i+3) + f(i+4) +! ---------------------------------------------------------------------------------------------------------- +! dx^8 + +! note the sign (-1)^r-1, now r=4 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i>imin+3 .and. i < imax-3 .and. & + j>jmin+3 .and. j < jmax-3 .and. & + k>kmin+3 .and. k < kmax-3) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dX/cof * ( & + (fh(i-4,j,k)+fh(i+4,j,k)) & + - F8 * (fh(i-3,j,k)+fh(i+3,j,k)) & + +F28 * (fh(i-2,j,k)+fh(i+2,j,k)) & + -F56 * (fh(i-1,j,k)+fh(i+1,j,k)) & + +F70 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dY/cof * ( & + (fh(i,j-4,k)+fh(i,j+4,k)) & + - F8 * (fh(i,j-3,k)+fh(i,j+3,k)) & + +F28 * (fh(i,j-2,k)+fh(i,j+2,k)) & + -F56 * (fh(i,j-1,k)+fh(i,j+1,k)) & + +F70 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-4)+fh(i,j,k+4)) & + - F8 * (fh(i,j,k-3)+fh(i,j,k+3)) & + +F28 * (fh(i,j,k-2)+fh(i,j,k+2)) & + -F56 * (fh(i,j,k-1)+fh(i,j,k+1)) & + +F70 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_sh + +! only in r direction + +subroutine kodis_shor(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8, dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8, parameter :: cof = 2.56d2 ! 2^8 +real*8, parameter :: F8=8.d0,F28=2.8d1,F56=5.6d1,F70=7.d1 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(k-4 >= kmin .and. k+4 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) - eps/dZ/cof * ( & + (fh(i,j,k-4)+fh(i,j,k+4)) & + - F8 * (fh(i,j,k-3)+fh(i,j,k+3)) & + +F28 * (fh(i,j,k-2)+fh(i,j,k+2)) & + -F56 * (fh(i,j,k-1)+fh(i,j,k+1)) & + +F70 * fh(i,j,k) ) + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_shor + +#elif (ghost_width == 5) +! eighth order code +!------------------------------------------------------------------------------------------------------------------------------ +!usual type Kreiss-Oliger type numerical dissipation +!We support cell center only +! Note the notation D_+ and D_- [P240 of B. Gustafsson, H.-O. Kreiss, and J. Oliger, Time +! Dependent Problems and Difference Methods (Wiley, New York, 1995).] +! D_+ = (f(i+1) - f(i))/h +! D_- = (f(i) - f(i-1))/h +! then we have D_+D_- = D_-D_+ = (f(i+1) - 2f(i) + f(i-1))/h^2 +! for nth order accurate finite difference code, we need r =n/2+1 +! D_+^rD_-^r = (D_+D_-)^r +! following the tradiation of PRD 77, 024027 (BB's calibration paper, Eq.(64), +! correct some typo according to above book) : +! + eps*(-1)^(r-1)*h^(2r-1)/2^(2r)*(D_+D_-)^r +! +! +! this is for 8th order accurate finite difference scheme +! (D_+D_-)^5 = +! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5) +! ------------------------------------------------------------------------------------------------------------------------------- +! dx^10 +!--------------------------------------------------------------------------------------------------------------------------------- +! do not add dissipation near boundary +subroutine kodis_sh(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps + +!~~~~~~ other variables + + real*8, dimension(2) :: SoA + real*8 :: dX,dY,dZ + real*8,dimension(-4:ex(1)+5,-4:ex(2)+5,ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8,parameter :: cof = 1.024d3 ! 2^2r = 2^10 + real*8, parameter :: F10=1.d1,F45=4.5d1,F120=1.2d2,F210=2.1d2,F252=2.52d2 + integer::i,j,k + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -4 + if(dabs(Y(1)) < dY) jmin = -4 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -4 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+5 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(5,ex,f,fh,SoA) + +! f(i-5) - 10 f(i-4) + 45 f(i-3) - 120 f(i-2) + 210 f(i-1) - 252 f(i) + 210 f(i+1) - 120 f(i+2) + 45 f(i+3) - 10 f(i+4) + f(i+5) +! ------------------------------------------------------------------------------------------------------------------------------- +! dx^10 + +! note the sign (-1)^r-1, now r=5 + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(i>imin+4 .and. i < imax-4 .and. & + j>jmin+4 .and. j < jmax-4 .and. & + k>kmin+4 .and. k < kmax-4) then +! x direction + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dX/cof * ( & + (fh(i-5,j,k)+fh(i+5,j,k)) & + - F10 * (fh(i-4,j,k)+fh(i+4,j,k)) & + + F45 * (fh(i-3,j,k)+fh(i+3,j,k)) & + - F120* (fh(i-2,j,k)+fh(i+2,j,k)) & + + F210* (fh(i-1,j,k)+fh(i+1,j,k)) & + - F252 * fh(i,j,k) ) +! y direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dY/cof * ( & + (fh(i,j-5,k)+fh(i,j+5,k)) & + - F10 * (fh(i,j-4,k)+fh(i,j+4,k)) & + + F45 * (fh(i,j-3,k)+fh(i,j+3,k)) & + - F120* (fh(i,j-2,k)+fh(i,j+2,k)) & + + F210* (fh(i,j-1,k)+fh(i,j+1,k)) & + - F252 * fh(i,j,k) ) +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-5)+fh(i,j,k+5)) & + - F10 * (fh(i,j,k-4)+fh(i,j,k+4)) & + + F45 * (fh(i,j,k-3)+fh(i,j,k+3)) & + - F120* (fh(i,j,k-2)+fh(i,j,k+2)) & + + F210* (fh(i,j,k-1)+fh(i,j,k+1)) & + - F252 * fh(i,j,k) ) + + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_sh + +! only in r direction + +subroutine kodis_shor(ex,X,Y,Z,f,f_rhs,SoAi,Symmetry,eps,sst) + +implicit none +! argument variables +integer,intent(in) :: Symmetry,sst +integer,dimension(3),intent(in)::ex +real*8, dimension(1:3), intent(in) :: SoAi +double precision,intent(in),dimension(ex(1))::X +double precision,intent(in),dimension(ex(2))::Y +double precision,intent(in),dimension(ex(3))::Z +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f +double precision,intent(inout),dimension(ex(1),ex(2),ex(3))::f_rhs +real*8,intent(in) :: eps +! local variables +real*8, dimension(2) :: SoA +real*8, dimension(-4:ex(1)+5,-4:ex(2)+5,ex(3)) :: fh +integer :: imin,jmin,kmin,imax,jmax,kmax +integer :: i,j,k +real*8 :: dX,dY,dZ +real*8,parameter :: cof = 1.024d3 ! 2^2r = 2^10 +real*8, parameter :: F10=1.d1,F45=4.5d1,F120=1.2d2,F210=2.1d2,F252=2.52d2 +integer, parameter :: NO_SYMM=0, EQ_SYMM=1, OCTANT=2 + +!rhs_i = rhs_i + eps/dx/cof*(f_i-3 - 6*f_i-2 + 15*f_i-1 - 20*f_i + 15*f_i+1 - 6*f_i+2 + f_i+3) + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -4 + if(dabs(Y(1)) < dY) jmin = -4 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -4 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+5 + endif + + if(sst==0)then + SoA = SoAi(1:2) + elseif(sst==2.or.sst==3)then + SoA(1) = SoAi(2) + SoA(2) = SoAi(3) + elseif(sst==4.or.sst==5)then + SoA(1) = SoAi(1) + SoA(2) = SoAi(3) + endif + + call symmetry_stbd(5,ex,f,fh,SoA) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + + if(k-5 >= kmin .and. k+5 <= kmax) then +! z direction + + f_rhs(i,j,k) = f_rhs(i,j,k) + eps/dZ/cof * ( & + (fh(i,j,k-5)+fh(i,j,k+5)) & + - F10 * (fh(i,j,k-4)+fh(i,j,k+4)) & + + F45 * (fh(i,j,k-3)+fh(i,j,k+3)) & + - F120* (fh(i,j,k-2)+fh(i,j,k+2)) & + + F210* (fh(i,j,k-1)+fh(i,j,k+1)) & + - F252 * fh(i,j,k) ) + endif + + enddo + enddo + enddo + + return + +end subroutine kodis_shor + +#endif diff --git a/AMSS_NCKU_source/linear_map.C b/AMSS_NCKU_source/linear_map.C new file mode 100644 index 0000000..df6e7e8 --- /dev/null +++ b/AMSS_NCKU_source/linear_map.C @@ -0,0 +1,244 @@ +#include +#include + +#include "stdc.h" +#include "util.h" +#include "linear_map.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + template + linear_map::linear_map(int min_int_in, int max_int_in, + fp_t min_fp_in, fp_t delta_fp_in, fp_t max_fp_in) + : delta_(delta_fp_in), inverse_delta_(1.0 / delta_fp_in), + min_int_(min_int_in), max_int_(max_int_in) + { + constructor_common(min_fp_in, max_fp_in); + } + + template + linear_map::linear_map(const linear_map &lm_in, + int min_int_in, int max_int_in) // subrange + : delta_(lm_in.delta_fp()), inverse_delta_(lm_in.inverse_delta_fp()), + min_int_(min_int_in), max_int_(max_int_in) + { + if (!(is_in_range(min_int_in) && is_in_range(max_int_in))) + then error_exit(ERROR_EXIT, + "***** linear_map::linear_map:\n" + " min_int_in=%d and/or max_int_in=%d\n" + " aren't in integer range [%d,%d] of existing linear_map!\n", + min_int_, max_int_, + lm_in.min_int(), lm_in.max_int()); /*NOTREACHED*/ + + constructor_common(lm_in.fp_of_int_unchecked(min_int_in), + lm_in.fp_of_int_unchecked(max_int_in)); + } + + //****************************************************************************** + + // + // This function does the common argument validation and setup for + // all the constructors of class linear_map:: . + // + template + void linear_map::constructor_common(fp_t min_fp_in, fp_t max_fp_in) + // assumes + // min_int_, max_int_, delta_, inverse_delta_ + // are already initialized + // ==> ok to use min_int(), max_int(), delta_fp(), inverse_delta_fp() + // ... other class members *not* yet initialized + { + origin_ = 0.0; // temp value + origin_ = min_fp_in - fp_of_int_unchecked(min_int()); + + // this should be guaranteed by the above calculation + assert(fuzzy::EQ(fp_of_int_unchecked(min_int()), min_fp_in)); + + // this is a test of the consistency of the input arguments + if (fuzzy::NE(fp_of_int_unchecked(max_int()), max_fp_in)) + then error_exit(ERROR_EXIT, + "***** linear_map::linear_map:\n" + " int range [%d,%d]\n" + " and fp range [%g(%g)%g]\n" + " are (fuzzily) inconsistent!\n", + min_int(), max_int(), + double(min_fp_in), double(delta_fp()), double(max_fp_in)); + /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function converts fp --> int coordinate, returning the result + // as an fp (which need not be fuzzily integral). + // + template + fp_t linear_map::fp_int_of_fp(fp_t x) + const + { + if (!is_in_range(x)) + then error_exit(ERROR_EXIT, + "***** linear_map::fp_int_of_fp:\n" + " fp value x=%g is (fuzzily) outside the grid!\n" + " {min(delta)max}_fp = %g(%g)%g\n", + double(x), + double(min_fp()), double(delta_fp()), double(max_fp())); + /*NOTREACHED*/ + + return inverse_delta_ * (x - origin_); + } + + //****************************************************************************** + + // + // This function converts fp --> int and checks that the result is + // fuzzily integral. (The nia argument specifies what to do if the + // result *isn't* fuzzily integral.) + // + // FIXME: + // Having to explicitly specify the namespace for jtutil::round:: + // is ++ugly. :( + // + template + int linear_map::int_of_fp(fp_t x, noninteger_action nia /* = nia_error */) + const + { + const fp_t fp_int = fp_int_of_fp(x); + + if (fuzzy::is_integer(fp_int)) + then + { + // x is (fuzzily) a grid point ==> return that + return jtutil::round::to_integer(fp_int); // *** EARLY RETURN *** + } + + // get to here ==> x isn't (fuzzily) a grid point + static const char *const noninteger_msg = + "%s linear_map::int_of_fp:\n" + " x=%g isn't (fuzzily) a grid point!\n" + " {min(delta)max}_fp() = %g(%g)%g\n"; + switch (nia) + { + case nia_error: + error_exit(ERROR_EXIT, + noninteger_msg, + "*****", + double(x), + double(min_fp()), double(delta_fp()), double(max_fp())); + /*NOTREACHED*/ + + case nia_warning: + printf(noninteger_msg, + "---", + double(x), + double(min_fp()), double(delta_fp()), double(max_fp())); + // fall through + + case nia_round: + return jtutil::round::to_integer(fp_int); // *** EARLY RETURN *** + + case nia_floor: + return jtutil::round::floor(fp_int); // *** EARLY RETURN *** + + case nia_ceiling: + return jtutil::round::ceiling(fp_int); // *** EARLY RETURN *** + + default: + error_exit(PANIC_EXIT, + "***** linear_map::int_of_fp: illegal nia=(int)%d\n" + " (this should never happen!)\n", + int(nia)); /*NOTREACHED*/ + } + return 0; // dummy return to quiet gcc + // (which doesn't grok that error_exit() never returns) + } + + //****************************************************************************** + + // + // This function converts "delta" spacings in the fp coordinate to + // corresponding "delta" spacings in the int coordinate, and checks that + // the result is fuzzily integral. (The nia argument specifies what to + // do if the result *isn't* fuzzily integral.) + // + // FIXME: + // Having to explicitly specify the namespace for jtutil::round:: + // is ++ugly. :( + // + template + int linear_map::delta_int_of_delta_fp(fp_t delta_x, noninteger_action nia /* = nia_error */) + const + { + const fp_t fp_delta_int = inverse_delta_ * delta_x; + + if (fuzzy::is_integer(fp_delta_int)) + then + { + // delta_x is (fuzzily) an integer number of grid spacings + // ==> return that + return jtutil::round::to_integer(fp_delta_int); + // *** EARLY RETURN *** + } + + // get to here ==> delta_x isn't (fuzzily) an integer number of grid spacings + static const char *const noninteger_msg = + "%s linear_map::delta_int_of_delta_fp:\n" + " delta_x=%g isn't (fuzzily) an integer number of grid spacings!\n" + " {min(delta)max}_fp() = %g(%g)%g\n"; + switch (nia) + { + case nia_error: + error_exit(ERROR_EXIT, + noninteger_msg, + "*****", + double(delta_x), + double(min_fp()), double(delta_fp()), double(max_fp())); + /*NOTREACHED*/ + + case nia_warning: + printf(noninteger_msg, + "---", + double(delta_x), + double(min_fp()), double(delta_fp()), double(max_fp())); + // fall through + + case nia_round: + return jtutil::round::to_integer(fp_delta_int); + // *** EARLY RETURN *** + + case nia_floor: + return jtutil::round::floor(fp_delta_int); // *** EARLY RETURN *** + + case nia_ceiling: + return jtutil::round::ceiling(fp_delta_int); + // *** EARLY RETURN *** + + default: + error_exit(PANIC_EXIT, + "***** linear_map::delta_int_of_delta_fp: illegal nia=(int)%d\n" + " (this should never happen!)\n", + int(nia)); /*NOTREACHED*/ + } + return 0; // dummy return to quiet gcc + // (which doesn't grok that error_exit() never returns) + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // ***** template instantiation ***** + // + + template class linear_map; + template class linear_map; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/linear_map.h b/AMSS_NCKU_source/linear_map.h new file mode 100644 index 0000000..66a6618 --- /dev/null +++ b/AMSS_NCKU_source/linear_map.h @@ -0,0 +1,131 @@ +#ifndef AHFINDERDIRECT__LINEAR_MAP_HH +#define AHFINDERDIRECT__LINEAR_MAP_HH +namespace AHFinderDirect +{ + namespace jtutil + { + + template + class linear_map + { + public: + // integer bounds info + int min_int() const { return min_int_; } + int max_int() const { return max_int_; } + int N_points() const + { + return jtutil::how_many_in_range(min_int_, max_int_); + } + bool is_in_range(int i) const + { + return (i >= min_int()) && (i <= max_int()); + } + int clamp(int i) const + { + if (i < min_int()) + then return min_int(); + else if (i > max_int()) + then return max_int(); + else + return i; + } + + // convert int --> fp + fp_t fp_of_int_unchecked(int i) const + { + return origin_ + delta_ * i; + } + fp_t fp_of_int(int i) const + { + assert(is_in_range(i)); + return fp_of_int_unchecked(i); + } + + // converg delta_int --> delta_fp + fp_t delta_fp_of_delta_int(int delta_i) const + { + return delta_ * delta_i; + } + + // fp bounds info + fp_t origin() const { return origin_; } + fp_t delta_fp() const { return delta_; } + fp_t inverse_delta_fp() const { return inverse_delta_; } + fp_t min_fp() const { return fp_of_int_unchecked(min_int_); } + fp_t max_fp() const { return fp_of_int_unchecked(max_int_); } + bool is_in_range(fp_t x) const + { + return fuzzy::GE(x, min_fp()) && fuzzy::LE(x, max_fp()); + } + fp_t clamp(fp_t x) const + { + if (x < min_fp()) + then return min_fp(); + else if (x > max_fp()) + then return max_fp(); + else + return x; + } + + // convert linear map indices <--> C-style 0-origin indices + int zero_origin_int(int i) const { return i - min_int(); } + int map_int(int zero_origin_i) { return zero_origin_i + min_int(); } + + // convert fp --> int coordinate, but return result as fp + // (which need not be fuzzily integral) + fp_t fp_int_of_fp(fp_t x) const; + + // convert fp --> int, check being fuzzily integral + enum noninteger_action // what to do if "int" + // isn't fuzzily integral? + { + nia_error, // jtutil::error_exit(...) + nia_warning, // print warning msg, + // then round to nearest + nia_round, // (silently) round to nearest + nia_floor, // (silently) round to -infinity + nia_ceiling // (silently) round to +infinity + }; + int int_of_fp(fp_t x, noninteger_action nia = nia_error) const; + + // convert delta_fp --> delta_int, check being fuzzily integral + int delta_int_of_delta_fp(fp_t delta_x, + noninteger_action nia = nia_error) + const; + + // constructors + linear_map(int min_int_in, int max_int_in, + fp_t min_fp_in, fp_t delta_fp_in, fp_t max_fp_in); + // ... construct with subrange of existing linear_map + linear_map(const linear_map &lm_in, + int min_int_in, int max_int_in); + + // no need for explicit destructor, compiler-generated no-op is ok + + // no need for copy constructor or assignment operator, + // compiler-generated defaults are ok + + private: + // common code (argument validation & setup) for all constructors + // assumes min_int_, max_int_, delta_ already initialized, + // other class members *not* initialized + void constructor_common(fp_t min_fp_in, fp_t max_fp_in); + + // these define the actual mapping + // via the fp_of_int() function (above) + fp_t origin_, delta_; + + // cache of 1.0/delta_ + // ==> avoids fp divide in inverse_delta_fp() + // ==> also makes fp --> int conversions slightly faster + fp_t inverse_delta_; + + const int min_int_, max_int_; + }; + + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect + +#endif /* AHFINDERDIRECT__LINEAR_MAP_HH */ diff --git a/AMSS_NCKU_source/lopsidediff.f90 b/AMSS_NCKU_source/lopsidediff.f90 new file mode 100644 index 0000000..2e97af5 --- /dev/null +++ b/AMSS_NCKU_source/lopsidediff.f90 @@ -0,0 +1,902 @@ + +! Compute advection terms in right hand sides of field equations + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!----------------------------------------------------------------------------- +! v +! D f = ------[ - 3 f + 4 f - f ] +! i 2dx i i+v i+2v +! +! where +! +! i +! |B | +! v = ----- +! i +! B +! +!----------------------------------------------------------------------------- +subroutine lopsided(ex,X,Y,Z,f,f_rhs,Sfx,Sfy,Sfz,Symmetry,SoA) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),Symmetry + real*8, intent(in) :: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8,dimension(ex(1),ex(2),ex(3)),intent(in) :: f,Sfx,Sfy,Sfz + + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout):: f_rhs + real*8,dimension(3),intent(in) ::SoA + +!~~~~~~> local variables: +! note index -1,0, so we have 2 extra points + real*8,dimension(-1:ex(1),-1:ex(2),-1:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: dX,dY,dZ + real*8 :: d2dx,d2dy,d2dz + real*8, parameter :: ZEO=0.d0,ONE=1.d0,TWO=2.d0,THR=3.d0,FOUR=4.d0 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -1 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -1 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -1 + + call symmetry_bd(2,ex,f,fh,SoA) + +! upper bound set ex-1 only for efficiency, +! the loop body will set ex 0 also + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(Sfx(i,j,k) >= ZEO)then + if( i+2 <= imax .and. i >= imin)then +! v +! D f = ------[ - 3 f + 4 f - f ] +! i 2dx i i+v i+2v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d2dx*(-THR*fh(i,j,k)+FOUR*fh(i+1,j,k)-fh(i+2,j,k)) + elseif(i+1 <= imax .and. i >= imin)then +! v +! D f = ------[ - f + f ] +! i dx i i+v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d2dx*(-fh(i,j,k)+fh(i+1,j,k)) + + endif + + elseif(Sfx(i,j,k) <= ZEO)then + if( i-2 >= imin .and. i <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d2dx*(-THR*fh(i,j,k)+FOUR*fh(i-1,j,k)-fh(i-2,j,k)) + elseif(i-1 >= imin .and. i <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d2dx*(-fh(i,j,k)+fh(i-1,j,k)) + endif + +! set imax and imin 0 + endif + +! y direction + if(Sfy(i,j,k) >= ZEO)then + if( j+2 <= jmax .and. j >= jmin)then +! v +! D f = ------[ - 3 f + 4 f - f ] +! i 2dx i i+v i+2v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d2dy*(-THR*fh(i,j,k)+FOUR*fh(i,j+1,k)-fh(i,j+2,k)) + elseif(j+1 <= jmax .and. j >= jmin)then +! v +! D f = ------[ - f + f ] +! i dx i i+v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d2dy*(-fh(i,j,k)+fh(i,j+1,k)) + endif + + elseif(Sfy(i,j,k) <= ZEO)then + if( j-2 >= jmin .and. j <= jmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d2dy*(-THR*fh(i,j,k)+FOUR*fh(i,j-1,k)-fh(i,j-2,k)) + elseif(j-1 >= jmin .and. j <= jmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d2dy*(-fh(i,j,k)+fh(i,j-1,k)) + endif + +! set jmin and jmax 0 + endif +!! z direction + if(Sfz(i,j,k) >= ZEO)then + if( k+2 <= kmax .and. k >= kmin)then +! v +! D f = ------[ - 3 f + 4 f - f ] +! i 2dx i i+v i+2v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d2dz*(-THR*fh(i,j,k)+FOUR*fh(i,j,k+1)-fh(i,j,k+2)) + elseif(k+1 <= kmax .and. k >= kmin)then +! v +! D f = ------[ - f + f ] +! i dx i i+v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d2dz*(-fh(i,j,k)+fh(i,j,k+1)) + endif + + elseif(Sfz(i,j,k) <= ZEO)then + if( k-2 >= kmin .and. k <= kmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d2dz*(-THR*fh(i,j,k)+FOUR*fh(i,j,k-1)-fh(i,j,k-2)) + elseif(k-1 >= kmin .and. k <= kmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d2dz*(-fh(i,j,k)+fh(i,j,k-1)) + endif + +! set kmin and kmax 0 + endif + + enddo + enddo + enddo + + return + + end subroutine lopsided + +#elif (ghost_width == 3) +! fourth order code + +!----------------------------------------------------------------------------- +! +! Compute advection terms in right hand sides of field equations +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v +! +! where +! +! i +! |B | +! v = ----- +! i +! B +! +!----------------------------------------------------------------------------- + +subroutine lopsided(ex,X,Y,Z,f,f_rhs,Sfx,Sfy,Sfz,Symmetry,SoA) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),Symmetry + real*8, intent(in) :: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8,dimension(ex(1),ex(2),ex(3)),intent(in) :: f,Sfx,Sfy,Sfz + + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout):: f_rhs + real*8,dimension(3),intent(in) ::SoA + +!~~~~~~> local variables: +! note index -2,-1,0, so we have 3 extra points + real*8,dimension(-2:ex(1),-2:ex(2),-2:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: dX,dY,dZ + real*8 :: d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F3=3.d0 + real*8, parameter :: TWO=2.d0,F6=6.0d0,F18=1.8d1 + real*8, parameter :: F12=1.2d1, F10=1.d1,EIT=8.d0 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -2 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -2 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -2 + + call symmetry_bd(3,ex,f,fh,SoA) + +! upper bound set ex-1 only for efficiency, +! the loop body will set ex 0 also + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +#if 0 +!! old code +! x direction + if(Sfx(i,j,k) >= ZEO .and. i+3 <= imax .and. i-1 >= imin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(-F3*fh(i-1,j,k)-F10*fh(i,j,k)+F18*fh(i+1,j,k) & + -F6*fh(i+2,j,k)+ fh(i+3,j,k)) + + elseif(Sfx(i,j,k) <= ZEO .and. i-3 >= imin .and. i+1 <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d12dx*(-F3*fh(i+1,j,k)-F10*fh(i,j,k)+F18*fh(i-1,j,k) & + -F6*fh(i-2,j,k)+ fh(i-3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfx(i,j,k)*d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + +! y direction + if(Sfy(i,j,k) >= ZEO .and. j+3 <= jmax .and. j-1 >= jmin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j-1,k)-F10*fh(i,j,k)+F18*fh(i,j+1,k) & + -F6*fh(i,j+2,k)+ fh(i,j+3,k)) + + elseif(Sfy(i,j,k) <= ZEO .and. j-3 >= jmin .and. j+1 <= jmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j+1,k)-F10*fh(i,j,k)+F18*fh(i,j-1,k) & + -F6*fh(i,j-2,k)+ fh(i,j-3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfy(i,j,k)*d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) +! set jmin and jmax 0 + endif +!! z direction + if(Sfz(i,j,k) >= ZEO .and. k+3 <= kmax .and. k-1 >= kmin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k-1)-F10*fh(i,j,k)+F18*fh(i,j,k+1) & + -F6*fh(i,j,k+2)+ fh(i,j,k+3)) + + elseif(Sfz(i,j,k) <= ZEO .and. k-3 >= kmin .and. k+1 <= kmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k+1)-F10*fh(i,j,k)+F18*fh(i,j,k-1) & + -F6*fh(i,j,k-2)+ fh(i,j,k-3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+Sfz(i,j,k)*d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) +! set kmin and kmax 0 + endif +#else +!! new code, 2012dec27, based on bam +! x direction + if(Sfx(i,j,k) > ZEO)then + if(i+3 <= imax)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(-F3*fh(i-1,j,k)-F10*fh(i,j,k)+F18*fh(i+1,j,k) & + -F6*fh(i+2,j,k)+ fh(i+3,j,k)) + elseif(i+2 <= imax)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d12dx*(-F3*fh(i+1,j,k)-F10*fh(i,j,k)+F18*fh(i-1,j,k) & + -F6*fh(i-2,j,k)+ fh(i-3,j,k)) +! set imax and imin 0 + endif + elseif(Sfx(i,j,k) < ZEO)then + if(i-3 >= imin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d12dx*(-F3*fh(i+1,j,k)-F10*fh(i,j,k)+F18*fh(i-1,j,k) & + -F6*fh(i-2,j,k)+ fh(i-3,j,k)) + elseif(i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i-1 >= imin)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(-F3*fh(i-1,j,k)-F10*fh(i,j,k)+F18*fh(i+1,j,k) & + -F6*fh(i+2,j,k)+ fh(i+3,j,k)) +! set imax and imin 0 + endif + endif + +! y direction + if(Sfy(i,j,k) > ZEO)then + if(j+3 <= jmax)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j-1,k)-F10*fh(i,j,k)+F18*fh(i,j+1,k) & + -F6*fh(i,j+2,k)+ fh(i,j+3,k)) + elseif(j+2 <= jmax)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j+1,k)-F10*fh(i,j,k)+F18*fh(i,j-1,k) & + -F6*fh(i,j-2,k)+ fh(i,j-3,k)) +! set imax and imin 0 + endif + elseif(Sfy(i,j,k) < ZEO)then + if(j-3 >= jmin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j+1,k)-F10*fh(i,j,k)+F18*fh(i,j-1,k) & + -F6*fh(i,j-2,k)+ fh(i,j-3,k)) + elseif(j-2 >= jmin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j-1 >= jmin)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(-F3*fh(i,j-1,k)-F10*fh(i,j,k)+F18*fh(i,j+1,k) & + -F6*fh(i,j+2,k)+ fh(i,j+3,k)) +! set jmax and jmin 0 + endif + endif + +! z direction + if(Sfz(i,j,k) > ZEO)then + if(k+3 <= kmax)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k-1)-F10*fh(i,j,k)+F18*fh(i,j,k+1) & + -F6*fh(i,j,k+2)+ fh(i,j,k+3)) + elseif(k+2 <= kmax)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k+1)-F10*fh(i,j,k)+F18*fh(i,j,k-1) & + -F6*fh(i,j,k-2)+ fh(i,j,k-3)) +! set imax and imin 0 + endif + elseif(Sfz(i,j,k) < ZEO)then + if(k-3 >= kmin)then +! v +! D f = ------[ - 3f - 10f + 18f - 6f + f ] +! i 12dx i-v i i+v i+2v i+3v + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k+1)-F10*fh(i,j,k)+F18*fh(i,j,k-1) & + -F6*fh(i,j,k-2)+ fh(i,j,k-3)) + elseif(k-2 >= kmin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k-1 >= kmin)then +! v +! D f = ------[ 3f + 10f - 18f + 6f - f ] +! i 12dx i+v i i-v i-2v i-3v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(-F3*fh(i,j,k-1)-F10*fh(i,j,k)+F18*fh(i,j,k+1) & + -F6*fh(i,j,k+2)+ fh(i,j,k+3)) +! set kmax and kmin 0 + endif + endif +#endif + enddo + enddo + enddo + + return + + end subroutine lopsided + +#elif (ghost_width == 4) +! sixth order code +! Compute advection terms in right hand sides of field equations +! v +! D f = ------[ 2f - 24f - 35f + 80f - 30f + 8f - f ] +! i 60dx i-2v i-v i i+v i+2v i+3v i+4v +! +! where +! +! i +! |B | +! v = ----- +! i +! B +! +!----------------------------------------------------------------------------- +subroutine lopsided(ex,X,Y,Z,f,f_rhs,Sfx,Sfy,Sfz,Symmetry,SoA) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),Symmetry + real*8, intent(in) :: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8,dimension(ex(1),ex(2),ex(3)),intent(in) :: f,Sfx,Sfy,Sfz + + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout):: f_rhs + real*8,dimension(3),intent(in) ::SoA + +!~~~~~~> local variables: + + real*8,dimension(-3:ex(1),-3:ex(2),-3:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: dX,dY,dZ + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,F24=2.4d1,F35=3.5d1,F80=8.d1,F30=3.d1,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + real*8, parameter :: F10=1.d1,F77=7.7d1,F150=1.5d2,F100=1.d2,F50=5.d1,F15=1.5d1 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -3 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -3 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -3 + + call symmetry_bd(4,ex,f,fh,SoA) + +! upper bound set ex-1 only for efficiency, +! the loop body will set ex 0 also + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(Sfx(i,j,k) >= ZEO .and. i+4 <= imax .and. i-2 >= imin)then +! v +! D f = ------[ 2f - 24f - 35f + 80f - 30f + 8f - f ] +! i 60dx i-2v i-v i i+v i+2v i+3v i+4v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d60dx*(TWO*fh(i-2,j,k)-F24*fh(i-1,j,k)-F35*fh(i,j,k)+F80*fh(i+1,j,k) & + -F30*fh(i+2,j,k)+EIT*fh(i+3,j,k)- fh(i+4,j,k)) + elseif(Sfx(i,j,k) >= ZEO .and. i+5 <= imax .and. i-1 >= imin)then +! v +! D f = ------[-10f - 77f + 150f - 100f + 50f -15f + 2f ] +! i 60dx i-v i i+v i+2v i+3v i+4v i+5v + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d60dx*(-F10*fh(i-1,j,k)-F77*fh(i ,j,k)+F150*fh(i+1,j,k)-F100*fh(i+2,j,k) & + +F50*fh(i+3,j,k)-F15*fh(i+4,j,k)+ TWO*fh(i+5,j,k)) + + elseif(Sfx(i,j,k) <= ZEO .and. i-4 >= imin .and. i+2 <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d60dx*(TWO*fh(i+2,j,k)-F24*fh(i+1,j,k)-F35*fh(i,j,k)+F80*fh(i-1,j,k) & + -F30*fh(i-2,j,k)+EIT*fh(i-3,j,k)- fh(i-4,j,k)) + elseif(Sfx(i,j,k) <= ZEO .and. i-5 >= imin .and. i+1 <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d60dx*(-F10*fh(i+1,j,k)-F77*fh(i ,j,k)+F150*fh(i-1,j,k)-F100*fh(i-2,j,k) & + +F50*fh(i-3,j,k)-F15*fh(i-4,j,k)+ TWO*fh(i-5,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfx(i,j,k)*d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + +! y direction + if(Sfy(i,j,k) >= ZEO .and. j+4 <= jmax .and. j-2 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d60dy*(TWO*fh(i,j-2,k)-F24*fh(i,j-1,k)-F35*fh(i,j,k)+F80*fh(i,j+1,k) & + -F30*fh(i,j+2,k)+EIT*fh(i,j+3,k)- fh(i,j+4,k)) + elseif(Sfy(i,j,k) >= ZEO .and. j+5 <= jmax .and. j-1 >= jmin)then + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d60dy*(-F10*fh(i,j-1,k)-F77*fh(i,j ,k)+F150*fh(i,j+1,k)-F100*fh(i,j+2,k) & + +F50*fh(i,j+3,k)-F15*fh(i,j+4,k)+ TWO*fh(i,j+5,k)) + + elseif(Sfy(i,j,k) <= ZEO .and. j-4 >= jmin .and. j+2 <= jmax)then + + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d60dy*(TWO*fh(i,j+2,k)-F24*fh(i,j+1,k)-F35*fh(i,j,k)+F80*fh(i,j-1,k) & + -F30*fh(i,j-2,k)+EIT*fh(i,j-3,k)- fh(i,j-4,k)) + + elseif(Sfy(i,j,k) <= ZEO .and. j-5 >= jmin .and. j+1 <= jmax)then + + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d60dy*(-F10*fh(i,j+1,k)-F77*fh(i,j ,k)+F150*fh(i,j-1,k)-F100*fh(i,j-2,k) & + +F50*fh(i,j-3,k)-F15*fh(i,j-4,k)+ TWO*fh(i,j-5,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfy(i,j,k)*d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) +! set jmin and jmax 0 + endif +!! z direction + if(Sfz(i,j,k) >= ZEO .and. k+4 <= kmax .and. k-2 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d60dz*(TWO*fh(i,j,k-2)-F24*fh(i,j,k-1)-F35*fh(i,j,k)+F80*fh(i,j,k+1) & + -F30*fh(i,j,k+2)+EIT*fh(i,j,k+3)- fh(i,j,k+4)) + elseif(Sfz(i,j,k) >= ZEO .and. k+5 <= kmax .and. k-1 >= kmin)then + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d60dz*(-F10*fh(i,j,k-1)-F77*fh(i,j,k )+F150*fh(i,j,k+1)-F100*fh(i,j,k+2) & + +F50*fh(i,j,k+3)-F15*fh(i,j,k+4)+ TWO*fh(i,j,k+5)) + + elseif(Sfz(i,j,k) <= ZEO .and. k-4 >= kmin .and. k+2 <= kmax)then + + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d60dz*(TWO*fh(i,j,k+2)-F24*fh(i,j,k+1)-F35*fh(i,j,k)+F80*fh(i,j,k-1) & + -F30*fh(i,j,k-2)+EIT*fh(i,j,k-3)- fh(i,j,k-4)) + + elseif(Sfz(i,j,k) <= ZEO .and. k-5 >= kmin .and. k+1 <= kmax)then + + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d60dz*(-F10*fh(i,j,k+1)-F77*fh(i,j,k )+F150*fh(i,j,k-1)-F100*fh(i,j,k-2) & + +F50*fh(i,j,k-3)-F15*fh(i,j,k-4)+ TWO*fh(i,j,k-5)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+Sfz(i,j,k)*d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) +! set kmin and kmax 0 + endif + + enddo + enddo + enddo + + return + + end subroutine lopsided + +#elif (ghost_width == 5) +! eighth order code +!----------------------------------------------------------------------------- +! PRD 77, 024034 (2008) +! Compute advection terms in right hand sides of field equations +! v [ - 5 f(i-3v) + 60 f(i-2v) - 420 f(i-v) - 378 f(i) + 1050 f(i+v) - 420 f(i+2v) + 140 f(i+3v) - 30 f(i+4v) + 3 f(i+5v)] +! D f = -------------------------------------------------------------------------------------------------------------------------- +! i 840 dx +! +! where +! +! i +! |B | +! v = ----- +! i +! B +! +!----------------------------------------------------------------------------- +subroutine lopsided(ex,X,Y,Z,f,f_rhs,Sfx,Sfy,Sfz,Symmetry,SoA) + implicit none + +!~~~~~~> Input parameters: + + integer, intent(in) :: ex(1:3),Symmetry + real*8, intent(in) :: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8,dimension(ex(1),ex(2),ex(3)),intent(in) :: f,Sfx,Sfy,Sfz + + real*8,dimension(ex(1),ex(2),ex(3)),intent(inout):: f_rhs + real*8,dimension(3),intent(in) ::SoA + +!~~~~~~> local variables: + + real*8,dimension(-4:ex(1),-4:ex(2),-4:ex(3)) :: fh + integer :: imin,jmin,kmin,imax,jmax,kmax,i,j,k + real*8 :: dX,dY,dZ + real*8 :: d840dx,d840dy,d840dz,d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,F30=3.d1,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F140=1.4d2,THR=3.d0 + real*8, parameter :: F840=8.4d2,F5=5.d0,F420=4.2d2,F378=3.78d2,F1050=1.05d3 + real*8, parameter :: F32=3.2d1,F168=1.68d2,F672=6.72d2 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + d840dx = ONE/F840/dX + d840dy = ONE/F840/dY + d840dz = ONE/F840/dZ + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = -4 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = -4 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = -4 + + call symmetry_bd(5,ex,f,fh,SoA) + +! upper bound set ex-1 only for efficiency, +! the loop body will set ex 0 also + do k=1,ex(3)-1 + do j=1,ex(2)-1 + do i=1,ex(1)-1 +! x direction + if(Sfx(i,j,k) >= ZEO .and. i+5 <= imax .and. i-3 >= imin)then +! v [ - 5 f(i-3v) + 60 f(i-2v) - 420 f(i-v) - 378 f(i) + 1050 f(i+v) - 420 f(i+2v) + 140 f(i+3v) - 30 f(i+4v) + 3 f(i+5v)] +! D f = -------------------------------------------------------------------------------------------------------------------------- +! i 840 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d840dx*(-F5*fh(i-3,j,k)+F60 *fh(i-2,j,k)-F420*fh(i-1,j,k)-F378*fh(i ,j,k) & + +F1050*fh(i+1,j,k)-F420*fh(i+2,j,k)+F140*fh(i+3,j,k)-F30 *fh(i+4,j,k)+THR*fh(i+5,j,k)) + + elseif(Sfx(i,j,k) <= ZEO .and. i-5 >= imin .and. i+3 <= imax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfx(i,j,k)*d840dx*(-F5*fh(i+3,j,k)+F60 *fh(i+2,j,k)-F420*fh(i+1,j,k)-F378*fh(i ,j,k) & + +F1050*fh(i-1,j,k)-F420*fh(i-2,j,k)+F140*fh(i-3,j,k)- F30*fh(i-4,j,k)+THR*fh(i-5,j,k)) + + elseif(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfx(i,j,k)*d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfx(i,j,k)*d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + +! y direction + if(Sfy(i,j,k) >= ZEO .and. j+5 <= jmax .and. j-3 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d840dy*(-F5*fh(i,j-3,k)+F60 *fh(i,j-2,k)-F420*fh(i,j-1,k)-F378*fh(i,j ,k) & + +F1050*fh(i,j+1,k)-F420*fh(i,j+2,k)+F140*fh(i,j+3,k)-F30 *fh(i,j+4,k)+THR*fh(i,j+5,k)) + + elseif(Sfy(i,j,k) <= ZEO .and. j-5 >= jmin .and. j+3 <= jmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfy(i,j,k)*d840dy*(-F5*fh(i,j+3,k)+F60 *fh(i,j+2,k)-F420*fh(i,j+1,k)-F378*fh(i,j ,k) & + +F1050*fh(i,j-1,k)-F420*fh(i,j-2,k)+F140*fh(i,j-3,k)- F30*fh(i,j-4,k)+THR*fh(i,j-5,k)) + + elseif(j+4 <= jmax .and. j-4 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfy(i,j,k)*d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k) + Sfy(i,j,k)*d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) +! set jmin and jmax 0 + endif +!! z direction + if(Sfz(i,j,k) >= ZEO .and. k+5 <= kmax .and. k-3 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d840dz*(-F5*fh(i,j,k-3)+F60 *fh(i,j,k-2)-F420*fh(i,j,k-1)-F378*fh(i,j,k ) & + +F1050*fh(i,j,k+1)-F420*fh(i,j,k+2)+F140*fh(i,j,k+3)-F30 *fh(i,j,k+4)+THR*fh(i,j,k+5)) + + elseif(Sfz(i,j,k) <= ZEO .and. k-5 >= kmin .and. k+3 <= kmax)then + f_rhs(i,j,k)=f_rhs(i,j,k)- & + Sfz(i,j,k)*d840dz*(-F5*fh(i,j,k+3)+F60 *fh(i,j,k+2)-F420*fh(i,j,k+1)-F378*fh(i,j,k ) & + +F1050*fh(i,j,k-1)-F420*fh(i,j,k-2)+F140*fh(i,j,k-3)- F30*fh(i,j,k-4)+THR*fh(i,j,k-5)) + + elseif(k+4 <= kmax .and. k-4 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+ & + Sfz(i,j,k)*d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + f_rhs(i,j,k)=f_rhs(i,j,k)+Sfz(i,j,k)*d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) +! set kmin and kmax 0 + endif + + enddo + enddo + enddo + + return + + end subroutine lopsided + +#endif diff --git a/AMSS_NCKU_source/macrodef.fh b/AMSS_NCKU_source/macrodef.fh new file mode 100644 index 0000000..ead5fe0 --- /dev/null +++ b/AMSS_NCKU_source/macrodef.fh @@ -0,0 +1,83 @@ + + +#if 0 +note here +v:r; u: phi; w: theta +tetradtype 0 +v^a = (x,y,z) +orthonormal order: v,u,w +m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007) +tetradtype 1 +orthonormal order: w,u,v +m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) +tetradtype 2 +v_a = (x,y,z) +orthonormal order: v,u,w +m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007) +#endif +#define tetradtype 2 + +#if 0 +note here +Cell center or Vertex center +#endif +#define Cell + +#if 0 +note here +2nd order: 2 +4th order: 3 +6th order: 4 +8th order: 5 +#endif +#define ghost_width 3 + +#if 0 +note here +use shell or not +#endif +#define WithShell + +#if 0 +note here +use constraint preserving boundary condition or not +only affect Z4c +#endif +#define CPBC + +#if 0 +note here +Gauge condition type +0: B^i gauge +1: David's puncture gauge +2: MB B^i gauge +3: RIT B^i gauge +4: MB beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006) +5: RIT beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006) +6: MGB1 B^i gauge +7: MGB2 B^i gauge +#endif +#define GAUGE 2 + +#if 0 +buffer points for CPBC boundary +#endif +#define CPBC_ghost_width (ghost_width) + +#if 0 +using BSSN variable for constraint violation and psi4 calculation: 0 +using ADM variable for constraint violation and psi4 calculation: 1 +#endif +#define ABV 0 + +#if 0 +Type of Potential and Scalar Distribution in F(R) Scalar-Tensor Theory +1: Case C of 1112.3928, V=0 +2: shell with a2^2*phi0/(1+a2^2), f(R) = R+a2*R^2 induced V +3: ground state of Schrodinger-Newton system, f(R) = R+a2*R^2 induced V +4: a2 = oo and phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma) - tanh((r-r0)/sigma) ) +5: shell with phi(r) = phi0*Exp(-(r-r0)**2/sigma), V = 0 +#endif +#define EScalar_CC 2 + + diff --git a/AMSS_NCKU_source/macrodef.h b/AMSS_NCKU_source/macrodef.h new file mode 100644 index 0000000..ca67877 --- /dev/null +++ b/AMSS_NCKU_source/macrodef.h @@ -0,0 +1,112 @@ + +#ifndef MICRODEF_H +#define MICRODEF_H + +#include "microdef.fh" + +// application parameters + +/// **** +// sommerfeld boundary type +// 0: bam, 1: shibata +#define SommerType 0 + +/// **** +// for Using Gauss-Legendre quadrature in theta direction +#define GaussInt + +/// **** +// 0: BSSN vacuum +// 1: coupled to scalar field +// 2: Z4c vacuum +// 3: coupled to Maxwell field +// +#define ABEtype 2 + +/// **** +// using Apparent Horizon Finder +//#define With_AHF + +/// **** +// Psi4 calculation method +// 0: EB method +// 1: 4-D method +// +#define Psi4type 0 + +/// **** +// for Using point psi4 or not +//#define Point_Psi4 + +/// **** +// RestrictProlong in Step (0) or after Step (1) +#define RPS 1 + +/// **** +// Enforce algebra constraint +// for every RK4 sub step: 0 +// only when iter_count == 3: 1 +// after routine Step: 2 +#define AGM 0 + +/// **** +// Restrict Prolong using BAM style 1 or old style 0 +#define RPB 0 + +/// **** +// 1: move Analysis out ot 4 sub steps and treat PBH with Euler method +#define MAPBH 1 + +/// **** +// parallel structure, 0: level by level, 1: considering all levels, 2: as 1 but reverse the CPU order, 3: Frank's scheme +#define PSTR 0 + +/// **** +// regrid for every level or for all levels at a time +// 0: for every level; 1: for all +#define REGLEV 0 + +/// **** +// use gpu or not +//#define USE_GPU + +/// **** +// use checkpoint for every process +//#define CHECKDETAIL + +/// **** +// use FakeCheckPrepare to write CheckPoint +//#define FAKECHECK +////================================================================ +// some basic parameters for numerical calculation +#define dim 3 + +//#define Cell or Vertex in "microdef.fh" + +// ****** +// buffer point number for mesh refinement interface +#define buffer_width 6 + +// ****** +// buffer point number shell-box interface, on shell +#define SC_width buffer_width +// buffer point number shell-box interface, on box +#define CS_width (2*buffer_width) + +#if(buffer_width < ghost_width) +#error we always assume buffer_width>ghost_width +#endif + +#define PACK 1 +#define UNPACK 2 + +#define Mymax(a,b) (((a) > (b)) ? (a) : (b)) +#define Mymin(a,b) (((a) < (b)) ? (a) : (b)) + +#define feq(a,b,d) (fabs(a-b)d) + +#define TINY 1e-10 + +#endif /* MICRODEF_H */ diff --git a/AMSS_NCKU_source/makefile b/AMSS_NCKU_source/makefile new file mode 100644 index 0000000..0e2a08d --- /dev/null +++ b/AMSS_NCKU_source/makefile @@ -0,0 +1,102 @@ + + +include makefile.inc + +.SUFFIXES: .o .f90 .C .for .cu + +.f90.o: + $(f90) $(f90appflags) -c $< -o $@ + +.C.o: + ${CXX} $(CXXAPPFLAGS) -c $< $(filein) -o $@ + +.for.o: + $(f77) -c $< -o $@ + +.cu.o: + $(Cu) $(CUDA_APP_FLAGS) -c $< -o $@ $(CUDA_LIB_PATH) + +# Input files +C++FILES = ABE.o Ansorg.o Block.o misc.o monitor.o Parallel.o MPatch.o var.o\ + cgh.o bssn_class.o surface_integral.o ShellPatch.o\ + bssnEScalar_class.o perf.o Z4c_class.o NullShellPatch.o\ + bssnEM_class.o cpbc_util.o z4c_rhs_point.o checkpoint.o\ + Parallel_bam.o scalar_class.o transpbh.o NullShellPatch2.o\ + NullShellPatch2_Evo.o writefile_f.o + +C++FILES_GPU = ABE.o Ansorg.o Block.o misc.o monitor.o Parallel.o MPatch.o var.o\ + cgh.o surface_integral.o ShellPatch.o\ + bssnEScalar_class.o perf.o Z4c_class.o NullShellPatch.o\ + bssnEM_class.o cpbc_util.o z4c_rhs_point.o checkpoint.o\ + Parallel_bam.o scalar_class.o transpbh.o NullShellPatch2.o\ + NullShellPatch2_Evo.o \ + bssn_gpu_class.o bssn_step_gpu.o bssn_macro.o writefile_f.o + +F90FILES = enforce_algebra.o fmisc.o initial_puncture.o prolongrestrict.o\ + prolongrestrict_cell.o prolongrestrict_vertex.o\ + rungekutta4_rout.o bssn_rhs.o diff_new.o kodiss.o kodiss_sh.o\ + lopsidediff.o sommerfeld_rout.o getnp4.o diff_new_sh.o\ + shellfunctions.o bssn_rhs_ss.o Set_Rho_ADM.o\ + getnp4EScalar.o bssnEScalar_rhs.o bssn_constraint.o ricci_gamma.o\ + fadmquantites_bssn.o Z4c_rhs.o Z4c_rhs_ss.o point_diff_new_sh.o\ + cpbc.o getnp4old.o NullEvol.o initial_null.o initial_maxwell.o\ + getnpem2.o empart.o NullNews.o fourdcurvature.o\ + bssn2adm.o adm_constraint.o adm_ricci_gamma.o\ + scalar_rhs.o initial_scalar.o NullEvol2.o initial_null2.o\ + NullNews2.o tool_f.o + +F77FILES = zbesh.o + +AHFDOBJS = expansion.o expansion_Jacobian.o patch.o coords.o patch_info.o patch_interp.o patch_system.o \ +tgrid.o fd_grid.o ghost_zone.o array.o round.o norm.o fuzzy.o error_exit.o miscfp.o \ +linear_map.o cpm_map.o BH_diagnostics.o setup.o horizon_sequence.o find_horizons.o \ +initial_guess.o Newton.o Jacobian.o ilucg.o IntPnts0.o IntPnts.o + +TwoPunctureFILES = TwoPunctureABE.o TwoPunctures.o + +CUDAFILES = bssn_gpu.o bssn_gpu_rhs_ss.o + +# file dependences +$(C++FILES) $(C++FILESGPU) $(F90FILES) $(AHFDOBJS) $(CUDAFILES): macrodef.fh + +$(C++FILES): Block.h enforce_algebra.h fmisc.h initial_puncture.h macrodef.h\ + misc.h monitor.h MyList.h Parallel.h MPatch.h prolongrestrict.h\ + rungekutta4_rout.h var.h bssn_class.h bssn_rhs.h sommerfeld_rout.h\ + cgh.h surface_integral.h ShellPatch.h shellfunctions.h perf.h\ + fadmquantites_bssn.h cpbc.h getnp4.h initial_null.h NullEvol.h\ + NullShellPatch.h initial_maxwell.h bssnEM_class.h getnpem2.h\ + empart.h NullNews.h kodiss.h Parallel_bam.h ricci_gamma.h\ + initial_null2.h NullShellPatch2.h + +$(C++FILES_GPU): Block.h enforce_algebra.h fmisc.h initial_puncture.h macrodef.h\ + misc.h monitor.h MyList.h Parallel.h MPatch.h prolongrestrict.h\ + rungekutta4_rout.h var.h bssn_rhs.h sommerfeld_rout.h\ + cgh.h surface_integral.h ShellPatch.h shellfunctions.h perf.h\ + fadmquantites_bssn.h cpbc.h getnp4.h initial_null.h NullEvol.h\ + NullShellPatch.h initial_maxwell.h bssnEM_class.h getnpem2.h\ + empart.h NullNews.h kodiss.h Parallel_bam.h ricci_gamma.h\ + initial_null2.h NullShellPatch2.h \ + bssn_gpu_class.h bssn_macro.h + +$(AHFDOBJS): cctk.h cctk_Config.h cctk_Types.h cctk_Constants.h myglobal.h + +$(C++FILES) $(C++FILES_GPU) $(AHFDOBJS) $(CUDAFILES): macrodef.h + +TwoPunctureFILES: TwoPunctures.h + +$(CUDAFILES): bssn_gpu.h gpu_mem.h gpu_rhsSS_mem.h + +misc.o : zbesh.o + +# projects +ABE: $(C++FILES) $(F90FILES) $(F77FILES) $(AHFDOBJS) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES) $(F90FILES) $(F77FILES) $(AHFDOBJS) $(LDLIBS) + +ABEGPU: $(C++FILES_GPU) $(F90FILES) $(F77FILES) $(AHFDOBJS) $(CUDAFILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES_GPU) $(F90FILES) $(F77FILES) $(AHFDOBJS) $(CUDAFILES) $(LDLIBS) + +TwoPunctureABE: $(TwoPunctureFILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(TwoPunctureFILES) $(LDLIBS) + +clean: + rm *.o ABE ABEGPU TwoPunctureABE make.log -f diff --git a/AMSS_NCKU_source/makefile.inc b/AMSS_NCKU_source/makefile.inc new file mode 100755 index 0000000..09600b7 --- /dev/null +++ b/AMSS_NCKU_source/makefile.inc @@ -0,0 +1,21 @@ + +## filein = -I/usr/include -I/usr/lib/x86_64-linux-gnu/mpich/include -I/usr/lib/x86_64-linux-gnu/openmpi/lib/ -I/usr/lib/gcc/x86_64-linux-gnu/11/ -I/usr/include/c++/11/ + +filein = -I/usr/include/ -I/usr/lib/x86_64-linux-gnu/openmpi/include/ -I/usr/lib/x86_64-linux-gnu/openmpi/lib/ -I/usr/lib/gcc/x86_64-linux-gnu/11/ -I/usr/include/c++/11/ -I/usr/lib/cuda/include + +## LDLIBS = -L/usr/lib/x86_64-linux-gnu -lmpich -L/usr/lib64 -L/usr/lib/gcc/x86_64-linux-gnu/11 -lgfortran +LDLIBS = -L/usr/lib/x86_64-linux-gnu -L/usr/lib64 -L/usr/lib/gcc/x86_64-linux-gnu/11 -lgfortran -L/usr/lib/cuda/lib64 -lcudart -lmpi -lgfortran + +CXXAPPFLAGS = -O3 -Wno-deprecated -Dfortran3 -Dnewc +#f90appflags = -O3 -fpp +f90appflags = -O3 -x f95-cpp-input +f90 = gfortran +f77 = gfortran +CXX = g++ +CC = gcc +CLINKER = mpic++ + +Cu = nvcc +CUDA_LIB_PATH = -L/usr/lib/cuda/lib64 -I/usr/include -I/usr/lib/cuda/include +#CUDA_APP_FLAGS = -c -g -O3 --ptxas-options=-v -arch compute_13 -code compute_13,sm_13 -Dfortran3 -Dnewc +CUDA_APP_FLAGS = -c -g -O3 --ptxas-options=-v -Dfortran3 -Dnewc diff --git a/AMSS_NCKU_source/misc.C b/AMSS_NCKU_source/misc.C new file mode 100644 index 0000000..b692485 --- /dev/null +++ b/AMSS_NCKU_source/misc.C @@ -0,0 +1,1358 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#endif +#include + +#include "misc.h" +#include "macrodef.h" +#include "zbesh.h" + +#define PI M_PI + +void misc::tillherecheck(int myrank) +{ + int atp = 1, tatp; + MPI_Allreduce(&atp, &tatp, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + if (myrank == 0) + cout << " here now: " << tatp << " processors." << endl; +} +void misc::tillherecheck(const char str[]) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + int atp = 1, tatp; + MPI_Allreduce(&atp, &tatp, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + if (myrank == 0) + { + cout << " here now: " << tatp << " processors." << endl; + cout << str << endl; + } +} +void misc::tillherecheck(MPI_Comm Comm_here, int out_rank, const char str[]) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + int atp = 1, tatp; + + MPI_Allreduce(&atp, &tatp, 1, MPI_INT, MPI_SUM, Comm_here); + if (myrank == out_rank) + { + cout << " here now: " << tatp << " processors." << endl; + cout << str << endl; + } +} +void misc::tillherecheck(MPI_Comm Comm_here, int out_rank, const string str) +{ + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + int atp = 1, tatp; + + MPI_Allreduce(&atp, &tatp, 1, MPI_INT, MPI_SUM, Comm_here); + if (myrank == out_rank) + { + cout << " here now: " << tatp << " processors." << endl; + cout << str << endl; + } +} +// pick out value from input string +int misc::parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind) +{ + int pos1, pos2; + string s0; + + ind = 0; + + // remove comments + str = str.substr(0, str.find("#")); + if (rTrim(str).empty()) + return 0; // continue; + + // parse {group, key, val} + pos1 = str.find("::"); + pos2 = str.find("="); + if (pos1 == string::npos || pos2 == string::npos) + return -1; + + s0 = str.substr(0, pos1); + sgrp = lTrim(s0); + s0 = str.substr(pos1 + 2, pos2 - pos1 - 2); + skey = rTrim(s0); + s0 = str.substr(pos2 + 1); + sval = Trim(s0); + + pos1 = sval.find("\""); + pos2 = sval.rfind("\""); + if (pos1 != string::npos) + { + sval = sval.substr(1, pos2 - 1); + } + + pos1 = skey.find("["); + pos2 = skey.find("]"); + if (pos1 != string::npos) + { + s0 = skey.substr(0, pos1); + ind = atoi(skey.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + skey = s0; + } + + return 1; +} +int misc::parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind1, int &ind2) +{ + int pos1, pos2; + string s0, s1; + + ind1 = ind2 = 0; + + // remove comments + str = str.substr(0, str.find("#")); + if (rTrim(str).empty()) + return 0; // continue; + + // parse {group, key, val} + pos1 = str.find("::"); + pos2 = str.find("="); + if (pos1 == string::npos || pos2 == string::npos) + return -1; + + s0 = str.substr(0, pos1); + sgrp = lTrim(s0); + s0 = str.substr(pos1 + 2, pos2 - pos1 - 2); + skey = rTrim(s0); + s0 = str.substr(pos2 + 1); + sval = Trim(s0); + + pos1 = sval.find("\""); + pos2 = sval.rfind("\""); + if (pos1 != string::npos) + { + sval = sval.substr(1, pos2 - 1); + } + + pos1 = skey.find("["); + pos2 = skey.find("]"); + if (pos1 != string::npos) + { + s0 = skey.substr(0, pos1); + s1 = skey.substr(pos2 + 1); + ind1 = atoi(skey.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + skey = s0; + } + + pos1 = s1.find("["); + pos2 = s1.find("]"); + if (pos1 != string::npos) + { + s0 = s1.substr(pos2 + 1); + ind2 = atoi(s1.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + } + + return 1; +} +int misc::parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind1, int &ind2, int &ind3) +{ + int pos1, pos2; + string s0, s1; + + ind1 = ind2 = ind3 = 0; + + // remove comments + str = str.substr(0, str.find("#")); + if (rTrim(str).empty()) + return 0; // continue; + + // parse {group, key, val} + pos1 = str.find("::"); + pos2 = str.find("="); + if (pos1 == string::npos || pos2 == string::npos) + return -1; + + s0 = str.substr(0, pos1); + sgrp = lTrim(s0); + s0 = str.substr(pos1 + 2, pos2 - pos1 - 2); + skey = rTrim(s0); + s0 = str.substr(pos2 + 1); + sval = Trim(s0); + + pos1 = sval.find("\""); + pos2 = sval.rfind("\""); + if (pos1 != string::npos) + { + sval = sval.substr(1, pos2 - 1); + } + + pos1 = skey.find("["); + pos2 = skey.find("]"); + if (pos1 != string::npos) + { + s0 = skey.substr(0, pos1); + s1 = skey.substr(pos2 + 1); + ind1 = atoi(skey.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + skey = s0; + } + + pos1 = s1.find("["); + pos2 = s1.find("]"); + if (pos1 != string::npos) + { + s0 = s1.substr(pos2 + 1); + ind2 = atoi(s1.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + } + + pos1 = s0.find("["); + pos2 = s0.find("]"); + if (pos1 != string::npos) + { + ind3 = atoi(s0.substr(pos1 + 1, pos2 - pos1 - 1).c_str()); + } + + return 1; +} +// sent me from Roman Gold on 2010-10-8 +void misc::gaulegf(double x1, double x2, double *x, double *w, int n) +{ + int i, j, m; + double eps = 1.2E-16; + double p1, p2, p3, pp, xl, xm, z, z1; + + m = (n + 1) / 2; + xm = 0.5 * (x2 + x1); + xl = 0.5 * (x2 - x1); + for (i = 0; i < m; i++) + { + z = cos(PI * ((double)i + 0.75) / ((double)n + 0.5)); + do + { + p1 = 1.0; + p2 = 0.0; + for (j = 0; j < n; j++) + { + p3 = p2; + p2 = p1; + p1 = ((2 * (double)j + 1) * z * p2 - (double)j * p3) / ((double)j + 1); + } + pp = n * (z * p1 - p2) / (z * z - 1.0); + z1 = z; + z = z1 - p1 / pp; + } while (fabs(z - z1) > eps); + x[i] = xm - xl * z; + x[n - 1 - i] = xm + xl * z; + w[i] = 2.0 * xl / ((1.0 - z * z) * pp * pp); + w[n - 1 - i] = w[i]; + } +} /* end gaulegf */ +void misc::inversearray(double *aa, int NN) +{ + int i, m; + m = (NN + 1) / 2; + double rr; + for (i = 0; i < m; i++) + { + rr = aa[i]; + aa[i] = aa[NN - 1 - i]; + aa[NN - 1 - i] = rr; + } +} +// Eq.(42) of PRD 77, 024027 (2008) +double misc::Wigner_d_function(int l, int m, int s, double costheta) +{ + // we consider only theta in [0,pi] + int C1 = max(0, m - s), C2 = min(l + m, l - s); + + double vv = 0; + double sinht = sqrt((1 - costheta) / 2.0), cosht = sqrt((1 + costheta) / 2.0); + if (C1 % 2 == 0) + { + for (int t = C1; t < C2 + 1; t += 2) + vv = vv + pow(cosht, 2 * l + m - s - 2 * t) * pow(sinht, 2 * t + s - m) / + (fact(l + m - t) * fact(l - s - t) * fact(t) * fact(t + s - m)); + for (int t = C1 + 1; t < C2 + 1; t += 2) + vv = vv - pow(cosht, 2 * l + m - s - 2 * t) * pow(sinht, 2 * t + s - m) / + (fact(l + m - t) * fact(l - s - t) * fact(t) * fact(t + s - m)); + } + else + { + for (int t = C1; t < C2 + 1; t += 2) + vv = vv - pow(cosht, 2 * l + m - s - 2 * t) * pow(sinht, 2 * t + s - m) / + (fact(l + m - t) * fact(l - s - t) * fact(t) * fact(t + s - m)); + for (int t = C1 + 1; t < C2 + 1; t += 2) + vv = vv + pow(cosht, 2 * l + m - s - 2 * t) * pow(sinht, 2 * t + s - m) / + (fact(l + m - t) * fact(l - s - t) * fact(t) * fact(t + s - m)); + } + return vv * sqrt(fact(l + m) * fact(l - m) * fact(l + s) * fact(l - s)); +} +double misc::fact(int N) +{ + if (N < 0) + cout << "error input for factorial." << endl; + double f; + if (N == 0) + f = 1; + else + f = N * fact(N - 1); + return f; +} +int misc::num_of_str(char *c) +{ + int NN = 0, N1 = 0; + std::istringstream iss; + iss.str(c); + + char c1[1000]; + while (!iss.eof()) + { + iss >> c1; + if (int(c1[0]) == 45 || int(c1[0]) == 46 || (int(c1[0]) > 47 && int(c1[0]) < 58)) + NN++; + N1++; + } + + char *c2 = c; + while (*(c2 + 1)) + c2++; + if (int(*c2) == 32) + { + NN--; + N1--; + } + + // cout<<"found "< &f0, + std::vector &f1, std::vector &f_rhs, const int RK4) +{ + const int N = f0.size(); + const double F1o6 = 1.0 / 6, HLF = 0.5, TWO = 2; + switch (RK4) + { + case 0: + for (int i = 0; i < N; i++) + f1[i] = f0[i] + HLF * dT * f_rhs[i]; + break; + case 1: + for (int i = 0; i < N; i++) + { + f_rhs[i] = f_rhs[i] + TWO * f1[i]; + f1[i] = f0[i] + HLF * dT * f1[i]; + } + break; + case 2: + for (int i = 0; i < N; i++) + { + f_rhs[i] = f_rhs[i] + TWO * f1[i]; + f1[i] = f0[i] + dT * f1[i]; + } + break; + case 3: + for (int i = 0; i < N; i++) + f1[i] = f0[i] + F1o6 * dT * (f1[i] + f_rhs[i]); + break; + default: + cout << "misc::rungekutta4: something is wrong in RK4 counting!!" << endl; + } +} +void misc::dividBlock(const int DIM, int *shape_here, double *bbox_here, const int pices, double *picef, int *shape_res, double *bbox_res, + const int min_width) +{ + if (pices < 1) + { + cerr << "error in dividBlock: pices = " << pices << endl; + return; + } + if (pices == 1) + { + for (int i = 0; i < DIM; i++) + { + shape_res[i] = shape_here[i]; + bbox_res[i] = bbox_here[i]; + bbox_res[DIM + i] = bbox_here[DIM + i]; + } + return; + } + + double dd = picef[0]; + for (int i = 1; i < pices; i++) + dd += picef[i]; + + if (feq(dd, 1, 1e-8)) + { + int leg = shape_here[0]; + int legi = 0; + for (int i = 1; i < DIM; i++) + { + if (leg < shape_here[i]) + { + leg = shape_here[i]; + legi = i; + } + } + + int pic = 0; + + for (int ip = 0; ip < pices; ip++) + { + for (int i = 0; i < DIM; i++) + { + if (i == legi) + { + if (ip == pices - 1) + shape_res[ip * DIM + i] = shape_here[i] - pic; + else + { + shape_res[ip * DIM + i] = shape_here[i] * picef[ip]; + pic += shape_res[ip * DIM + i]; + } + } + else + shape_res[ip * DIM + i] = shape_here[i]; + } + } + + for (int ip = 0; ip < pices; ip++) + { + for (int i = 0; i < DIM; i++) + { +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + dd = (bbox_here[DIM + i] - bbox_here[i]) / (shape_here[i] - 1); +#else +#ifdef Cell + dd = (bbox_here[DIM + i] - bbox_here[i]) / shape_here[i]; +#else +#error Not define Vertex nor Cell +#endif +#endif + + if (i == legi) + { + if (shape_res[ip * DIM + i] < min_width) + { + cerr << "dividBlock: resulted too small shape, shapeo = " << shape_here[i] << ", shape = " << shape_res[ip * DIM + i] << ", min_width = " << min_width << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + if (ip == 0) + bbox_res[ip * 2 * DIM + i] = bbox_here[i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + bbox_res[ip * 2 * DIM + i] = bbox_res[(ip - 1) * 2 * DIM + DIM + i] - ghost_width * dd + dd; // because for ip-1 we have already considered ghost points +#else +#ifdef Cell + else + bbox_res[ip * 2 * DIM + i] = bbox_res[(ip - 1) * 2 * DIM + DIM + i] - ghost_width * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + + if (ip == pices - 1) + bbox_res[ip * 2 * DIM + DIM + i] = bbox_here[DIM + i]; +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + else + bbox_res[ip * 2 * DIM + DIM + i] = bbox_res[ip * 2 * DIM + i] + (shape_res[ip * DIM + i] - 1) * dd; +#else +#ifdef Cell + else + bbox_res[ip * 2 * DIM + DIM + i] = bbox_res[ip * 2 * DIM + i] + shape_res[ip * DIM + i] * dd; +#else +#error Not define Vertex nor Cell +#endif +#endif + + if (ip > 0) + { + shape_res[ip * DIM + i] += ghost_width; + bbox_res[ip * 2 * DIM + i] -= ghost_width * dd; + } + if (ip < pices - 1) + { + shape_res[ip * DIM + i] += ghost_width; + bbox_res[ip * 2 * DIM + DIM + i] += ghost_width * dd; + } + } + else + { + bbox_res[ip * 2 * DIM + i] = bbox_here[i]; + bbox_res[ip * 2 * DIM + DIM + i] = bbox_here[DIM + i]; + } + } + } + } + else + { + cerr << "error in dividBlock: "; + for (int i = 0; i < pices; i++) + cerr << picef[i] << " "; + cerr << endl; + } +#if 0 +// for check + int myrank; + MPI_Comm_rank(MPI_COMM_WORLD,&myrank); + if(myrank == 0) + { + cerr<<"original one"< &f0, std::vector &f1) +{ + const int N = f0.size(); + double tt; + for (int i = 0; i < N; i++) + { + tt = f0[i]; + f0[i] = f1[i]; + f1[i] = tt; + } +} +complex misc::complex_gamma(complex z) +{ + const double p[9] = {0.99999999999980993, 676.5203681218851, -1259.1392167224028, + 771.32342877765313, -176.61502916214059, 12.507343278686905, + -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7}; + + if (real(z) < 0.5) + { + return PI / (sin(PI * z) * complex_gamma(1.0 - z)); + } + z -= 1.0; + complex x = p[0]; + for (int i = 1; i < 9; i++) + { + x += p[i] / (z + complex(i, 0)); + } + complex t = z + (7 + 0.5); + t = sqrt(2 * PI) * pow(t, z + 0.5) * exp(-t) * x; + + return t; +} +// also called Kummer function, +// Confluent hypergeometric function 1F1 +#if 1 +complex misc::KummerComplex(const complex a, const complex b, complex x) +{ + // Default tolerance is tol = 1e-10. Feel free to change this as needed. + const double tol = 1e-10; + + // Estimates the value by summing powers of the generalized hypergeometric + // series: + // + // sum(n=0-->Inf)[(a)_n*x^n/{(b)_n*n!}] + // + // until the specified tolerance is acheived. + + complex term = x * a / b; + complex f = 1.0 + term; + int n = 1; + complex an = a; + complex bn = b; + int nmin = 100000; + + while (n < nmin && (abs(term)) > tol) + { + n = n + 1; + an = an + 1.0; + bn = bn + 1.0; + term = x * term * an / bn / double(n); + f = f + term; + } + + if ((abs(term)) > tol && n == nmin) + cout << "misc::KummerComplex has n > " << nmin << " with error " << abs(term) << endl + << "a = " << a << " b = " << b << " x = " << x << endl; + + return f; +} +// new code +#else +complex misc::KummerComplex(const complex a, const complex b, complex z) +{ + // Default tolerance is tol = 1e-10. Feel free to change this as needed. + int precision = 15; + int m, j, k; + complex cr, chg; + double cMax; + complex g1, g2, g3; + complex ba; + complex cs1, cs2, cr1, cr2; + double c1Max, c2Max; + + // Special cases + + if (b.imag() == 0 && b.real() <= 0 && b.real() == int(b.real())) // b==-n;n=1,2,3,.. + { + if (a.imag() == 0 && a.real() <= 0 && a.real() == int(a.real()) && abs(a) < abs(b)) // a==-m;m=1,2,.. + { + m = int(-a.real()); + cr = 1; + chg = 1; + + cMax = abs(cr); + + for (k = 1; k <= m; k++) + { + cr = cr * (k - 1.0 + a) / double(k) / (k - 1.0 + b) * z; + chg = chg + cr; + + cMax = max(cMax, max(abs(cr), abs(chg))); + } + + precision = 15 - int(log10(cMax / abs(chg))); + } + else if (a.imag() == 0 && a.real() <= 0 && a.real() == int(a.real()) && abs(a) == abs(b)) // a==b; + { + cout << "!!!Confluent hypergeometric function is indeterminate for input a = " + << a << " b = " << b << " z = " << z << endl; + chg = 0; + } + else + { + cout << "!!!Confluent hypergeometric function error for input a = " + << a << " b = " << b << " z = " << z << endl; + chg = 0; + } + } + else if (a == 0.0 || z == 0.0) + { + chg = 1; + } + else if (a == -1.0) + { + chg = 1.0 - z / b; + } + else if (a == b) + { + chg = exp(z); + } + else if ((a - b) == 1.0) + { + chg = (1.0 + z / b) * exp(z); + } + else if (a == 1.0 && b == 2.0) + { + chg = (exp(z) - 1.0) / z; + } + // finite number of elements in a row + else if (a.imag() == 0 && a.real() < 0 && a.real() == int(a.real())) + { + m = int(-a.real()); + cr = 1; + chg = 1; + + cMax = abs(cr); + + for (k = 1; k <= m; k++) + { + cr = cr * (k - 1.0 + a) / double(k) / (k - 1.0 + b) * z; + chg = chg + cr; + + cMax = max(cMax, max(abs(cr), abs(chg))); + } + + precision = 15 - int(log10(cMax / abs(chg))); + } + else if (abs(z) > 10 * abs(a) && abs(z) > 10 * abs(b)) // Abramowitz Stegun 13.5.1 + { + g1 = complex_gamma(a); + g2 = complex_gamma(b); + ba = b - a; + g3 = complex_gamma(ba); + + cs1 = 1; + cs2 = 1; + cr1 = 1; + cr2 = 1; + + c1Max = abs(cr1); + c2Max = abs(cr2); + + for (j = 1; j <= 500; j++) + { + cr1 = -cr1 * (j - 1.0 + a) * (a - b + double(j)) / (z * double(j)); + cr2 = cr2 * (j - 1.0 + b - a) * (double(j) - a) / (z * double(j)); + cs1 = cs1 + cr1; + cs2 = cs2 + cr2; + + c1Max = max(c1Max, max(abs(cr1), abs(cs1))); + c2Max = max(c2Max, max(abs(cr2), abs(cs2))); + + if (abs(cr1) / abs(cs1) < 1e-15 && abs(cr2) / abs(cs2) < 1e-15) + break; // break j + + if (j == 500) + { + cout << "Got to the " << j << " limit in the series of confluent hypergeometric function!" << endl; + chg = 0; + return chg; + } + } + + precision = 15 - int(log10(max(c1Max / abs(cs1), c2Max / abs(cs2)))); + + double x = z.real(); + double y = z.imag(); + double phi; + complex cfac, chg1, chg2; + int ns; + + if (x == 0.0 && y >= 0.0) + phi = 0.5 * PI; + else if (x == 0.0 && y <= 0.0) + phi = -0.5 * PI; + else + phi = atan(y / x); + + if (phi > -0.5 * PI && phi < 1.5 * PI) + ns = 1; + + if (phi > -1.5 * PI && phi <= -0.5 * PI) + ns = -1; + + cfac = exp(PI * ns * (complex(0, 1)) * a); + + if (y == 0) + cfac = cos(PI * a); + + chg1 = g2 / g3 * pow(z, -a) * cfac * cs1; + chg2 = g2 / g1 * exp(z) * pow(z, a - b) * cs2; + chg = chg1 + chg2; + } + else // General case + { + chg = 1; + complex crg = 1; + double cgMax = abs(crg); + + for (j = 1; j <= 500; j++) + { + crg = crg * (j - 1.0 + a) / (double(j) * (j - 1.0 + b)) * z; // Abramowitz Stegun 13.1.2 + chg = chg + crg; + + cgMax = max(cgMax, max(abs(crg), abs(chg))); + + if (abs(crg) / abs(chg) < 1e-15) + break; // break j + + if (j == 500) + { + cout << "Got to the " << j << " limit in the series of confluent hypergeometric function!" << endl; + chg = 0; + return chg; + } + } + + precision = 15 - int(log10(cgMax / abs(chg))); + } + + if (precision <= 0) + { + precision = 0; + chg = 0; + } + + if (precision < 10) + cout << "!!! Warning!!! Only about " << precision << " first digits are correct!!!" << endl; + + return chg; +} +#endif +// Bessel function of the first kind: J_a +#if 0 +// +// sum(m=0-->Inf)(-1)^m/m!/Gamma(m+a+1) (x/2)^{2 m+a} +// +complex misc::First_Bessel(const complex a,complex x) +{ +// Default tolerance is tol = 1e-10. Feel free to change this as needed. + const double tol = 1e-10; + + x = x/2.0; + complex term,term1=pow(x,a),term2=1.0/complex_gamma(a+1.0); + complex f = term1*term2; + int m = 0; + const int mmax = 50; + + term = f; + while(m < mmax && (abs(term)) > tol) + { + m++; + term1 = x*x*term1; + term2 = -term2/double(m*m); + term = term1*term2; + f = f + term; + } + +if((abs(term)) > tol && m == mmax) cout<<"misc::First_Bessel has m > "< " << jmax << ", error = " << abs(sum2 - sum) << endl; + + return sum2; +} +complex misc::Simpson_Int(const double xmin, const double xmax, complex fun(double x)) +{ + // Default tolerance is tol = 1e-10. Feel free to change this as needed. + const double tol = 1e-8; + + int N = 1000; + double dx = (xmax - xmin) / (N - 1); + complex sum = 0, sum2 = 0; + sum2 = 17.0 * fun(xmin) + 59.0 * fun(xmin + dx) + 43.0 * fun(xmin + 2 * dx) + 49.0 * fun(xmin + 3 * dx); + for (int i = 4; i < N - 3; i++) + { + sum2 += 48.0 * fun(xmin + i * dx); + } + sum2 = sum2 + 17.0 * fun(xmax) + 59.0 * fun(xmax - dx) + 43.0 * fun(xmax - 2 * dx) + 49.0 * fun(xmax - 3 * dx); + sum2 = sum2 * dx / 48.0; + + int j = 1; + const int jmax = 50; + while (j < jmax && abs(sum2 - sum) > tol) + { + j++; + N = N * 2; + dx = (xmax - xmin) / (N - 1); + sum = sum2; + sum2 = 17.0 * fun(xmin) + 59.0 * fun(xmin + dx) + 43.0 * fun(xmin + 2 * dx) + 49.0 * fun(xmin + 3 * dx); + for (int i = 4; i < N - 3; i++) + { + sum2 += 48.0 * fun(xmin + i * dx); + } + sum2 = sum2 + 17.0 * fun(xmax) + 59.0 * fun(xmax - dx) + 43.0 * fun(xmax - 2 * dx) + 49.0 * fun(xmax - 3 * dx); + sum2 = sum2 * dx / 48.0; + + // cout<<"j = "< " << jmax << ", error = " << abs(sum2 - sum) << endl; + + return sum2; +} +complex misc::Simpson3o8_Int(const double xmin, const double xmax, complex fun(double x)) +{ + // Default tolerance is tol = 1e-10. Feel free to change this as needed. + const double tol = 1e-8; + + int m = 300, N; + N = 3 * m + 2; + double dx = (xmax - xmin) / (N - 1); + complex sum = 0, sum2; + sum2 = fun(xmin) + fun(xmax); + for (int i = 0; i < m; i++) + { + sum2 += 3.0 * (fun(xmin + (3 * i + 1) * dx) + fun(xmin + (3 * i + 2) * dx)) + 2.0 * fun(xmin + (3 * i + 3) * dx); + // cout< tol) + { + j++; + m = m * 2; + N = 3 * m + 2; + dx = (xmax - xmin) / (N - 1); + sum = sum2; + sum2 = fun(xmin) + fun(xmax); + for (int i = 0; i < m; i++) + { + sum2 += 3.0 * (fun(xmin + (3 * i + 1) * dx) + fun(xmin + (3 * i + 2) * dx)) + 2.0 * fun(xmin + (3 * i + 3) * dx); + } + sum2 = sum2 * dx * 3.0 / 8.0; + + // cout<<"j = "< " << jmax << ", error = " << abs(sum2 - sum) << endl; + + return sum2; +} +#if 0 +complex misc::Gauss_Int(const double xmin,const double xmax,complex fun(double x)) +{ +// Default tolerance is tol = 1e-10. Feel free to change this as needed. + const double tol = 1e-8; + + int N=int(xmax-xmin)*10; + if(N<1000) N = 1000; + double *arcostheta,*wtcostheta; +// weight function cover all of [xmin,xmax] + arcostheta = new double[N]; + wtcostheta = new double[N]; + + gaulegf(xmin,xmax,arcostheta,wtcostheta,N); + complex sum=0,sum2=0; + for(int i =0;i tol) + { + j++; + N = N*2; + arcostheta = new double[N]; + wtcostheta = new double[N]; + + gaulegf(xmin,xmax,arcostheta,wtcostheta,N); + sum=sum2; + sum2=0; + for(int i =0;i "< " << jmax << ", error = " << abs(sum2 - sum) << endl; + + return sum2; +} +#endif +complex misc::gaulegf(double x1, double x2, int n, complex fun(double x)) +{ + int i, j, m; + double eps = 1.2E-16; + double p1, p2, p3, pp, xl, xm, z, z1; + double w; + + m = (n + 1) / 2; + xm = 0.5 * (x2 + x1); + xl = 0.5 * (x2 - x1); + complex sum = 0; + for (i = 0; i < m; i++) + { + z = cos(PI * ((double)i + 0.75) / ((double)n + 0.5)); + do + { + p1 = 1.0; + p2 = 0.0; + for (j = 0; j < n; j++) + { + p3 = p2; + p2 = p1; + p1 = ((2 * (double)j + 1) * z * p2 - (double)j * p3) / ((double)j + 1); + } + pp = n * (z * p1 - p2) / (z * z - 1.0); + z1 = z; + z = z1 - p1 / pp; + // cout<<"here"< eps); + + // cout<<"there"<> 1; + j = 0; + for (i = 0; i < n - 1; i++) + { + if (i < j) + { + tx = x[i]; + ty = y[i]; + x[i] = x[j]; + y[i] = y[j]; + x[j] = tx; + y[j] = ty; + } + k = i2; + while (k <= j) + { + j -= k; + k >>= 1; + } + j += k; + } + + /* Compute the FFT */ + c1 = -1.0; + c2 = 0.0; + l2 = 1; + for (l = 0; l < m; l++) + { + l1 = l2; + l2 <<= 1; + u1 = 1.0; + u2 = 0.0; + for (j = 0; j < l1; j++) + { + for (i = j; i < n; i += l2) + { + i1 = i + l1; + t1 = u1 * x[i1] - u2 * y[i1]; + t2 = u1 * y[i1] + u2 * x[i1]; + x[i1] = x[i] - t1; + y[i1] = y[i] - t2; + x[i] += t1; + y[i] += t2; + } + z = u1 * c1 - u2 * c2; + u2 = u1 * c2 + u2 * c1; + u1 = z; + } + c2 = sqrt((1.0 - c1) / 2.0); + if (dir == 1) + c2 = -c2; + c1 = sqrt((1.0 + c1) / 2.0); + } + + /* Scaling for forward transform */ + if (dir == 1) + { + for (i = 0; i < n; i++) + { + x[i] /= n; + y[i] /= n; + } + } +} +// assume a[0] a[1]......a[NN/2-1] a[NN/2] ...... a[NN-1] +// 0 df (NN/2-1)*df combine of \pm NN/2*df -df +// 0 1 2 3 4 5 +// ^ ^ ^ o ^ ^ +// 0 1 2 3 +// ^ ^ o ^ +void misc::Low_Pass_Filt(const int NN, double *a) +{ + // we use 2/3 law, NN/2 * 2/3 = NN/3 + for (int i = 0; i < NN / 3; i++) + { + a[NN / 2 + i] = 0; + a[NN / 2 - i] = 0; + } +} +void misc::polyinterp(double t, double &rr, double *ti, double *ri, const int ORD) +{ + // (x -x_1)...(x -x_i-1)(x -x_i+1)...(x -x_N) + // ------------------------------------------------f_i + // (x_i-x_1)...(x_i-x_i-1)(x_i-x_i+1)...(x_i-x_N) + + rr = 0; + for (int i = 0; i < ORD; i++) + { + double ss = 1, xx = 1; + for (int j = 0; j < ORD; j++) + { + if (j != i) + { + ss *= t - ti[j]; + xx *= ti[i] - ti[j]; + } + } + rr += ss / xx * ri[i]; + } +#if 0 + if(!isfinite(rr)) + { + cout.setf(ios::scientific); + cout<<"misc::polyinterp: error at t = "< Nin +} +int misc::MYpow2(int i) +{ + if (i == 0) + return 1; + else if (i > 0) + return 2 * MYpow2(i - 1); + else + return MYpow2(i + 1) / 2; +} diff --git a/AMSS_NCKU_source/misc.h b/AMSS_NCKU_source/misc.h new file mode 100644 index 0000000..3b9ddcc --- /dev/null +++ b/AMSS_NCKU_source/misc.h @@ -0,0 +1,94 @@ + +#ifndef MISC_H +#define MISC_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +namespace misc +{ + inline string &lTrim(string &ss) + { + string::iterator p = find_if(ss.begin(), ss.end(), not1(ptr_fun(isspace))); + ss.erase(ss.begin(), p); + return ss; + } + inline string &rTrim(string &ss) + { + string::reverse_iterator p = find_if(ss.rbegin(), ss.rend(), not1(ptr_fun(isspace))); + ss.erase(p.base(), ss.end()); + return ss; + } + inline string &Trim(string &st) + { + lTrim(rTrim(st)); + return st; + } + + template + void swap(T &a, T &b) + { + T c = a; + a = b; + b = c; + } + void tillherecheck(int myrank); + void tillherecheck(const char str[]); + void tillherecheck(MPI_Comm Comm_here, int out_rank, const char str[]); + void tillherecheck(MPI_Comm Comm_here, int out_rank, const string str); + int parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind); + int parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind1, int &ind2); + int parse_parts(string str, string &sgrp, string &skey, string &sval, int &ind1, int &ind2, int &ind3); + void gaulegf(double x1, double x2, double *x, double *w, int n); + complex gaulegf(double x1, double x2, int n, complex fun(double x)); + void inversearray(double *aa, int NN); + double fact(int N); + double Wigner_d_function(int l, int m, int s, double costheta); + int num_of_str(char *c); + void TVDrungekutta3(const int N, const double dT, double *f0, double *f1, double *f_rhs, const int RK4); + void rungekutta4(const int N, const double dT, double *f0, double *f1, double *f_rhs, const int RK4); + void rungekutta4(const double dT, const std::vector &f0, + std::vector &f1, std::vector &f_rhs, const int RK4); + void dividBlock(const int DIM, int *shape_here, double *bbox_here, const int pices, double *picef, int *shape_res, double *bbox_res, const int min_width); + void swapvector(std::vector &f0, std::vector &f1); + complex complex_gamma(complex z); + complex KummerComplex(const complex a, const complex b, complex x); +#if 0 +complex First_Bessel(const complex a,complex x); +#else + complex First_Bessel(double a, complex x); +#endif + complex Rec_Int(const double xmin, const double xmax, complex fun(double x)); + complex Simpson_Int(const double xmin, const double xmax, complex fun(double x)); + complex Simpson3o8_Int(const double xmin, const double xmax, complex fun(double x)); + complex Gauss_Int(const double xmin, const double xmax, complex fun(double x)); + + void FFT(short int dir, long m, double *x, double *y); + void Low_Pass_Filt(const int NN, double *a); + void polyinterp(double t, double &rr, double *ti, double *ri, const int ORD); + void polyinterp_d1(double t, double &rr, double *ti, double *ri, const int ORD); + void next2power(long int Nin, long int &Nout, int &M); + int MYpow2(int i); +} +#endif /* MISC_H */ diff --git a/AMSS_NCKU_source/miscfp.C b/AMSS_NCKU_source/miscfp.C new file mode 100644 index 0000000..a63ebf7 --- /dev/null +++ b/AMSS_NCKU_source/miscfp.C @@ -0,0 +1,66 @@ +#include +#include + +#include "cctk.h" + +#include "stdc.h" +#include "util.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + double signum(double x) + { + if (x == 0.0) + then return 0.0; + else + return (x > 0.0) ? 1.0 : -1.0; + } + double hypot3(double x, double y, double z) + { + return sqrt(x * x + y * y + z * z); + } + double arctan_xy(double x, double y) + { + return ((x == 0.0) && (y == 0.0)) ? 0.0 : atan2(y, x); + } + double modulo_reduce(double x, double xmod, double xmin, double xmax) + { + double xx = x; + + while (fuzzy::LT(xx, xmin)) + { + xx += xmod; + } + + while (fuzzy::GT(xx, xmax)) + { + xx -= xmod; + } + + if (!(fuzzy::GE(xx, xmin) && fuzzy::LE(xx, xmax))) + then error_exit(ERROR_EXIT, + "***** modulo_reduce(): no modulo value is fuzzily within specified range!\n" + " x = %g xmod = %g\n" + " [xmin,xmax] = [%g,%g]\n" + " ==> xx = %g\n", + x, xmod, + xmin, xmax, + xx); /*NOTREACHED*/ + + return xx; + } + template + void zero_C_array(int N, fp_t array[]) + { + for (int i = 0; i < N; ++i) + { + array[i] = 0; + } + } + + template void zero_C_array(int, CCTK_REAL[]); + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/monitor.C b/AMSS_NCKU_source/monitor.C new file mode 100644 index 0000000..20c718f --- /dev/null +++ b/AMSS_NCKU_source/monitor.C @@ -0,0 +1,173 @@ + +#ifdef newc +#include +using namespace std; +#else +#include +#endif + +#include "unistd.h" + +#include "monitor.h" +#include "parameters.h" +#include "misc.h" + +monitor::monitor(const char fname[], int myrank, string head) +{ + I_Print = (myrank == 0); + + if (I_Print) + { + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + // read parameter from file + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + // considering checkpoint run + char filename[50]; + sprintf(filename, "%s/%s", out_dir.c_str(), fname); + int i = 1; + while ((access(filename, F_OK)) != -1) + { + sprintf(filename, "%s/%d_%s", out_dir.c_str(), i, fname); + i++; + } + + outfile.open(filename, ios::trunc); + + time_t tnow; + time(&tnow); + struct tm *loc_time; + loc_time = localtime(&tnow); + + outfile << "# File created on " << asctime(loc_time); + outfile << "#" << endl; + outfile.setf(ios::left); + outfile << head << endl; + } +} + +monitor::monitor(const char fname[], int myrank, const int out_rank, string head) +{ + I_Print = (myrank == out_rank); + + if (I_Print) + { + // considering checkpoint run + char filename[50]; + sprintf(filename, "%s/%s", out_dir.c_str(), fname); + int i = 1; + while ((access(filename, F_OK)) != -1) + { + sprintf(filename, "%s/%d_%s", out_dir.c_str(), i, fname); + i++; + } + + outfile.open(filename, ios::trunc); + + time_t tnow; + time(&tnow); + struct tm *loc_time; + loc_time = localtime(&tnow); + + outfile << "# File created on " << asctime(loc_time); + outfile << "#" << endl; + outfile.setf(ios::left); + outfile << head << endl; + } +} +monitor::~monitor() +{ + if (I_Print) + outfile.close(); +} +void monitor::writefile(double time, int NN, double *DDAT) +{ + if (I_Print) + { + outfile << setprecision(8); + outfile << setw(14) << time; + for (int countlm = 0; countlm < NN; countlm++) + { + outfile << " " << setw(15) << DDAT[countlm]; + } + outfile << endl; + flush(outfile); + } +} +void monitor::writefile(double time, int NN, double *DDAT1, double *DDAT2) +{ + if (I_Print) + { + outfile << setprecision(8); + outfile << setw(14) << time; + for (int countlm = 0; countlm < NN; countlm++) + { + outfile << " " << setw(15) << DDAT1[countlm] + << " " << setw(15) << DDAT2[countlm]; + } + outfile << endl; + flush(outfile); + } +} +void monitor::print_message(string head) +{ + if (I_Print) + { + outfile << head << endl; + flush(outfile); + } +} diff --git a/AMSS_NCKU_source/monitor.h b/AMSS_NCKU_source/monitor.h new file mode 100644 index 0000000..49692d4 --- /dev/null +++ b/AMSS_NCKU_source/monitor.h @@ -0,0 +1,45 @@ + +#ifndef MONITOR_H +#define MONITOR_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#endif +#include + +#include + +class monitor +{ + +public: + string out_dir; + ofstream outfile; + + bool I_Print; + +public: + monitor(const char fname[], int myrank, string head); + monitor(const char fname[], int myrank, const int out_rank, string head); + + ~monitor(); + + void writefile(double time, int NN, double *DDAT); + void writefile(double time, int NN, double *DDAT1, double *DDAT2); + void print_message(string head); +}; + +#endif /* MONITOR */ diff --git a/AMSS_NCKU_source/myglobal.h b/AMSS_NCKU_source/myglobal.h new file mode 100644 index 0000000..ef48a9d --- /dev/null +++ b/AMSS_NCKU_source/myglobal.h @@ -0,0 +1,65 @@ +#ifndef MYGLOBAL_H +#define MYGLOBAL_H + +#include "var.h" +#include "MyList.h" + +#ifdef USE_GPU +#include "bssn_gpu_class.h" +#else +#include "bssn_class.h" +#endif + +#include "driver.h" + +namespace AHFinderDirect +{ + + int globalInterpGFL(double *X, double *Y, double *Z, int Ns, + double *Data); + + int globalInterpGFLlash(double *X, double *Y, double *Z, int Ns, + double *Data); + + void AHFinderDirect_setup(MyList *AHList, MyList *GaugeList, bssn_class *ADM, + int Symmetry, int HN, double *PhysTime); + + void AHFinderDirect_cleanup(); + + void AHFinderDirect_find_horizons(int HN, int *dumpid, + double *xc, double *yc, double *zc, double *xr, double *yr, double *zr, + bool *trigger, double *); + + void AHFinderDirect_enforcefind(int HN, + double *xc, double *yc, double *zc, double *xr, double *yr, double *zr); + // + struct state + { + int N_procs; // total number of processors + int my_proc; // processor number of this processor + // (0 to N_procs-1) + + int Symmetry; + double *PhysTime; + + MyList *AHList; + MyList *GaugeList; + + bssn_class *ADM; + + int N_horizons; // total number of genuine horizons + // being searched for + int N_active_procs; // total number of active processors + // (the active processors are processor + // numbers 0 to N_active_procs-1) + + struct iteration_status_buffers isb; + + horizon_sequence *my_hs; + + struct AH_data **AH_data_array; + + double *Data, *oX, *oY, *oZ; + }; +} +#endif /* MYGLOBAL_H */ diff --git a/AMSS_NCKU_source/norm.C b/AMSS_NCKU_source/norm.C new file mode 100644 index 0000000..857d9c6 --- /dev/null +++ b/AMSS_NCKU_source/norm.C @@ -0,0 +1,68 @@ +#include +#include +#include + +#include "util.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + + template + norm::norm() + : N_(0L), + sum_(0.0), sum2_(0.0), + max_abs_value_(0.0), min_abs_value_(0.0), + max_value_(0.0), min_value_(0.0) + { + } + + template + void norm::reset() + { + N_ = 0L; + sum_ = 0.0; + sum2_ = 0.0; + max_abs_value_ = 0.0; + min_abs_value_ = 0.0; + max_value_ = 0.0; + min_value_ = 0.0; + } + + template + void norm::data(fp_t x) + { + sum_ += x; + sum2_ += x * x; + + const fp_t abs_x = jtutil::abs(x); + max_abs_value_ = jtutil::tmax(max_abs_value_, abs_x); + min_abs_value_ = (N_ == 0) ? abs_x : jtutil::tmin(min_abs_value_, abs_x); + + min_value_ = (N_ == 0) ? x : jtutil::tmin(min_value_, x); + max_value_ = (N_ == 0) ? x : jtutil::tmax(max_value_, x); + + ++N_; + } + + template + fp_t norm::mean() const { return sum_ / fp_t(N_); } + template + fp_t norm::two_norm() const { return sqrt(sum2_); } + template + fp_t norm::rms_norm() const + { + assert(is_nonempty()); + return sqrt(sum2_ / fp_t(N_)); + } + + template class jtutil::norm; + template class jtutil::norm; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/parameters.h b/AMSS_NCKU_source/parameters.h new file mode 100644 index 0000000..edd0a71 --- /dev/null +++ b/AMSS_NCKU_source/parameters.h @@ -0,0 +1,35 @@ + +#ifndef PARAMETERS_H +#define PARAMETERS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +namespace parameters +{ + extern map int_par; + extern map dou_par; + extern map str_par; +} +#endif /* PARAMETERS_H */ diff --git a/AMSS_NCKU_source/patch.C b/AMSS_NCKU_source/patch.C new file mode 100644 index 0000000..22929e3 --- /dev/null +++ b/AMSS_NCKU_source/patch.C @@ -0,0 +1,955 @@ +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function constructs a patch object. + // + patch::patch(patch_system &my_patch_system_in, int patch_number_in, + const char name_in[], bool is_plus_in, char ctype_in, + local_coords::coords_set coords_set_rho_in, + local_coords::coords_set coords_set_sigma_in, + local_coords::coords_set coords_set_tau_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in) + + : fd_grid(grid_array_pars_in, grid_pars_in), + + my_patch_system_(my_patch_system_in), + patch_number_(patch_number_in), + name_(name_in), + is_plus_(is_plus_in), ctype_(ctype_in), + + coords_set_rho_(coords_set_rho_in), + coords_set_sigma_(coords_set_sigma_in), + coords_set_tau_(coords_set_tau_in), + + min_rho_patch_edge_(*new patch_edge(*this, side_is_min, side_is_rho)), + max_rho_patch_edge_(*new patch_edge(*this, side_is_max, side_is_rho)), + min_sigma_patch_edge_(*new patch_edge(*this, side_is_min, side_is_sigma)), + max_sigma_patch_edge_(*new patch_edge(*this, side_is_max, side_is_sigma)), + + min_rho_ghost_zone_(NULL), + max_rho_ghost_zone_(NULL), + min_sigma_ghost_zone_(NULL), + max_sigma_ghost_zone_(NULL) // no comma + + { + } + + //****************************************************************************** + + // + // This function destroys a patch object. + // + patch::~patch() + { + // no need to check for null pointers, since delete NULL is a silent no-op + + delete max_sigma_ghost_zone_; + delete min_sigma_ghost_zone_; + delete max_rho_ghost_zone_; + delete min_rho_ghost_zone_; + + delete &max_sigma_patch_edge_; + delete &min_sigma_patch_edge_; + delete &max_rho_patch_edge_; + delete &min_rho_patch_edge_; + } + + //****************************************************************************** + + // + // This function constructs a z_patch object. + // + z_patch::z_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in) + : patch(my_patch_system_in, patch_number_in, + name_in, is_plus_in, 'z', + local_coords::coords_set_mu, local_coords::coords_set_nu, + local_coords::coords_set_phi, + grid_array_pars_in, grid_pars_in) + { + } + + //****************************************************************************** + + // + // This function constructs an x_patch object. + // + x_patch::x_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in) + : patch(my_patch_system_in, patch_number_in, + name_in, is_plus_in, 'x', + local_coords::coords_set_nu, local_coords::coords_set_phi, + local_coords::coords_set_mu, + grid_array_pars_in, grid_pars_in) + { + } + + //****************************************************************************** + + // + // This function constructs a y_patch object. + // + y_patch::y_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in) + : patch(my_patch_system_in, patch_number_in, + name_in, is_plus_in, 'y', + local_coords::coords_set_mu, local_coords::coords_set_phi, + local_coords::coords_set_nu, + grid_array_pars_in, grid_pars_in) + { + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function computes the (rho,sigma) induced 2-D metric from the + // 3-D (x,y,z) metric of the space containing the patch, as per p.33 of + // my apparent horizon finding notes. + // + // Arguments: + // (r,rho,sigma) = The coordinates where the Jacobian is wanted. + // partial_surface_r_wrt_(rho,sigma) + // = The partial derivatives of the surface radius with respect to + // the (rho,sigma) coordinates. + // g_{xx,xy,xz,yy,yz,zz} = The xyz 3-metric components $g_{ij}$. + // g_{rho_rho,rho_sigma,sigma_sigma} = The (rho,sigma) induced 2-D metric. + // + // Results: + // This function returns the Jacobian of the (rho,sigma) induced 2-D metric. + // + fp patch::rho_sigma_metric(fp r, fp rho, fp sigma, + fp partial_surface_r_wrt_rho, + fp partial_surface_r_wrt_sigma, + fp g_xx, fp g_xy, fp g_xz, + fp g_yy, fp g_yz, + fp g_zz, + fp &g_rho_rho, fp &g_rho_sigma, + fp &g_sigma_sigma) + const + { + fp partial_x_wrt_r, partial_x_wrt_rho, partial_x_wrt_sigma; + fp partial_y_wrt_r, partial_y_wrt_rho, partial_y_wrt_sigma; + fp partial_z_wrt_r, partial_z_wrt_rho, partial_z_wrt_sigma; + partial_xyz_wrt_r_rho_sigma(r, rho, sigma, + partial_x_wrt_r, partial_x_wrt_rho, partial_x_wrt_sigma, + partial_y_wrt_r, partial_y_wrt_rho, partial_y_wrt_sigma, + partial_z_wrt_r, partial_z_wrt_rho, partial_z_wrt_sigma); + + const fp dx_wrt_rho = partial_x_wrt_rho + partial_x_wrt_r * partial_surface_r_wrt_rho; + const fp dx_wrt_sigma = partial_x_wrt_sigma + partial_x_wrt_r * partial_surface_r_wrt_sigma; + const fp dy_wrt_rho = partial_y_wrt_rho + partial_y_wrt_r * partial_surface_r_wrt_rho; + const fp dy_wrt_sigma = partial_y_wrt_sigma + partial_y_wrt_r * partial_surface_r_wrt_sigma; + const fp dz_wrt_rho = partial_z_wrt_rho + partial_z_wrt_r * partial_surface_r_wrt_rho; + const fp dz_wrt_sigma = partial_z_wrt_sigma + partial_z_wrt_r * partial_surface_r_wrt_sigma; + + g_rho_rho = +dx_wrt_rho * dx_wrt_rho * g_xx + 2.0 * dx_wrt_rho * dy_wrt_rho * g_xy + 2.0 * dx_wrt_rho * dz_wrt_rho * g_xz + dy_wrt_rho * dy_wrt_rho * g_yy + 2.0 * dy_wrt_rho * dz_wrt_rho * g_yz + dz_wrt_rho * dz_wrt_rho * g_zz; + g_rho_sigma = +dx_wrt_rho * dx_wrt_sigma * g_xx + (dx_wrt_rho * dy_wrt_sigma + dy_wrt_rho * dx_wrt_sigma) * g_xy + (dx_wrt_rho * dz_wrt_sigma + dz_wrt_rho * dx_wrt_sigma) * g_xz + dy_wrt_rho * dy_wrt_sigma * g_yy + (dy_wrt_rho * dz_wrt_sigma + dz_wrt_rho * dy_wrt_sigma) * g_yz + dz_wrt_rho * dz_wrt_sigma * g_zz; + g_sigma_sigma = +dx_wrt_sigma * dx_wrt_sigma * g_xx + 2.0 * dx_wrt_sigma * dy_wrt_sigma * g_xy + 2.0 * dx_wrt_sigma * dz_wrt_sigma * g_xz + dy_wrt_sigma * dy_wrt_sigma * g_yy + 2.0 * dy_wrt_sigma * dz_wrt_sigma * g_yz + dz_wrt_sigma * dz_wrt_sigma * g_zz; + + return g_rho_rho * g_sigma_sigma - jtutil::pow2(g_rho_sigma); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function decodes the character-string name of an integration method + // into an enum integration_method . See the comments in "patch.hh" on the + // declaration of enum integration_method for details on the methods and + // their character-string names. + // + // static + enum patch::integration_method + patch::decode_integration_method(const char method_string[]) + { + if ((strcmp(method_string, "trapezoid") == 0) || (strcmp(method_string, "trapezoid rule") == 0)) + return integration_method__trapezoid; + else if ((strcmp(method_string, "Simpson") == 0) || (strcmp(method_string, "Simpson's rule") == 0)) + return integration_method__Simpson; + else if ((strcmp(method_string, "Simpson (variant)") == 0) || (strcmp(method_string, "Simpson's rule (variant)") == 0)) + return integration_method__Simpson_variant; + else if (strcmp(method_string, "automatic choice") == 0) + return integration_method__automatic_choice; + else + error_exit(ERROR_EXIT, + "***** patch::decode_integration_method():\n" + " unknown method_string=\"%s\"!\n", + method_string); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function computes an approximation to the arc length of a surface + // over the patch's nominal bounds along the rho direction (i.e. in a + // dsigma=constant plane where dsigma is a multiple of 90 degrees) + // + // Arguments: + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp patch::rho_arc_length(int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + fp dsigma; + if (is_valid_dsigma(0.0)) + then dsigma = 0.0; + else if (is_valid_dsigma(90.0)) + then dsigma = 90.0; + else if (is_valid_dsigma(180.0)) + then dsigma = 180.0; + else if (is_valid_dsigma(-90.0)) + then dsigma = -90.0; + else + error_exit(PANIC_EXIT, + "***** patch::rho_arc_length(): can't find valid dsigma\n" + " which is a multiple of 90 degrees!\n" + " %s patch: [min,max]_dsigma()=[%g,%g]\n", + name(), min_dsigma(), max_dsigma()); + const fp sigma = sigma_of_dsigma(dsigma); + const int isigma = isigma_of_sigma(sigma); + + fp sum = 0.0; + + for (int irho = min_irho(); irho <= max_irho(); ++irho) + { + const fp rho = rho_of_irho(irho); + const fp r = ghosted_gridfn(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_rho = partial_rho(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_sigma = partial_sigma(ghosted_radius_gfn, irho, isigma); + + const fp g_xx = gridfn(g_xx_gfn, irho, isigma); + const fp g_xy = gridfn(g_xy_gfn, irho, isigma); + const fp g_xz = gridfn(g_xz_gfn, irho, isigma); + const fp g_yy = gridfn(g_yy_gfn, irho, isigma); + const fp g_yz = gridfn(g_yz_gfn, irho, isigma); + const fp g_zz = gridfn(g_zz_gfn, irho, isigma); + + fp g_rho_rho, g_rho_sigma, g_sigma_sigma; + rho_sigma_metric(r, rho, sigma, + partial_surface_r_wrt_rho, + partial_surface_r_wrt_sigma, + g_xx, g_xy, g_xz, + g_yy, g_yz, + g_zz, + g_rho_rho, g_rho_sigma, + g_sigma_sigma); + + const fp coeff = integration_coeff(method, + max_irho() - min_irho(), + irho - min_irho()); + + sum += coeff * sqrt(g_rho_rho); + } + + return delta_rho() * sum; + } + + //****************************************************************************** + + // + // This function computes an approximation to the arc length of a surface + // over the patch's nominal bounds along the sigma direction (i.e. in a + // drho=constant plane where drho is a multiple of 90 degrees) + // + // Arguments: + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp patch::sigma_arc_length(int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + fp drho; + if (is_valid_drho(0.0)) + then drho = 0.0; + else if (is_valid_drho(90.0)) + then drho = 90.0; + else if (is_valid_drho(180.0)) + then drho = 180.0; + else if (is_valid_drho(-90.0)) + then drho = -90.0; + else + error_exit(PANIC_EXIT, + "***** patch::sigma_arc_length(): can't find valid drho\n" + " which is a multiple of 90 degrees!\n" + " %s patch: [min,max]_drho()=[%g,%g]\n", + name(), min_drho(), max_drho()); + const fp rho = rho_of_drho(drho); + const int irho = irho_of_rho(rho); + + fp sum = 0.0; + + for (int isigma = min_isigma(); isigma <= max_isigma(); ++isigma) + { + const fp sigma = sigma_of_isigma(isigma); + const fp r = ghosted_gridfn(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_rho = partial_rho(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_sigma = partial_sigma(ghosted_radius_gfn, irho, isigma); + + const fp g_xx = gridfn(g_xx_gfn, irho, isigma); + const fp g_xy = gridfn(g_xy_gfn, irho, isigma); + const fp g_xz = gridfn(g_xz_gfn, irho, isigma); + const fp g_yy = gridfn(g_yy_gfn, irho, isigma); + const fp g_yz = gridfn(g_yz_gfn, irho, isigma); + const fp g_zz = gridfn(g_zz_gfn, irho, isigma); + + fp g_rho_rho, g_rho_sigma, g_sigma_sigma; + rho_sigma_metric(r, rho, sigma, + partial_surface_r_wrt_rho, + partial_surface_r_wrt_sigma, + g_xx, g_xy, g_xz, + g_yy, g_yz, + g_zz, + g_rho_rho, g_rho_sigma, + g_sigma_sigma); + + const fp coeff = integration_coeff(method, + max_isigma() - min_isigma(), + isigma - min_isigma()); + + sum += coeff * sqrt(g_sigma_sigma); + } + + return delta_sigma() * sum; + } + + //****************************************************************************** + + // + // This function computes the arc length of a surface in the specified + // plane ("xz" or "yz") over the patch's nominal bounds. + // + // Arguments: + // plane[] = (in) "xz" or "yz" to specify the plane. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp z_patch::plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + if ((plane[0] == 'x') && (plane[1] == 'z')) + then // xz-plane = rotation about y = nu arc = sigma sigma + return sigma_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else if ((plane[0] == 'y') && (plane[1] == 'z')) + then // yz-plane = rotation about x = mu arc = rho arc + return rho_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else + error_exit(ERROR_EXIT, + "***** z_patch::plane_arc_length(): %s patch, plane=\"%s\", but\n" + " this patch doesn't contain that plane!\n", + name(), plane); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function computes the arc length of a surface in the specified + // plane ("xy" or "xz") over the patch's nominal bounds. + // + // Arguments: + // plane[] = (in) "xy" or "xz" to specify the plane. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp x_patch::plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + if ((plane[0] == 'x') && (plane[1] == 'y')) + then // xy-plane = rotation about z = phi arc = sigma arc + return sigma_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else if ((plane[0] == 'x') && (plane[1] == 'z')) + then // xz-plane = rotation about y = nu arc = rho arc + return rho_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else + error_exit(ERROR_EXIT, + "***** x_patch::plane_arc_length(): %s patch, plane=\"%s\", but\n" + " this patch doesn't contain that plane!\n", + name(), plane); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function computes the arc length of a surface in the specified + // plane ("xy" or "yz") over the patch's nominal bounds. + // + // Arguments: + // plane[] = (in) "xy" or "yz" to specify the plane. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp y_patch::plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + if ((plane[0] == 'x') && (plane[1] == 'y')) + then // xy-plane = rotation about z = phi arc = sigma arc + return sigma_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else if ((plane[0] == 'y') && (plane[1] == 'z')) + then // yz-plane = rotation about x = mu arc = rho arc + return rho_arc_length(ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + else + error_exit(ERROR_EXIT, + "***** y_patch::plane_arc_length(): %s patch, plane=\"%s\", but\n" + " this patch doesn't contain that plane!\n", + name(), plane); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function computes an approximation to the (surface) integral of + // a gridfn over the patch's nominal area, + // $\int f(\rho,\sigma) \, dA$ + // = \int f(\rho,\sigma) \sqrt{|J|} \, d\rho \, d\sigma$ + // where $J$ is the Jacobian of $(x,y,z)$ with respect to $(rho,sigma). + // + // Arguments: + // unknown_src_gfn = (in) The gridfn to be integrated. This may be + // either nominal-grid or ghosted-grid; n.b. in + // the latter case the integral is still done only + // over the patch's nominal area. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp patch::integrate_gridfn(int unknown_src_gfn, + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const + { + const bool src_is_ghosted = is_valid_ghosted_gfn(unknown_src_gfn); + + fp sum = 0.0; + for (int irho = min_irho(); irho <= max_irho(); ++irho) + { + for (int isigma = min_isigma(); isigma <= max_isigma(); ++isigma) + { + const fp fn = unknown_gridfn(src_is_ghosted, + unknown_src_gfn, irho, isigma); + + const fp rho = rho_of_irho(irho); + const fp sigma = sigma_of_isigma(isigma); + const fp r = ghosted_gridfn(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_rho = partial_rho(ghosted_radius_gfn, irho, isigma); + const fp partial_surface_r_wrt_sigma = partial_sigma(ghosted_radius_gfn, irho, isigma); + + const fp g_xx = gridfn(g_xx_gfn, irho, isigma); + const fp g_xy = gridfn(g_xy_gfn, irho, isigma); + const fp g_xz = gridfn(g_xz_gfn, irho, isigma); + const fp g_yy = gridfn(g_yy_gfn, irho, isigma); + const fp g_yz = gridfn(g_yz_gfn, irho, isigma); + const fp g_zz = gridfn(g_zz_gfn, irho, isigma); + + fp g_rho_rho, g_rho_sigma, g_sigma_sigma; + const fp Jac = rho_sigma_metric(r, rho, sigma, + partial_surface_r_wrt_rho, + partial_surface_r_wrt_sigma, + g_xx, g_xy, g_xz, + g_yy, g_yz, + g_zz, + g_rho_rho, g_rho_sigma, + g_sigma_sigma); + + const fp coeff_rho = integration_coeff(method, + max_irho() - min_irho(), + irho - min_irho()); + const fp coeff_sigma = integration_coeff(method, + max_isigma() - min_isigma(), + isigma - min_isigma()); + + sum += coeff_rho * coeff_sigma * fn * sqrt(jtutil::abs(Jac)); + } + } + + return delta_rho() * delta_sigma() * sum; + } + + //****************************************************************************** + + // + // This function computes the integration coefficients for + // integrate_gridfn() . That is, if we write + // $\int_{x_0}^{x_N} f(x) \, dx + // \approx \Delta x \, \sum_{i=0}^N c_i f(x_i)$ + // then this function computes $c_i$. + // + // For method == integration_method__automatic_choice the choices are + // N=1 trapezoid + // N=2 Simpson + // N=3 trapezoid + // N=4 Simpson + // N=5 trapezoid + // N=6 Simpson + // N=7 and up Simpson variant + // + // Arguments: + // method = Specifies the integration method. + // N = The number of integration *intervals*. (The number of integration + // *points* is N+1.) + // i = Specifies the point at which the coefficient is desired. + // + // static + fp patch::integration_coeff(enum integration_method method, int N, int i) + { + assert(i >= 0); + assert(i <= N); + + if (method == integration_method__automatic_choice) + then + { + if (N >= 7) + then method = integration_method__Simpson_variant; + else if ((N % 2) == 0) + then method = integration_method__Simpson; + else + method = integration_method__trapezoid; + } + + switch (method) + { + case integration_method__trapezoid: + if ((i == 0) || (i == N)) + then return 0.5; + else + return 1.0; + + case integration_method__Simpson: + if ((N % 2) != 0) + then error_exit(ERROR_EXIT, + "***** patch::integration_coeff():\n" + " Simpson's rule requires N to be even, but N=%d!\n", + N); /*NOTREACHED*/ + if ((i == 0) || (i == N)) + then return 1.0 / 3.0; + else if ((i % 2) == 0) + then return 2.0 / 3.0; + else + return 4.0 / 3.0; + + case integration_method__Simpson_variant: + if (N < 7) + then error_exit(ERROR_EXIT, + "***** patch::integration_coeff():\n" + " Simpson's rule (variant) requires N >= 7, but N=%d!\n", + N); /*NOTREACHED*/ + if ((i == 0) || (i == N)) + then return 17.0 / 48.0; + else if ((i == 1) || (i == N - 1)) + then return 59.0 / 48.0; + else if ((i == 2) || (i == N - 2)) + then return 43.0 / 48.0; + else if ((i == 3) || (i == N - 3)) + then return 49.0 / 48.0; + else + return 1.0; + + default: + error_exit(ERROR_EXIT, + "***** patch::integration_coeff(): unknown method=(int)%d!\n" + " (this should never happen!)\n", + int(method)); /*NOTREACHED*/ + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function returns a reference to the ghost zone on a specified + // edge, after first assert()ing that the edge belongs to this patch. + // + // N.b. This function can't be inline in "patch.hh" because it needs + // member functions of class patch_edge, which comes after class patch + // in our #include order. + // + ghost_zone &patch::ghost_zone_on_edge(const patch_edge &e) + const + { + assert(e.my_patch() == *this); + return minmax_ang_ghost_zone(e.is_min(), e.is_rho()); + } + + //****************************************************************************** + + // + // This function determines which of the two adjacent ghost zones meeting + // at a specified corner, contains a specified point. If the point isn't + // in either ghost zone, an error_exit() is done. If the point is in both + // ghost zones, it's arbitrary which one will be chosen. + // + // Arguments: + // {rho,sigma}_is_min = Specify the corner (and implicitly the ghost zones). + // irho,isigma = Specify the point. + // + // Results: + // This function returns (a reference to) the desired ghost zone. + ghost_zone &patch::corner_ghost_zone_containing_point(bool rho_is_min, bool sigma_is_min, + int irho, int isigma) + const + { + ghost_zone &rho_gz = minmax_rho_ghost_zone(rho_is_min); + ghost_zone &sigma_gz = minmax_sigma_ghost_zone(sigma_is_min); + + const patch_edge &rho_edge = rho_gz.my_edge(); + const patch_edge &sigma_edge = sigma_gz.my_edge(); + + const int rho_iperp = rho_edge.iperp_of_irho_isigma(irho, isigma); + const int rho_ipar = rho_edge.ipar_of_irho_isigma(irho, isigma); + const int sigma_iperp = sigma_edge.iperp_of_irho_isigma(irho, isigma); + const int sigma_ipar = sigma_edge.ipar_of_irho_isigma(irho, isigma); + + const bool is_in_rho_ghost_zone = rho_gz.is_in_ghost_zone(rho_iperp, rho_ipar); + const bool is_in_sigma_ghost_zone = sigma_gz.is_in_ghost_zone(sigma_iperp, sigma_ipar); + + // check that point is in at least one ghost zone + if (!is_in_rho_ghost_zone && !is_in_sigma_ghost_zone) + then error_exit(ERROR_EXIT, + "***** patch::corner_ghost_zone_containing_point():\n" + " neither ghost zone contains point (this should never happen)!\n" + " patch=%s rho_is_min=(int)%d sigma_is_min=(int)%d\n" + " irho=%d isigma=%d\n", + name(), int(rho_is_min), int(sigma_is_min), + irho, isigma); /*NOTREACHED*/ + + return is_in_rho_ghost_zone ? rho_gz : sigma_gz; + } + + //****************************************************************************** + + // + // This function determines which ghost zone contains a specified + // noncorner point. + // + // If the point isn't in any ghost zone of this patch, or if the point + // is in the corner of a ghost zone, an error_exit() is done. + // + // Arguments: + // irho,isigma = Specify the point. + // + // Results: + // This function returns (a reference to) the desired ghost zone. + ghost_zone &patch::ghost_zone_containing_noncorner_point(int irho, int isigma) + const + { + // n.b. these loops must use _int_ variables for the loop + // to terminate! + for (int want_min = false; want_min <= true; ++want_min) + { + for (int want_rho = false; want_rho <= true; ++want_rho) + { + const patch_edge &e = minmax_ang_patch_edge(want_min, want_rho); + const int iperp = e.iperp_of_irho_isigma(irho, isigma); + const int ipar = e.ipar_of_irho_isigma(irho, isigma); + + ghost_zone &gz = minmax_ang_ghost_zone(want_min, want_rho); + if (gz.is_in_ghost_zone(iperp, ipar) && gz.my_edge().ipar_is_in_noncorner(ipar)) + then return gz; + } + } + + error_exit(ERROR_EXIT, + "***** patch::ghost_zone_containing_noncorner_point():\n" + " no ghost zone contains point (this should never happen)!\n" + " patch=%s irho=%d isigma=%d\n", + name(), irho, isigma); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function assert()s that a specified ghost zone of this patch + // hasn't already been set up, then constructs it as a mirror-symmetry + // ghost zone and properly links this to/from the patch. + // + void patch::create_mirror_symmetry_ghost_zone(const patch_edge &my_edge) + { + // make sure we belong to the right patch + assert(my_edge.my_patch() == *this); + + symmetry_ghost_zone *temp = new symmetry_ghost_zone(my_edge); + set_ghost_zone(my_edge, temp); + } + + //****************************************************************************** + + // + // This function assert()s that a specified ghost zone of this patch + // hasn't already been set up, then creates it as a periodic-symmetry + // ghost zone and properly links this to/from the patch. + // + void patch::create_periodic_symmetry_ghost_zone(const patch_edge &my_edge, const patch_edge &other_edge, + bool is_ipar_map_plus) + { + // make sure we belong to the right patch + assert(my_edge.my_patch() == *this); + + int my_sample_ipar = my_edge.min_ipar_without_corners(); + int other_sample_ipar = is_ipar_map_plus + ? other_edge.min_ipar_without_corners() + : other_edge.max_ipar_without_corners(); + + symmetry_ghost_zone *temp = new symmetry_ghost_zone(my_edge, other_edge, + my_sample_ipar, other_sample_ipar, + is_ipar_map_plus); + set_ghost_zone(my_edge, temp); + } + + //****************************************************************************** + + // + // This function assert()s that a specified ghost zone of this patch + // hasn't already been set up, then creates it as an interpatch ghost + // zone (with lots of NULL pointers for info we can't compute yet) + // and properly links this to/from the patch. + // + void patch::create_interpatch_ghost_zone(const patch_edge &my_edge, const patch_edge &other_edge, + int patch_overlap_width) + { + // make sure we belong to the right patch + assert(my_edge.my_patch() == *this); + + interpatch_ghost_zone *temp = new interpatch_ghost_zone(my_edge, other_edge, + patch_overlap_width); + set_ghost_zone(my_edge, temp); + } + + //****************************************************************************** + + // + // This is a helper function for setup_*_ghost_zone(). This function + // assert()s that one of the ghost zone pointers (which one is selected + // by edge ) is NULL, then stores a value in it. + // + void patch::set_ghost_zone(const patch_edge &edge, ghost_zone *gzp) + { + ghost_zone *&ghost_zone_ptr_to_set = edge.is_min() + ? (edge.is_rho() ? min_rho_ghost_zone_ : min_sigma_ghost_zone_) + : (edge.is_rho() ? max_rho_ghost_zone_ : max_sigma_ghost_zone_); + + assert(ghost_zone_ptr_to_set == NULL); + ghost_zone_ptr_to_set = gzp; + } + + //****************************************************************************** + + // + // This function finds which patch edge is adjacent to a neighboring + // patch q, or does an error_exit() if q isn't actually a neighboring patch. + // The computation is done using only (rho,sigma) coordinate sets and + // min/max dang bounds ==> it's ok to use this function in setting up + // interpatch ghost zones. + // + // Arguments: + // q = The (supposedly) neighboring patch. + // patch_overlap_width = The number of grid points these patches overlap. + // If this is nonzero, then these patches must have the + // same grid spacing in the perpendicular direction. + // + const patch_edge &patch::edge_adjacent_to_patch(const patch &q, + int patch_overlap_width /* = 0 */) + const + { + const patch &p = *this; + + // which (rho,sigma) coordinate do the patches have in common? + // ... this is the perp coordinate for the border + const local_coords::coords_set common_coord_set = p.coords_set_rho_sigma() & q.coords_set_rho_sigma(); + + // is this coordinate rho or sigma in each patch? + const bool common_is_p_rho = (common_coord_set == p.coords_set_rho()); + const bool common_is_p_sigma = (common_coord_set == p.coords_set_sigma()); + if ((common_is_p_rho ^ common_is_p_sigma) != 0x1) + then error_exit(ERROR_EXIT, + "***** patch::edge_adjacent_to_patch():\n" + " common coordinate isn't exactly one of p.{rho,sigma}!\n" + " p.name()=\"%s\" q.name()=\"%s\"\n" + " common_coord_set=%s\n" + " common_is_p_rho=%d common_is_p_sigma=%d\n", + p.name(), q.name(), + local_coords::name_of_coords_set(common_coord_set), + int(common_is_p_rho), int(common_is_p_sigma)); + /*NOTREACHED*/ + const bool common_is_q_rho = (common_coord_set == q.coords_set_rho()); + const bool common_is_q_sigma = (common_coord_set == q.coords_set_sigma()); + if ((common_is_q_rho ^ common_is_q_sigma) != 0x1) + then error_exit(ERROR_EXIT, + "***** patch::edge_adjacent_to_patch():\n" + " common coordinate isn't exactly one of q.{rho,sigma}!\n" + " p.name()=\"%s\" q.name()=\"%s\"\n" + " common_coord_set=%s\n" + " common_is_q_rho=%d common_is_q_sigma=%d\n", + p.name(), q.name(), + local_coords::name_of_coords_set(common_coord_set), + int(common_is_q_rho), int(common_is_q_sigma)); + /*NOTREACHED*/ + + // how much do the patches overlap? + // ... eg patch_overlap_width = 3 would be + // p p p p p + // q q q q q + // so the overlap would be (patch_overlap_width-1) * delta = 2 * delta + if ((patch_overlap_width - 1 != 0) && jtutil::fuzzy::NE(p.delta_dang(common_is_p_rho), + q.delta_dang(common_is_q_rho))) + then error_exit(ERROR_EXIT, + "***** patch::edge_adjacent_to_patch():\n" + " patch_overlap_width != 0 must have same perp grid spacing in both patches!\n" + " p.name()=\"%s\" q.name()=\"%s\"\n" + " common_coord_set=%s\n" + " common_is_p_rho=%d common_is_q_rho=%d\n" + " p.delta_dang(common_is_p_rho)=%g\n" + " q.delta_dang(common_is_q_rho)=%g\n", + p.name(), q.name(), + local_coords::name_of_coords_set(common_coord_set), + int(common_is_p_rho), int(common_is_q_rho), + double(p.delta_dang(common_is_p_rho)), + double(q.delta_dang(common_is_q_rho))); /*NOTREACHED*/ + + const fp doverlap = fp(patch_overlap_width - 1) * p.delta_dang(common_is_p_rho); + + // where is the common boundary relative to the min/max sides of each patch? + const bool common_is_p_min_q_max = local_coords::fuzzy_EQ_dang(p.min_dang(common_is_p_rho), + q.max_dang(common_is_q_rho) - doverlap); + const bool common_is_p_max_q_min = local_coords::fuzzy_EQ_dang(p.max_dang(common_is_p_rho), + q.min_dang(common_is_q_rho) + doverlap); + if ((common_is_p_min_q_max ^ common_is_p_max_q_min) != 0x1) + then error_exit(ERROR_EXIT, + "***** patch::edge_adjacent_to_patch():\n" + " common coordinate isn't exactly one of {pmax/qmin, pmin/qmax}!\n" + " p.name()=\"%s\" q.name()=\"%s\"\n" + " common_coord_set=%s\n" + " common_is_p_rho=%d common_is_q_rho=%d\n" + " p.delta_dang(common_is_p_rho)=%g\n" + " q.delta_dang(common_is_q_rho)=%g\n" + " patch_overlap_width=%d doverlap=%g\n" + " common_is_p_min_q_max=%d common_is_p_max_q_min=%d\n", + p.name(), q.name(), + local_coords::name_of_coords_set(common_coord_set), + int(common_is_p_rho), int(common_is_q_rho), + double(p.delta_dang(common_is_p_rho)), + double(q.delta_dang(common_is_q_rho)), + patch_overlap_width, double(doverlap), + int(common_is_p_min_q_max), int(common_is_p_max_q_min)); + /*NOTREACHED*/ + + return p.minmax_ang_patch_edge(common_is_p_min_q_max, common_is_p_rho); + } + + //****************************************************************************** + + // + // This function verifies (via assert()) that all ghost zones of this + // patch have been fully set up. + // + void patch::assert_all_ghost_zones_fully_setup() const + { + assert(min_rho_ghost_zone_ != NULL); + assert(max_rho_ghost_zone_ != NULL); + assert(min_sigma_ghost_zone_ != NULL); + assert(max_sigma_ghost_zone_ != NULL); + + // these calls are no-ops for non-interpatch ghost zones + min_rho_ghost_zone().assert_fully_setup(); + max_rho_ghost_zone().assert_fully_setup(); + min_sigma_ghost_zone().assert_fully_setup(); + max_sigma_ghost_zone().assert_fully_setup(); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/patch.h b/AMSS_NCKU_source/patch.h new file mode 100644 index 0000000..36833bc --- /dev/null +++ b/AMSS_NCKU_source/patch.h @@ -0,0 +1,1150 @@ +#ifndef TPATCH_H +#define TPATCH_H +namespace AHFinderDirect +{ + + //***************************************************************************** + //***************************************************************************** + //***************************************************************************** + + // + // ***** how patch boundaries are handled ***** + // + + // + // Basically, we handle patch boundaries using the usual "ghost zone" + // technique, interpolating values from neighboring patches as necessary. + // + // In more detail, we use the following interrelated types of objects + // to handle patch boundaries: + // + // A patch_edge object represents the basic geometry of a min/max + // rho/sigma side of a patch, i.e. it provides which-side-am-I predicates, + // coordinate conversions between (perp,par) and (rho,sigma), etc. + // Every patch has (points to) 4 patch_edge objects, one for each of + // the patch's sides. + // + // A ghost_zone object describes a patch's ghost zone, and knows how + // to fill in gridfns there based on either the patch system's symmetry + // or interpolation from a neighboring patch. ghost_zone is an abstract + // base class, from which we derive two classes: + // * A symmetry_ghost_zone object describes a ghost zone which is a + // (discrete) symmetry of spacetime, either mirror-image or periodic. + // Such an object knows how to fill in ghost-zone gridfn data from + // the "other side" of the symmetry. + // * An interpatch_ghost_zone object describes a ghost zone which + // overlaps another patch. Such an object knows how to get ghost + // zone gridfn data from the other patch. More accurately, it gets + // the data by asking (calling) the appropriate one of the other + // patch's patch_interp objects. + // Every patch has (points to) 4 ghost_zone objects, one for each of + // the patch's sides. + // + // A patch_interp object does the actual interpolation of data from + // within a patch (for filling in data in another patch's ghost zone). + // A patch_interp object points to the patch and patch_edge where it + // will be interpolating. + // + // For example, suppose we have two patches p and q with a common + // angular boundary. Then the desired network of pointers looks like + // this (omitting the patch_edge objects for simplicity): + // + // +-----+ +-----+ + // | | <--> p.interpatch_ghost_zone ---> q.patch_interp ---> | | + // | p | | q | + // | | <--- p.patch_interp <--- q.interpatch_ghost_zone <--> | | + // +-----+ +-----+ + // + // Because of the mutual pointers, we can't easily construct (say) p's + // interpatch_ghost_zone until after q itself has been constructed, and + // vice versa. Moreover, the patch_interp:: constructor needs the + // adjacent-side ghost_zone objects to already exist, and it needs to + // know the iperp range of the interpolation region, which can only be + // computed from the adjacent-patch interpatch_ghost_zone object. + // + // The solution adopted here is to use a 3-phase algorithm, ultimately + // driven by the patch_system constructor: + // * The patch constructors themselves construct the patch_edge objects + // and links them to/from the patches. + // * The patch_system constructor calls the appropriate functions + // patch::create_mirror_symmetry_ghost_zone() + // patch::create_periodic_symmetry_ghost_zone() + // patch::create_interpatch_ghost_zone() + // to construct the ghost_zone objects and link them to/from the + // patches. + // * The patch_system constructor calls the functions + // interpatch_ghost_zone::finish_setup() + // to finish setting up the interpatch_ghost_zone objects, construct + // the other patch's patch_interp objects, and finish linking the + // interpatch_ghost_zone objects to the patch_interp objects. + // + + //***************************************************************************** + //***************************************************************************** + //***************************************************************************** + + // + // patch - abstract base class to describe a generic coordinate/grid patch + // + + // + // There are 3 types of patches, z, x, and y. Each type uses two of + // (mu,nu,phi) as its angular coordinates (rho,sigma); the remaining + // "unused" one of (mu,nu,phi) is tau. + // + // z patch ==> (rho,sigma) = (mu,nu) tau = phi + // x patch ==> (rho,sigma) = (nu,phi) tau = mu + // y patch ==> (rho,sigma) = (mu,phi) tau = nu + // + + // forward declarations + class patch_edge; + class ghost_zone; + class symmetry_ghost_zone; + class interpatch_ghost_zone; + class patch_interp; + class patch_system; + + // + // const qualifiers refer to the gridfn values + // + class patch + : public fd_grid + { + // + // ***** patch system, type, and coordinate metadata ***** + // + public: + // to which patch system do we belong? + patch_system &my_patch_system() const + { + return my_patch_system_; + } + + // each patch has a unique 0-origin small-integer patch number, + // usually denoted pn + int patch_number() const { return patch_number_; } + + // each patch has a unique human-readable patch name for debugging etc + const char *name() const { return name_; } // typically "+z" etc + + // are we a +[xyz] or -[xyz] patch? + bool is_plus() const { return is_plus_; } + + // ... values for the is_plus_in constructor argument + // FIXME: these should really be bool, but then we couldn't + // use the "enum hack" for in-class constants + enum + { + patch_is_plus = true, + patch_is_minus = false + }; + + // are we a (+/-) x or y or z patch? + // ... n.b. type is `char' because this is handy for both + // switch() and human-readable printing + char ctype() const { return ctype_; } // 'z' or 'x' or 'y' + + // are two patches really the same patch? + // n.b. this does *not* compare any of the gridfn data! + bool operator==(const patch &other_patch) const + { + return this == &other_patch; + } + bool operator!=(const patch &other_patch) const + { + return !operator==(other_patch); + } + + // (rho,sigma,tau) coordinates as singleton coordinate sets + local_coords::coords_set coords_set_rho() const + { + return coords_set_rho_; + } + local_coords::coords_set coords_set_sigma() const + { + return coords_set_sigma_; + } + local_coords::coords_set coords_set_tau() const + { + return coords_set_tau_; + } + + // {rho,sigma} coordinate set + local_coords::coords_set coords_set_rho_sigma() const + { + return coords_set_rho() | coords_set_sigma(); + } + + // (rho,sigma) coordinates as human-readable character strings + // (for labelling output files etc) + virtual const char *name_of_rho() const = 0; + virtual const char *name_of_sigma() const = 0; + + // + // ***** (rho,sigma,tau) coordinates ***** + // + public: + // convert (rho,sigma) --> tau + virtual fp tau_of_rho_sigma(fp rho, fp sigma) const = 0; + + // convert (rho,sigma) --> (mu,nu,phi) + virtual fp mu_of_rho_sigma(fp rho, fp sigma) const = 0; + virtual fp nu_of_rho_sigma(fp rho, fp sigma) const = 0; + virtual fp phi_of_rho_sigma(fp rho, fp sigma) const = 0; + + // convert (rho,sigma) <--> usual polar spherical (theta,phi) + virtual void theta_phi_of_rho_sigma(fp rho, fp sigma, + fp &ps_theta, fp &ps_phi) + const = 0; + virtual void rho_sigma_of_theta_phi(fp ps_theta, fp ps_phi, + fp &rho, fp &sigma) + const = 0; + + // convert (r,rho,sigma) <--> local (x,y,z) + virtual void xyz_of_r_rho_sigma(fp r, fp rho, fp sigma, + fp &x, fp &y, fp &z) + const = 0; + virtual fp rho_of_xyz(fp x, fp y, fp z) const = 0; + virtual fp sigma_of_xyz(fp x, fp y, fp z) const = 0; + + // convert (rho,sigma) --> direction cosines (xcos,ycos,zcos) + // with respect to the local coordinate system + virtual void xyzcos_of_rho_sigma(fp rho, fp sigma, + fp &xcos, fp &ycos, fp &zcos) + const = 0; + + // partial (x,y,z) / partial (rho,sigma) + virtual void partial_xyz_wrt_r_rho_sigma(fp r, fp rho, fp sigma, + fp &partial_x_wrt_r, fp &partial_x_wrt_rho, fp &partial_x_wrt_sigma, + fp &partial_y_wrt_r, fp &partial_y_wrt_rho, fp &partial_y_wrt_sigma, + fp &partial_z_wrt_r, fp &partial_z_wrt_rho, fp &partial_z_wrt_sigma) + const = 0; + + // partial (rho,sigma) / partial (x,y,z) + virtual fp partial_rho_wrt_x(fp x, fp y, fp z) const = 0; + virtual fp partial_rho_wrt_y(fp x, fp y, fp z) const = 0; + virtual fp partial_rho_wrt_z(fp x, fp y, fp z) const = 0; + virtual fp partial_sigma_wrt_x(fp x, fp y, fp z) const = 0; + virtual fp partial_sigma_wrt_y(fp x, fp y, fp z) const = 0; + virtual fp partial_sigma_wrt_z(fp x, fp y, fp z) const = 0; + + // partial^2 (rho,sigma) / partial (xx,xy,xz,yy,yz) + virtual fp partial2_rho_wrt_xx(fp x, fp y, fp z) const = 0; + virtual fp partial2_rho_wrt_xy(fp x, fp y, fp z) const = 0; + virtual fp partial2_rho_wrt_xz(fp x, fp y, fp z) const = 0; + virtual fp partial2_rho_wrt_yy(fp x, fp y, fp z) const = 0; + virtual fp partial2_rho_wrt_yz(fp x, fp y, fp z) const = 0; + virtual fp partial2_rho_wrt_zz(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_xx(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_xy(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_xz(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_yy(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_yz(fp x, fp y, fp z) const = 0; + virtual fp partial2_sigma_wrt_zz(fp x, fp y, fp z) const = 0; + + // compute (rho,sigma) 2-D induced metric from 3-D xyz metric + // as per p.33 of my apparent horizon finding notes + // ... returns Jacobian of (rho,sigma) 2-D induced metric + fp rho_sigma_metric(fp r, fp rho, fp sigma, + fp partial_surface_r_wrt_rho, + fp partial_surface_r_wrt_sigma, + fp g_xx, fp g_xy, fp g_xz, + fp g_yy, fp g_yz, + fp g_zz, + fp &g_rho_rho, fp &g_rho_sigma, + fp &g_sigma_sigma) + const; + + // plotting coordinates (dpx,dpy) + // ... character string describing how (dpx,dpy) are + // defined in terms of (mu,nu,phi), eg "90 - drho = 90 - dphi" + // (used for labelling output files) + virtual const char *name_of_dpx() const = 0; + virtual const char *name_of_dpy() const = 0; + // ... (irho,isimga) --> (px,py) + virtual fp dpx_of_rho_sigma(fp rho, fp sigma) const = 0; + virtual fp dpy_of_rho_sigma(fp rho, fp sigma) const = 0; + + // + // ***** line/surface integrals ***** + // + public: + // + // The following enum describes the integration methods supported + // by integrate_gridfn() . + // + // For convenience of exposition we describe the methods as if for + // 1-D integration, but integrate_gridfn() actually does 2-D + // (surface) integration over the patch. + // + // Suppose we're computing $\int_{x_0}^{x^N} f(x) \, dx$, using the + // equally spaced integration points $f_0$, $f_1$, \dots, $f_N$, + // spaced $\Delta x$ apart. Then the integration methods are as + // follows, with the convention that $\langle X \rangle$ denotes + // indefinite repetition of the "X" terms, depending on N: + // + enum integration_method + { + // Trapezoid rule + // ... character-string name "trapezoid" or "trapezoid rule" + // ... 2nd order accurate for smooth functions + // ... requires N >= 1 + // $$ + // \Delta x \left[ + // \half f_0 + // + \langle + // f_k + // \rangle + // + \half f_N + // \right] + // $$ + integration_method__trapezoid, + + // Simpson's rule + // ... character-string name "Simpson" or "Simpson's rule" + // ... 4th order accurate for smooth functions + // ... requires N >= 2 and N even + // $$ + // \Delta x \left[ + // \frac{1}{3} f_0 + // + \frac{4}{3} f_1 + // + \langle + // \frac{2}{3} f_{2k} + \frac{4}{3} f_{2k+1} + // \rangle + // + \frac{1}{3} f_N + // \right] + // $$ + integration_method__Simpson, + + // Simpson's rule, variant form + // ... characgter-string name "Simpson (variant)" + // or "Simpson's rule (variant)" + // ... described in Numerical Recipes 1st edition (4.1.14) + // ... 4th order accurate for smooth functions + // ... requires N >= 7 + // $$ + // \Delta x \left[ + // \frac{17}{48} f_0 + // + \frac{59}{48} f_1 + // + \frac{43}{48} f_2 + // + \frac{49}{48} f_3 + // + \langle + // f_k + // \rangle + // + \frac{49}{48} f_{N-3} + // + \frac{43}{48} f_{N-2} + // + \frac{59}{48} f_{N-1} + // + \frac{17}{48} f_N + // \right] + // $$ + integration_method__Simpson_variant, + + // automatic choice of the "best" one of the above methods: + // ... i.e. choose Simpson's rule or variant if applicable, + // otherwise trapezoid rule + // N == 2 Simpson's rule + // N == 3 trapezoid rule + // N == 4 Simpson's rule + // N == 5 trapezoid rule + // N == 6 Simpson's rule + // N >= 7 Simpson's rule, variant form + integration_method__automatic_choice // no comma here! + }; + + // decode character string name into internal enum + static enum integration_method + decode_integration_method(const char method_string[]); + + // compute the arc length of a surface in the specified plane + // (must be one of "xy", "xz", or "yz") over the patch's nominal bounds + // ... error_exit() if plane is invalid and/or + // the patch doesn't contain that coordinate plane + virtual fp plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const = 0; + + // ... along the rho direction (i.e. in a dsigma=constant plane + // where dsigma is a multiple of 90 degrees) + fp rho_arc_length(int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + // ... along the sigma direction (i.e. in a drho=constant plane + // where drho is a multiple of 90 degrees) + fp sigma_arc_length(int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + + // compute the surface integral of a gridfn over the patch's + // nominal area, + // $\int f(\rho,\sigma) \, dA$ + // = \int f(\rho,\sigma) \sqrt{|J|} \, d\rho \, d\sigma$ + // where $J$ is the Jacobian of $(x,y,z)$ with respect to $(rho,sigma) + // ... integration method selected by method argument + // ... src gridfn may be either nominal-grid or ghosted-grid + // (n.b. in the latter case the integral is still done + // only over the patch's nominal area) + fp integrate_gridfn(int unknown_src_gfn, + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + + // compute integration coefficient $c_i$ where + // $\int_{x_0}^{x_N} f(x) \, dx + // \approx \Delta x \, \sum_{i=0}^N c_i f(x_i)$ + private: + static fp integration_coeff(enum integration_method method, int N, int i); + + // + // ***** patch edges **** + // + public: + const patch_edge &min_rho_patch_edge() const + { + return min_rho_patch_edge_; + } + const patch_edge &max_rho_patch_edge() const + { + return max_rho_patch_edge_; + } + const patch_edge &min_sigma_patch_edge() const + { + return min_sigma_patch_edge_; + } + const patch_edge &max_sigma_patch_edge() const + { + return max_sigma_patch_edge_; + } + const patch_edge &minmax_ang_patch_edge(bool want_min, bool want_rho) + const + { + return want_min ? (want_rho ? min_rho_patch_edge() + : min_sigma_patch_edge()) + : (want_rho ? max_rho_patch_edge() + : max_sigma_patch_edge()); + } + + // find which patch edge is adjacent to neighboring patch q, + // or error_exit() if it's not actually a neighboring patch + // ... computation done using only (rho,sigma) coordinate sets + // and min/max dang bounds ==> ok to use in setting up ghost zones + // ... patch_overlap_width = number of grid points (grid spacings + // in the perpendicular direction) these patches' nominal grids + // overlap, + // ... if this is nonzero, then these patches must have + // the *same* grid spacing in the perpendicular direction + // ... e.g. delta_dang = 5, this patch max_dang = 50, + // other patch min_dang = 40 ==> patch_overlap_width = 3 + // p p p p p + // q q q q q + const patch_edge &edge_adjacent_to_patch(const patch &q, + int patch_overlap_width = 0) + const; + + // + // ***** ghost zones ***** + // + public: + ghost_zone &min_rho_ghost_zone() const + { + assert(min_rho_ghost_zone_ != NULL); + return *min_rho_ghost_zone_; + } + ghost_zone &max_rho_ghost_zone() const + { + assert(max_rho_ghost_zone_ != NULL); + return *max_rho_ghost_zone_; + } + ghost_zone &min_sigma_ghost_zone() const + { + assert(min_sigma_ghost_zone_ != NULL); + return *min_sigma_ghost_zone_; + } + ghost_zone &max_sigma_ghost_zone() const + { + assert(max_sigma_ghost_zone_ != NULL); + return *max_sigma_ghost_zone_; + } + ghost_zone &minmax_rho_ghost_zone(bool want_min) + const + { + return want_min ? min_rho_ghost_zone() + : max_rho_ghost_zone(); + } + ghost_zone &minmax_sigma_ghost_zone(bool want_min) + const + { + return want_min ? min_sigma_ghost_zone() + : max_sigma_ghost_zone(); + } + + ghost_zone &minmax_ang_ghost_zone(bool want_min, bool want_rho) + const + { + return want_rho ? minmax_rho_ghost_zone(want_min) + : minmax_sigma_ghost_zone(want_min); + } + + ghost_zone &ghost_zone_on_edge(const patch_edge &e) const; + + // which of the two ghost zones at a specified corner, + // contains a specified point? + ghost_zone &corner_ghost_zone_containing_point(bool rho_is_min, bool sigma_is_min, // specifies corner + int irho, int isigma) // specifies point + const; + + // which ghost zone contains a specified noncorner point? + ghost_zone &ghost_zone_containing_noncorner_point(int irho, int isigma) + const; + + // + // ***** set up ghost zones + // + public: + // assert() that this ghost zone hasn't been set up yet, + // then set it up as mirror-symmetry + void create_mirror_symmetry_ghost_zone(const patch_edge &edge); + + // assert() that this ghost zone hasn't been set up yet, + // then set it up as periodic-symmetry + void create_periodic_symmetry_ghost_zone(const patch_edge &my_edge, const patch_edge &other_edge, + bool ipar_map_is_plus); + + // assert() that this ghost zone hasn't been set up yet, + // then set it up as interpatch + // ... this only sets up ghost zone in skeletal form; use + // interpatch_ghost_zone::finish_setup() to complete + // the setup process + void create_interpatch_ghost_zone(const patch_edge &my_edge, const patch_edge &other_edge, + int patch_overlap_width); + + // assert() that all ghost zones + // are fully setup + void assert_all_ghost_zones_fully_setup() const; + + private: + // helper function for setup_*_ghost_zone(): + // assert() that ghost zone pointer on specified edge is NULL + // (i.e. that we haven't already setup this ghost zone), + // then assign new value to it + void set_ghost_zone(const patch_edge &edge, ghost_zone *gzp); + + // + // ***** constructor, destructor, et al ***** + // + protected: + // ... used only from derived classes + // ... doesn't set up ghost zone info, since this depends on + // knowing our neighbouring patches, which might not exist yet + // ... saves a pointer to name_in[], so this should have a + // lifetime at least as long as that of this object + patch(patch_system &my_patch_system_in, int patch_number_in, + const char name_in[], bool is_plus_in, char ctype_in, + local_coords::coords_set coords_set_rho_in, + local_coords::coords_set coords_set_sigma_in, + local_coords::coords_set coords_set_tau_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in); + + public: + // destructor must be virtual to allow destruction + // of derived classes via ptr/ref to this class + virtual ~patch(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + patch(const patch &rhs); + patch &operator=(const patch &rhs); + + // + // ***** data members ***** + // + private: + // type/coordinate metadata + patch_system &my_patch_system_; + const int patch_number_; + const char *name_; + const bool is_plus_; + const char ctype_; + const local_coords::coords_set coords_set_rho_, + coords_set_sigma_, + coords_set_tau_; + + // edges + const patch_edge &min_rho_patch_edge_; + const patch_edge &max_rho_patch_edge_; + const patch_edge &min_sigma_patch_edge_; + const patch_edge &max_sigma_patch_edge_; + + // ghost zones + // ... pointers are set to NULL by ctor, + // reset to non-NULL by set_ghost_zone(), which is called by + // create_mirror_symmetry_ghost_zone() + // create_periodic_symmetry_ghost_zone() + // create_interpatch_ghost_zone() + ghost_zone *min_rho_ghost_zone_; + ghost_zone *max_rho_ghost_zone_; + ghost_zone *min_sigma_ghost_zone_; + ghost_zone *max_sigma_ghost_zone_; + }; + + //***************************************************************************** + //***************************************************************************** + //***************************************************************************** + + // + // This class describes a +/- z patch. It doesn't define any new + // functions not already present in class patch ; it "just" defines + // non-virtual versions of all the pure virtual functions defined there. + // + // z patch ==> (rho,sigma) = (mu,nu) tau = phi + // + class z_patch + : public patch + { + public: + // human-readable names of (rho,sigma) + const char *name_of_rho() const { return "mu"; } + const char *name_of_sigma() const { return "nu"; } + + // convert (rho,sigma) --> tau + fp tau_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::phi_of_mu_nu(rho, sigma); + } + + // convert (rho,sigma) --> (mu,nu,phi) + fp mu_of_rho_sigma(fp rho, fp sigma) const { return rho; } + fp nu_of_rho_sigma(fp rho, fp sigma) const { return sigma; } + fp phi_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::phi_of_mu_nu(rho, sigma); + } + + // convert (rho,sigma) <--> usual polar spherical (theta,phi) + void theta_phi_of_rho_sigma(fp rho, fp sigma, fp &ps_theta, fp &ps_phi) + const + { + local_coords::theta_phi_of_mu_nu(rho, sigma, ps_theta, ps_phi); + } + void rho_sigma_of_theta_phi(fp ps_theta, fp ps_phi, fp &rho, fp &sigma) + const + { + local_coords::mu_nu_of_theta_phi(ps_theta, ps_phi, rho, sigma); + } + + // convert (r,rho,sigma) <--> (x,y,z) + void xyz_of_r_rho_sigma(fp r, fp rho, fp sigma, fp &x, fp &y, fp &z) + const + { + local_coords::xyz_of_r_mu_nu(r, rho, sigma, x, y, z); + } + fp rho_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_rho(local_coords::mu_of_yz(y, z)); + } + fp sigma_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_sigma(local_coords::nu_of_xz(x, z)); + } + + // convert (rho,sigma) --> direction cosines (xcos,ycos,zcos) + // with respect to the local coordinate system + void xyzcos_of_rho_sigma(fp rho, fp sigma, + fp &xcos, fp &ycos, fp &zcos) + const + { + local_coords::xyzcos_of_mu_nu(rho, sigma, xcos, ycos, zcos); + } + + // partial (x,y,z) / partial (rho,sigma) + void partial_xyz_wrt_r_rho_sigma(fp r, fp rho, fp sigma, + fp &partial_x_wrt_r, fp &partial_x_wrt_rho, fp &partial_x_wrt_sigma, + fp &partial_y_wrt_r, fp &partial_y_wrt_rho, fp &partial_y_wrt_sigma, + fp &partial_z_wrt_r, fp &partial_z_wrt_rho, fp &partial_z_wrt_sigma) + const + { + local_coords::partial_xyz_wrt_r_mu_nu(r, rho, sigma, + partial_x_wrt_r, partial_x_wrt_rho, partial_x_wrt_sigma, + partial_y_wrt_r, partial_y_wrt_rho, partial_y_wrt_sigma, + partial_z_wrt_r, partial_z_wrt_rho, partial_z_wrt_sigma); + } + + // partial (rho,sigma) / partial (x,y,z) + fp partial_rho_wrt_x(fp x, fp y, fp z) const { return 0.0; } + fp partial_rho_wrt_y(fp x, fp y, fp z) const + { + return local_coords::partial_mu_wrt_y(y, z); + } + fp partial_rho_wrt_z(fp x, fp y, fp z) const + { + return local_coords::partial_mu_wrt_z(y, z); + } + fp partial_sigma_wrt_x(fp x, fp y, fp z) const + { + return local_coords::partial_nu_wrt_x(x, z); + } + fp partial_sigma_wrt_y(fp x, fp y, fp z) const { return 0.0; } + fp partial_sigma_wrt_z(fp x, fp y, fp z) const + { + return local_coords::partial_nu_wrt_z(x, z); + } + + // partial^2 (rho,sigma) / partial (xx,xy,xz,yy,yz) + fp partial2_rho_wrt_xx(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_xy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_xz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_yy(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_yy(y, z); + } + fp partial2_rho_wrt_yz(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_yz(y, z); + } + fp partial2_rho_wrt_zz(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_zz(y, z); + } + fp partial2_sigma_wrt_xx(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_xx(x, z); + } + fp partial2_sigma_wrt_xy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_xz(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_xz(x, z); + } + fp partial2_sigma_wrt_yy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_yz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_zz(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_zz(x, z); + } + + // plotting coordinates (px,py) + // ... character string describing how (dpx,dpy) are + // defined in terms of (mu,nu,phi), eg "90 - drho = 90 - dphi" + // (used for labelling output files) + const char *name_of_dpx() const + { + return "dsigma = dnu"; + } + const char *name_of_dpy() const + { + return is_plus() ? "drho = dmu" : "180 - drho = 180 - dmu"; + } + // ... (irho,isimga) --> (px,py) + fp dpx_of_rho_sigma(fp rho, fp sigma) const + { + return jtutil::degrees_of_radians(sigma); + } + fp dpy_of_rho_sigma(fp rho, fp sigma) const + { + const fp drho = jtutil::degrees_of_radians(rho); + return is_plus() ? drho : 180.0 - drho; + } + + // compute the arc length of a surface in the specified plane + // (must be one of "xz" or "yz") over the patch's nominal bounds + // ... error_exit() if plane is invalid + fp plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + + // constructor, destructor + z_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in); + ~z_patch() {} + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + z_patch(const z_patch &rhs); + z_patch &operator=(const z_patch &rhs); + }; + + //***************************************************************************** + + // + // This class describes a +/- x patch. It doesn't define any new + // functions not already present in class patch ; it "just" defines + // non-virtual versions of all the pure virtual functions defined there. + // + // x patch ==> (rho,sigma) = (nu,phi) tau = mu + // + class x_patch + : public patch + { + public: + // human-readable names of (rho,sigma) + const char *name_of_rho() const { return "nu"; } + const char *name_of_sigma() const { return "phi"; } + + // convert (rho,sigma) --> tau + fp tau_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::mu_of_nu_phi(rho, sigma); + } + + // convert (rho,sigma) --> (mu,nu,phi) + fp nu_of_rho_sigma(fp rho, fp sigma) const { return rho; } + fp phi_of_rho_sigma(fp rho, fp sigma) const { return sigma; } + fp mu_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::mu_of_nu_phi(rho, sigma); + } + + // convert (rho,sigma) <--> usual polar spherical (theta,phi) + void theta_phi_of_rho_sigma(fp rho, fp sigma, fp &ps_theta, fp &ps_phi) + const + { + local_coords::theta_phi_of_nu_phi(rho, sigma, ps_theta, ps_phi); + } + void rho_sigma_of_theta_phi(fp ps_theta, fp ps_phi, fp &rho, fp &sigma) + const + { + local_coords::nu_phi_of_theta_phi(ps_theta, ps_phi, rho, sigma); + } + + // convert (r,rho,sigma) <--> (x,y,z) + void xyz_of_r_rho_sigma(fp r, fp rho, fp sigma, fp &x, fp &y, fp &z) + const + { + local_coords::xyz_of_r_nu_phi(r, rho, sigma, x, y, z); + } + fp rho_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_rho(local_coords::nu_of_xz(x, z)); + } + fp sigma_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_sigma(local_coords::phi_of_xy(x, y)); + } + + // convert (rho,sigma) --> direction cosines (xcos,ycos,zcos) + // with respect to the local coordinate system + void xyzcos_of_rho_sigma(fp rho, fp sigma, + fp &xcos, fp &ycos, fp &zcos) + const + { + local_coords::xyzcos_of_nu_phi(rho, sigma, xcos, ycos, zcos); + } + + // partial (x,y,z) / partial (rho,sigma) + void partial_xyz_wrt_r_rho_sigma(fp r, fp rho, fp sigma, + fp &partial_x_wrt_r, fp &partial_x_wrt_rho, fp &partial_x_wrt_sigma, + fp &partial_y_wrt_r, fp &partial_y_wrt_rho, fp &partial_y_wrt_sigma, + fp &partial_z_wrt_r, fp &partial_z_wrt_rho, fp &partial_z_wrt_sigma) + const + { + local_coords::partial_xyz_wrt_r_nu_phi(r, rho, sigma, + partial_x_wrt_r, partial_x_wrt_rho, partial_x_wrt_sigma, + partial_y_wrt_r, partial_y_wrt_rho, partial_y_wrt_sigma, + partial_z_wrt_r, partial_z_wrt_rho, partial_z_wrt_sigma); + } + + // partial (rho,sigma) / partial (x,y,z) + fp partial_rho_wrt_x(fp x, fp y, fp z) const + { + return local_coords::partial_nu_wrt_x(x, z); + } + fp partial_rho_wrt_y(fp x, fp y, fp z) const { return 0.0; } + fp partial_rho_wrt_z(fp x, fp y, fp z) const + { + return local_coords::partial_nu_wrt_z(x, z); + } + fp partial_sigma_wrt_x(fp x, fp y, fp z) const + { + return local_coords::partial_phi_wrt_x(x, y); + } + fp partial_sigma_wrt_y(fp x, fp y, fp z) const + { + return local_coords::partial_phi_wrt_y(x, y); + } + fp partial_sigma_wrt_z(fp x, fp y, fp z) const { return 0.0; } + + // partial^2 (rho,sigma) / partial (xx,xy,xz,yy,yz) + fp partial2_rho_wrt_xx(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_xx(x, z); + } + fp partial2_rho_wrt_xy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_xz(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_xz(x, z); + } + fp partial2_rho_wrt_yy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_yz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_zz(fp x, fp y, fp z) const + { + return local_coords::partial2_nu_wrt_zz(x, z); + } + fp partial2_sigma_wrt_xx(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_xx(x, y); + } + fp partial2_sigma_wrt_xy(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_xy(x, y); + } + fp partial2_sigma_wrt_xz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_yy(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_yy(x, y); + } + fp partial2_sigma_wrt_yz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_zz(fp x, fp y, fp z) const { return 0.0; } + + // plotting coordinates (px,py) + // ... character string describing how (dpx,dpy) are + // defined in terms of (mu,nu,phi), eg "90 - drho = 90 - dphi" + // (used for labelling output files) + const char *name_of_dpx() const { return "drho = dnu"; } + const char *name_of_dpy() const + { + return is_plus() ? "dsigma = dphi" + : "180 - dsigma = 180 - dphi"; + } + // ... (irho,isimga) --> (px,py) + fp dpx_of_rho_sigma(fp rho, fp sigma) const + { + return jtutil::degrees_of_radians(rho); + } + fp dpy_of_rho_sigma(fp rho, fp sigma) const + { + const fp dsigma = jtutil::degrees_of_radians(sigma); + return is_plus() ? dsigma : 180.0 - dsigma; + } + + // compute the arc length of a surface in the specified plane + // (must be one of "xy" or "xz") over the patch's nominal bounds + // ... error_exit() if plane is invalid + fp plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + + // constructor, destructor + x_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in); + ~x_patch() {} + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + x_patch(const x_patch &rhs); + x_patch &operator=(const x_patch &rhs); + }; + + //***************************************************************************** + + // + // This class describes a +/- y patch. It doesn't define any new + // functions not already present in class patch ; it "just" defines + // non-virtual versions of all the pure virtual functions defined there. + // + // y patch ==> (rho,sigma) = (mu,phi) tau = nu + // + class y_patch + : public patch + { + public: + // human-readable names of (rho,sigma) + const char *name_of_rho() const { return "mu"; } + const char *name_of_sigma() const { return "phi"; } + + // convert (rho,sigma) --> tau + fp tau_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::nu_of_mu_phi(rho, sigma); + } + + // convert (rho,sigma) --> (mu,nu,phi) + fp mu_of_rho_sigma(fp rho, fp sigma) const { return rho; } + fp phi_of_rho_sigma(fp rho, fp sigma) const { return sigma; } + fp nu_of_rho_sigma(fp rho, fp sigma) const + { + return local_coords::nu_of_mu_phi(rho, sigma); + } + + // convert (rho,sigma) <--> usual polar spherical (theta,phi) + void theta_phi_of_rho_sigma(fp rho, fp sigma, fp &ps_theta, fp &ps_phi) + const + { + local_coords::theta_phi_of_mu_phi(rho, sigma, ps_theta, ps_phi); + } + void rho_sigma_of_theta_phi(fp ps_theta, fp ps_phi, fp &rho, fp &sigma) + const + { + local_coords::mu_phi_of_theta_phi(ps_theta, ps_phi, rho, sigma); + } + + // convert (r,rho,sigma) <--> (x,y,z) + void xyz_of_r_rho_sigma(fp r, fp rho, fp sigma, fp &x, fp &y, fp &z) + const + { + local_coords::xyz_of_r_mu_phi(r, rho, sigma, x, y, z); + } + fp rho_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_rho(local_coords::mu_of_yz(y, z)); + } + fp sigma_of_xyz(fp x, fp y, fp z) const + { + return modulo_reduce_sigma(local_coords::phi_of_xy(x, y)); + } + + // convert (rho,sigma) --> direction cosines (xcos,ycos,zcos) + // with respect to the local coordinate system + void xyzcos_of_rho_sigma(fp rho, fp sigma, + fp &xcos, fp &ycos, fp &zcos) + const + { + local_coords::xyzcos_of_mu_phi(rho, sigma, xcos, ycos, zcos); + } + + // partial (x,y,z) / partial (rho,sigma) + void partial_xyz_wrt_r_rho_sigma(fp r, fp rho, fp sigma, + fp &partial_x_wrt_r, fp &partial_x_wrt_rho, fp &partial_x_wrt_sigma, + fp &partial_y_wrt_r, fp &partial_y_wrt_rho, fp &partial_y_wrt_sigma, + fp &partial_z_wrt_r, fp &partial_z_wrt_rho, fp &partial_z_wrt_sigma) + const + { + local_coords::partial_xyz_wrt_r_mu_phi(r, rho, sigma, + partial_x_wrt_r, partial_x_wrt_rho, partial_x_wrt_sigma, + partial_y_wrt_r, partial_y_wrt_rho, partial_y_wrt_sigma, + partial_z_wrt_r, partial_z_wrt_rho, partial_z_wrt_sigma); + } + + // partial (rho,sigma) / partial (x,y,z) + fp partial_rho_wrt_x(fp x, fp y, fp z) const { return 0.0; } + fp partial_rho_wrt_y(fp x, fp y, fp z) const + { + return local_coords::partial_mu_wrt_y(y, z); + } + fp partial_rho_wrt_z(fp x, fp y, fp z) const + { + return local_coords::partial_mu_wrt_z(y, z); + } + fp partial_sigma_wrt_x(fp x, fp y, fp z) const + { + return local_coords::partial_phi_wrt_x(x, y); + } + fp partial_sigma_wrt_y(fp x, fp y, fp z) const + { + return local_coords::partial_phi_wrt_y(x, y); + } + fp partial_sigma_wrt_z(fp x, fp y, fp z) const { return 0.0; } + + // partial^2 (rho,sigma) / partial (xx,xy,xz,yy,yz) + fp partial2_rho_wrt_xx(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_xy(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_xz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_rho_wrt_yy(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_yy(y, z); + } + fp partial2_rho_wrt_yz(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_yz(y, z); + } + fp partial2_rho_wrt_zz(fp x, fp y, fp z) const + { + return local_coords::partial2_mu_wrt_zz(y, z); + } + fp partial2_sigma_wrt_xx(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_xx(x, y); + } + fp partial2_sigma_wrt_xy(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_xy(x, y); + } + fp partial2_sigma_wrt_xz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_yy(fp x, fp y, fp z) const + { + return local_coords::partial2_phi_wrt_yy(x, y); + } + fp partial2_sigma_wrt_yz(fp x, fp y, fp z) const { return 0.0; } + fp partial2_sigma_wrt_zz(fp x, fp y, fp z) const { return 0.0; } + + // plotting coordinates (px,py) + // ... character string describing how (dpx,dpy) are + // defined in terms of (mu,nu,phi), eg "90 - drho = 90 - dphi" + // (used for labelling output files) + const char *name_of_dpx() const + { + return is_plus() ? "90 - dsigma = 90 - dphi" + : "90 + dsigma = 90 + dphi"; + } + const char *name_of_dpy() const { return "drho = dmu"; } + // ... (rho,simga) --> (px,py) + fp dpx_of_rho_sigma(fp rho, fp sigma) const + { + const fp dsigma = jtutil::degrees_of_radians(sigma); + return is_plus() ? 90.0 - dsigma : 90.0 + dsigma; + } + fp dpy_of_rho_sigma(fp rho, fp sigma) const + { + return jtutil::degrees_of_radians(rho); + } + + // compute the arc length of a surface in the specified plane + // (must be one of "xy" or "yz") over the patch's nominal bounds + // ... error_exit() if plane is invalid + fp plane_arc_length(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum integration_method method) + const; + + // constructor, destructor + y_patch(patch_system &my_patch_system_in, int patch_number_in, + const char *name_in, bool is_plus_in, + const grid_arrays::grid_array_pars &grid_array_pars_in, + const grid::grid_pars &grid_pars_in); + ~y_patch() {} + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + y_patch(const y_patch &rhs); + y_patch &operator=(const y_patch &rhs); + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* TPATCH_H */ diff --git a/AMSS_NCKU_source/patch_edge.h b/AMSS_NCKU_source/patch_edge.h new file mode 100644 index 0000000..2ec7d04 --- /dev/null +++ b/AMSS_NCKU_source/patch_edge.h @@ -0,0 +1,320 @@ +#ifndef TPATCH_EDGE_H +#define TPATCH_EDGE_H +namespace AHFinderDirect +{ + + //***************************************************************************** + + // + // patch_edge -- perpendicular/parallel geometry of one side of a patch + // + // A patch_edge object is a very light-weight object which represents + // the basic geometry of a min/max rho/sigma side of a patch, i.e. it + // provides which-side-am-I predicates, coordinate conversions between + // (perp,par) and (rho,sigma), etc. Every patch has (points to) 4 patch_edge + // objects, one for each of the patch's sides. See the comments in + // "patch.hh" for a "big picture" discussion of patches, patch edges, + // ghost zones, and patch interpolation regions. + // + // Note that since patch_edge has only const member functions + // (and members!), a patch_edge object is effectively always const . + // This means there's no harm in always declaring patch_edge objects + // to be const . + // + + class patch_edge + { + public: + // + // ***** meta-info ***** + // + + // meta-info about patch + patch &my_patch() const { return my_patch_; } + + // meta-info about edge + bool is_rho() const { return is_rho_; } + bool is_min() const { return is_min_; } + bool perp_is_rho() const { return is_rho(); } + bool par_is_rho() const { return !is_rho(); } + + // human-readable {min,max}_{rho,sigma} name (for debugging etc) + const char *name() const + { + return is_min() + ? (is_rho() ? "min_rho" : "min_sigma") + : (is_rho() ? "max_rho" : "max_sigma"); + } + + // are two edges really the same edge? + bool operator==(const patch_edge &other_edge) const + { + return (my_patch() == other_edge.my_patch()) && (is_rho() == other_edge.is_rho()) && (is_min() == other_edge.is_min()); + } + bool operator!=(const patch_edge &other_edge) const + { + return !operator==(other_edge); + } + + // + // ***** adjacent edges ***** + // + + // get adjacent edges to our min/max par corners + const patch_edge &min_par_adjacent_edge() const + { + return my_patch() + .minmax_ang_patch_edge(grid::side_is_min, par_is_rho()); + } + const patch_edge &max_par_adjacent_edge() const + { + return my_patch() + .minmax_ang_patch_edge(grid::side_is_max, par_is_rho()); + } + const patch_edge &minmax_par_adjacent_edge(bool want_min) const + { + return want_min ? min_par_adjacent_edge() + : max_par_adjacent_edge(); + } + + // + // ***** gridfn subscripting and coordinate maps ***** + // + + // gridfn strides perpendicular/parallel to the edge + int perp_stride() const + { + return my_patch().iang_stride(perp_is_rho()); + } + int par_stride() const + { + return my_patch().iang_stride(par_is_rho()); + } + int ghosted_perp_stride() const + { + return my_patch().ghosted_iang_stride(perp_is_rho()); + } + int ghosted_par_stride() const + { + return my_patch().ghosted_iang_stride(par_is_rho()); + } + + // coordinate maps perpendicular/parallel to the edge + // ... range is that of the grid *including* ghost zones + const jtutil::linear_map &perp_map() const + { + return my_patch().ang_map(perp_is_rho()); + } + const jtutil::linear_map &par_map() const + { + return my_patch().ang_map(par_is_rho()); + } + + // meta-info about perp/par coordinates + // ... as (mu,nu,phi) tensor indices + local_coords::coords_set coords_set_perp() const + { + return perp_is_rho() ? my_patch().coords_set_rho() + : my_patch().coords_set_sigma(); + } + local_coords::coords_set coords_set_par() const + { + return par_is_rho() ? my_patch().coords_set_rho() + : my_patch().coords_set_sigma(); + } + + // + // ***** coordinate conversions ***** + // + + // coordinate conversions based on ghost zone direction + // ... (iperp,ipar) <--> (perp,par) + fp perp_of_iperp(int iperp) const + { + return my_patch().ang_of_iang(perp_is_rho(), iperp); + } + fp par_of_ipar(int ipar) const + { + return my_patch().ang_of_iang(par_is_rho(), ipar); + } + fp fp_iperp_of_perp(fp perp) const + { + return my_patch().fp_iang_of_ang(perp_is_rho(), perp); + } + fp fp_ipar_of_par(fp par) const + { + return my_patch().fp_iang_of_ang(par_is_rho(), par); + } + int iperp_of_perp(fp perp, jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + { + return my_patch().iang_of_ang(perp_is_rho(), perp, nia); + } + int ipar_of_par(fp par, jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + { + return my_patch().iang_of_ang(par_is_rho(), par, nia); + } + + // ... (perp,par) --> (rho,sigma) + int irho_of_iperp_ipar(int iperp, int ipar) const + { + return perp_is_rho() ? iperp : ipar; + } + int isigma_of_iperp_ipar(int iperp, int ipar) const + { + return perp_is_rho() ? ipar : iperp; + } + fp rho_of_perp_par(fp perp, fp par) const + { + return perp_is_rho() ? perp : par; + } + fp sigma_of_perp_par(fp perp, fp par) const + { + return perp_is_rho() ? par : perp; + } + // ... (rho,sigma) --> (perp,par) + int iperp_of_irho_isigma(int irho, int isigma) const + { + return perp_is_rho() ? irho : isigma; + } + int ipar_of_irho_isigma(int irho, int isigma) const + { + return par_is_rho() ? irho : isigma; + } + fp perp_of_rho_sigma(fp rho, fp sigma) const + { + return perp_is_rho() ? rho : sigma; + } + fp par_of_rho_sigma(fp rho, fp sigma) const + { + return par_is_rho() ? rho : sigma; + } + + // outer perp of nominal grid on this edge + // ... this is outermost *grid point* + fp grid_outer_iperp() const + { + return my_patch().minmax_iang(is_min(), is_rho()); + } + // ... this is actual outer edge of grid + // (might be halfway between two grid points) + fp grid_outer_perp() const + { + return my_patch().minmax_ang(is_min(), is_rho()); + } + // ... this is grid_outer_perp() converted back to the iperp + // coordinate, but still returned as floating-point; + // it will be either integer or half-integer + fp fp_grid_outer_iperp() const + { + return fp_iperp_of_perp(grid_outer_perp()); + } + + // + // ***** min/max/outer coordinates of edge ***** + // + + // min/max/size ipar of the edge + // (these are exteme limits for any iperp, a given ghost zone + // or interpolation region may have tighter and/or iperp-dependent + // limits) + // ... not including corners + int min_ipar_without_corners() const + { + return my_patch().min_iang(par_is_rho()); + } + int max_ipar_without_corners() const + { + return my_patch().max_iang(par_is_rho()); + } + // ... including corners + int min_ipar_with_corners() const + { + return my_patch().ghosted_min_iang(par_is_rho()); + } + int max_ipar_with_corners() const + { + return my_patch().ghosted_max_iang(par_is_rho()); + } + // ... of the corners themselves + int min_ipar_corner__min_ipar() const + { + return min_ipar_with_corners(); + } + int min_ipar_corner__max_ipar() const + { + return min_ipar_without_corners() - 1; + } + int max_ipar_corner__min_ipar() const + { + return max_ipar_without_corners() + 1; + } + int max_ipar_corner__max_ipar() const + { + return max_ipar_with_corners(); + } + + // membership predicates for ipar corners, non-corners + bool ipar_is_in_min_ipar_corner(int ipar) const + { + return (ipar >= min_ipar_corner__min_ipar()) && (ipar <= min_ipar_corner__max_ipar()); + } + bool ipar_is_in_max_ipar_corner(int ipar) const + { + return (ipar >= max_ipar_corner__min_ipar()) && (ipar <= max_ipar_corner__max_ipar()); + } + bool ipar_is_in_corner(int ipar) const + { + return ipar_is_in_min_ipar_corner(ipar) || ipar_is_in_max_ipar_corner(ipar); + } + bool ipar_is_in_noncorner(int ipar) const + { + return (ipar >= min_ipar_without_corners()) && (ipar <= max_ipar_without_corners()); + } + + // convenience function selecting amongst the above + // membership predicates + bool ipar_is_in_selected_part(bool want_corners, + bool want_noncorner, + int ipar) + const + { + return (want_corners && ipar_is_in_corner(ipar)) || (want_noncorner && ipar_is_in_noncorner(ipar)); + } + + // outer (farthest from patch center) iperp of nominal grid + int nominal_grid_outer_iperp() const + { + return my_patch() + .minmax_iang(is_min(), is_rho()); + } + + // + // ***** constructor, destructor ***** + // + + patch_edge(patch &my_patch_in, + bool is_min_in, bool is_rho_in) + : my_patch_(my_patch_in), + is_min_(is_min_in), is_rho_(is_rho_in) + { + } + // compiler-synthesized (no-op) destructor is fine + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + patch_edge(const patch_edge &rhs); + patch_edge &operator=(const patch_edge &rhs); + + private: + patch &my_patch_; + const bool is_min_, is_rho_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* TPATCH_EDGE_H */ diff --git a/AMSS_NCKU_source/patch_info.C b/AMSS_NCKU_source/patch_info.C new file mode 100644 index 0000000..3503f47 --- /dev/null +++ b/AMSS_NCKU_source/patch_info.C @@ -0,0 +1,187 @@ +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "patch_info.h" + +namespace AHFinderDirect + { +using jtutil::error_exit; + +//****************************************************************************** +//****************************************************************************** +//****************************************************************************** + +// +// This function computes, and returns a reference to, a +// struct grid_arrays::grid_array_pars from the info in a +// struct patch_info and the additional information in the arguments. +// +// The result refers to an internal static buffer in this function; the +// usual caveats about lifetimes/overwriting apply. +// +// Arguments: +// ghost_zone_width = Width in grid points of all ghost zones. +// patch_extend_width = Number of grid points to extend each patch past +// "just touching" so as to overlap neighboring patches. +// Thus patches overlap by +// patch_overlap_width = 2*patch_extend_width + 1 +// grid points. For example, with patch_extend_width == 2, +// here are the grid points of two neighboring patches: +// x x x x x X X +// | +// O O o o o o o +// Here | marks the "just touching" boundary, +// x and o the grid points before this extension, +// and X and O the extra grid points added by this +// extension. +// N_zones_per_right_angle = This sets the grid spacing (same in both +// directions) to 90.0 / N_zones_per_right_angle. +// It's a fatal error (error_exit()) if this +// doesn't evenly divide the grid sizes in both +// directions. +// +const grid_arrays::grid_array_pars& + patch_info::grid_array_pars(int ghost_zone_width, int patch_extend_width, + int N_zones_per_right_angle) + const +{ +static + struct grid_arrays::grid_array_pars grid_array_pars_buffer; + +// +// the values of min_(irho,isigma) are actually arbitrary, but for +// debugging convenience it's handy to have (irho,isigma) ranges map +// one-to-one with (rho,sigma) ranges across all patches; the assignments +// here have this property +// +const fp delta_drho_dsigma = 90.0 / fp(N_zones_per_right_angle); +grid_array_pars_buffer.min_irho + = jtutil::round::to_integer(min_drho /delta_drho_dsigma); +grid_array_pars_buffer.min_isigma + = jtutil::round::to_integer(min_dsigma/delta_drho_dsigma); + +verify_grid_spacing_ok(N_zones_per_right_angle); +const int N_irho_zones + = jtutil::round::to_integer( + fp(N_zones_per_right_angle) * (max_drho -min_drho ) / 90.0 + ); +const int N_isigma_zones + = jtutil::round::to_integer( + fp(N_zones_per_right_angle) * (max_dsigma-min_dsigma) / 90.0 + ); + +grid_array_pars_buffer.max_irho + = grid_array_pars_buffer.min_irho + N_irho_zones; +grid_array_pars_buffer.max_isigma + = grid_array_pars_buffer.min_isigma + N_isigma_zones; + +grid_array_pars_buffer.min_irho -= patch_extend_width; +grid_array_pars_buffer.min_isigma -= patch_extend_width; +grid_array_pars_buffer.max_irho += patch_extend_width; +grid_array_pars_buffer.max_isigma += patch_extend_width; + +grid_array_pars_buffer.min_rho_ghost_zone_width = ghost_zone_width; +grid_array_pars_buffer.max_rho_ghost_zone_width = ghost_zone_width; +grid_array_pars_buffer.min_sigma_ghost_zone_width = ghost_zone_width; +grid_array_pars_buffer.max_sigma_ghost_zone_width = ghost_zone_width; + +return grid_array_pars_buffer; +} + +//****************************************************************************** +// +// +// This function computes, and returns a reference to, a +// struct grid_arrays::grid_pars from the info in a struct patch_info +// and the additional information in the arguments. +// +// The result refers to an internal static buffer in this function; the +// usual caveats about lifetimes/overwriting apply. +// +// Arguments: +// patch_extend_width = Number of grid points to extend each patch past +// "just touching" so as to overlap neighboring patches. +// Thus patches overlap by 2*patch_extend_width + 1 grid +// points. For example, with patch_extend_width == 2, here +// are the grid points of two neighboring patches: +// x x x x x X X +// | +// O O o o o o o +// Here | marks the "just touching" boundary, +// x and o the grid points before this extension, +// and X and O the extra grid points added by this +// extension. +// N_zones_per_right_angle = This sets the grid spacing (same in both +// directions) to 90.0 / N_zones_per_right_angle. +// It's a fatal error (error_exit()) if this +// doesn't evenly divide the grid sizes in both +// directions. +// +const grid::grid_pars& patch_info::grid_pars(int patch_extend_width, + int N_zones_per_right_angle) + const +{ +static + struct grid::grid_pars grid_pars_buffer; + +verify_grid_spacing_ok(N_zones_per_right_angle); +const fp delta_drho_dsigma = 90.0 / fp(N_zones_per_right_angle); +const fp extend_drho_dsigma = fp(patch_extend_width) * delta_drho_dsigma; + +grid_pars_buffer. min_drho = min_drho - extend_drho_dsigma; +grid_pars_buffer.delta_drho = delta_drho_dsigma; +grid_pars_buffer. max_drho = max_drho + extend_drho_dsigma; +grid_pars_buffer. min_dsigma = min_dsigma - extend_drho_dsigma; +grid_pars_buffer.delta_dsigma = delta_drho_dsigma; +grid_pars_buffer. max_dsigma = max_dsigma + extend_drho_dsigma; + +return grid_pars_buffer; +} + +//****************************************************************************** + +// +// This function verifies that the grid spacing evenly divides the +// grid sizes in both directions, and does an error_exit() if not. +// +// Arguments: +// N_zones_per_right_angle = This sets the grid spacing (same in both +// directions) to 90.0 / N_zones_per_right_angle. +// +void patch_info::verify_grid_spacing_ok(int N_zones_per_right_angle) + const +{ +const fp N_irho_zones_fp + = fp(N_zones_per_right_angle) * (max_drho -min_drho ) / 90.0; +const fp N_isigma_zones_fp + = fp(N_zones_per_right_angle) * (max_dsigma-min_dsigma) / 90.0; + +if (! ( jtutil::fuzzy::is_integer(N_irho_zones_fp) + && jtutil::fuzzy::is_integer(N_isigma_zones_fp) ) ) + then error_exit(ERROR_EXIT, +"***** patch_info::verify_grid_spacing_ok():\n" +" N_zones_per_right_angle=%d gives grid spacing which\n" +" doesn't evenly divide grid sizes!\n" +" [min,max]_drho=[%g,%g] [min,max]_dsigma=[%g,%g]\n" +" ==> N_irho_zones_fp=%g N_isigma_zones_fp=%g\n" + , + N_zones_per_right_angle, + double(min_drho), double(max_drho), + double(min_dsigma), double(max_dsigma), + double(N_irho_zones_fp), double(N_isigma_zones_fp)); + /*NOTREACHED*/ +} + + } // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/patch_info.h b/AMSS_NCKU_source/patch_info.h new file mode 100644 index 0000000..9af436f --- /dev/null +++ b/AMSS_NCKU_source/patch_info.h @@ -0,0 +1,70 @@ +namespace AHFinderDirect +{ + + //***************************************************************************** + + // + // This (POD, and hence static-initializable) struct gives a minimal + // set of information which varies from one patch to another. + // + // The member functions allow computing all the grid:: constructor + // arguments; with these in hand it's fairly easy to construct the + // patch itself. This scheme doesn't allow the most general possible + // type of patch (eg it constrains all ghost zones to have the same width, + // and it requires the grid spacing to evenly divide 90 degrees), but + // it does cover all the cases that seem to come up in practice. + // + // Arguments for member functions: + // ghost_zone_width = Width in grid points of all ghost zones. + // patch_extend_width = Number of grid points to extend each patch past + // "just touching" so as to overlap neighboring patches. + // Thus patches overlap by + // patch_overlap_width = 2*patch_extend_width + 1 + // grid points. For example, with patch_extend_width == 2, + // here are the grid points of two neighboring patches: + // x x x x x X X + // | + // O O o o o o o + // Here | marks the "just touching" boundary, + // x and o the grid points before this extension, + // and X and O the extra grid points added by this + // extension. + // N_zones_per_right_angle = This sets the grid spacing (same in both + // directions) to 90.0 / N_zones_per_right_angle. + // It's a fatal error (error_exit()) if this + // doesn't evenly divide the grid sizes in both + // directions. + // + struct patch_info + { + const char *name; + bool is_plus; + char ctype; + fp min_drho, max_drho; + fp min_dsigma, max_dsigma; + + // compute and return reference to struct grid_arrays::grid_array_pars + // ... result refers to internal static buffer; + // the usual caveats about lifetimes/overwriting apply + const grid_arrays::grid_array_pars & + grid_array_pars(int ghost_zone_width, int patch_extend_width, + int N_zones_per_right_angle) + const; + + // compute and return reference to struct grid::grid_pars + // ... result refers to internal static buffer; + // the usual caveats about lifetimes/overwriting apply + const grid::grid_pars &grid_pars(int patch_extend_width, + int N_zones_per_right_angle) + const; + + private: + // verify that grid spacing evenly divides grid sizes + // in both directions; no-op if ok, error_exit() if not ok + void verify_grid_spacing_ok(int N_zones_per_right_angle) + const; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/patch_interp.C b/AMSS_NCKU_source/patch_interp.C new file mode 100644 index 0000000..b2a5624 --- /dev/null +++ b/AMSS_NCKU_source/patch_interp.C @@ -0,0 +1,360 @@ +#include +#include +#include + +#include "util_Table.h" +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" + +namespace AHFinderDirect +{ + int lagrange_interp(double coor_orin, double dx, double *gf, + int PTS, double ipx, double *out, int *mposn, double *Jac, + int ORD) // ORD-1 order lagrange interpolation + { + assert(PTS >= ORD); + int mi, mf; + + double *L, *x; + L = new double[PTS]; + x = new double[PTS]; + int i, j, k; + + //-- Determine molecular range + // for odd points, say 5, the molecular is + // | + // +-----+---x-+-----+-----+ + // + mi = jtutil::round::ceiling((ipx - coor_orin) / dx) - ORD / 2; + mf = mi + ORD; + if (mi < 0) + { + mi = 0; + mf = ORD; + } + else if (mf > PTS) + { + mf = PTS; + mi = PTS - ORD; + } + + //-- Setup coordinate by input origin, dx + for (j = mi; j < mf; j++) + x[j] = coor_orin + j * dx; + + //-- Lagrange basis function + *out = 0; + for (i = mi; i < mf; i++) + { + L[i] = 1.0; + for (k = mi; k < mf; k++) + if (k != i) + { + L[i] *= (ipx - x[k]) / (x[i] - x[k]); + } + *out += *(gf + i) * L[i]; + *Jac = L[i]; + Jac++; + } + + *mposn = mi; + + delete[] L; + delete[] x; + + return 0; // Normal retrun + } + + using jtutil::error_exit; + + patch_interp::patch_interp(const patch_edge &my_edge_in, + int min_iperp_in, int max_iperp_in, + const jtutil::array1d &min_parindex_array_in, + const jtutil::array1d &max_parindex_array_in, + const jtutil::array2d &interp_par_in, + bool ok_to_use_min_par_ghost_zone, + bool ok_to_use_max_par_ghost_zone, + int interp_handle_in, int interp_par_table_handle_in) + : my_patch_(my_edge_in.my_patch()), + my_edge_(my_edge_in), + min_gfn_(my_patch().ghosted_min_gfn()), + max_gfn_(my_patch().ghosted_max_gfn()), + ok_to_use_min_par_ghost_zone_(ok_to_use_min_par_ghost_zone), + ok_to_use_max_par_ghost_zone_(ok_to_use_max_par_ghost_zone), + min_iperp_(min_iperp_in), max_iperp_(max_iperp_in), + min_ipar_(ok_to_use_min_par_ghost_zone + ? my_edge_in.min_ipar_with_corners() + : my_edge_in.min_ipar_without_corners()), + max_ipar_(ok_to_use_max_par_ghost_zone + ? my_edge_in.max_ipar_with_corners() + : my_edge_in.max_ipar_without_corners()), + min_parindex_array_(min_parindex_array_in), + max_parindex_array_(max_parindex_array_in), + interp_par_(interp_par_in), + interp_handle_(interp_handle_in), + interp_par_table_handle_(1), + gridfn_coord_origin_(my_edge().par_map().fp_of_int(min_ipar_)), + gridfn_coord_delta_(my_edge().par_map().delta_fp()), + gridfn_data_ptrs_(min_gfn_, max_gfn_), + interp_data_buffer_ptrs_(min_gfn_, max_gfn_) // no comma + { + int status; + + const CCTK_INT stride = my_edge().ghosted_par_stride(); + + status = 0; + if (status < 0) + then error_exit(ERROR_EXIT, + "***** patch_interp::patch_interp():\n" + " can't set gridfn stride in interpolator parmameter table!\n" + " error status=%d\n", + status); /*NOTREACHED*/ + } + + patch_interp::~patch_interp() + { + } + + void patch_interp::interpolate(int ghosted_min_gfn_to_interp, + int ghosted_max_gfn_to_interp, + jtutil::array3d &data_buffer, + jtutil::array2d &posn_buffer, + jtutil::array3d &Jacobian_buffer) + const + + { + int status; + + const int N_dims = 1; + const int N_gridfns = jtutil::how_many_in_range(ghosted_min_gfn_to_interp, + ghosted_max_gfn_to_interp); + const CCTK_INT N_gridfn_data_points = jtutil::how_many_in_range(min_ipar(), max_ipar()); + + //-- Jacobian + const int Jacobian_interp_point_stride = Jacobian_buffer.subscript_stride_j(); + + // + // do the interpolations at each iperp + // + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + // + // interpolation-point coordinates + // + const int min_parindex = min_parindex_array_(iperp); + const int max_parindex = max_parindex_array_(iperp); + const CCTK_INT N_interp_points = jtutil::how_many_in_range(min_parindex, max_parindex); + const fp *const interp_coords_ptr = &interp_par_(iperp, min_parindex); + const void *const interp_coords[N_dims] = {static_cast(interp_coords_ptr)}; + + // + // pointers to gridfn data to interpolate, and to result buffer + // + for (int ghosted_gfn = ghosted_min_gfn_to_interp; + ghosted_gfn <= ghosted_max_gfn_to_interp; + ++ghosted_gfn) + { + // set up data pointer to --> (iperp,min_ipar) gridfn + const int start_irho = my_edge().irho_of_iperp_ipar(iperp, min_ipar()); + const int start_isigma = my_edge().isigma_of_iperp_ipar(iperp, min_ipar()); + gridfn_data_ptrs_(ghosted_gfn) = static_cast( + &my_patch() + .ghosted_gridfn(ghosted_gfn, + start_irho, start_isigma)); + interp_data_buffer_ptrs_(ghosted_gfn) = static_cast( + &data_buffer(ghosted_gfn, iperp, min_parindex)); + } + const void *const *const gridfn_data = &gridfn_data_ptrs_(ghosted_min_gfn_to_interp); + void *const *const interp_buffer = &interp_data_buffer_ptrs_(ghosted_min_gfn_to_interp); + + //-- molecule position + CCTK_POINTER molecule_posn_ptrs[N_dims] = {static_cast(&posn_buffer(iperp, min_parindex))}; + //-- Jacobian + CCTK_POINTER const Jacobian_ptrs[1] //[N_gridfns] + = {static_cast( + &Jacobian_buffer(iperp, min_parindex, 0))}; + // Jacobian_buffer has continuous memory allocation. + + const CCTK_INT stride = my_edge().ghosted_par_stride(); + double y[N_gridfn_data_points]; + + for (int i = 0; i < N_gridfn_data_points; i++) + { + y[i] = *((double *)(*gridfn_data) + stride * i); + } + + const int ORD = 6; + double Jac[ORD]; + int posn; // of molecular, starting from 0 + for (int i = 0; i < N_interp_points; i++) + { + status = lagrange_interp(gridfn_coord_origin_, gridfn_coord_delta_, + y, N_gridfn_data_points, + *((double *)interp_coords[0] + i), ((double *)(*interp_buffer) + i), + &posn, Jac, ORD); + + *((int *)molecule_posn_ptrs[0] + i) = posn + 2; + + memcpy((double *)(Jacobian_ptrs[0]) + Jacobian_buffer.min_k() + + Jacobian_interp_point_stride * i, + Jac, sizeof(Jac)); + } + + // convert the molecule positions from parindex-min_ipar + // to parindex values (again, cf comments on array subscripting + // at the start of "patch_interp.hh") + for (int parindex = min_parindex; + parindex <= max_parindex; + ++parindex) + { + posn_buffer(iperp, parindex) += min_ipar(); + } + + if (status < 0) + then error_exit(ERROR_EXIT, + "***** patch_interp::interpolate():\n" + " error return %d from interpolator at iperp=%d of [%d,%d]!\n" + " my_patch()=\"%s\" my_edge()=\"%s\"\n", + status, iperp, min_iperp(), max_iperp(), + my_patch().name(), my_edge().name()); /*NOTREACHED*/ + + } // end for iperp + } + + void patch_interp::verify_Jacobian_sparsity_pattern_ok() + const + { + CCTK_INT MSS_is_fn_of_interp_coords = 0, MSS_is_fn_of_input_array_values = 0; + CCTK_INT Jacobian_is_fn_of_input_array_values = 0; + + // + // verify that we grok the Jacobian sparsity pattern + // + if (MSS_is_fn_of_interp_coords || MSS_is_fn_of_input_array_values || Jacobian_is_fn_of_input_array_values) + then error_exit(ERROR_EXIT, + "***** patch_interp::verify_Jacobian_sparsity_pattern_ok():\n" + " implementation restriction: we only grok Jacobians with\n" + " fixed-sized hypercube-shaped molecules, independent of\n" + " the interpolation coordinates and the floating-point values!\n" + " MSS_is_fn_of_interp_coords=(int)%d (we only grok 0)\n" + " MSS_is_fn_of_input_array_values=(int)%d (we only grok 0)\n" + " Jacobian_is_fn_of_input_array_values=(int)%d (we only grok 0)\n", + MSS_is_fn_of_interp_coords, + MSS_is_fn_of_input_array_values, + Jacobian_is_fn_of_input_array_values); + } + + //****************************************************************************** + + // + // This function queries the interpolator to get the [min,max] ipar m + // coordinates of the interpolation molecules. + // + // (This API implicitly assumes that the Jacobian sparsity is one which + // is "ok" as verified by verify_Jacobian_sparsity_pattern_ok() .) + // + void patch_interp::molecule_minmax_ipar_m(int &min_ipar_m, int &max_ipar_m) + const + { + min_ipar_m = -2; + max_ipar_m = 3; + } + + //****************************************************************************** + + // + // This function queries the interpolator at each iperp to find out the + // molecule ipar positions (which we implicitly assume to be independent + // of ghosted_gfn), and stores these in posn_buffer(iperp, parindex) . + // + // (This API implicitly assumes that the Jacobian sparsity is one which + // is "ok" as verified by verify_Jacobian_sparsity_pattern_ok() .) + // + void patch_interp::molecule_posn(jtutil::array2d &posn_buffer) + const + { + const int N_dims = 1; + int status; + + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + const int min_parindex = min_parindex_array_(iperp); + const int max_parindex = max_parindex_array_(iperp); + + // set up the molecule-position query in the parameter table + CCTK_POINTER molecule_posn_ptrs[N_dims] = {static_cast(&posn_buffer(iperp, min_parindex))}; + status = 0; // Util_TableSetPointerArray(interp_par_table_handle_, N_dims, + // molecule_posn_ptrs, "molecule_positions"); + + if (status < 0) + then error_exit(ERROR_EXIT, + "***** patch_interp::molecule_posn():\n" + " can't set molecule position query\n" + " in interpolator parmameter table at iperp=%d of [%d,%d]!\n" + " error status=%d\n", + iperp, min_iperp(), max_iperp(), + status); /*NOTREACHED*/ + + for (int parindex = min_parindex; + parindex <= max_parindex; + ++parindex) + { + posn_buffer(iperp, parindex) += min_ipar(); + } + } + } + + void patch_interp::Jacobian(jtutil::array3d &Jacobian_buffer) + const + { + const int N_dims = 1; + const int N_gridfns = 1; + + int status1, status2; + + // + // set Jacobian stride info in parameter table + // + const int Jacobian_interp_point_stride = Jacobian_buffer.subscript_stride_j(); + + status1 = 0; + + status2 = 0; + + if ((status1 < 0) || (status2 < 0)) + then error_exit(ERROR_EXIT, + "***** patch_interp::Jacobian():\n" + " can't set Jacobian stride info in interpolator parmameter table!\n" + " error status1=%d status2=%d\n", + status1, status2); + + // + // query the Jacobians at each iperp + // + for (int iperp = min_iperp(); iperp <= max_iperp(); ++iperp) + { + const int min_parindex = min_parindex_array_(iperp); + const int max_parindex = max_parindex_array_(iperp); + + // + // set up the Jacobian query in the parameter table + // + CCTK_POINTER const Jacobian_ptrs[N_gridfns] = {static_cast( + &Jacobian_buffer(iperp, min_parindex, 0))}; + } + } +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/patch_interp.h b/AMSS_NCKU_source/patch_interp.h new file mode 100644 index 0000000..3bb550c --- /dev/null +++ b/AMSS_NCKU_source/patch_interp.h @@ -0,0 +1,293 @@ +#ifndef TPATCH_INTERP_H +#define TPATCH_INTERP_H +namespace AHFinderDirect + { + +// +// patch_interp - interpolation from a patch +// + +// +// A patch_interp object is responsible for interpolating gridfn data +// from its owning patch for use by another patch's ghost_zone object +// (in setting up the gridfn in the other ghost zone). A patch_interp +// object deals only in its own patch's coordinates; other code elsewhere +// (in practice in interpatch_ghost_zone::) is responsible for translating +// other patch's coordinates into our coordinates. +// + +// +// A patch_interp defines a "patch interpolation region", the region of +// its owning patch from which this interpolation will use gridfn data. +// + +// +// The way the patch coordnates are constructed, any two adjacent patches +// share a common (perpendicular) coordinate. Thus we only have to do +// 1-dimensional interpolation here (in the parallel direction). In +// other words, for each iperp we interpolate in par. +// +// In general we interpolate each gridfn at a number of distinct par +// for each iperp; the integer "parindex" indexes these points. We +// attach no particular semantics to parindex, and it need not be +// 0-origin or have the same range for each iperp. [In practice, +// parindex will be the other patch's ipar coordinate.] However, +// we assume that the range of parindex is roughly similar for each +// iperp, so it's ok to use (iperp,parindex) as a 2-D rectangular +// index space. +// +// For example, we might interpolate at the points +// ipar ipar ipar ipar ipar ipar ipar ipar ipar +// 1 2 3 4 5 6 7 8 9 +// iperp=10 (2a) (3b) (4c) +// iperp=11 (2d) (3e) (4f) (5g) +// where the (2a)-(5g) are the interpolation points, with 2-5 being the +// parindex values and a-g being unique identifiers used in our description +// below. In terms of our member data, this interpolation region would +// be described by +// [min,max]_iperp_=[10,11] +// [min,max]_ipar_=[1,9] +// [min,max]_parindex_array_(10)=[2,5] +// [min,max]_parindex_array_(11)=[2,6] +// interp_par_(10,2) = x[a] +// interp_par_(10,3) = x[b] +// interp_par_(10,4) = x[c] +// interp_par_(11,2) = x[d] +// interp_par_(11,3) = x[e] +// interp_par_(11,4) = x[f] +// interp_par_(11,5) = x[g] +// + +// +// We use the Cactus local interpolator CCTK_InterpLocalUniform() +// to do the interpolation. To minimize interpolator overheads, we +// interpolate all the gridfns at each iperp in a single interpolator +// call. [Different iperp values involve different sets of (1-D) +// gridfn data, and so inherently require distinct interpolator calls.] +// +// Setting up the array subscripting for the interpolator to access +// the gridfn data is a bit tricky: The interpolator accesses the +// gridfn data using the generic (1-D) subscripting expression +// data[offset + i*stride] +// where i is the data array index. However, we'd rather not use +// offset , because it has to be supplied in the parameter table as +// an array subscripted by gfn , and so would require changing the +// parameter table for each call on interpolate() (with potentially +// different numbers of gridfns being interpolated). Instead, at each +// iperp we use i = ipar-min_ipar , so the default offset=0 makes +// the subscripting expression zero for ipar = min_ipar . This also +// makes the interpolator's min_i = 0 and max_i be dims-1 (both +// the defaults), so those also don't have to be set in the parameter +// table either. We set the interpolator's data coordinate origin to +// the par coordinate for min_ipar , so it correctly maps i --> par . +// With this strategy we can share the interpolator parameter table +// across all the iperp values, and we don't need to modify the +// parameter table at all after the initial setup in our constructor. +// However, we do have to adjust the molecule positions in +// patch_interp::molecule_posn() , since the interpolator will return +// i values, while molecule_posn() needs ipar values. +// + +class patch_interp + { +public: + // to which patch/edge do we belong? + const patch& my_patch() const { return my_patch_; } + const patch_edge& my_edge() const { return my_edge_; } + + +public: + // + // ***** main client interface ***** + // + // interpolate specified range of ghosted gridfns + // at all the coordinates specified when we were constructed, + // store interpolated data in + // data_buffer(ghosted_gfn, iperp, parindex) + void interpolate(int ghosted_min_gfn_to_interp, + int ghosted_max_gfn_to_interp, + jtutil::array3d& data_buffer) + const; + void interpolate(int ghosted_min_gfn_to_interp, + int ghosted_max_gfn_to_interp, + jtutil::array3d& data_buffer, + jtutil::array2d& posn_buffer, + jtutil::array3d& Jacobian_buffe) + const; + +public: + // + // ***** Jacobian of interpolate() ***** + // + + // verify (no-op if ok, error_exit() if not) that interpolator + // has a Jacobian sparsity pattern which we grok: at present this + // means molecules are fixed-sized hypercubes, with size/shape + // independent of interpolation coordinates and the floating-point + // values in the input arrays + void verify_Jacobian_sparsity_pattern_ok() const; + + // + // The API for the remaining Jacobian functions implicitly + // assumes that the Jacobian sparsity pattern is "ok" as + // verified by verify_Jacobian_sparsity_pattern_ok() , + // and in particular that [min,max]_ipar_m are independent + // of iperp and parindex. + // + + // get [min,max] ipar m coordinates of interpolation molecules + void molecule_minmax_ipar_m(int& min_ipar_m, int& max_ipar_m) const; + + // get interpolation molecule ipar positions in + // molecule_posn_buffer(iperp, parindex) + // ... array type is CCTK_INT so we can pass by reference + // to interpolator + void molecule_posn(jtutil::array2d& posn_buffer) const; + + // get Jacobian of interpolated data with respect to this patch's + // ghosted gridfns, + // partial interpolate() data_buffer(ghosted_gfn, iperp, parindex) + // --------------------------------------------------------------- + // partial ghosted_gridfn(ghosted_gfn, iperp, posn+ipar_m) + // store Jacobian in + // Jacobian_buffer(iperp, parindex, ipar_m) + // where we implicitly assume the Jacobian to be independent of + // ghosted_gfn, and where + // posn = posn_buffer(iperp, parindex) + // as returned by molecule_posn() + void Jacobian(jtutil::array3d& Jacobian_buffer) const; + + // + // ***** internal functions ***** + // +private: + // [min,max] iperp for interpolation and gridfn data + int min_iperp() const { return min_iperp_; } + int max_iperp() const { return max_iperp_; } + + // min/max (iperp,ipar) of the gridfn data to use for interpolation + int min_ipar() const { return min_ipar_; } + int max_ipar() const { return max_ipar_; } + + // + // ***** constructor, destructor, et al ***** + // +public: + // + // Constructor arguments: + // my_edge_in = Identifies the patch/edge to which this + // interpolation region is to belong. + // [min,max]_iperp_in = The range of iperp for this interpolation + // region + // [min,max]_parindex_array_in(iperp) + // = [min,max] range of parindex actually used at each iperp. + // We keep references to these arrays, so they should have + // lifetimes at last as long as that of this object. + // interp_par_in(iperp,parindex) + // = Gives the par coordinates at which we will interpolate; + // array entries outside the range [min,max]_parindex_in + // are unused. We keep a reference to this array, so it + // should have a lifetime at last as long as that of this + // object. + // ok_to_use_[min,max]_par_ghost_zone + // = Boolean flags saying whether or not we should use gridfn + // data from the [min,max]_par ghost zones in the interpolation. + // interp_handle_in = Cactus handle to the interpatch interpolation + // operator. + // interp_par_table_handle_in + // = Cactus handle to a Cactus key/value table giving + // parameters (eg order) for the interpatch interpolation + // operator. This class internally clones this table and + // modifies the clone, so the original table is not modified + // by any actions of this class. + // + // This constructor requires that this patch's gridfns already + // exist, since we size various arrays based on the patch's min/max + // ghosted gfn. + // + patch_interp(const patch_edge& my_edge_in, + int min_iperp_in, int max_iperp_in, + const jtutil::array1d& min_parindex_array_in, + const jtutil::array1d& max_parindex_array_in, + const jtutil::array2d& interp_par_in, + bool ok_to_use_min_par_ghost_zone, + bool ok_to_use_max_par_ghost_zone, + int interp_handle_in, int interp_par_table_handle_in); + ~patch_interp(); + +private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + patch_interp(const patch_interp& rhs); + patch_interp& operator=(const patch_interp& rhs); + + + // + // ***** data members ***** + // +private: + const patch& my_patch_; + const patch_edge& my_edge_; + + // range of gfn we can handle + // (any given interpolate() call may specify a subrange) + const int min_gfn_, max_gfn_; + + // these are strictly speaking redundant + // but we keep them for use in debugging + bool ok_to_use_min_par_ghost_zone_, ok_to_use_max_par_ghost_zone_; + + // patch interpolation region, + // i.e. range of (iperp,ipar) in this patch from which + // we will use gridfn data in interpolation + const int min_iperp_, max_iperp_; + const int min_ipar_, max_ipar_; + + // [min,max] parindex at each iperp + // ... these are references to arrays passed in to our constructor + // ==> we do *not* own them! + // ... indices are (iperp) + const jtutil::array1d& min_parindex_array_; + const jtutil::array1d& max_parindex_array_; + + // interp_par_(iperp,parindex) + // = Gives the par coordinates at which we will interpolate; + // array entries outside the range [min,max]_parindex_in + // are unused (n.b. this interface implicitly takes the + // par coordinates to be independent of ghosted_gfn). + // ... this is a reference to an array passed in to our constructor + // ==> we do *not* own this! + const jtutil::array2d& interp_par_; // indices (iperp,parindex) + + // Cactus handle to the interpolation operator + int interp_handle_; + + // Cactus handle to our private Cactus key/value table + // giving parameters for the interpolation operator + // ... this starts out as a copy of the passed-in table, + // then gets extra stuff added to it specific to this + // interpolation region; it's shared across all iperp + // ... we own this table + const int interp_par_table_handle_; + + // (par) origin and delta values of the gridfn data + const fp gridfn_coord_origin_, gridfn_coord_delta_; + + // --> start of gridfn data to use for interpolation + // (reset for each iperp) + // ... we do *not* own the pointed-to data! + // ... index is (gfn) + mutable jtutil::array1d gridfn_data_ptrs_; + + // --> start of interpolation data buffer for each gridfn + // (reset for each iperp) + // ... we do *not* own the pointed-to data! + // ... index is (gfn) + mutable jtutil::array1d interp_data_buffer_ptrs_; + }; + +//****************************************************************************** + + } // namespace AHFinderDirect +#endif /* TPATCH_INTERP_H */ diff --git a/AMSS_NCKU_source/patch_system.C b/AMSS_NCKU_source/patch_system.C new file mode 100644 index 0000000..f31f5de --- /dev/null +++ b/AMSS_NCKU_source/patch_system.C @@ -0,0 +1,2522 @@ +#include +#include +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_info.h" +#include "patch_system.h" +#include "patch_system_info.h" + +namespace AHFinderDirect +{ + using jtutil::error_exit; + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function constructs a patch_system object. + // + // Constructor arguments: + // ghost_zone_width = Width in grid points of all ghost zones. + // patch_overlap_width = Number of grid points that adjacent + // nominally-just-touching patches should overlap. + // For example, with patch_overlap_width == 3, here + // are the grid points of two neighboring patches: + // x x x x x X + // | + // O o o o o o + // Here | marks the "just touching" boundary, + // x and o the grid points before this extension, + // and X and O the extra grid points added by this + // extension. For this example, the patch_extend_width + // parameter used by some other functions would + // be 1; in general + // patch_overlap_width = 2*patch_extend_width + 1 + // N_zones_per_right_angle = This sets the grid spacing (same in both + // directions) to 90.0 / N_zones_per_right_angle. + // It's a fatal error (error_exit()) if this + // doesn't evenly divide the grid sizes in both + // directions. + // ip_interp_handle = Cactus handle to the interpatch interpolation operator; + // this must be a 1-D interpolator + // ip_interp_par_table_handle = Cactus handle to the parameter table for the + // interpatch interpolation operator + // surface_interp_handle = Cactus handle to the surface interpolation + // operator; this is optional, and is only used by + // radius_in_{local,global}_xyz_direction() + // If this is used, it must be a 2-D interpolator + // surface_interp_par_table_handle = Cactus handle to the parameter table + // for the surface interpolation operator; + // this is optional, and is only used by + // radius_in_local_xyz_direction() + // print_summary_msg_flag = true to print 2 lines of CCTK_VInfo messages + // giving the patch system type and origin + // false to skip this + // print_detailed_msg_flag = true to print extensive messages tracing the + // creation and initialization of various + // data structures + // false to skip this + // + patch_system::patch_system(fp origin_x_in, fp origin_y_in, fp origin_z_in, + enum patch_system_type type_in, + int ghost_zone_width, int patch_overlap_width, + int N_zones_per_right_angle, + int min_gfn_in, int max_gfn_in, + int ghosted_min_gfn_in, int ghosted_max_gfn_in, + int ip_interp_handle, int ip_interp_par_table_handle, + int surface_interp_handle_in, + int surface_interp_par_table_handle_in, + bool print_summary_msg_flag, + bool print_detailed_msg_flag) + + : global_coords_(origin_x_in, origin_y_in, origin_z_in), + type_(type_in), + N_patches_(N_patches_of_type(type_in)), + all_patches_(new patch *[N_patches_]), + starting_gpn_(new int[N_patches_ + 1]), + ghosted_starting_gpn_(new int[N_patches_ + 1]), + gridfn_storage_(NULL), // set in setup_gridfn_storage() + ghosted_gridfn_storage_(NULL), // set in setup_gridfn_storage() + global_min_ym_(0), global_max_ym_(0), + // set in compute_synchronize_Jacobian() + surface_interp_handle_(surface_interp_handle_in), + surface_interp_par_table_handle_(surface_interp_par_table_handle_in) + { + if (!jtutil::is_odd(patch_overlap_width)) + then error_exit(ERROR_EXIT, + "***** patch_system::patch_system(): implementation restriction:\n" + " patch_overlap_width=%d, but we only support odd values!\n", + patch_overlap_width); /*NOTREACHED*/ + const int patch_extend_width = patch_overlap_width >> 1; + + if (ghost_zone_width < fd_grid::molecule_radius()) + { + cout << "***** patch_system::patch_system():" << endl + << " must have ghost_zone_width >= fd_grid::molecule_radius()" << endl + << " but got ghost_zone_width=" << ghost_zone_width << " fd_grid::molecule_radius()=" << fd_grid::molecule_radius() << "!" << endl + << " finite difference order=4" << endl; + abort(); + } + + if (print_summary_msg_flag) + then + { + CCTK_VInfo(CCTK_THORNSTRING, + " constructing %s patch system", + name_of_type(type())); + CCTK_VInfo(CCTK_THORNSTRING, + " with %d angular zones per right angle", + N_zones_per_right_angle); + } + + // construct/interlink the patches and ghost zones + switch (type_in) + { + case patch_system__full_sphere: + create_patches(patch_system_info::full_sphere::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__full_sphere(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_z_hemisphere: + create_patches(patch_system_info::plus_z_hemisphere::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_z_hemisphere(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xy_quadrant_mirrored: + create_patches(patch_system_info::plus_xy_quadrant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xy_quadrant_mirrored(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xy_quadrant_rotating: + create_patches(patch_system_info::plus_xy_quadrant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xy_quadrant_rotating(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xz_quadrant_mirrored: + create_patches(patch_system_info::plus_xz_quadrant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xz_quadrant_mirrored(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xz_quadrant_rotating: + create_patches(patch_system_info::plus_xz_quadrant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xz_quadrant_rotating(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xyz_octant_mirrored: + create_patches(patch_system_info::plus_xyz_octant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xyz_octant_mirrored(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + case patch_system__plus_xyz_octant_rotating: + create_patches(patch_system_info::plus_xyz_octant::patch_info_array, + ghost_zone_width, patch_extend_width, + N_zones_per_right_angle, + print_detailed_msg_flag); + setup_gridfn_storage(min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in, + print_detailed_msg_flag); + setup_ghost_zones__plus_xyz_octant_rotating(patch_overlap_width, + ip_interp_handle, + ip_interp_par_table_handle, + print_detailed_msg_flag); + break; + + default: + error_exit(ERROR_EXIT, + "***** patch_system::patch_system(): bad type_in=(int)%d!\n", + int(type_in)); /*NOTREACHED*/ + } + + if (print_summary_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " ==> %d nominal, %d ghosted angular grid points", + N_grid_points(), ghosted_N_grid_points()); + } + + //****************************************************************************** + + // + // This function destroys a patch_system object. + // + patch_system::~patch_system() + { + for (int pn = N_patches() - 1; pn >= 0; --pn) + { + if (&ith_patch(pn)) + delete &ith_patch(pn); + } + + if (ghosted_gridfn_storage_) + delete[] ghosted_gridfn_storage_; + if (gridfn_storage_) + delete[] gridfn_storage_; + if (ghosted_starting_gpn_) + delete[] ghosted_starting_gpn_; + if (starting_gpn_) + delete[] starting_gpn_; + if (all_patches_) + delete[] all_patches_; + } + + //****************************************************************************** + + // + // This function is called from the patch_system:: constructor to + // construct a set of patches as described by an array of patch_info + // structures and associated arguments, and make these patches members + // of this patch system. This function also correctly sets + // N_grid_points_ + // N_ghosted_grid_points_ + // all_patches_[] + // starting_gpn_[] + // ghosted_starting_gpn_[] + // This function does *NOT* create any of the ghost zones, and does + // *NOT* set up any gridfns. + // + void patch_system::create_patches(const struct patch_info patch_info_in[], + int ghost_zone_width, int patch_extend_width, + int N_zones_per_right_angle, + bool print_msg_flag) + { + N_grid_points_ = 0; + ghosted_N_grid_points_ = 0; + for (int pn = 0; pn < N_patches(); ++pn) + { + const struct patch_info &pi = patch_info_in[pn]; + const struct grid::grid_array_pars &grid_array_pars = pi.grid_array_pars(ghost_zone_width, + patch_extend_width, + N_zones_per_right_angle); + const struct grid::grid_pars &grid_pars = pi.grid_pars(patch_extend_width, + N_zones_per_right_angle); + + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " constructing %s patch (%d x %d grid points)", + pi.name, + jtutil::how_many_in_range(grid_array_pars.min_irho, + grid_array_pars.max_irho), + jtutil::how_many_in_range(grid_array_pars.min_isigma, + grid_array_pars.max_isigma)); + + struct patch *p; + switch (pi.ctype) + { + case 'z': + p = new z_patch(*this, pn, + pi.name, pi.is_plus, + grid_array_pars, grid_pars); + break; + case 'x': + p = new x_patch(*this, pn, + pi.name, pi.is_plus, + grid_array_pars, grid_pars); + break; + case 'y': + p = new y_patch(*this, pn, + pi.name, pi.is_plus, + grid_array_pars, grid_pars); + break; + default: + error_exit(ERROR_EXIT, + "***** patch_system::create_patches():\n" + " unknown patch_info_in[pn=%d].ctype=0x%02d='%c'!\n", + pn, pi.ctype, pi.ctype); /*NOTREACHED*/ + } + + // these record number of grid points in *previous* patches, + // i.e. they do *not* include the number of grid points in this patch + starting_gpn_[pn] = N_grid_points_; + ghosted_starting_gpn_[pn] = ghosted_N_grid_points_; + + N_grid_points_ += p->N_grid_points(); + ghosted_N_grid_points_ += p->ghosted_N_grid_points(); + + all_patches_[pn] = p; + } + + starting_gpn_[N_patches_] = N_grid_points_; + ghosted_starting_gpn_[N_patches_] = ghosted_N_grid_points_; + } + + //****************************************************************************** + + // + // This function is called from the patch_system:: constructor to set + // up the storage for all gridfns in all patches, giving each gridfn a + // contiguous-across-all-patches storage array. This function also makes + // a number of self-consistency checks to ensure that the gridfn storage + // subscripting is set up properly. + // + // This function assumes that all the patches have already been constructed + // before it is called. + // + // For example, given the patches {x,y,z}, the ghosted gridfns {H,J}, + // and the nominal gridfns {a,b,c}, we might picture the storage like + // this: + // + // xa xa xa ya ya za za za za + // xb xb xb yb yb zb zb zb zb + // xc xc xc yc yc zc zc zc zc + // + // xH xH xH xH yH yH yH zH zH zH zH zH + // xJ xJ xJ xJ yJ yJ yJ zJ zJ zJ zJ zJ + // + // Here the upper/lower blocks are for nominal/ghosted gridfns. + // The storage is taken as being contiguous within each row (in fact + // within each block). Thus the storage for all the nominal gridfns + // (or all the ghosted gridfns) in a single patch is *non*-contiguous. + // + // The creation of patches is done in several phases: first the patches + // are constructed with no gridfn storage, then we are called to set up + // the gridfn storage (taking into account the sizes of the other patches), + // then finally ghost zones are constructed and interlinked. + // + // FIXME: We should pad the gridfn storage as necessary to avoid cache + // conflicts, but we don't do this at present. + // + void patch_system::setup_gridfn_storage(int min_gfn_in, int max_gfn_in, + int ghosted_min_gfn_in, int ghosted_max_gfn_in, + bool print_msg_flag) + { + const int N_gridfns_in = jtutil::how_many_in_range(min_gfn_in, max_gfn_in); + const int ghosted_N_gridfns_in = jtutil::how_many_in_range(ghosted_min_gfn_in, ghosted_max_gfn_in); + + const int gfn_stride = N_grid_points(); + const int ghosted_gfn_stride = ghosted_N_grid_points(); + + const int N_storage = gfn_stride * N_gridfns_in; + const int ghosted_N_storage = ghosted_gfn_stride * ghosted_N_gridfns_in; + + if (print_msg_flag) + then + { + CCTK_VInfo(CCTK_THORNSTRING, + " setting up gridfn storage"); + CCTK_VInfo(CCTK_THORNSTRING, + " gfn=[%d,%d] ghosted_gfn=[%d,%d]", + min_gfn_in, max_gfn_in, + ghosted_min_gfn_in, ghosted_max_gfn_in); + CCTK_VInfo(CCTK_THORNSTRING, + " N_grid_points()=%d ghosted_N_grid_points()=%d", + N_grid_points(), ghosted_N_grid_points()); + } + + // storage arrays for all gridfns + gridfn_storage_ = new fp[N_storage]; + ghosted_gridfn_storage_ = new fp[ghosted_N_storage]; + + // divide up the storage array among the patches + // and set up the storage in the individual patches themselves + { + for (int pn = 0; pn < N_patches(); ++pn) + { + const int posn = starting_gpn_[pn]; + const int ghosted_posn = ghosted_starting_gpn_[pn]; + const struct grid_arrays::gridfn_pars gridfn_pars = { + min_gfn_in, max_gfn_in, + &gridfn_storage_[posn], + gfn_stride, 0, 0}; + const struct grid_arrays::gridfn_pars ghosted_gridfn_pars = { + ghosted_min_gfn_in, ghosted_max_gfn_in, + &ghosted_gridfn_storage_[ghosted_posn], + ghosted_gfn_stride, 0, 0}; + + patch &p = ith_patch(pn); + p.setup_gridfn_storage(gridfn_pars, ghosted_gridfn_pars); + } + } + + if (print_msg_flag) + then + { + CCTK_VInfo(CCTK_THORNSTRING, + " checking that storage is partitioned properly"); + } + + // check to make sure storage for distinct gridfns + // forms a partition of the overall storage array + const patch &pfirst = ith_patch(0); + const patch &plast = ith_patch(N_patches() - 1); + { + for (int gfn = min_gfn(); gfn + 1 < max_gfn(); ++gfn) + { + // range of storage occupied by gridfns: + // gfn --> [gfn_first, gfn_last] + // gfn+1 --> [gfn1_first, gfn1_last] + const fp *const gfn_last_ptr = &plast.gridfn(gfn, plast.max_irho(), + plast.max_isigma()); + const fp *const gfn1_first_ptr = &pfirst.gridfn(gfn + 1, pfirst.min_irho(), + pfirst.min_isigma()); + if (!(gfn1_first_ptr == gfn_last_ptr + 1)) + then error_exit(PANIC_EXIT, + "***** patch_system::setup_gridfn_storage():\n" + " nominal-grid gridfns don't partition overall storage array!" + " (this should never happen!)\n" + " gfn=%d last point at gfn_last_ptr=%p\n" + " gfn+1=%d first point at gfn1_first_ptr=%p\n" + " should have gfn1_first_ptr == gfn_last_ptr+1\n", + gfn, (const void *)gfn_last_ptr, + gfn + 1, (const void *)gfn1_first_ptr); /*NOTREACHED*/ + } + } + + { + for (int ghosted_gfn = ghosted_min_gfn(); + ghosted_gfn + 1 < ghosted_max_gfn(); + ++ghosted_gfn) + { + // range of storage occupied by ghosted gridfns: + // ghosted_gfn --> [gfn_first, gfn_last] + // ghosted_gfn+1 --> [gfn1_first, gfn1_last] + const fp *const ghosted_gfn_last_ptr = &plast.ghosted_gridfn(ghosted_gfn, + plast.ghosted_max_irho(), + plast.ghosted_max_isigma()); + const fp *const ghosted_gfn1_first_ptr = &pfirst.ghosted_gridfn(ghosted_gfn + 1, + pfirst.ghosted_min_irho(), + pfirst.ghosted_min_isigma()); + if (!(ghosted_gfn1_first_ptr == ghosted_gfn_last_ptr + 1)) + then error_exit(PANIC_EXIT, + "***** patch_system::setup_gridfn_storage():\n" + " ghosted-grid gridfns don't partition overall storage array!" + " (this should never happen!)\n" + " ghosted_gfn=%d last point at ghosted_gfn_last_ptr=%p\n" + " ghosted_gfn+1=%d first point at ghosted_gfn1_first_ptr=%p\n" + " should have ghosted_gfn1_first_ptr == ghosted_gfn_last_ptr+1\n", + ghosted_gfn, (const void *)ghosted_gfn_last_ptr, + ghosted_gfn + 1, + (const void *)ghosted_gfn1_first_ptr); + /*NOTREACHED*/ + } + } + + // check to make sure storage for distinct patches + // forms a partition of the storage for each gridfn + { + for (int gfn = min_gfn(); gfn < max_gfn(); ++gfn) + { + for (int pn = 0; pn + 1 < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + const patch &p1 = ith_patch(pn + 1); + + // range of storage occupied by gridfn: + // p --> [p_first, p_last] + // p1 --> [p1_first, p1_last] + const fp *const p_last_ptr = &p.gridfn(gfn, p.max_irho(), p.max_isigma()); + const fp *const p1_first_ptr = &p1.gridfn(gfn, p1.min_irho(), p1.min_isigma()); + if (!(p1_first_ptr == p_last_ptr + 1)) + then error_exit(PANIC_EXIT, + "***** patch_system::setup_gridfn_storage():\n" + " nominal-grid patches gridfns don't partition storage for gfn=%d!\n" + " (this should never happen!)\n" + " gfn=%d %s patch last point at p_last_ptr=%p\n" + " gfn=%d %s patch first point at p1_first_ptr=%p\n" + " should have p1_first_ptr == p_last_ptr+1\n", + gfn, + gfn, p.name(), (const void *)p_last_ptr, + gfn + 1, p1.name(), (const void *)p1_first_ptr); + /*NOTREACHED*/ + } + } + } + + { + for (int ghosted_gfn = ghosted_min_gfn(); + ghosted_gfn < ghosted_max_gfn(); + ++ghosted_gfn) + { + for (int pn = 0; pn + 1 < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + const patch &p1 = ith_patch(pn + 1); + + // range of storage occupied by ghosted gridfn: + // p --> [p_first, p_last] + // p1 --> [p1_first, p1_last] + const fp *const p_last_ptr = &p.ghosted_gridfn(ghosted_gfn, + p.ghosted_max_irho(), + p.ghosted_max_isigma()); + const fp *const p1_first_ptr = &p1.ghosted_gridfn(ghosted_gfn, + p1.ghosted_min_irho(), + p1.ghosted_min_isigma()); + if (!(p1_first_ptr == p_last_ptr + 1)) + then error_exit(PANIC_EXIT, + "***** patch_system::setup_gridfn_storage():\n" + " nominal-grid patches gridfns don't partition storage for gfn=%d!\n" + " (this should never happen!)\n" + " %s patch (pn=%d) last point at p_last_ptr=%p\n" + " %s patch (pn=%d) first point at p1_first_ptr=%p\n" + " should have p1_first_ptr == p_last_ptr+1\n", + ghosted_gfn, + p.name(), pn, (const void *)p_last_ptr, + p1.name(), pn + 1, (const void *)p1_first_ptr); + /*NOTREACHED*/ + } + } + } + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a full-sphere patch system. + // + void patch_system::setup_ghost_zones__full_sphere(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " seting up full sphere ghost zones"); + + patch &pz = ith_patch(patch_system_info::full_sphere::patch_number__pz); + patch &px = ith_patch(patch_system_info::full_sphere::patch_number__px); + patch &py = ith_patch(patch_system_info::full_sphere::patch_number__py); + patch &mx = ith_patch(patch_system_info::full_sphere::patch_number__mx); + patch &my = ith_patch(patch_system_info::full_sphere::patch_number__my); + patch &mz = ith_patch(patch_system_info::full_sphere::patch_number__mz); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(pz, mx, patch_overlap_width); + create_interpatch_ghost_zones(pz, my, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(py, mx, patch_overlap_width); + create_interpatch_ghost_zones(mx, my, patch_overlap_width); + create_interpatch_ghost_zones(my, px, patch_overlap_width); + create_interpatch_ghost_zones(mz, px, patch_overlap_width); + create_interpatch_ghost_zones(mz, py, patch_overlap_width); + create_interpatch_ghost_zones(mz, mx, patch_overlap_width); + create_interpatch_ghost_zones(mz, my, patch_overlap_width); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, mx, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(py, mx, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mx, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(my, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, mx, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +z hemisphere patch system. + // + void patch_system::setup_ghost_zones__plus_z_hemisphere(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +z hemisphere ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_z_hemisphere::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_z_hemisphere::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_z_hemisphere::patch_number__py); + patch &mx = ith_patch(patch_system_info::plus_z_hemisphere::patch_number__mx); + patch &my = ith_patch(patch_system_info::plus_z_hemisphere::patch_number__my); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(pz, mx, patch_overlap_width); + create_interpatch_ghost_zones(pz, my, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(py, mx, patch_overlap_width); + create_interpatch_ghost_zones(mx, my, patch_overlap_width); + create_interpatch_ghost_zones(my, px, patch_overlap_width); + px.create_mirror_symmetry_ghost_zone(px.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_rho_patch_edge()); + mx.create_mirror_symmetry_ghost_zone(mx.min_rho_patch_edge()); + my.create_mirror_symmetry_ghost_zone(my.min_rho_patch_edge()); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, mx, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(py, mx, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mx, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(my, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xy quadrant (mirrored) patch system. + // + void patch_system::setup_ghost_zones__plus_xy_quadrant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xy quadrant (mirrored) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__py); + patch &mz = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__mz); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(mz, px, patch_overlap_width); + create_interpatch_ghost_zones(mz, py, patch_overlap_width); + pz.create_mirror_symmetry_ghost_zone(pz.min_rho_patch_edge()); + pz.create_mirror_symmetry_ghost_zone(pz.min_sigma_patch_edge()); + px.create_mirror_symmetry_ghost_zone(px.min_sigma_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_sigma_patch_edge()); + mz.create_mirror_symmetry_ghost_zone(mz.max_rho_patch_edge()); + mz.create_mirror_symmetry_ghost_zone(mz.max_sigma_patch_edge()); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xy quadrant (rotating) patch system. + // + void patch_system::setup_ghost_zones__plus_xy_quadrant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xy quadrant (rotating) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__py); + patch &mz = ith_patch(patch_system_info::plus_xy_quadrant::patch_number__mz); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(mz, px, patch_overlap_width); + create_interpatch_ghost_zones(mz, py, patch_overlap_width); + create_periodic_symmetry_ghost_zones(pz.min_rho_patch_edge(), + pz.min_sigma_patch_edge(), + true); + create_periodic_symmetry_ghost_zones(px.min_sigma_patch_edge(), + py.max_sigma_patch_edge(), + true); + create_periodic_symmetry_ghost_zones(mz.max_rho_patch_edge(), + mz.max_sigma_patch_edge(), + true); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(mz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xz quadrant (mirrored) patch system. + // + void patch_system::setup_ghost_zones__plus_xz_quadrant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xz quadrant (mirrored) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__py); + patch &my = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__my); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(pz, my, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(px, my, patch_overlap_width); + pz.create_mirror_symmetry_ghost_zone(pz.min_sigma_patch_edge()); + px.create_mirror_symmetry_ghost_zone(px.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_sigma_patch_edge()); + my.create_mirror_symmetry_ghost_zone(my.min_rho_patch_edge()); + my.create_mirror_symmetry_ghost_zone(my.min_sigma_patch_edge()); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xz quadrant (rotating) patch system. + // + void patch_system::setup_ghost_zones__plus_xz_quadrant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xz quadrant (rotating) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__py); + patch &my = ith_patch(patch_system_info::plus_xz_quadrant::patch_number__my); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(pz, my, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + create_interpatch_ghost_zones(px, my, patch_overlap_width); + px.create_mirror_symmetry_ghost_zone(px.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_rho_patch_edge()); + my.create_mirror_symmetry_ghost_zone(my.min_rho_patch_edge()); + create_periodic_symmetry_ghost_zones(pz.min_sigma_patch_edge(), + pz.min_sigma_patch_edge(), + false); + create_periodic_symmetry_ghost_zones(py.max_sigma_patch_edge(), + my.min_sigma_patch_edge(), + false); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, my, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xyz octant (mirrored) patch system. + // + void patch_system::setup_ghost_zones__plus_xyz_octant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xyz octant (mirrored) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xyz_octant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xyz_octant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xyz_octant::patch_number__py); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + pz.create_mirror_symmetry_ghost_zone(pz.min_rho_patch_edge()); + pz.create_mirror_symmetry_ghost_zone(pz.min_sigma_patch_edge()); + px.create_mirror_symmetry_ghost_zone(px.max_rho_patch_edge()); + px.create_mirror_symmetry_ghost_zone(px.min_sigma_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_sigma_patch_edge()); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + + // + // This function sets up (constructs and interlinks) the ghost zones + // for a +xyz octant (rotating) patch system. + // + void patch_system::setup_ghost_zones__plus_xyz_octant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag) + { + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " setting up +xyz octant (rotating) ghost zones"); + + patch &pz = ith_patch(patch_system_info::plus_xyz_octant::patch_number__pz); + patch &px = ith_patch(patch_system_info::plus_xyz_octant::patch_number__px); + patch &py = ith_patch(patch_system_info::plus_xyz_octant::patch_number__py); + + // create the ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " creating ghost zones"); + create_interpatch_ghost_zones(pz, px, patch_overlap_width); + create_interpatch_ghost_zones(pz, py, patch_overlap_width); + create_interpatch_ghost_zones(px, py, patch_overlap_width); + px.create_mirror_symmetry_ghost_zone(px.max_rho_patch_edge()); + py.create_mirror_symmetry_ghost_zone(py.max_rho_patch_edge()); + create_periodic_symmetry_ghost_zones(pz.min_rho_patch_edge(), + pz.min_sigma_patch_edge(), + true); + create_periodic_symmetry_ghost_zones(px.min_sigma_patch_edge(), + py.max_sigma_patch_edge(), + true); + + // finish setting up the interpatch ghost zones + if (print_msg_flag) + then CCTK_VInfo(CCTK_THORNSTRING, + " finishing interpatch setup"); + finish_interpatch_setup(pz, px, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(pz, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + finish_interpatch_setup(px, py, + patch_overlap_width, + ip_interp_handle, ip_interp_par_table_handle); + + assert_all_ghost_zones_fully_setup(); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function creates a pair of periodic-symmetry ghost zones. + // + // static + void patch_system::create_periodic_symmetry_ghost_zones(const patch_edge &ex, const patch_edge &ey, + bool ipar_map_is_plus) + { + ex.my_patch() + .create_periodic_symmetry_ghost_zone(ex, ey, ipar_map_is_plus); + + if (ex == ey) + then + { + // ex and ey are the same edge (i.e. the symmetry maps the edge + // back to itself), so we only want to set up the edge once + // ==> no-op here + } + else + ey.my_patch() + .create_periodic_symmetry_ghost_zone(ey, ex, ipar_map_is_plus); + } + + //****************************************************************************** + + // + // This function automagically figures out which edges of two adjacent + // patches are adjacent, then creates both patches' ghost zones on those + // edges and interlinks them with their respective patches. + // + // static + void patch_system::create_interpatch_ghost_zones(patch &px, patch &py, + int patch_overlap_width) + { + const patch_edge &ex = px.edge_adjacent_to_patch(py, patch_overlap_width); + const patch_edge &ey = py.edge_adjacent_to_patch(px, patch_overlap_width); + + px.create_interpatch_ghost_zone(ex, ey, patch_overlap_width); + py.create_interpatch_ghost_zone(ey, ex, patch_overlap_width); + } + + //****************************************************************************** + + // + // This function automagically figures out which edges of two adjacent + // patches are adjacent, then finishes setting up both ghost zones. + // + // static + void patch_system::finish_interpatch_setup(patch &px, patch &py, + int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle) + { + const patch_edge &ex = px.edge_adjacent_to_patch(py, patch_overlap_width); + const patch_edge &ey = py.edge_adjacent_to_patch(px, patch_overlap_width); + px.ghost_zone_on_edge(ex) + .cast_to_interpatch_ghost_zone() + .finish_setup(ip_interp_handle, ip_interp_par_table_handle); + py.ghost_zone_on_edge(ey) + .cast_to_interpatch_ghost_zone() + .finish_setup(ip_interp_handle, ip_interp_par_table_handle); + } + + //****************************************************************************** + + // + // This function assert()s that all ghost zones of all patches have + // been fully set up. + // + void patch_system::assert_all_ghost_zones_fully_setup() const + { + for (int pn = 0; pn < N_patches(); ++pn) + { + ith_patch(pn).assert_all_ghost_zones_fully_setup(); + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function decodes a patch system's type into N_patches. + // + // static + int patch_system::N_patches_of_type(enum patch_system_type type_in) + { + switch (type_in) + { + case patch_system__full_sphere: + return patch_system_info::full_sphere::N_patches; + case patch_system__plus_z_hemisphere: + return patch_system_info::plus_z_hemisphere::N_patches; + case patch_system__plus_xy_quadrant_mirrored: + case patch_system__plus_xy_quadrant_rotating: + return patch_system_info::plus_xy_quadrant::N_patches; + case patch_system__plus_xz_quadrant_mirrored: + case patch_system__plus_xz_quadrant_rotating: + return patch_system_info::plus_xz_quadrant::N_patches; + case patch_system__plus_xyz_octant_mirrored: + case patch_system__plus_xyz_octant_rotating: + return patch_system_info::plus_xyz_octant::N_patches; + default: + error_exit(PANIC_EXIT, + "***** patch_system::N_patches_of_type(): bad type=(int)%d!\n" + " (this should never happen!)\n", + int(type_in)); /*NOTREACHED*/ + } + } + + //****************************************************************************** + + // + // This function decodes a patch system's type into a human-readable + // type name (a C string). + // + // static + const char *patch_system::name_of_type(enum patch_system_type type_in) + { + switch (type_in) + { + case patch_system__full_sphere: + return "full sphere"; + case patch_system__plus_z_hemisphere: + return "+z hemisphere"; + case patch_system__plus_xy_quadrant_mirrored: + return "+xy quadrant (mirrored)"; + case patch_system__plus_xy_quadrant_rotating: + return "+xy quadrant (rotating)"; + case patch_system__plus_xz_quadrant_mirrored: + return "+xz quadrant (mirrored)"; + case patch_system__plus_xz_quadrant_rotating: + return "+xz quadrant (rotating)"; + case patch_system__plus_xyz_octant_mirrored: + return "+xyz octant (mirrored)"; + case patch_system__plus_xyz_octant_rotating: + return "+xyz octant (rotating)"; + default: + error_exit(PANIC_EXIT, + "***** patch_system::name_of_type(): bad type=(int)%d!\n" + " (this should never happen!)\n", + int(type_in)); /*NOTREACHED*/ + } + } + + //****************************************************************************** + + // + // This function encodes a human-readable type name (a C string) into + // a patch system's type into. + // + // static + enum patch_system::patch_system_type + patch_system::type_of_name(const char *name_in) + { + if (strcmp(name_in, "full sphere") == 0) + return patch_system__full_sphere; + else if (strcmp(name_in, "+z hemisphere") == 0) + return patch_system__plus_z_hemisphere; + else if (strcmp(name_in, "+xy quadrant (mirrored)") == 0) + return patch_system__plus_xy_quadrant_mirrored; + else if (strcmp(name_in, "+xy quadrant (rotating)") == 0) + return patch_system__plus_xy_quadrant_rotating; + else if (strcmp(name_in, "+xz quadrant (mirrored)") == 0) + return patch_system__plus_xz_quadrant_mirrored; + else if (strcmp(name_in, "+xz quadrant (rotating)") == 0) + return patch_system__plus_xz_quadrant_rotating; + else if (strcmp(name_in, "+xyz octant (mirrored)") == 0) + return patch_system__plus_xyz_octant_mirrored; + else if (strcmp(name_in, "+xyz octant (rotating)") == 0) + return patch_system__plus_xyz_octant_rotating; + else + error_exit(PANIC_EXIT, + "***** patch_system::type_of_name(): unknown name=\"%s\"!", + name_in); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function finds a (the) patch with a specified sign and xyz ctype. + // If no such patch exists, it does an error_exit() (and doesn't return + // to the caller). + // + // FIXME: + // - This function could be implemented to be very fast (using the + // patch numbers in patch_system_info::), but right now it just does + // a sequential search through all the patches, so it's pretty slow :( + // + const patch &patch_system::plus_or_minus_xyz_patch(bool is_plus, char ctype) + const + { + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + if ((p.is_plus() == is_plus) && (p.ctype() == ctype)) + then return p; + } + + error_exit(ERROR_EXIT, + "***** patch_system::plus_or_minus_xyz_patch():\n" + " can't find any %c%c patch!", + (is_plus ? '+' : '-'), ctype); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function finds a patch from its human-readable name, and returns + // the patch number, or does an error_exit() if no patch is found with + // the specified name. + // + int patch_system::patch_number_of_name(const char *name) const + { + for (int pn = 0; pn < N_patches(); ++pn) + { + if (strcmp(ith_patch(pn).name(), name) == 0) + return pn; + } + + error_exit(ERROR_EXIT, + "***** patch_system::patch_number_of_name():\n" + " no patch with name \"%s\"!\n", + name); /*NOTREACHED*/ + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function decodes a 0-origin grid point number into a + // (patch,irho,isigma) triple. + // + // Arguments: + // gpn = The grid point number to decode. + // (irho,isigma) = (out) The decoded patch coordinates. + // + // Results: + // This function returns a reference to the decoded patch. (An alternative + // design would be to return this via a patch*& argument, but the design + // used here seems slightly cleaner to use in practice.) + // + const patch & + patch_system::patch_irho_isigma_of_gpn(int gpn, int &irho, int &isigma) + const + { + assert(gpn >= 0); + assert(gpn < N_grid_points()); + + for (int pn = 0; pn < N_patches(); ++pn) + { + // n.b. [pn+1] is ok since starting_gpn_[] has size N_patches()+1 + if ((gpn >= starting_gpn_[pn]) && (gpn < starting_gpn_[pn + 1])) + then + { + const patch &p = ith_patch(pn); + const int gpn_in_patch = gpn - starting_gpn_[pn]; + assert(gpn_in_patch >= 0); + assert(gpn_in_patch < p.N_grid_points()); + p.irho_isigma_of_gpn(gpn_in_patch, irho, isigma); + return p; + } + } + + error_exit(PANIC_EXIT, + "***** patch_system::patch_irho_isigma_of_gpn(gpn=%d):\n" + " couldn't find any patch! (this should never happen!)\n" + " N_grid_points()=%d\n", + gpn, + N_grid_points()); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function decodes a 0-origin grid point number into a *ghosted* + // (patch,irho,isigma) triple. + // + // Arguments: + // gpn = The grid point number to decode. + // (irho,isigma) = (out) The decoded patch coordinates. + // + // Results: + // This function returns a reference to the decoded patch. (An alternative + // design would be to return this via a patch*& argument, but the design + // used here seems slightly cleaner to use in practice.) + // + const patch & + patch_system::ghosted_patch_irho_isigma_of_gpn(int gpn, int &irho, int &isigma) + const + { + assert(gpn >= 0); + assert(gpn < ghosted_N_grid_points()); + + for (int pn = 0; pn < N_patches(); ++pn) + { + // n.b. [pn+1] is ok since ghosted_starting_gpn_[] + // has size N_patches()+1 + if ((gpn >= ghosted_starting_gpn_[pn]) && (gpn < ghosted_starting_gpn_[pn + 1])) + then + { + const patch &p = ith_patch(pn); + const int gpn_in_patch = gpn - ghosted_starting_gpn_[pn]; + assert(gpn_in_patch >= 0); + assert(gpn_in_patch < p.ghosted_N_grid_points()); + p.ghosted_irho_isigma_of_gpn(gpn_in_patch, irho, isigma); + return p; + } + } + + error_exit(PANIC_EXIT, + "***** patch_system::ghosted_patch_irho_isigma_of_gpn(gpn=%d):\n" + " couldn't find any patch! (this should never happen!)\n" + " ghosted_N_grid_points()=%d\n", + gpn, + ghosted_N_grid_points()); /*NOTREACHED*/ + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function sets a (nominal-grid) gridfn to a constant value. + // + void patch_system::set_gridfn_to_constant(fp a, int dst_gfn) + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + p.gridfn(dst_gfn, irho, isigma) = a; + } + } + } + } + + //****************************************************************************** + + // + // This function copies one (nominal-grid) gridfn to another. + // + void patch_system::gridfn_copy(int src_gfn, int dst_gfn) + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + p.gridfn(dst_gfn, irho, isigma) = p.gridfn(src_gfn, irho, isigma); + } + } + } + } + + //****************************************************************************** + + // + // This function adds a scalar to a ghosted gridfn. + // + void patch_system::add_to_ghosted_gridfn(fp delta, int ghosted_dst_gfn) + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + for (int irho = p.ghosted_min_irho(); + irho <= p.ghosted_max_irho(); + ++irho) + { + for (int isigma = p.ghosted_min_isigma(); + isigma <= p.ghosted_max_isigma(); + ++isigma) + { + p.ghosted_gridfn(ghosted_dst_gfn, irho, isigma) += delta; + } + } + } + } + + //****************************************************************************** + + // + // Recentering + // + void patch_system::recentering(fp x, fp y, fp z) + { + global_coords_.recentering(x, y, z); + } + + //****************************************************************************** + + // + // This function computes norms of a nominal-grid gridfn. + // + void patch_system::gridfn_norms(int src_gfn, jtutil::norm &norms) + const + { + if (!is_valid_gfn(src_gfn)) + then error_exit(ERROR_EXIT, + "***** patch_system::gridfn_norms(): invalid src_gfn=%d!\n", + src_gfn); /*NOTREACHED*/ + + norms.reset(); + + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + norms.data(p.gridfn(src_gfn, irho, isigma)); + } + } + } + } + + //****************************************************************************** + + // + // This function computes norms of a ghosted-grid gridfn over the + // nominal grid. + // + void patch_system::ghosted_gridfn_norms(int ghosted_src_gfn, + jtutil::norm &norms) + const + { + if (!is_valid_ghosted_gfn(ghosted_src_gfn)) + then error_exit(ERROR_EXIT, + "***** patch_system::gridfn_norms(): invalid ghosted_src_gfn=%d!\n", + ghosted_src_gfn); /*NOTREACHED*/ + norms.reset(); + + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + for (int irho = p.min_irho(); irho <= p.max_irho(); ++irho) + { + for (int isigma = p.min_isigma(); + isigma <= p.max_isigma(); + ++isigma) + { + norms.data(p.ghosted_gridfn(ghosted_src_gfn, irho, isigma)); + } + } + } + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function computes an approximation to the circumference of a + // surface in the xy, xz, or yz plane. Note that we compute the full + // circumference all around the sphere, even if the patch system only + // covers a proper subset of this. + // + // We assume that adjacent patches are butt-joined, i.e. that their + // nominal boundaries just touch. + // + // Arguments: + // plane[] = (in) "xy", "xz", or "yz" to specify the integration plane. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp patch_system::circumference(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum patch::integration_method method) + const + { + // + // compute arc length around the patch system + // + fp arc_length = 0.0; + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + if ((p.ctype() == plane[0]) || (p.ctype() == plane[1])) + then arc_length += p.plane_arc_length(plane, + ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + } + + // + // correct the arc length + // for the fact that the patch system may not cover the full 2-sphere + // + switch (type()) + { + case patch_system__full_sphere: + break; + case patch_system__plus_z_hemisphere: + arc_length *= ((plane[0] == 'x') && (plane[1] == 'y')) ? 1.0 : 2.0; + break; + case patch_system__plus_xy_quadrant_mirrored: + case patch_system__plus_xy_quadrant_rotating: + arc_length *= ((plane[0] == 'x') && (plane[1] == 'y')) ? 4.0 : 2.0; + break; + case patch_system__plus_xz_quadrant_mirrored: + case patch_system__plus_xz_quadrant_rotating: + arc_length *= ((plane[0] == 'x') && (plane[1] == 'z')) ? 4.0 : 2.0; + break; + case patch_system__plus_xyz_octant_mirrored: + case patch_system__plus_xyz_octant_rotating: + arc_length *= 4.0; + break; + default: + error_exit(PANIC_EXIT, + "***** patch_system::circumference(): unknown patch system type()=(int)%d!\n" + " (this should never happen!)\n", + int(type())); /*NOTREACHED*/ + } + + return arc_length; + } + + //****************************************************************************** + + // + // This function computes an approximation to the (surface) integral of + // a gridfn over the 2-sphere + // $\int f(\rho,\sigma) \, dA$ + // = \int f(\rho,\sigma) \sqrt{|J|} \, d\rho \, d\sigma$ + // where $J$ is the Jacobian of $(x,y,z)$ with respect to $(rho,sigma). + // + // We assume that adjacent patches are butt-joined, i.e. that their + // nominal boundaries just touch. + // + // Arguments: + // unknown_src_gfn = (in) The gridfn to be integrated. This may be + // either nominal-grid or ghosted-grid. + // src_gfn_is_even_across_{xy,xz,yz}_plane + // = (in) Boolean flags specifying whether the gridfn to be integrated + // is even (true) or odd (false) across the corresponding planes. + // Only the flags corresponding to boundaries of the patch system + // are used. For example, for a plus_z_hemisphere patch system, + // only the src_gfn_is_even_across_xy_plane flag is used. + // ghosted_radius_gfn = (in) The surface radius. + // g_{xx,xy,xz,yy,yz,zz}_gfn = (in) The xyz 3-metric components. + // method = (in) Selects the integration scheme. + // + fp patch_system::integrate_gridfn(int unknown_src_gfn, + bool src_gfn_is_even_across_xy_plane, + bool src_gfn_is_even_across_xz_plane, + bool src_gfn_is_even_across_yz_plane, + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum patch::integration_method method) + const + { + // + // compute integral over patch system + // + fp integral = 0.0; + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + integral += p.integrate_gridfn(unknown_src_gfn, + ghosted_radius_gfn, + g_xx_gfn, g_xy_gfn, g_xz_gfn, + g_yy_gfn, g_yz_gfn, + g_zz_gfn, + method); + } + + // + // correct the integral + // for the fact that the patch system may not cover the full 2-sphere + // + switch (type()) + { + case patch_system__full_sphere: + break; + case patch_system__plus_z_hemisphere: + integral *= src_gfn_is_even_across_xy_plane ? 2.0 : 0.0; + break; + case patch_system__plus_xy_quadrant_mirrored: + case patch_system__plus_xy_quadrant_rotating: + integral *= src_gfn_is_even_across_xz_plane ? 2.0 : 0.0; + integral *= src_gfn_is_even_across_yz_plane ? 2.0 : 0.0; + break; + case patch_system__plus_xz_quadrant_mirrored: + case patch_system__plus_xz_quadrant_rotating: + integral *= src_gfn_is_even_across_xy_plane ? 2.0 : 0.0; + integral *= src_gfn_is_even_across_yz_plane ? 2.0 : 0.0; + break; + case patch_system__plus_xyz_octant_mirrored: + case patch_system__plus_xyz_octant_rotating: + integral *= src_gfn_is_even_across_xy_plane ? 2.0 : 0.0; + integral *= src_gfn_is_even_across_xz_plane ? 2.0 : 0.0; + integral *= src_gfn_is_even_across_yz_plane ? 2.0 : 0.0; + break; + default: + error_exit(PANIC_EXIT, + "***** patch_system::integrate_gridfn(): bad patch system type()=(int)%d!\n" + " (this should never happen!)\n", + int(type())); /*NOTREACHED*/ + } + + return integral; + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function finds what patch contains (the ray from the origin to) + // a given local (x,y,z) position. + // + // If there are multiple patches containing the position, we return the + // one which would still contain it if patches didn't overlap; if multiple + // patches satisfy this criterion then it's arbitrary which one we return. + // + // If no patch contains the position (this can only if the point as at + // the local coordinate origin, or for a non--full-sphere patch system), + // then we return a NULL pointer. + // + // Arguments: + // (x,y,z) = The local coordinates to be converted. + // + // Results: + // This function returns a reference to the containing patch. + // + const patch *patch_system::patch_containing_local_xyz(fp x, fp y, fp z) + const + { + if ((x == 0.0) && (y == 0.0) && (z == 0.0)) + then return NULL; + + // to which axis is (x,y,z) closest? + // ... or equivalently, which of |x|, |y|, and |z| is largest? + const fp abs_x = jtutil::abs(x); + const fp abs_y = jtutil::abs(y); + const fp abs_z = jtutil::abs(z); + + if ((abs_z >= abs_x) && (abs_z >= abs_y)) + then return &plus_or_minus_xyz_patch(z > 0.0, 'z'); // +/- z patch + else if ((abs_x >= abs_y) && (abs_x >= abs_z)) + then return &plus_or_minus_xyz_patch(x > 0.0, 'x'); // +/- x patch + else if ((abs_y >= abs_x) && (abs_y >= abs_z)) + then return &plus_or_minus_xyz_patch(y > 0.0, 'y'); // +/- y patch + else + error_exit(ERROR_EXIT, + "***** patch_system::patch_containing_local_xyz():\n" + " unknown (wierd!) ordering of |x|, |y|, and |z|!\n" + " (this should never happen!)\n" + " [local] (x,y,z)=(%g,%g,%g)\n", + double(x), double(y), double(z)); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function computes the radius of a patch-system 2-surface in the + // direction of a specified local (x,y,z) point, taking into account any + // patch-system symmetries. If the point coincides with the local origin, + // we return the dummy value 1.0. + // + // Bugs: + // Due to the surface-interpolator overhead, repeatedly calling this + // function is rather inefficient. + // + fp patch_system::radius_in_local_xyz_direction(int ghosted_radius_gfn, + fp x, fp y, fp z) + const + { + if ((x == 0.0) && (y == 0.0) && (z == 0.0)) + then return 1.0; + + // + // apply symmetries to map (x,y,z) into that part of the 2-sphere + // which is covered by the patch system + // + switch (type()) + { + case patch_system__full_sphere: + break; + case patch_system__plus_z_hemisphere: + z = fabs(z); + break; + case patch_system__plus_xy_quadrant_mirrored: + case patch_system__plus_xy_quadrant_rotating: + x = fabs(x); + y = fabs(y); + break; + case patch_system__plus_xz_quadrant_mirrored: + case patch_system__plus_xz_quadrant_rotating: + x = fabs(x); + z = fabs(z); + break; + case patch_system__plus_xyz_octant_mirrored: + case patch_system__plus_xyz_octant_rotating: + x = fabs(x); + y = fabs(y); + z = fabs(z); + break; + default: + error_exit(PANIC_EXIT, + "***** patch_system::radius_in_local_xyz_direction():\n" + " unknown patch system type()=(int)%d!\n" + " (this should never happen!)\n", + int(type())); /*NOTREACHED*/ + } + + const patch *p_ptr = patch_containing_local_xyz(x, y, z); + if (p_ptr == NULL) + then error_exit(ERROR_EXIT, + "***** patch_system::radius_in_local_xyz_direction():\n" + " can't find containing patch!\n" + " (this should never happen!)\n" + " [local] (x,y,z)=(%g,%g,%g)\n", + double(x), double(y), double(z)); /*NOTREACHED*/ + + const patch &p = *p_ptr; + const fp rho = p.rho_of_xyz(x, y, z); + const fp sigma = p.sigma_of_xyz(x, y, z); + + // + // Set up the surface interpolator to interpolate the surface radius + // gridfn to the (rho,sigma) coordinates: + // + // Notes on the interpolator setup: + // * The interpolator assumes Fortran subscripting, so we take the + // coordinates in the order (sigma,rho) to match our C subscripting + // in the patch system. + // * To avoid having to set up min/max array subscripts in the parameter + // table, we treat the patch as using 0-origin (integer) array subscripts + // (irho - ghosted_min_irho(), isigma - ghosted_min_isigma()). However, + // we use the usual floating-point coordinates. + // + + const int N_dims = 2; + const CCTK_REAL coord_origin[N_dims] = {p.ghosted_min_sigma(), p.ghosted_min_rho()}; + const CCTK_REAL coord_delta[N_dims] = {p.delta_sigma(), p.delta_rho()}; + + const int N_interp_points = 1; + const int interp_coords_type_code = CCTK_VARIABLE_REAL; + const void *const interp_coords[N_dims] = {static_cast(&sigma), static_cast(&rho)}; + + const int N_input_arrays = 1; + const CCTK_INT input_array_dims[N_dims] = {p.ghosted_N_isigma(), p.ghosted_N_irho()}; + const CCTK_INT input_array_type_codes[N_input_arrays] = {CCTK_VARIABLE_REAL}; + const void *const input_arrays[N_input_arrays] = { + static_cast( + p.ghosted_gridfn_data_array(ghosted_radius_gfn))}; + + const int N_output_arrays = 1; + const CCTK_INT output_array_type_codes[N_output_arrays] = {CCTK_VARIABLE_REAL}; + fp xyz_radius; + void *const output_arrays[N_output_arrays] = {static_cast(&xyz_radius)}; + + return xyz_radius; + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function prints an unknown-grid gridfn in ASCII format to a + // named output file. The output format is suitable for a gnuplot + // 'splot' command. (Individual patches may be selected with the + // select.patch program (perl script).) The output format is either + // # print_xyz_flag == false + // dpx dpy gridfn + // or + // # print_xyz_flag == true + // dpx dpy gridfn global_x global_y global_z + // where global_[xyz} are derived from the angular position and a + // specified (unknown-grid) radius gridfn. + // + void patch_system::print_unknown_gridfn(bool ghosted_flag, int unknown_gfn, + bool print_xyz_flag, bool radius_is_ghosted_flag, + int unknown_radius_gfn, + const char output_file_name[], bool want_ghost_zones) + const + { + if (want_ghost_zones && !ghosted_flag) + then error_exit(PANIC_EXIT, + "***** patch_system::print_unknown_gridfn(unknown_gfn=%d):\n" + " can't have want_ghost_zones && !ghosted_flag !\n", + unknown_gfn); /*NOTREACHED*/ + if (want_ghost_zones && print_xyz_flag && !radius_is_ghosted_flag) + then error_exit(PANIC_EXIT, + "***** patch_system::print_unknown_gridfn(unknown_gfn=%d):\n" + " can't have want_ghost_zones && print_xyz_flag\n" + " && !radius_is_ghosted_flag!\n" + " unknown_radius_gfn=%d\n", + unknown_gfn, + unknown_radius_gfn); /*NOTREACHED*/ + + FILE *output_fp = fopen(output_file_name, "w"); + if (output_fp == NULL) + then error_exit(ERROR_EXIT, + "***** patch_system::print_unknown_gridfn(unknown_gfn=%d):\n" + " can't open output file \"%s\"\n!", + unknown_gfn, + output_file_name); /*NOTREACHED*/ + + fprintf(output_fp, "# N_patches = %d\n", N_patches()); + fprintf(output_fp, "# origin = %.15g %.15g %.15g\n", + double(origin_x()), double(origin_y()), double(origin_z())); + fprintf(output_fp, "\n"); + + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + + fprintf(output_fp, "### %s patch\n", p.name()); + fprintf(output_fp, "# N_rho = %d\n", + p.effective_N_irho(want_ghost_zones)); + fprintf(output_fp, "# N_sigma = %d\n", + p.effective_N_isigma(want_ghost_zones)); + fprintf(output_fp, "# %s_gfn=%d\n", + (ghosted_flag ? "ghosted" : "nominal"), unknown_gfn); + fprintf(output_fp, "# dpx = %s\n", p.name_of_dpx()); + fprintf(output_fp, "# dpy = %s\n", p.name_of_dpy()); + fprintf(output_fp, "#\n"); + fprintf(output_fp, + print_xyz_flag + ? "# dpx\tdpy\tgridfn\tglobal_x\tglobal_y\tglobal_z\n" + : "# dpx\tdpy\tgridfn\n"); + + for (int irho = p.effective_min_irho(want_ghost_zones); + irho <= p.effective_max_irho(want_ghost_zones); + ++irho) + { + for (int isigma = p.effective_min_isigma(want_ghost_zones); + isigma <= p.effective_max_isigma(want_ghost_zones); + ++isigma) + { + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + const fp dpx = p.dpx_of_rho_sigma(rho, sigma); + const fp dpy = p.dpy_of_rho_sigma(rho, sigma); + fprintf(output_fp, + "%g\t%g\t%#.15g", + dpx, dpy, p.unknown_gridfn(ghosted_flag, unknown_gfn, irho, isigma)); + if (print_xyz_flag) + then + { + const fp r = p.unknown_gridfn(radius_is_ghosted_flag, + unknown_radius_gfn, + irho, isigma); + fp local_x, local_y, local_z; + p.xyz_of_r_rho_sigma(r, rho, sigma, + local_x, local_y, local_z); + const fp global_x = origin_x() + local_x; + const fp global_y = origin_y() + local_y; + const fp global_z = origin_z() + local_z; + fprintf(output_fp, + "\t%#.10g\t%#.10g\t%#.10g", + global_x, global_y, global_z); + } + fprintf(output_fp, "\n"); + } + fprintf(output_fp, "\n"); + } + fprintf(output_fp, "\n"); + } + + fclose(output_fp); + } + + //****************************************************************************** + + // + // This function reads an unknown-grid gridfn in ASCII format from + // a named input file. Comments ('#' in column 1) and blank lines + // are ignored, otherwise the input format matches that written by + // print_unknown_gridfn(): the first 3 numbers on each line are taken + // to be dpx, dpy, and the gridfn value; anything else on the line is + // ignored. + // + void patch_system::read_unknown_gridfn(bool ghosted_flag, int unknown_gfn, + const char input_file_name[], + bool want_ghost_zones) + { + if (want_ghost_zones && !ghosted_flag) + then error_exit(PANIC_EXIT, + "***** patch_system::read_unknown_gridfn(unknown_gfn=%d):\n" + " can't have want_ghost_zones && !ghosted_flag !\n", + unknown_gfn); /*NOTREACHED*/ + + FILE *input_fp = fopen(input_file_name, "r"); + if (input_fp == NULL) + then error_exit(ERROR_EXIT, + "***** patch_system::read_unknown_gridfn(unknown_gfn=%d):\n" + " can't open input file \"%s\"\n!", + unknown_gfn, + input_file_name); /*NOTREACHED*/ + + int line_number = 1; + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + + for (int irho = p.effective_min_irho(want_ghost_zones); + irho <= p.effective_max_irho(want_ghost_zones); + ++irho) + { + for (int isigma = p.effective_min_isigma(want_ghost_zones); + isigma <= p.effective_max_isigma(want_ghost_zones); + ++isigma) + { + const fp rho = p.rho_of_irho(irho); + const fp sigma = p.sigma_of_isigma(isigma); + const fp dpx = p.dpx_of_rho_sigma(rho, sigma); + const fp dpy = p.dpy_of_rho_sigma(rho, sigma); + + const int buffer_size = 250; + char buffer[buffer_size]; + // read/discard comments and blank lines + do + { + if (fgets(buffer, buffer_size, input_fp) == NULL) + then error_exit(ERROR_EXIT, + "***** patch::read_unknown_gridfn(%s patch, unknown_gfn=%d):\n" + " I/O error or unexpected end-of-file on input!\n" + " at irho=%d of [%d,%d], isigma=%d of [%d,%d]\n" + " dpx=%g dpy=%g\n", + p.name(), unknown_gfn, + irho, p.effective_min_irho(want_ghost_zones), + p.effective_max_irho(want_ghost_zones), + isigma, + p.effective_min_isigma(want_ghost_zones), + p.effective_max_isigma(want_ghost_zones), + dpx, dpy); /*NOTREACHED*/ + ++line_number; + } while ((buffer[0] == '#') || (buffer[0] == '\n')); + + double read_dpx, read_dpy, read_gridfn_value; + if (sscanf(buffer, "%lf %lf %lf", + &read_dpx, &read_dpy, &read_gridfn_value) != 3) + then error_exit(ERROR_EXIT, + "***** patch::read_unknown_gridfn(%s patch, unknown_gfn=%d):\n" + " bad input data at input line %d!\n", + p.name(), unknown_gfn, + line_number); /*NOTREACHED*/ + if (!(jtutil::fuzzy::EQ(read_dpx, dpx) && jtutil::fuzzy::EQ(read_dpy, dpy))) + then error_exit(ERROR_EXIT, + "***** patch::read_unknown_gridfn(%s patch, unknown_gfn=%d):\n" + " wrong (dpx,dpy) at input line %d!\n" + " expected (%g,%g)\n" + " read (%g,%g)\n", + p.name(), unknown_gfn, + line_number, + dpx, dpy, + read_dpx, read_dpy); /*NOTREACHED*/ + + p.unknown_gridfn(ghosted_flag, + unknown_gfn, irho, isigma) = read_gridfn_value; + } + } + } + + fclose(input_fp); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + + // + // This function "synchronizes" all ghost zones of all patches, i.e. it + // update the ghost-zone values of the specified gridfns via the appropriate + // sequence of symmetry operations and interpatch interpolations. This + // process is described in detail in the header comments in "ghost_zone.hh". + // + void patch_system::synchronize(int ghosted_min_gfn_to_sync, + int ghosted_max_gfn_to_sync) + { + // + // Phase 1: + // Fill in gridfn data at all the non-corner points of symmetry ghost + // zones, using the symmetries to get this data from its "home patch" + // nominal grids. + // + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + // n.b. these loops must use _int_ variables for the loop + // to terminate! + for (int want_min = false; want_min <= true; ++want_min) + { + for (int want_rho = false; want_rho <= true; ++want_rho) + { + ghost_zone &gz = p.minmax_ang_ghost_zone(want_min, want_rho); + if (gz.is_symmetry()) + then gz.synchronize(ghosted_min_gfn_to_sync, + ghosted_max_gfn_to_sync, + false, // want corners? + true); // want non-corner? + } + } + } + } + + // + // Phase 2: + // Fill in gridfn data in all the interpatch ghost zones, using interpatch + // interpolation from neighboring patches as described above. + // + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + // n.b. these loops must use _int_ variables for the loop + // to terminate! + for (int want_min = false; want_min <= true; ++want_min) + { + for (int want_rho = false; want_rho <= true; ++want_rho) + { + ghost_zone &gz = p.minmax_ang_ghost_zone(want_min, want_rho); + if (gz.is_interpatch()) + then gz.synchronize(ghosted_min_gfn_to_sync, + ghosted_max_gfn_to_sync); + } + } + } + } + + // + // Phase 3: + // Fill in gridfn data at all the corner points of symmetry ghost zones, + // using the symmetries to get this data from its "home patch" nominal + // grids or ghost zones. + // + { + for (int pn = 0; pn < N_patches(); ++pn) + { + patch &p = ith_patch(pn); + // n.b. these loops must use _int_ variables for the loop + // to terminate! + for (int want_min = false; want_min <= true; ++want_min) + { + for (int want_rho = false; want_rho <= true; ++want_rho) + { + ghost_zone &gz = p.minmax_ang_ghost_zone(want_min, want_rho); + if (gz.is_symmetry()) + then gz.synchronize(ghosted_min_gfn_to_sync, + ghosted_max_gfn_to_sync, + true, // want corners? + false); // want non-corner? + } + } + } + } + } + + //****************************************************************************** + + // + // This function does any precomputation necessary to compute the Jacobian + // of synchronize() , taking into account synchronize()'s full 3-phase + // algorithm. In practice, this means it computes the individual Jacobian + // of each ghost zone, and sets global_{min,max}_ym_ . + // + void patch_system::compute_synchronize_Jacobian(int ghosted_min_gfn_to_sync, + int ghosted_max_gfn_to_sync) + const + { + global_min_ym_ = +INT_MAX; + global_max_ym_ = -INT_MAX; + for (int pn = 0; pn < N_patches(); ++pn) + { + const patch &p = ith_patch(pn); + // n.b. these loops must use _int_ variables for the loop + // to terminate! + for (int want_min = false; want_min <= true; ++want_min) + { + for (int want_rho = false; want_rho <= true; ++want_rho) + { + ghost_zone &gz = p.minmax_ang_ghost_zone(want_min, want_rho); + // is dummy//gz.compute_Jacobian(ghosted_min_gfn_to_sync, ghosted_max_gfn_to_sync); + + global_min_ym_ = min(global_min_ym_, + gz.Jacobian_min_y_ipar_m()); + global_max_ym_ = max(global_max_ym_, + gz.Jacobian_max_y_ipar_m()); + } + } + } + } + + //****************************************************************************** + + // + // Given that compute_synchronize_Jacobian() has been called, this + // function computes the global min/max m over all ghost zone points. + // This is useful for sizing the buffer for synchronize_Jacobian(). + // + void patch_system::synchronize_Jacobian_global_minmax_ym(int &min_ym, int &max_ym) + const + { + min_ym = global_min_ym_; + max_ym = global_max_ym_; + } + + //****************************************************************************** + + // + // Given that compute_synchronize_Jacobian() has been called, this + // function computes a single row of the Jacobian, taking into account + // synchronize()'s 3-phase algorithm: + // - It returns the edge to which the y point belongs (the caller can get + // the patch from this edge). + // - It stores y_iperp and y_posn and min/max ym in the named arguments. + // - It stores the Jacobian elements + // partial synchronize() gridfn(ghosted_gfn, px, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial gridfn(ghosted_gfn, py, y_iperp, y_posn+ym) + // in the caller-supplied buffer + // Jacobian_buffer(ym) + // for each ym in the min/max ym range. + // + // In practice, the main task of this function is taking into account + // synchronize()'s 3-phase algorithm. There are several cases: + // - ghost zone is symmetry && x point is in non-corner + // ==> x value was computed by a phase 1 symmetry operation, + // using (only) nominal-grid data + // ==> overall Jacobian(x,y) = ghost zone Jacobian(x,y) + // - ghost zone is symmetry && x point is in corner + // --> x value was computed by a phase 3 symmetry operation, + // from some point (call it z), + // ==> overall Jacobian(x,y) = overall Jacobian(z,y) + // ==> call this function recursively to get z's Jacobian + // (z must be in the noncorner part of some ghost zone, + // so this won't lead to infinite recursion) + // - ghost zone is interpatch + // ==> x value was computed by a phase 2 interpatch interpolation + // - using (only) nominal-grid data + // ==> overall Jacobian(x,y) = ghost zone Jacobian(x,y) + // - using a mixture of nominal-grid data + // and data computed by a phase 1 symmetry operation + // ==> overall Jacobian(x,y) = "fold" ghost zone Jacobian(x,y) + // to take the phase 1 symmetry + // operation into account + // + const patch_edge & + patch_system::synchronize_Jacobian(const ghost_zone &xgz, + int x_iperp, int x_ipar, + int &y_iperp, + int &y_posn, int &min_ym, int &max_ym, + jtutil::array1d &Jacobian_buffer) + const + { + const patch_edge &xe = xgz.my_edge(); + + if (xgz.is_symmetry() && xe.ipar_is_in_noncorner(x_ipar)) + then + { + // ghost zone is symmetry && x point is in non-corner + // ==> x value was computed by a phase 1 symmetry operation, + // using (only) nominal-grid data + // ==> overall Jacobian(x,y) = ghost zone Jacobian(x,y) + return ghost_zone_Jacobian(xgz, + x_iperp, x_ipar, + y_iperp, + y_posn, min_ym, max_ym, + Jacobian_buffer); + } + + else if (xgz.is_symmetry() && xe.ipar_is_in_corner(x_ipar)) + then + { + // ghost zone is symmetry && x point is in corner + // --> x value was computed by a phase 3 symmetry operation, + // from some point (call it z), + // ==> overall Jacobian(x,y) = overall Jacobian(z,y) + // ==> call this function recursively to get z's Jacobian + // (z must be in the noncorner part of some ghost zone, + // so this won't lead to infinite recursion) + + const patch &zp = xgz.other_patch(); + const patch_edge &ze = xgz.other_edge(); + const symmetry_ghost_zone &xsgz = xgz.cast_to_symmetry_ghost_zone(); + const int z_iperp = xsgz.iperp_map_of_iperp(x_iperp); + const int z_ipar = xsgz.ipar_map_of_ipar(x_ipar); + + // + // Computing z's edge/ghost zone is tricky. For example: + // | + // p1 e3|e4 p2 + // | + // | z + // -----------e1-----------+------------e2--------- + // | x + // | + // Here the point x in the corner of p1's e1 ghost zone, + // is computed by the phase 3 symmetry operation (a reflection + // about e1) from z. Thus zp == p1 and ze == e1. + // + // But we need to "turn the corner" to compute z's "true" edge + // e3 (so we can recursively call this function to compute z's + // Jacobian). Thus we explicitly check which ghost zone of p1 + // (here the e3 ghost zone) contains the point z. + // + const int z_irho = ze.irho_of_iperp_ipar(z_iperp, z_ipar); + const int z_isigma = ze.isigma_of_iperp_ipar(z_iperp, z_ipar); + const ghost_zone &true_zgz = zp.ghost_zone_containing_noncorner_point(z_irho, z_isigma); + const patch_edge &true_ze = true_zgz.my_edge(); + const int true_z_iperp = true_ze.iperp_of_irho_isigma(z_irho, z_isigma); + const int true_z_ipar = true_ze.ipar_of_irho_isigma(z_irho, z_isigma); + + // make sure we have the right ghost zone! + assert(true_zgz.is_in_ghost_zone(true_z_iperp, true_z_ipar)); + + return synchronize_Jacobian(true_zgz, + true_z_iperp, true_z_ipar, + y_iperp, + y_posn, min_ym, max_ym, + Jacobian_buffer); + } + + else if (xgz.is_interpatch()) + then + { + // ghost zone is interpatch + // ==> x value was computed by a phase 2 interpatch interpolation + // - using (only) nominal-grid data + // ==> overall Jacobian(x,y) = ghost zone Jacobian(x,y) + // - using a mixture of nominal-grid data + // and data computed by a phase 1 symmetry operation + // ==> overall Jacobian(x,y) = "fold" ghost zone Jacobian(x,y) + // to take the phase 1 symmetry + // operation into account + // + // For example, + // | + // xp xe|ye a yp + // | b + // | xc + // ----------xse-----------+---d-------yse---------- + // | e + // | + // here point x is computed by interpatch-interpolating in the + // par direction from the 5 y points abcde. e is outside the + // nominal grid, so its Jacobian must be "folded" over to c. + // Notice that this "folding" must be done about the edge yse, + // *not* about ye itself. + + // Jacobian of the phase 2 interpatch interpolation + const patch_edge &ye = ghost_zone_Jacobian(xgz, + x_iperp, x_ipar, + y_iperp, + y_posn, min_ym, max_ym, + Jacobian_buffer); + const int min_y_ipar = y_posn + min_ym; + const int max_y_ipar = y_posn + max_ym; + + // fold any points in the Jacobian outside the nominal grid + if (ye.ipar_is_in_min_ipar_corner(min_y_ipar)) + then + { + fold_Jacobian(ye, ye.min_par_adjacent_edge(), + y_iperp, + y_posn, min_ym, max_ym, + min_ym, ye.min_ipar_corner__max_ipar() - y_posn, + Jacobian_buffer); + min_ym = ye.min_ipar_without_corners() - y_posn; + } + if (ye.ipar_is_in_max_ipar_corner(max_y_ipar)) + then + { + fold_Jacobian(ye, ye.max_par_adjacent_edge(), + y_iperp, + y_posn, min_ym, max_ym, + ye.max_ipar_corner__min_ipar() - y_posn, max_ym, + Jacobian_buffer); + max_ym = ye.max_ipar_without_corners() - y_posn; + } + + return ye; + } + + else + error_exit(PANIC_EXIT, + "***** patch_system::synchronize_Jacobian():\n" + " don't know what to do with ghost zone (this should never happen)!\n" + " xgz.my_patch()=\"%s\" xe=xgz.my_edge()=\"%s\"\n" + " xgz.other_patch()=\"%s\" xgz.other_edge()=\"%s\"\n" + " xgz.is_symmetry()=(int)%d xgz.is_interpatch()=(int)%d\n" + " x_iperp=%d x_ipar=%d\n" + " xe.ipar_is_in_{min,max}_ipar_corner(x_ipar)=(int){%d,%d}\n" + " xe.ipar_is_in_{corner,noncorner}(x_ipar)=(int){%d,%d}\n", + xgz.my_patch().name(), xe.name(), + xgz.other_patch().name(), xgz.other_edge().name(), + int(xgz.is_symmetry()), int(xgz.is_interpatch()), + x_iperp, x_ipar, + xe.ipar_is_in_min_ipar_corner(x_ipar), + xe.ipar_is_in_max_ipar_corner(x_ipar), + xe.ipar_is_in_corner(x_ipar), + xe.ipar_is_in_noncorner(x_ipar)); /*NOTREACHED*/ + } + + //****************************************************************************** + + // + // This function "folds" part of a(n interpatch) Jacobian row to take + // a symmetry operation into account. For example: + // | + // |e_Jac + // | p + // | a + // | b + // | c=y + // ---------+---d-------e_fold------- + // | e=x sgz_fold + // | + // Here the Jacobian abcde is to be "folded", because e is outside the + // nominal grid (its Jacobian must be "folded" over to c). + // + // Notice that the folding (about the edge e_fold) is in the par direction + // with respect to e_Jac, but the perp direction with respect to e_fold. + // Since e_fold and e_Jac are adjacent edges, + // e_Jac (iperp,ipar) == e_fold (ipar,iperp) + // + // Arguments: + // e_Jac = edge which the Jacobian lies along + // e_fold = edge about which to fold; the corresponding ghost zone must be + // symmetry ghost zone, and at present we only support the case + // where this is a "local" (mirror-image) symmetry ghost zone + // iperp = iperp-wrt-e_Jac coordinate of Jacobian + // posn = ipar-wrt-e_Jac coordinate of Jacobian molecule reference point + // [min,max]_m = range of ipar-wrt-e_Jac molecule m in Jacobian + // [min,max]_fold_m = range of ipar-wrt-e_Jac molecule m which is to folded; + // this must be a subrange of [min,max]_m + // + void patch_system::fold_Jacobian(const patch_edge &e_Jac, + const patch_edge &e_fold, + int iperp, + int posn, int min_m, int max_m, + int min_fold_m, int max_fold_m, + jtutil::array1d &Jacobian_buffer) + const + { + // check that [min,max]_fold_m is a subrange of [min,max]_m + assert(min_fold_m >= min_m); + assert(min_fold_m <= max_m); + assert(max_fold_m >= min_m); + assert(max_fold_m <= max_m); + + const patch &p = e_fold.my_patch(); + assert(e_Jac.my_patch() == p); + + const symmetry_ghost_zone &sgz_fold = p.ghost_zone_on_edge(e_fold) + .cast_to_symmetry_ghost_zone(); + + // + // At present we only handle the case show in the comments above, + // where sgz_fold is a local (mirror-image) symmetry, i.e. where + // y is guaranteed to be within the molecule abcde. + // + if (sgz_fold.other_edge() != e_fold) + then error_exit(ERROR_EXIT, + "***** patch_system::fold_Jacobian()\n" + " implementation restriction: at present we only handle folding\n" + " via \"local\" (mirror-image) symmetries!\n" + " p=\"%s\" e_Jac=\"%s\" e_fold=\"%s\"\n" + " but sgz_fold.other_edge()=\"%s\" != e_fold\n", + p.name(), e_Jac.name(), e_fold.name(), + sgz_fold.other_edge().name()); /*NOTREACHED*/ + + for (int xm = min_fold_m; xm <= max_fold_m; ++xm) + { + const int x_Jac_ipar = posn + xm; // x ipar wrt e_Jac + const int x_fold_iperp = x_Jac_ipar; // ... == iperp wrt e_fold + + const int y_fold_iperp = sgz_fold.iperp_map_of_iperp(x_fold_iperp); + // y iperp wrt e_fold + const int y_Jac_ipar = y_fold_iperp; // ... == ipar wrt e_Jac + const int ym = y_Jac_ipar - posn; + + // check that y is indeed within the molecule + assert(ym >= min_m); + assert(ym <= max_m); + + // actually "fold" the molecule + Jacobian_buffer(ym) += Jacobian_buffer(xm); + } + } + + //****************************************************************************** + + // + // Given that compute_synchronize_Jacobian() has been called, this + // function computes a single row of the Jacobian of a given ghost zone, + // *not* taking into account synchronize()'s 3-phase algorithm: + // - It returns the edge to which the y point belongs (the caller can get + // the patch from this edge). + // - It stores y_iperp and y_posn and min/max ym in the named arguments. + // - It stores the Jacobian elements + // partial synchronize() gridfn(ghosted_gfn, px, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial gridfn(ghosted_gfn, py, y_iperp, y_posn+ym) + // in the caller-supplied buffer + // Jacobian_buffer(ym) + // for each ym in the min/max ym range + // + const patch_edge & + patch_system::ghost_zone_Jacobian(const ghost_zone &xgz, + int x_iperp, int x_ipar, + int &y_iperp, + int &y_posn, int &min_ym, int &max_ym, + jtutil::array1d &Jacobian_buffer) + const + { + y_iperp = xgz.Jacobian_y_iperp(x_iperp); + + y_posn = xgz.Jacobian_y_ipar_posn(x_iperp, x_ipar); + min_ym = xgz.Jacobian_min_y_ipar_m(); + max_ym = xgz.Jacobian_max_y_ipar_m(); + + for (int ym = min_ym; ym <= max_ym; ++ym) + { + Jacobian_buffer(ym) = xgz.Jacobian(x_iperp, x_ipar, ym); + } + + return xgz.other_edge(); + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/patch_system.h b/AMSS_NCKU_source/patch_system.h new file mode 100644 index 0000000..0d91c1c --- /dev/null +++ b/AMSS_NCKU_source/patch_system.h @@ -0,0 +1,595 @@ +#ifndef TPATCH_SYSTEM_H +#define TPATCH_SYSTEM_H +namespace AHFinderDirect +{ + + //****************************************************************************** + + // + // A patch_system object describes a system of interlinked patches. + // + // Its const qualifiers refer (only) to the gridfn data. Notably, this + // means that synchronize() is a non-const function (it modifies gridfn + // data), while synchronize_Jacobian() et al are const functions (they + // don't modify gridfn data) even though they may update other internal + // state in the patch_system object and its subobjects. + // + + class patch_system + { + // + // ***** static data & functions describing patch systems ***** + // + public: + // what patch-system type are supported? + // (see "patch_system_info.hh" for detailed descriptions of these) + enum patch_system_type + { + patch_system__full_sphere, + patch_system__plus_z_hemisphere, + patch_system__plus_xy_quadrant_mirrored, + patch_system__plus_xy_quadrant_rotating, + patch_system__plus_xz_quadrant_mirrored, + patch_system__plus_xz_quadrant_rotating, + patch_system__plus_xyz_octant_mirrored, + patch_system__plus_xyz_octant_rotating + }; + + // maximum number of patches in any patch-system type + static const int max_N_patches = 6; + + // decode patch system type into N_patches + static int N_patches_of_type(enum patch_system_type type_in); + + // patch system type <--> human-readable character-string name + static const char *name_of_type(enum patch_system_type type_in); + static enum patch_system_type type_of_name(const char *name_in); + + // + // ***** coordinates ***** + // + public: +#ifdef NOT_USED + // global (x,y,z) --> local (x,y,z) + fp local_x_of_global_x(fp global_x) const + { + return global_coords_.local_x_of_global_x(global_x); + } + fp local_y_of_global_y(fp global_y) const + { + return global_coords_.local_y_of_global_y(global_y); + } + fp local_z_of_global_z(fp global_z) const + { + return global_coords_.local_z_of_global_z(global_z); + } +#endif /* NOT_USED */ + +#ifdef NOT_USED + // local (x,y,z) --> global (x,y,z) + fp global_x_of_local_x(fp local_x) const + { + return global_coords_.global_x_of_local_x(local_x); + } + fp global_y_of_local_y(fp local_y) const + { + return global_coords_.global_y_of_local_y(local_y); + } + fp global_z_of_local_z(fp local_z) const + { + return global_coords_.global_z_of_local_z(local_z); + } +#endif /* NOT_USED */ + + // get global (x,y,z) coordinates of local origin point + fp origin_x() const { return global_coords_.origin_x(); } + fp origin_y() const { return global_coords_.origin_y(); } + fp origin_z() const { return global_coords_.origin_z(); } + + // + // ***** meta-info about the entire patch system ***** + // + public: + // patch-system type + enum patch_system_type type() const { return type_; } + + // total number of patches + int N_patches() const { return N_patches_; } + + // get patches by patch number + const patch &ith_patch(int pn) const + { + return *all_patches_[pn]; + } + patch &ith_patch(int pn) + { + return *all_patches_[pn]; + } + + // find a patch by +/- xyz "ctype" + // FIXME: the present implementation of this function is quite slow + const patch &plus_or_minus_xyz_patch(bool is_plus, char ctype) + const; + + // find a patch by name, return patch number; error_exit() if not found + int patch_number_of_name(const char *name) const; + + // total number of grid points + int N_grid_points() const { return N_grid_points_; } + int ghosted_N_grid_points() const { return ghosted_N_grid_points_; } + + // + // ***** meta-info about gridfns ***** + // + public: + int min_gfn() const { return ith_patch(0).min_gfn(); } + int max_gfn() const { return ith_patch(0).max_gfn(); } + int N_gridfns() const { return ith_patch(0).N_gridfns(); } + bool is_valid_gfn(int gfn) const + { + return ith_patch(0).is_valid_gfn(gfn); + } + int ghosted_min_gfn() const { return ith_patch(0).ghosted_min_gfn(); } + int ghosted_max_gfn() const { return ith_patch(0).ghosted_max_gfn(); } + int ghosted_N_gridfns() const + { + return ith_patch(0).ghosted_N_gridfns(); + } + bool is_valid_ghosted_gfn(int ghosted_gfn) const + { + return ith_patch(0).is_valid_ghosted_gfn(ghosted_gfn); + } + + // + // ***** synchronize() and its Jacobian ***** + // + public: + // "synchronize" all ghost zones of all patches, + // i.e. update the ghost-zone values of the specified gridfns + // via the appropriate sequence of symmetry operations + // and interpatch interpolations + void synchronize(int ghosted_min_gfn_to_sync, + int ghosted_max_gfn_to_sync); + + // ... do this for all ghosted gridfns + void synchronize() + { + synchronize(ghosted_min_gfn(), + ghosted_max_gfn()); + } + + // + // do any precomputation necessary to compute Jacobian of + // synchronize() , taking into account synchronize()'s + // full 3-phase algorithm + // + void compute_synchronize_Jacobian(int ghosted_min_gfn_to_sync, + int ghosted_max_gfn_to_sync) + const; + + // ... do this for all ghosted gridfns + void compute_synchronize_Jacobian() + const + { + compute_synchronize_Jacobian(ghosted_min_gfn(), + ghosted_max_gfn()); + } + + // + // The following functions access the Jacobian computed by + // compute_synchronize_Jacobian() . Note this API is rather + // different than that of ghost_zone::comute_Jacobian() et al: + // here we must take into account synchronize()'s full 3-phase + // algorithm, and this may lead to a more general Jacobian + // structure. + // + // This API still implicitly assumes that the Jacobian is + // independent of ghosted_gfn , and that the set of y points + // (with nonzero Jacobian values) in a single row of the Jacobian + // matrix (i.e. the set of points on which a single ghost-zone + // point depends), + // - lies entirely within a single y patch + // - has a single yiperp value + // - have a contiguous interval of yipar; we parameterize this + // interval as yipar = posn+m + // + + // what are the global min/max m over all ghost zone points? + // (this is useful for sizing the buffer for synchronize_Jacobian()) + void synchronize_Jacobian_global_minmax_ym(int &min_ym, int &max_ym) + const; + + // compute a single row of the Jacobian: + // - return value is edge to which y point belongs + // (caller can get patch from this edge) + // - store y_iperp and y_posn and min/max ym in named arguments + // - stores the Jacobian elements + // partial synchronize() gridfn(ghosted_gfn, px, x_iperp, x_ipar) + // ------------------------------------------------------------- + // partial gridfn(ghosted_gfn, py, y_iperp, y_posn+ym) + // (taking into account synchronize()'s full 3-phase algorithm) + // in the caller-supplied buffer + // Jacobian_buffer(ym) + // for each ym in the min/max ym range + const patch_edge & + synchronize_Jacobian(const ghost_zone &xgz, + int x_iperp, int x_ipar, + int &y_iperp, + int &y_posn, int &min_ym, int &max_ym, + jtutil::array1d &Jacobian_buffer) + const; + + // helper functions for synchronize_Jacobian(): + private: + // "fold" (part of) a Jacobian row + // to take a symmetry operation into acount + // e_Jac = edge which the Jacobian lies along + // e_fold = edge about which to fold + // [min,max]_m = range of m in the Jacobian + // [min,max]_fold_m = range of m to fold + // (must be a subrange of {min,max}_m) + void fold_Jacobian(const patch_edge &e_Jac, const patch_edge &e_fold, + int iperp, + int posn, int min_m, int max_m, + int min_fold_m, int max_fold_m, + jtutil::array1d &Jacobian_buffer) + const; + + // compute the Jacobian of ghost zone's synchronize() + // *without* taking into account 3-phase algorithm + const patch_edge & + ghost_zone_Jacobian(const ghost_zone &xgz, + int x_iperp, int x_ipar, + int &y_iperp, + int &y_posn, int &min_ym, int &max_ym, + jtutil::array1d &Jacobian_buffer) + const; + + // + // ***** gridfn operations ***** + // + public: + // dst = a + void set_gridfn_to_constant(fp a, int dst_gfn); + + // dst = src + void gridfn_copy(int src_gfn, int dst_gfn); + + // dst += delta + void add_to_ghosted_gridfn(fp delta, int ghosted_dst_gfn); + + void recentering(fp x, fp y, fp z); + + // compute norms of gridfn (only over nominal grid) + void gridfn_norms(int src_gfn, jtutil::norm &norms) + const; + void ghosted_gridfn_norms(int ghosted_src_gfn, jtutil::norm &norms) + const; + + // + // ***** testing (x,y,z) point position versus a surface ***** + // + + // find patch containing (ray from origin to) given local (x,y,z) + // ... if there are multiple patches containing the position, + // we return the one which would still contain it if patches + // didn't overlap; if multiple patches satisfy this criterion + // then it's arbitrary which one we return + // ... if no patch contains the position (for a non--full-sphere + // patch system), or the position is at the origin, then + // we return a NULL pointer + const patch *patch_containing_local_xyz(fp x, fp y, fp z) + const; + + // radius of surface in direction of an (x,y,z) point, + // taking into account any patch-system symmetries; + // or dummy value 1.0 if point is identical to local origin + // + // FIXME: + // We should provide another API to compute this for a whole + // batch of points at once, since this would be more efficient + // (the interpolator overhead would be amortized over the whole batch) + fp radius_in_local_xyz_direction(int ghosted_radius_gfn, + fp x, fp y, fp z) + const; + + // + // ***** line/surface operations ***** + // + + // compute the circumference of a surface in the {xy, xz, yz} plane + // ... note this is the full circumference all around the sphere, + // even if the patch system only covers a proper subset of this + // ... the implementation assumes adjacent patches are butt-joined + // ... plane must be one of "xy", "xz", or "yz" + fp circumference(const char plane[], + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum patch::integration_method method) + const; + + // compute the surface integral of a gridfn over the 2-sphere + // $\int f(\rho,\sigma) \, dA$ + // = \int f(\rho,\sigma) \sqrt{|J|} \, d\rho \, d\sigma$ + // where $J$ is the Jacobian of $(x,y,z)$ with respect to $(rho,sigma) + // ... integration method selected by method argument + // ... src gridfn may be either nominal-grid or ghosted-grid + // ... Boolean flags src_gfn_is_even_across_{xy,xz,yz}_planes + // specify whether the gridfn to be integrated is even (true) + // or odd (false) across the corresponding planes. Only the + // flags corresponding to boundaries of the patch system are + // used. For example, for a plus_z_hemisphere patch system, + // only the src_gfn_is_even_across_xy_plane flag is used. + // ... note integral is over the full 2-sphere, + // even if the patch system only covers a proper subset of this + // ... the implementation assumes adjacent patches are butt-joined + fp integrate_gridfn(int unknown_src_gfn, + bool src_gfn_is_even_across_xy_plane, + bool src_gfn_is_even_across_xz_plane, + bool src_gfn_is_even_across_yz_plane, + int ghosted_radius_gfn, + int g_xx_gfn, int g_xy_gfn, int g_xz_gfn, + int g_yy_gfn, int g_yz_gfn, + int g_zz_gfn, + enum patch::integration_method method) + const; + + // + // ***** I/O ***** + // + public: + // print to a named file (newly (re)created) + // output format is + // dpx dpy gridfn + void print_gridfn(int gfn, const char output_file_name[]) const + { + print_unknown_gridfn(false, gfn, + false, false, 0, + output_file_name, false); + } + void print_ghosted_gridfn(int ghosted_gfn, + const char output_file_name[], + bool want_ghost_zones = true) + const + { + print_unknown_gridfn(true, ghosted_gfn, + false, false, 0, + output_file_name, want_ghost_zones); + } + + // print to a named file (newly (re)created) + // output format is + // dpx dpy gridfn global_x global_y global_z + // where global_[xyz} are derived from the angular position + // and a specified (unknown-grid) radius gridfn + void print_gridfn_with_xyz(int gfn, + bool radius_is_ghosted_flag, int unknown_radius_gfn, + const char output_file_name[]) + const + { + print_unknown_gridfn(false, gfn, + true, radius_is_ghosted_flag, + unknown_radius_gfn, + output_file_name, false); + } + void print_ghosted_gridfn_with_xyz(int ghosted_gfn, + bool radius_is_ghosted_flag, int unknown_radius_gfn, + const char output_file_name[], + bool want_ghost_zones = true) + const + { + print_unknown_gridfn(true, ghosted_gfn, + true, radius_is_ghosted_flag, + unknown_radius_gfn, + output_file_name, want_ghost_zones); + } + + public: + // read from a named file + void read_gridfn(int gfn, const char input_file_name[]) + { + read_unknown_gridfn(false, gfn, input_file_name, false); + } + void read_ghosted_gridfn(int ghosted_gfn, + const char input_file_name[], + bool want_ghost_zones = true) + { + read_unknown_gridfn(true, ghosted_gfn, + input_file_name, want_ghost_zones); + } + + private: + // ... internal worker functions + void print_unknown_gridfn(bool ghosted_flag, int unknown_gfn, + bool print_xyz_flag, bool radius_is_ghosted_flag, + int unknown_radius_gfn, + const char output_file_name[], bool want_ghost_zones) + const; + void read_unknown_gridfn(bool ghosted_flag, int unknown_gfn, + const char input_file_name[], + bool want_ghost_zones); + + // + // ***** access to gridfns as 1-D arrays ***** + // + // ... n.b. this interface implicitly assumes that gridfn data + // arrays are contiguous across patches; this is ensured by + // setup_gridfn_storage() (called by our constructor) + // + public: + // convert (patch,irho,isigma) <--> 1-D 0-origin grid point number (gpn) + int gpn_of_patch_irho_isigma(const patch &p, int irho, int isigma) + const + { +#ifdef DEBUG_AHFD + printf(" <%d> ", isigma); +#endif + return starting_gpn_[p.patch_number()] + p.gpn_of_irho_isigma(irho, isigma); + } + int ghosted_gpn_of_patch_irho_isigma(const patch &p, + int irho, int isigma) + const + { + return ghosted_starting_gpn_[p.patch_number()] + p.ghosted_gpn_of_irho_isigma(irho, isigma); + } + // ... n.b. we return patch as a reference via the function result; + // an alternative would be to have a patch*& argument + const patch & + patch_irho_isigma_of_gpn(int gpn, int &irho, int &isigma) + const; + const patch & + ghosted_patch_irho_isigma_of_gpn(int gpn, int &irho, int &isigma) + const; + + // access actual gridfn data arrays + // (low-level, dangerous, use with caution) + const fp *gridfn_data(int gfn) const + { + return ith_patch(0).gridfn_data_array(gfn); + } + fp *gridfn_data(int gfn) + { + return ith_patch(0).gridfn_data_array(gfn); + } + const fp *ghosted_gridfn_data(int ghosted_gfn) const + { + return ith_patch(0).ghosted_gridfn_data_array(ghosted_gfn); + } + fp *ghosted_gridfn_data(int ghosted_gfn) + { + return ith_patch(0).ghosted_gridfn_data_array(ghosted_gfn); + } + + // + // ***** constructor, destructor ***** + // + // This constructor doesn't support the full generality of the + // patch data structures (which would, eg, allow ghost_zone_width + // and patch_extend_width and the interpolator parameters to vary + // from ghost zone to ghost zone, and the grid spacings to vary + // from patch to patch. But in practice we'd probably never + // use that generality... + // + public: + patch_system(fp origin_x_in, fp origin_y_in, fp origin_z_in, + enum patch_system_type type_in, + int ghost_zone_width, int patch_overlap_width, + int N_zones_per_right_angle, + int min_gfn_in, int max_gfn_in, + int ghosted_min_gfn_in, int ghosted_max_gfn_in, + int ip_interp_handle_in, int ip_interp_par_table_handle_in, + int surface_interp_handle_in, + int surface_interp_par_table_handle_in, + bool print_summary_msg_flag, bool print_detailed_msg_flag); + ~patch_system(); + + // + // ***** helper functions for constructor ***** + // + private: + // construct patches as described by patch_info[] array, + // and link them into the patch system + // does *NOT* create ghost zones + // does *NOT* set up gridfns + void create_patches(const struct patch_info patch_info_in[], + int ghost_zone_width, int patch_extend_width, + int N_zones_per_right_angle, + bool print_msg_flag); + + // setup all gridfns with contiguous-across-patches storage + void setup_gridfn_storage(int min_gfn_in, int max_gfn_in, + int ghosted_min_gfn_in, int ghosted_max_gfn_in, + bool print_msg_flag); + + // setup (create/interlink) all ghost zones + void setup_ghost_zones__full_sphere(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_z_hemisphere(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xy_quadrant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xy_quadrant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xz_quadrant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xz_quadrant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xyz_octant_mirrored(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + void setup_ghost_zones__plus_xyz_octant_rotating(int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle, + bool print_msg_flag); + + // create/interlink a pair of periodic-symmetry ghost zones + static void create_periodic_symmetry_ghost_zones(const patch_edge &ex, const patch_edge &ey, + bool ipar_map_is_plus); + + // construct a pair of interpatch ghost zones + // ... automagically figures out which edges are adjacent + static void create_interpatch_ghost_zones(patch &px, patch &py, + int patch_overlap_width); + + // finish setup of a pair of interpatch ghost zones + // ... automagically figures out which edges are adjacent + static void finish_interpatch_setup(patch &px, patch &py, + int patch_overlap_width, + int ip_interp_handle, int ip_interp_par_table_handle); + + // assert() that all ghost zones of all patches are fully setup + void assert_all_ghost_zones_fully_setup() const; + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + patch_system(const patch_system &rhs); + patch_system &operator=(const patch_system &rhs); + + private: + // local <--> global coordinate mapping + global_coords global_coords_; + + // meta-info about patch system + enum patch_system_type type_; + int N_patches_; + int N_grid_points_, ghosted_N_grid_points_; + + // [pn] = --> individual patches + // *** constructor initialization list ordering: + // *** this must be declared after N_patches_ + patch **all_patches_; + + // [pn] = starting grid point number of individual patches + // ... arrays are actually of size N_patches_+1, the [N_patches_] + // entries are == N_grid_points_ and ghosted_N_grid_points_ + // *** constructor initialization list ordering: + // *** these must be declared after N_patches_ + int *starting_gpn_; + int *ghosted_starting_gpn_; + + // pointers to storage blocks for all gridfns + // ... patches point into these, but we own the storage blocks + fp *gridfn_storage_; + fp *ghosted_gridfn_storage_; + + // min/max m over all ghost zone points + mutable int global_min_ym_, global_max_ym_; + + // info about the surface interpolator + // ... used only by radius_in_local_xyz_direction() + int surface_interp_handle_, surface_interp_par_table_handle_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* TPATCH_SYSTEM_H */ diff --git a/AMSS_NCKU_source/patch_system_info.h b/AMSS_NCKU_source/patch_system_info.h new file mode 100644 index 0000000..6404805 --- /dev/null +++ b/AMSS_NCKU_source/patch_system_info.h @@ -0,0 +1,183 @@ +#ifndef TPATCH_SYSTEM_INFO_H +#define TPATCH_SYSTEM_INFO_H +namespace AHFinderDirect +{ + + //****************************************************************************** + + // + // This namespace contains static data describing the patch sizes and + // shapes for each type of patch system. Since this data only describes + // the patch sizes/shapes, we don't distinguish between the different + // boundary conditions. + // + + namespace patch_system_info + { + // + // full-sphere patch system + // ... covers all 4pi steradians + // + namespace full_sphere + { + enum + { + patch_number__pz = 0, + patch_number__px, + patch_number__py, + patch_number__mx, + patch_number__my, + patch_number__mz, + N_patches // no comma + }; + static const struct patch_info patch_info_array[N_patches] = { + // +z patch (90 x 90 degrees): dmu [ -45, 45], dnu [ -45, 45] + {"+z", patch::patch_is_plus, 'z', -45.0, 45.0, -45.0, 45.0}, + + // +x patch (90 x 90 degrees): dnu [ 45, 135], dphi [ -45, 45] + {"+x", patch::patch_is_plus, 'x', 45.0, 135.0, -45.0, 45.0}, + + // +y patch (90 x 90 degrees): dmu [ 45, 135], dphi [ 45, 135] + {"+y", patch::patch_is_plus, 'y', 45.0, 135.0, 45.0, 135.0}, + + // -x patch (90 x 90 degrees): dnu [-135, -45], dphi [ 135, 225] + {"-x", patch::patch_is_minus, 'x', -135.0, -45.0, 135.0, 225.0}, + + // -y patch (90 x 90 degrees): dmu [-135, -45], dphi [-135, -45] + {"-y", patch::patch_is_minus, 'y', -135.0, -45.0, -135.0, -45.0}, + + // -z patch (90 x 90 degrees): dmu [ 135, 225], dnu [ 135, 225] + {"-z", patch::patch_is_minus, 'z', 135.0, 225.0, 135.0, 225.0}, + }; + } // namespace patch_system_info::full_sphere + + // + // +z hemisphere (half) patch system + // ... mirror symmetry across z=0 plane + // + namespace plus_z_hemisphere + { + enum + { + patch_number__pz = 0, + patch_number__px, + patch_number__py, + patch_number__mx, + patch_number__my, + N_patches // no comma + }; + static const struct patch_info patch_info_array[N_patches] = { + // +z patch (90 x 90 degrees): dmu [ -45, 45], dnu [ -45, 45] + {"+z", patch::patch_is_plus, 'z', -45.0, 45.0, -45.0, 45.0}, + + // +x patch (45 x 90 degrees): dnu [ 45, 90], dphi [ -45, 45] + {"+x", patch::patch_is_plus, 'x', 45.0, 90.0, -45.0, 45.0}, + + // +y patch (45 x 90 degrees): dmu [ 45, 90], dphi [ 45, 135] + {"+y", patch::patch_is_plus, 'y', 45.0, 90.0, 45.0, 135.0}, + + // -x patch (45 x 90 degrees): dnu [ -90, -45], dphi [ 135, 225] + {"-x", patch::patch_is_minus, 'x', -90.0, -45.0, 135.0, 225.0}, + + // -y patch (45 x 90 degrees): dmu [ -90, -45], dphi [-135, -45] + {"-y", patch::patch_is_minus, 'y', -90.0, -45.0, -135.0, -45.0}, + }; + } // namespace patch_system_info::plus_z_hemisphere + + // + // +[xy] "vertical" quarter-grid (quadrant) patch system + // two types of boundary conditions: + // ... mirror symmetry across x=0 and y=0 planes + // ... 90 degree periodic rotation symmetry about z axis + // + namespace plus_xy_quadrant + { + enum + { + patch_number__pz = 0, + patch_number__px, + patch_number__py, + patch_number__mz, + N_patches // no comma + }; + static const struct patch_info patch_info_array[N_patches] = { + // +z patch (45 x 45 degrees): dmu [ 0, 45], dnu [ 0, 45] + {"+z", patch::patch_is_plus, 'z', 0.0, 45.0, 0.0, 45.0}, + + // +x patch (90 x 45 degrees): dnu [ 45, 135], dphi [ 0, 45] + {"+x", patch::patch_is_plus, 'x', 45.0, 135.0, 0.0, 45.0}, + + // +y patch (90 x 45 degrees): dmu [ 45, 135], dphi [ 45, 90] + {"+y", patch::patch_is_plus, 'y', 45.0, 135.0, 45.0, 90.0}, + + // -z patch (45 x 45 degrees): dmu [ 135, 180], dnu [ 135, 180] + {"-z", patch::patch_is_minus, 'z', 135.0, 180.0, 135.0, 180.0}, + }; + } // namespace patch_system_info::plus_xy_quadrant + + // + // +[xz] "horizontal" quarter-grid (quadrant) patch system + // two types of boundary conditions + // ... mirror symmetry across x=0 plane, z=0 plane + // ... 180 degree periodic rotation symmetry about z axis, + // mirror symmetry across z=0 plane + // + namespace plus_xz_quadrant + { + enum + { + patch_number__pz = 0, + patch_number__px, + patch_number__py, + patch_number__my, + N_patches // no comma + }; + static const struct patch_info patch_info_array[N_patches] = { + // +z patch (90 x 45 degrees): dmu [ -45, 45], dnu [ 0, 45] + {"+z", patch::patch_is_plus, 'z', -45.0, 45.0, 0.0, 45.0}, + + // +x patch (45 x 90 degrees): dnu [ 45, 90], dphi [ -45, 45] + {"+x", patch::patch_is_plus, 'x', 45.0, 90.0, -45.0, 45.0}, + + // +y patch (45 x 45 degrees): dmu [ 45, 90], dphi [ 45, 90] + {"+y", patch::patch_is_plus, 'y', 45.0, 90.0, 45.0, 90.0}, + + // -y patch (45 x 45 degrees): dmu [ -90, -45], dphi [ -90, -45] + {"-y", patch::patch_is_minus, 'y', -90.0, -45.0, -90.0, -45.0}, + }; + } // namespace patch_system_info::plus_xz_quadrant_rotating + + // + // +[xyz] (octant) patch system + // two types of boundary conditions: + // ... mirror symmetry across x=0 plane, y=0 plane, z=0 plane + // ... 90 degree periodic rotation symmetry about z axis, + // mirror symmetry across z=0 plane + // + namespace plus_xyz_octant + { + enum + { + patch_number__pz = 0, + patch_number__px, + patch_number__py, + N_patches // no comma + }; + static const struct patch_info patch_info_array[N_patches] = { + // +z patch (45 x 45 degrees): dmu [ 0, 45], dnu [ 0, 45] + {"+z", patch::patch_is_plus, 'z', 0.0, 45.0, 0.0, 45.0}, + + // +x patch (45 x 45 degrees): dnu [ 45, 90], dphi [ 0, 45] + {"+x", patch::patch_is_plus, 'x', 45.0, 90.0, 0.0, 45.0}, + + // +y patch (45 x 45 degrees): dmu [ 45, 90], dphi [ 45, 90] + {"+y", patch::patch_is_plus, 'y', 45.0, 90.0, 45.0, 90.0}, + }; + } // namespace patch_system_info::octant_mirrored + + } // namespace patch_system_info:: + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* TPATCH_SYSTEM_INFO_H */ diff --git a/AMSS_NCKU_source/perf.C b/AMSS_NCKU_source/perf.C new file mode 100644 index 0000000..447c2bd --- /dev/null +++ b/AMSS_NCKU_source/perf.C @@ -0,0 +1,116 @@ + +#include "perf.h" + +// initialize staic members +size_t perf::mem_peak = 0; +size_t perf::mem_current = 0; +int perf::sampling_interval = 200; +bool perf::have_statm = false; +char perf::statm[40] = " "; +struct itimerval perf::new_it; +struct itimerval perf::old; +struct sigaction perf::sa; +struct sigaction perf::old_sa; + +perf::perf() +{ + int fd; + sprintf(statm, "/proc/%d/statm", (int)getpid()); + if ((fd = open(statm, O_RDONLY)) != -1) + { + have_statm = true; + close(fd); + } + + if (sampling_interval > 0) + { + /* setup timer to sample memory usage */ + sa.sa_handler = &perf::sample_mem_usage; + sigemptyset(&sa.sa_mask); + /*sigfillset (&sa.sa_mask);*/ + sa.sa_flags = SA_RESTART; + if (sigaction(TimerSignal, &sa, &old_sa)) + perror("sigaction 0"); + new_it.it_value.tv_sec = sampling_interval / 1000; + new_it.it_value.tv_usec = (sampling_interval % 1000) * 1000; + new_it.it_interval = new_it.it_value; + if (setitimer(TimerType, &new_it, &old)) + perror("setitimer 0"); + } +} +perf::~perf() +{ +} +void perf::sample_mem_usage(int dummy) +{ + int fd; + struct rusage RU; + size_t mem; + static bool locked = false; + + if (locked) + return; + locked = true; + + /* TODO: configure checks for different systems */ + + /* first, try /proc/pid/statm for Linux systems */ + if (have_statm && (fd = open(statm, O_RDONLY)) != -1) + { + int rsspages; + static char buffer[256]; + char *p = buffer; + /* see linux-2.6.15/Documentation/filesystems/proc.txt */ + rsspages = read(fd, buffer, sizeof(buffer) - 1); + close(fd); + buffer[rsspages] = '\0'; + + strtol(p, &p, 10); /* first number () */ + rsspages = strtol(p, &p, 10); /* second number */ + + mem = (size_t)rsspages * (size_t)getpagesize(); + } + else + { + /* next, try getrusage() */ + if (getrusage(RUSAGE_SELF, &RU)) + cout << "perf::sample_mem_usage calling getrusage fail" << endl; + else + mem = RU.ru_maxrss * (size_t)1024; + /*mem = RU.ru_maxrss * getpagesize();*/ + } + + if (mem > mem_peak) + mem_peak = mem; + mem_current = mem; + locked = false; +} +size_t perf::MemoryUsage(size_t *current_min, size_t *current_avg, size_t *current_max, + size_t *peak_min, size_t *peak_avg, size_t *peak_max, + int nprocs) +{ + sample_mem_usage(0); + + double a[2][3], b[2][3]; + a[0][0] = a[0][1] = a[0][2] = mem_current; + a[1][0] = a[1][1] = a[1][2] = mem_peak; + MPI_Allreduce(a, b, 6, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + b[0][1] /= nprocs; + b[1][1] /= nprocs; + + if (current_min != NULL) + *current_min = (size_t)(b[0][0] + 0.5); + if (current_avg != NULL) + *current_avg = (size_t)(b[0][1] + 0.5); + if (current_max != NULL) + *current_max = (size_t)(b[0][2] + 0.5); + + if (peak_min != NULL) + *peak_min = (size_t)(b[1][0] + 0.5); + if (peak_avg != NULL) + *peak_avg = (size_t)(b[1][1] + 0.5); + if (peak_max != NULL) + *peak_max = (size_t)(b[1][2] + 0.5); + + return (size_t)b[0][2]; /* return max(mem_current) */ +} diff --git a/AMSS_NCKU_source/perf.h b/AMSS_NCKU_source/perf.h new file mode 100644 index 0000000..c16723d --- /dev/null +++ b/AMSS_NCKU_source/perf.h @@ -0,0 +1,59 @@ + +#ifndef PERF_H +#define PERF_H +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +/* for open/read/close */ +#include +#include +#include +#include + +#include +#include +#include + +#include + +/* Real time */ +#define TimerSignal SIGALRM +#define TimerType ITIMER_REAL + +class perf +{ +public: + static size_t mem_peak; + static size_t mem_current; + /* The sampling interval of the timer in ms, <= 0 disables the timer. */ + static int sampling_interval; + static char statm[40]; + static bool have_statm; + static struct itimerval new_it, old; + static struct sigaction sa, old_sa; + +public: + perf(); + ~perf(); + static void sample_mem_usage(int dummy); + size_t MemoryUsage(size_t *current_min, size_t *current_avg, size_t *current_max, + size_t *peak_min, size_t *peak_avg, size_t *peak_max, + int nprocs); +}; +#endif /* PERF_H */ diff --git a/AMSS_NCKU_source/point_diff_new_sh.f90 b/AMSS_NCKU_source/point_diff_new_sh.f90 new file mode 100644 index 0000000..ff7a815 --- /dev/null +++ b/AMSS_NCKU_source/point_diff_new_sh.f90 @@ -0,0 +1,5287 @@ + + +#include "macrodef.fh" + +! we need only distinguish different finite difference order +! Vertex or Cell is distinguished in routine symmetry_bd which locates in +! file "fmisc.f90" + +#if (ghost_width == 2) +! second order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 2_nd oder accurate +! +! f(i+1) - f(i-1) +! fx(i) = ----------------------- +! 2 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine point_fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin & + .and. j+1 <= jmax .and. j-1 >= jmin & + .and. k+1 <= kmax .and. k-1 >= kmin )then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-f(i-1,j,k)+f(i+1,j,k)) + + fy=d2dy*(-f(i,j-1,k)+f(i,j+1,k)) + + fz=d2dz*(-f(i,j,k-1)+f(i,j,k+1)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine point_fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d2dx = ONE/TWO/dX + + fx = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin )then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-f(i-1,j,k)+f(i+1,j,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +! x direction + if(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + return + + end subroutine point_fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine point_fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d2dy = ONE/TWO/dY + + fy = ZEO + +! if inner point + if(j+1 <= jmax .and. j-1 >= jmin )then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + + fy=d2dy*(-f(i,j-1,k)+f(i,j+1,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + return + + end subroutine point_fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine point_fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d2dz = ONE/TWO/dZ + + fz = ZEO + +! if inner point + if( k+1 <= kmax .and. k-1 >= kmin )then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + + fz=d2dz*(-f(i,j,k-1)+f(i,j,k+1)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 2_nd oder accurate +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 +! +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine point_fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Sdydy,Sdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin & + .and. j+1 <= jmax .and. j-1 >= jmin & + .and. k+1 <= kmax .and. k-1 >= kmin )then +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(f(i-1,j,k)-TWO*f(i,j,k) & + +f(i+1,j,k) ) + + fyy = Sdydy*(f(i,j-1,k)-TWO*f(i,j,k) & + +f(i,j+1,k) ) + + fzz = Sdzdz*(f(i,j,k-1)-TWO*f(i,j,k) & + +f(i,j,k+1) ) +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(f(i-1,j-1,k)-f(i+1,j-1,k)-f(i-1,j+1,k)+f(i+1,j+1,k)) + + fxz = Sdxdz*(f(i-1,j,k-1)-f(i+1,j,k-1)-f(i-1,j,k+1)+f(i+1,j,k+1)) + + fyz = Sdydz*(f(i,j-1,k-1)-f(i,j+1,k-1)-f(i,j-1,k+1)+f(i,j+1,k+1)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine point_fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + + fxx = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin )then +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(f(i-1,j,k)-TWO*f(i,j,k) & + +f(i+1,j,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+1 <= imax .and. i-1 >= imin)then + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + return + + end subroutine point_fddxx_sh + + subroutine point_fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydy = ONE /( dY * dY ) + + fyy = ZEO + +! if inner point + if(j+1 <= jmax .and. j-1 >= jmin )then +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + + fyy = Sdydy*(f(i,j-1,k)-TWO*f(i,j,k) & + +f(i,j+1,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fyy + if(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + return + + end subroutine point_fddyy_sh + + subroutine point_fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdzdz = ONE /( dZ * dZ ) + + fzz = ZEO + +! if inner point + if( k+1 <= kmax .and. k-1 >= kmin )then +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + + fzz = Sdzdz*(f(i,j,k-1)-TWO*f(i,j,k) & + +f(i,j,k+1) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fzz + if(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + return + + end subroutine point_fddzz_sh + + subroutine point_fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdy = F1o4 /( dX * dY ) + + fxy = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin & + .and. j+1 <= jmax .and. j-1 >= jmin )then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(f(i-1,j-1,k)-f(i+1,j-1,k)-f(i-1,j+1,k)+f(i+1,j+1,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fxy + if(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + return + + end subroutine point_fddxy_sh + + subroutine point_fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdz = F1o4 /( dX * dZ ) + + fxz = ZEO + +! if inner point + if(i+1 <= imax .and. i-1 >= imin & + .and. k+1 <= kmax .and. k-1 >= kmin )then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + + fxz = Sdxdz*(f(i-1,j,k-1)-f(i+1,j,k-1)-f(i-1,j,k+1)+f(i+1,j,k+1)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fxz + if(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + return + + end subroutine point_fddxz_sh + + subroutine point_fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(0:ex(1)+1,0:ex(2)+1,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydz = F1o4 /( dY * dZ ) + + fyz = ZEO + +! if inner point + if(j+1 <= jmax .and. j-1 >= jmin & + .and. k+1 <= kmax .and. k-1 >= kmin )then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + + fyz = Sdydz*(f(i,j-1,k-1)-f(i,j+1,k-1)-f(i,j-1,k+1)+f(i,j+1,k+1)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = 0 + if(dabs(Y(1)) < dY) jmin = 0 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = 0 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+1 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(1,ex,f,fh,SoA) + +!~~~~~~ fyz + if(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fddyz_sh + +#elif (ghost_width == 3) +! fourth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 4_th oder accurate +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine point_fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin & + .and. j+2 <= jmax .and. j-2 >= jmin & + .and. k+2 <= kmax .and. k-2 >= kmin )then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(f(i-2,j,k)-EIT*f(i-1,j,k)+EIT*f(i+1,j,k)-f(i+2,j,k)) + fy=d12dy*(f(i,j-2,k)-EIT*f(i,j-1,k)+EIT*f(i,j+1,k)-f(i,j+2,k)) + fz=d12dz*(f(i,j,k-2)-EIT*f(i,j,k-1)+EIT*f(i,j,k+1)-f(i,j,k+2)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine point_fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin )then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(f(i-2,j,k)-EIT*f(i-1,j,k)+EIT*f(i+1,j,k)-f(i+2,j,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! x direction + if(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + return + + end subroutine point_fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine point_fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + +! if inner point + if(j+2 <= jmax .and. j-2 >= jmin )then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fy=d12dy*(f(i,j-2,k)-EIT*f(i,j-1,k)+EIT*f(i,j+1,k)-f(i,j+2,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! y direction + if(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + return + + end subroutine point_fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine point_fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + +! if inner point + if( k+2 <= kmax .and. k-2 >= kmin )then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fz=d12dz*(f(i,j,k-2)-EIT*f(i,j,k-1)+EIT*f(i,j,k+1)-f(i,j,k+2)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +! z direction + if(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 4_th oder accurate +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 +! +! - ( - f(i+2,j+2) + 8 f(i+1,j+2) - 8 f(i-1,j+2) + f(i-2,j+2) ) +! + 8 ( - f(i+2,j+1) + 8 f(i+1,j+1) - 8 f(i-1,j+1) + f(i-2,j+1) ) +! - 8 ( - f(i+2,j-1) + 8 f(i+1,j-1) - 8 f(i-1,j-1) + f(i-2,j-1) ) +! + ( - f(i+2,j-2) + 8 f(i+1,j-2) - 8 f(i-1,j-2) + f(i-2,j-2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine point_fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin & + .and. j+2 <= jmax .and. j-2 >= jmin & + .and. k+2 <= kmax .and. k-2 >= kmin )then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx = Fdxdx*(-f(i-2,j,k)+F16*f(i-1,j,k)-F30*f(i,j,k) & + -f(i+2,j,k)+F16*f(i+1,j,k) ) + + fyy = Fdydy*(-f(i,j-2,k)+F16*f(i,j-1,k)-F30*f(i,j,k) & + -f(i,j+2,k)+F16*f(i,j+1,k) ) + + fzz = Fdzdz*(-f(i,j,k-2)+F16*f(i,j,k-1)-F30*f(i,j,k) & + -f(i,j,k+2)+F16*f(i,j,k+1) ) + +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy = Fdxdy*( (f(i-2,j-2,k)-F8*f(i-1,j-2,k)+F8*f(i+1,j-2,k)-f(i+2,j-2,k)) & + -F8 *(f(i-2,j-1,k)-F8*f(i-1,j-1,k)+F8*f(i+1,j-1,k)-f(i+2,j-1,k)) & + +F8 *(f(i-2,j+1,k)-F8*f(i-1,j+1,k)+F8*f(i+1,j+1,k)-f(i+2,j+1,k)) & + - (f(i-2,j+2,k)-F8*f(i-1,j+2,k)+F8*f(i+1,j+2,k)-f(i+2,j+2,k))) + + fxz = Fdxdz*( (f(i-2,j,k-2)-F8*f(i-1,j,k-2)+F8*f(i+1,j,k-2)-f(i+2,j,k-2)) & + -F8 *(f(i-2,j,k-1)-F8*f(i-1,j,k-1)+F8*f(i+1,j,k-1)-f(i+2,j,k-1)) & + +F8 *(f(i-2,j,k+1)-F8*f(i-1,j,k+1)+F8*f(i+1,j,k+1)-f(i+2,j,k+1)) & + - (f(i-2,j,k+2)-F8*f(i-1,j,k+2)+F8*f(i+1,j,k+2)-f(i+2,j,k+2))) + + fyz = Fdydz*( (f(i,j-2,k-2)-F8*f(i,j-1,k-2)+F8*f(i,j+1,k-2)-f(i,j+2,k-2)) & + -F8 *(f(i,j-2,k-1)-F8*f(i,j-1,k-1)+F8*f(i,j+1,k-1)-f(i,j+2,k-1)) & + +F8 *(f(i,j-2,k+1)-F8*f(i,j-1,k+1)+F8*f(i,j+1,k+1)-f(i,j+2,k+1)) & + - (f(i,j-2,k+2)-F8*f(i,j-1,k+2)+F8*f(i,j+1,k+2)-f(i,j+2,k+2))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine point_fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Fdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + fxx = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin )then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx = Fdxdx*(-f(i-2,j,k)+F16*f(i-1,j,k)-F30*f(i,j,k) & + -f(i+2,j,k)+F16*f(i+1,j,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+2 <= imax .and. i-2 >= imin)then + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + return + + end subroutine point_fddxx_sh + + subroutine point_fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydy,Fdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + fyy = ZEO + +! if inner point + if(j+2 <= jmax .and. j-2 >= jmin )then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + + fyy = Fdydy*(-f(i,j-2,k)+F16*f(i,j-1,k)-F30*f(i,j,k) & + -f(i,j+2,k)+F16*f(i,j+1,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fyy + if(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + return + + end subroutine point_fddyy_sh + + subroutine point_fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdzdz,Fdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + fzz = ZEO + +! if inner point + if( k+2 <= kmax .and. k-2 >= kmin )then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + + fzz = Fdzdz*(-f(i,j,k-2)+F16*f(i,j,k-1)-F30*f(i,j,k) & + -f(i,j,k+2)+F16*f(i,j,k+1) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fzz + if(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + return + + end subroutine point_fddzz_sh + + subroutine point_fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdy,Fdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + fxy = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin & + .and. j+2 <= jmax .and. j-2 >= jmin )then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy = Fdxdy*( (f(i-2,j-2,k)-F8*f(i-1,j-2,k)+F8*f(i+1,j-2,k)-f(i+2,j-2,k)) & + -F8 *(f(i-2,j-1,k)-F8*f(i-1,j-1,k)+F8*f(i+1,j-1,k)-f(i+2,j-1,k)) & + +F8 *(f(i-2,j+1,k)-F8*f(i-1,j+1,k)+F8*f(i+1,j+1,k)-f(i+2,j+1,k)) & + - (f(i-2,j+2,k)-F8*f(i-1,j+2,k)+F8*f(i+1,j+2,k)-f(i+2,j+2,k))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fxy + if(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + return + + end subroutine point_fddxy_sh + + subroutine point_fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdz,Fdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + fxz = ZEO + +! if inner point + if(i+2 <= imax .and. i-2 >= imin & + .and. k+2 <= kmax .and. k-2 >= kmin )then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + + fxz = Fdxdz*( (f(i-2,j,k-2)-F8*f(i-1,j,k-2)+F8*f(i+1,j,k-2)-f(i+2,j,k-2)) & + -F8 *(f(i-2,j,k-1)-F8*f(i-1,j,k-1)+F8*f(i+1,j,k-1)-f(i+2,j,k-1)) & + +F8 *(f(i-2,j,k+1)-F8*f(i-1,j,k+1)+F8*f(i+1,j,k+1)-f(i+2,j,k+1)) & + - (f(i-2,j,k+2)-F8*f(i-1,j,k+2)+F8*f(i+1,j,k+2)-f(i+2,j,k+2))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fxz + if(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + return + + end subroutine point_fddxz_sh + + subroutine point_fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-1:ex(1)+2,-1:ex(2)+2,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydz,Fdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + fyz = ZEO + +! if inner point + if(j+2 <= jmax .and. j-2 >= jmin & + .and. k+2 <= kmax .and. k-2 >= kmin )then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + + fyz = Fdydz*( (f(i,j-2,k-2)-F8*f(i,j-1,k-2)+F8*f(i,j+1,k-2)-f(i,j+2,k-2)) & + -F8 *(f(i,j-2,k-1)-F8*f(i,j-1,k-1)+F8*f(i,j+1,k-1)-f(i,j+2,k-1)) & + +F8 *(f(i,j-2,k+1)-F8*f(i,j-1,k+1)+F8*f(i,j+1,k+1)-f(i,j+2,k+1)) & + - (f(i,j-2,k+2)-F8*f(i,j-1,k+2)+F8*f(i,j+1,k+2)-f(i,j+2,k+2))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -1 + if(dabs(Y(1)) < dY) jmin = -1 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -1 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+2 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(2,ex,f,fh,SoA) + +!~~~~~~ fyz + if(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fddyz_sh + +#elif (ghost_width == 4) +! sixth order code + +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 6_th oder accurate +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine point_fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin & + .and. j+3 <= jmax .and. j-3 >= jmin & + .and. k+3 <= kmax .and. k-3 >= kmin )then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-f(i-3,j,k)+F9*f(i-2,j,k)-F45*f(i-1,j,k)+F45*f(i+1,j,k)-F9*f(i+2,j,k)+f(i+3,j,k)) + + fy=d60dy*(-f(i,j-3,k)+F9*f(i,j-2,k)-F45*f(i,j-1,k)+F45*f(i,j+1,k)-F9*f(i,j+2,k)+f(i,j+3,k)) + + fz=d60dz*(-f(i,j,k-3)+F9*f(i,j,k-2)-F45*f(i,j,k-1)+F45*f(i,j,k+1)-F9*f(i,j,k+2)+f(i,j,k+3)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine point_fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin )then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-f(i-3,j,k)+F9*f(i-2,j,k)-F45*f(i-1,j,k)+F45*f(i+1,j,k)-F9*f(i+2,j,k)+f(i+3,j,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +! x direction + if(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + return + + end subroutine point_fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine point_fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + +! if inner point + if(j+3 <= jmax .and. j-3 >= jmin )then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + + fy=d60dy*(-f(i,j-3,k)+F9*f(i,j-2,k)-F45*f(i,j-1,k)+F45*f(i,j+1,k)-F9*f(i,j+2,k)+f(i,j+3,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +! y direction + if(j+3 <= jmax .and. j-3 >= jmin)then + + fy=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + return + + end subroutine point_fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine point_fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1 + real*8, parameter :: TWO=2.d0,EIT=8.d0 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + +! if inner point + if( k+3 <= kmax .and. k-3 >= kmin )then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + + fz=d60dz*(-f(i,j,k-3)+F9*f(i,j,k-2)-F45*f(i,j,k-1)+F45*f(i,j,k+1)-F9*f(i,j,k+2)+f(i,j,k+3)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +! z direction + if(k+3 <= kmax .and. k-3 >= kmin)then + + fz=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 6_th oder accurate +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine point_fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin & + .and. j+3 <= jmax .and. j-3 >= jmin & + .and. k+3 <= kmax .and. k-3 >= kmin )then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx = Xdxdx*(TWO*f(i-3,j,k)-F27*f(i-2,j,k)+F270*f(i-1,j,k)-F490*f(i,j,k) & + +TWO*f(i+3,j,k)-F27*f(i+2,j,k)+F270*f(i+1,j,k) ) + + fyy = Xdydy*(TWO*f(i,j-3,k)-F27*f(i,j-2,k)+F270*f(i,j-1,k)-F490*f(i,j,k) & + +TWO*f(i,j+3,k)-F27*f(i,j+2,k)+F270*f(i,j+1,k) ) + + fzz = Xdzdz*(TWO*f(i,j,k-3)-F27*f(i,j,k-2)+F270*f(i,j,k-1)-F490*f(i,j,k) & + +TWO*f(i,j,k+3)-F27*f(i,j,k+2)+F270*f(i,j,k+1) ) + +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy = Xdxdy*(- (-f(i-3,j-3,k)+F9*f(i-2,j-3,k)-F45*f(i-1,j-3,k)+F45*f(i+1,j-3,k)-F9*f(i+2,j-3,k)+f(i+3,j-3,k)) & + +F9 *(-f(i-3,j-2,k)+F9*f(i-2,j-2,k)-F45*f(i-1,j-2,k)+F45*f(i+1,j-2,k)-F9*f(i+2,j-2,k)+f(i+3,j-2,k)) & + -F45*(-f(i-3,j-1,k)+F9*f(i-2,j-1,k)-F45*f(i-1,j-1,k)+F45*f(i+1,j-1,k)-F9*f(i+2,j-1,k)+f(i+3,j-1,k)) & + +F45*(-f(i-3,j+1,k)+F9*f(i-2,j+1,k)-F45*f(i-1,j+1,k)+F45*f(i+1,j+1,k)-F9*f(i+2,j+1,k)+f(i+3,j+1,k)) & + -F9 *(-f(i-3,j+2,k)+F9*f(i-2,j+2,k)-F45*f(i-1,j+2,k)+F45*f(i+1,j+2,k)-F9*f(i+2,j+2,k)+f(i+3,j+2,k)) & + + (-f(i-3,j+3,k)+F9*f(i-2,j+3,k)-F45*f(i-1,j+3,k)+F45*f(i+1,j+3,k)-F9*f(i+2,j+3,k)+f(i+3,j+3,k))) + + fxz = Xdxdz*(- (-f(i-3,j,k-3)+F9*f(i-2,j,k-3)-F45*f(i-1,j,k-3)+F45*f(i+1,j,k-3)-F9*f(i+2,j,k-3)+f(i+3,j,k-3)) & + +F9 *(-f(i-3,j,k-2)+F9*f(i-2,j,k-2)-F45*f(i-1,j,k-2)+F45*f(i+1,j,k-2)-F9*f(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-f(i-3,j,k-1)+F9*f(i-2,j,k-1)-F45*f(i-1,j,k-1)+F45*f(i+1,j,k-1)-F9*f(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-f(i-3,j,k+1)+F9*f(i-2,j,k+1)-F45*f(i-1,j,k+1)+F45*f(i+1,j,k+1)-F9*f(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-f(i-3,j,k+2)+F9*f(i-2,j,k+2)-F45*f(i-1,j,k+2)+F45*f(i+1,j,k+2)-F9*f(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-f(i-3,j,k+3)+F9*f(i-2,j,k+3)-F45*f(i-1,j,k+3)+F45*f(i+1,j,k+3)-F9*f(i+2,j,k+3)+fh(i+3,j,k+3))) + + fyz = Xdydz*(- (-f(i,j-3,k-3)+F9*f(i,j-2,k-3)-F45*f(i,j-1,k-3)+F45*f(i,j+1,k-3)-F9*f(i,j+2,k-3)+f(i,j+3,k-3)) & + +F9 *(-f(i,j-3,k-2)+F9*f(i,j-2,k-2)-F45*f(i,j-1,k-2)+F45*f(i,j+1,k-2)-F9*f(i,j+2,k-2)+f(i,j+3,k-2)) & + -F45*(-f(i,j-3,k-1)+F9*f(i,j-2,k-1)-F45*f(i,j-1,k-1)+F45*f(i,j+1,k-1)-F9*f(i,j+2,k-1)+f(i,j+3,k-1)) & + +F45*(-f(i,j-3,k+1)+F9*f(i,j-2,k+1)-F45*f(i,j-1,k+1)+F45*f(i,j+1,k+1)-F9*f(i,j+2,k+1)+f(i,j+3,k+1)) & + -F9 *(-f(i,j-3,k+2)+F9*f(i,j-2,k+2)-F45*f(i,j-1,k+2)+F45*f(i,j+1,k+2)-F9*f(i,j+2,k+2)+f(i,j+3,k+2)) & + + (-f(i,j-3,k+3)+F9*f(i,j-2,k+3)-F45*f(i,j-1,k+3)+F45*f(i,j+1,k+3)-F9*f(i,j+2,k+3)+f(i,j+3,k+3))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine point_fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Fdxdx,Xdxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + fxx = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin )then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx = Xdxdx*(TWO*f(i-3,j,k)-F27*f(i-2,j,k)+F270*f(i-1,j,k)-F490*f(i,j,k) & + +TWO*f(i+3,j,k)-F27*f(i+2,j,k)+F270*f(i+1,j,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+3 <= imax .and. i-3 >= imin)then + fxx = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + return + + end subroutine point_fddxx_sh + + subroutine point_fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydy,Fdydy,Xdydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + fyy = ZEO + +! if inner point + if(j+3 <= jmax .and. j-3 >= jmin )then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + + fyy = Xdydy*(TWO*f(i,j-3,k)-F27*f(i,j-2,k)+F270*f(i,j-1,k)-F490*f(i,j,k) & + +TWO*f(i,j+3,k)-F27*f(i,j+2,k)+F270*f(i,j+1,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fyy + if(j+3 <= jmax .and. j-3 >= jmin)then + + fyy = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + return + + end subroutine point_fddyy_sh + + subroutine point_fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdzdz,Fdzdz,Xdzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + fzz = ZEO + +! if inner point + if( k+3 <= kmax .and. k-3 >= kmin )then +! +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + + fzz = Xdzdz*(TWO*f(i,j,k-3)-F27*f(i,j,k-2)+F270*f(i,j,k-1)-F490*f(i,j,k) & + +TWO*f(i,j,k+3)-F27*f(i,j,k+2)+F270*f(i,j,k+1) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fzz + if(k+3 <= kmax .and. k-3 >= kmin)then + + fzz = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + return + + end subroutine point_fddzz_sh + + subroutine point_fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdy,Fdxdy,Xdxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + fxy = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin & + .and. j+3 <= jmax .and. j-3 >= jmin )then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy = Xdxdy*(- (-f(i-3,j-3,k)+F9*f(i-2,j-3,k)-F45*f(i-1,j-3,k)+F45*f(i+1,j-3,k)-F9*f(i+2,j-3,k)+f(i+3,j-3,k)) & + +F9 *(-f(i-3,j-2,k)+F9*f(i-2,j-2,k)-F45*f(i-1,j-2,k)+F45*f(i+1,j-2,k)-F9*f(i+2,j-2,k)+f(i+3,j-2,k)) & + -F45*(-f(i-3,j-1,k)+F9*f(i-2,j-1,k)-F45*f(i-1,j-1,k)+F45*f(i+1,j-1,k)-F9*f(i+2,j-1,k)+f(i+3,j-1,k)) & + +F45*(-f(i-3,j+1,k)+F9*f(i-2,j+1,k)-F45*f(i-1,j+1,k)+F45*f(i+1,j+1,k)-F9*f(i+2,j+1,k)+f(i+3,j+1,k)) & + -F9 *(-f(i-3,j+2,k)+F9*f(i-2,j+2,k)-F45*f(i-1,j+2,k)+F45*f(i+1,j+2,k)-F9*f(i+2,j+2,k)+f(i+3,j+2,k)) & + + (-f(i-3,j+3,k)+F9*f(i-2,j+3,k)-F45*f(i-1,j+3,k)+F45*f(i+1,j+3,k)-F9*f(i+2,j+3,k)+f(i+3,j+3,k))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fxy + if(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + return + + end subroutine point_fddxy_sh + + subroutine point_fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdz,Fdxdz,Xdxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + fxz = ZEO + +! if inner point + if(i+3 <= imax .and. i-3 >= imin & + .and. k+3 <= kmax .and. k-3 >= kmin )then + +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + + fxz = Xdxdz*(- (-f(i-3,j,k-3)+F9*f(i-2,j,k-3)-F45*f(i-1,j,k-3)+F45*f(i+1,j,k-3)-F9*f(i+2,j,k-3)+f(i+3,j,k-3)) & + +F9 *(-f(i-3,j,k-2)+F9*f(i-2,j,k-2)-F45*f(i-1,j,k-2)+F45*f(i+1,j,k-2)-F9*f(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-f(i-3,j,k-1)+F9*f(i-2,j,k-1)-F45*f(i-1,j,k-1)+F45*f(i+1,j,k-1)-F9*f(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-f(i-3,j,k+1)+F9*f(i-2,j,k+1)-F45*f(i-1,j,k+1)+F45*f(i+1,j,k+1)-F9*f(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-f(i-3,j,k+2)+F9*f(i-2,j,k+2)-F45*f(i-1,j,k+2)+F45*f(i+1,j,k+2)-F9*f(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-f(i-3,j,k+3)+F9*f(i-2,j,k+3)-F45*f(i-1,j,k+3)+F45*f(i+1,j,k+3)-F9*f(i+2,j,k+3)+fh(i+3,j,k+3))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fxz + if(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + return + + end subroutine point_fddxz_sh + + subroutine point_fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-2:ex(1)+3,-2:ex(2)+3,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydz,Fdydz,Xdydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + fyz = ZEO + +! if inner point + if(j+3 <= jmax .and. j-3 >= jmin & + .and. k+3 <= kmax .and. k-3 >= kmin )then + +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + + fyz = Xdydz*(- (-f(i,j-3,k-3)+F9*f(i,j-2,k-3)-F45*f(i,j-1,k-3)+F45*f(i,j+1,k-3)-F9*f(i,j+2,k-3)+f(i,j+3,k-3)) & + +F9 *(-f(i,j-3,k-2)+F9*f(i,j-2,k-2)-F45*f(i,j-1,k-2)+F45*f(i,j+1,k-2)-F9*f(i,j+2,k-2)+f(i,j+3,k-2)) & + -F45*(-f(i,j-3,k-1)+F9*f(i,j-2,k-1)-F45*f(i,j-1,k-1)+F45*f(i,j+1,k-1)-F9*f(i,j+2,k-1)+f(i,j+3,k-1)) & + +F45*(-f(i,j-3,k+1)+F9*f(i,j-2,k+1)-F45*f(i,j-1,k+1)+F45*f(i,j+1,k+1)-F9*f(i,j+2,k+1)+f(i,j+3,k+1)) & + -F9 *(-f(i,j-3,k+2)+F9*f(i,j-2,k+2)-F45*f(i,j-1,k+2)+F45*f(i,j+1,k+2)-F9*f(i,j+2,k+2)+f(i,j+3,k+2)) & + + (-f(i,j-3,k+3)+F9*f(i,j-2,k+3)-F45*f(i,j-1,k+3)+F45*f(i,j+1,k+3)-F9*f(i,j+2,k+3)+f(i,j+3,k+3))) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -2 + if(dabs(Y(1)) < dY) jmin = -2 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -2 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+3 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(3,ex,f,fh,SoA) + +!~~~~~~ fyz + if(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fddyz_sh + +#elif (ghost_width == 5) +! eighth order code + +! PRD 77, 024034 (2008) +!----------------------------------------------------------------------------------------------------------------- +! +! General first derivatives of 8_th oder accurate +! +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx +! +!----------------------------------------------------------------------------------------------------------------- + + subroutine point_fderivs_sh(ex,f,fx,fy,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx,fy,fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d840dx,d840dy,d840dz + real*8 :: d60dx,d60dy,d60dz,d12dx,d12dy,d12dz,d2dx,d2dy,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d840dx = ONE/F840/dX + d840dy = ONE/F840/dY + d840dz = ONE/F840/dZ + + d60dx = ONE/F60/dX + d60dy = ONE/F60/dY + d60dz = ONE/F60/dZ + + d12dx = ONE/F12/dX + d12dy = ONE/F12/dY + d12dz = ONE/F12/dZ + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + fx = ZEO + fy = ZEO + fz = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin & + .and. j+4 <= jmax .and. j-4 >= jmin & + .and. k+4 <= kmax .and. k-4 >= kmin )then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx=d840dx*( THR*f(i-4,j,k)-F32 *f(i-3,j,k)+F168*f(i-2,j,k)-F672*f(i-1,j,k)+ & + F672*f(i+1,j,k)-F168*f(i+2,j,k)+F32 *f(i+3,j,k)-THR *f(i+4,j,k)) + + fy=d840dy*( THR*f(i,j-4,k)-F32 *f(i,j-3,k)+F168*f(i,j-2,k)-F672*f(i,j-1,k)+ & + F672*f(i,j+1,k)-F168*f(i,j+2,k)+F32 *f(i,j+3,k)-THR *f(i,j+4,k)) + + fz=d840dz*( THR*f(i,j,k-4)-F32 *f(i,j,k-3)+F168*f(i,j,k-2)-F672*f(i,j,k-1)+ & + F672*f(i,j,k+1)-F168*f(i,j,k+2)+F32 *f(i,j,k+3)-THR *f(i,j,k+4)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fderivs_sh +!----------------------------------------------------------------------------- +! +! single derivatives dx +! +!----------------------------------------------------------------------------- + subroutine point_fdx_sh(ex,f,fx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fx + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d840dx,d60dx,d12dx,d2dx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d840dx = ONE/F840/dX + + d60dx = ONE/F60/dX + + d12dx = ONE/F12/dX + + d2dx = ONE/TWO/dX + + fx = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin )then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx=d840dx*( THR*f(i-4,j,k)-F32 *f(i-3,j,k)+F168*f(i-2,j,k)-F672*f(i-1,j,k)+ & + F672*f(i+1,j,k)-F168*f(i+2,j,k)+F32 *f(i+3,j,k)-THR *f(i+4,j,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +! x direction + if(i+4 <= imax .and. i-4 >= imin)then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + fx=d840dx*( THR*fh(i-4,j,k)-F32 *fh(i-3,j,k)+F168*fh(i-2,j,k)-F672*fh(i-1,j,k)+ & + F672*fh(i+1,j,k)-F168*fh(i+2,j,k)+F32 *fh(i+3,j,k)-THR *fh(i+4,j,k)) + + elseif(i+3 <= imax .and. i-3 >= imin)then +! +! - f(i-3) + 9 f(i-2) - 45 f(i-1) + 45 f(i+1) - 9 f(i+2) + f(i+3) +! fx(i) = ----------------------------------------------------------------- +! 60 dx + fx=d60dx*(-fh(i-3,j,k)+F9*fh(i-2,j,k)-F45*fh(i-1,j,k)+F45*fh(i+1,j,k)-F9*fh(i+2,j,k)+fh(i+3,j,k)) + + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! f(i-2) - 8 f(i-1) + 8 f(i+1) - f(i+2) +! fx(i) = --------------------------------------------- +! 12 dx + fx=d12dx*(fh(i-2,j,k)-EIT*fh(i-1,j,k)+EIT*fh(i+1,j,k)-fh(i+2,j,k)) + + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! - f(i-1) + f(i+1) +! fx(i) = -------------------------------- +! 2 dx + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + +! set imax and imin 0 + endif + + return + + end subroutine point_fdx_sh +!----------------------------------------------------------------------------- +! +! single derivatives dy +! +!----------------------------------------------------------------------------- + subroutine point_fdy_sh(ex,f,fy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fy + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d840dy,d60dy,d12dy,d2dy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d840dy = ONE/F840/dY + + d60dy = ONE/F60/dY + + d12dy = ONE/F12/dY + + d2dy = ONE/TWO/dY + + fy = ZEO + +! if inner point + if(j+4 <= jmax .and. j-4 >= jmin )then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + + fy=d840dy*( THR*f(i,j-4,k)-F32 *f(i,j-3,k)+F168*f(i,j-2,k)-F672*f(i,j-1,k)+ & + F672*f(i,j+1,k)-F168*f(i,j+2,k)+F32 *f(i,j+3,k)-THR *f(i,j+4,k)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +! y direction + if(j+4 <= jmax .and. j-4 >= jmin)then + + fy=d840dy*( THR*fh(i,j-4,k)-F32 *fh(i,j-3,k)+F168*fh(i,j-2,k)-F672*fh(i,j-1,k)+ & + F672*fh(i,j+1,k)-F168*fh(i,j+2,k)+F32 *fh(i,j+3,k)-THR *fh(i,j+4,k)) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fy=d60dy*(-fh(i,j-3,k)+F9*fh(i,j-2,k)-F45*fh(i,j-1,k)+F45*fh(i,j+1,k)-F9*fh(i,j+2,k)+fh(i,j+3,k)) + + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fy=d12dy*(fh(i,j-2,k)-EIT*fh(i,j-1,k)+EIT*fh(i,j+1,k)-fh(i,j+2,k)) + + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + +! set jmax and jmin 0 + endif + + return + + end subroutine point_fdy_sh +!----------------------------------------------------------------------------- +! +! single derivatives dz +! +!----------------------------------------------------------------------------- + subroutine point_fdz_sh(ex,f,fz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)), intent(in ):: f + real*8, intent(out):: fz + real*8, intent(in) :: X(ex(1)),Y(ex(2)),Z(ex(3)) + real*8, intent(in ):: SYM1,SYM2,SYM3 + +!~~~~~~ other variables + + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: d840dz,d60dz,d12dz,d2dz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0,ONE=1.d0, F60=6.d1, F32 = 3.2d1 + real*8, parameter :: TWO=2.d0,THR=3.d0, EIT=8.d0, F168=1.68d2 + real*8, parameter :: F9=9.d0,F45=4.5d1,F12=1.2d1,F672=6.72d2 + real*8, parameter :: F840=8.4d2 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + d840dz = ONE/F840/dZ + + d60dz = ONE/F60/dZ + + d12dz = ONE/F12/dZ + + d2dz = ONE/TWO/dZ + + fz = ZEO + +! if inner point + if( k+4 <= kmax .and. k-4 >= kmin )then +! 3 f(i-4) - 32 f(i-3) + 168 f(i-2) - 672 f(i-1) + 672 f(i+1) - 168 f(i+2) + 32 f(i+3) - 3 f(i+4) +! fx(i) = ------------------------------------------------------------------------------------------------- +! 840 dx + + fz=d840dz*( THR*f(i,j,k-4)-F32 *f(i,j,k-3)+F168*f(i,j,k-2)-F672*f(i,j,k-1)+ & + F672*f(i,j,k+1)-F168*f(i,j,k+2)+F32 *f(i,j,k+3)-THR *f(i,j,k+4)) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +! z direction + if(k+4 <= kmax .and. k-4 >= kmin)then + + fz=d840dz*( THR*fh(i,j,k-4)-F32 *fh(i,j,k-3)+F168*fh(i,j,k-2)-F672*fh(i,j,k-1)+ & + F672*fh(i,j,k+1)-F168*fh(i,j,k+2)+F32 *fh(i,j,k+3)-THR *fh(i,j,k+4)) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fz=d60dz*(-fh(i,j,k-3)+F9*fh(i,j,k-2)-F45*fh(i,j,k-1)+F45*fh(i,j,k+1)-F9*fh(i,j,k+2)+fh(i,j,k+3)) + + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fz=d12dz*(fh(i,j,k-2)-EIT*fh(i,j,k-1)+EIT*fh(i,j,k+1)-fh(i,j,k+2)) + + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + +! set kmax and kmin 0 + endif + + return + + end subroutine point_fdz_sh +!----------------------------------------------------------------------------------------------------------------- +! +! General second derivatives of 8_th oder accurate +! +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 +! +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy +! +!----------------------------------------------------------------------------------------------------------------- + subroutine point_fdderivs_sh(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z, & + SYM1,SYM2,SYM3,symmetry,onoff,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,onoff,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx,fxy,fxz,fyy,fyz,fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Sdydy,Sdzdz,Fdxdx,Fdydy,Fdzdz,Xdxdx,Xdydy,Xdzdz,Edxdx,Edydy,Edzdz + real*8 :: Sdxdy,Sdxdz,Sdydz,Fdxdy,Fdxdz,Fdydz,Xdxdy,Xdxdz,Xdydz,Edxdy,Edxdz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + Sdydy = ONE /( dY * dY ) + Sdzdz = ONE /( dZ * dZ ) + + Fdxdx = F1o12 /( dX * dX ) + Fdydy = F1o12 /( dY * dY ) + Fdzdz = F1o12 /( dZ * dZ ) + + Xdxdx = F1o180 /( dX * dX ) + Xdydy = F1o180 /( dY * dY ) + Xdzdz = F1o180 /( dZ * dZ ) + + Edxdx = F1o5040 /( dX * dX ) + Edydy = F1o5040 /( dY * dY ) + Edzdz = F1o5040 /( dZ * dZ ) + + Sdxdy = F1o4 /( dX * dY ) + Sdxdz = F1o4 /( dX * dZ ) + Sdydz = F1o4 /( dY * dZ ) + + Fdxdy = F1o144 /( dX * dY ) + Fdxdz = F1o144 /( dX * dZ ) + Fdydz = F1o144 /( dY * dZ ) + + Xdxdy = F1o3600 /( dX * dY ) + Xdxdz = F1o3600 /( dX * dZ ) + Xdydz = F1o3600 /( dY * dZ ) + + Edxdy = F1o705600 /( dX * dY ) + Edxdz = F1o705600 /( dX * dZ ) + Edydz = F1o705600 /( dY * dZ ) + + fxx = ZEO + fyy = ZEO + fzz = ZEO + fxy = ZEO + fxz = ZEO + fyz = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin & + .and. j+4 <= jmax .and. j-4 >= jmin & + .and. k+4 <= kmax .and. k-4 >= kmin )then +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx = Edxdx*(-F9*f(i-4,j,k)+F128*f(i-3,j,k)-F1008*f(i-2,j,k)+F8064*f(i-1,j,k)-F14350*f(i,j,k) & + -F9*f(i+4,j,k)+F128*f(i+3,j,k)-F1008*f(i+2,j,k)+F8064*f(i+1,j,k) ) + + fyy = Edydy*(-F9*f(i,j-4,k)+F128*f(i,j-3,k)-F1008*f(i,j-2,k)+F8064*f(i,j-1,k)-F14350*f(i,j,k) & + -F9*f(i,j+4,k)+F128*f(i,j+3,k)-F1008*f(i,j+2,k)+F8064*f(i,j+1,k) ) + + fzz = Edzdz*(-F9*f(i,j,k-4)+F128*f(i,j,k-3)-F1008*f(i,j,k-2)+F8064*f(i,j,k-1)-F14350*f(i,j,k) & + -F9*f(i,j,k+4)+F128*f(i,j,k+3)-F1008*f(i,j,k+2)+F8064*f(i,j,k+1) ) + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy = Edxdy*( THR *( THR*f(i-4,j-4,k)-F32*f(i-3,j-4,k)+F168*f(i-2,j-4,k)-F672*f(i-1,j-4,k) & + -THR*f(i+4,j-4,k)+F32*f(i+3,j-4,k)-F168*f(i+2,j-4,k)+F672*f(i+1,j-4,k)) & + -F32 *( THR*f(i-4,j-3,k)-F32*f(i-3,j-3,k)+F168*f(i-2,j-3,k)-F672*f(i-1,j-3,k) & + -THR*f(i+4,j-3,k)+F32*f(i+3,j-3,k)-F168*f(i+2,j-3,k)+F672*f(i+1,j-3,k)) & + +F168*( THR*f(i-4,j-2,k)-F32*f(i-3,j-2,k)+F168*f(i-2,j-2,k)-F672*f(i-1,j-2,k) & + -THR*f(i+4,j-2,k)+F32*f(i+3,j-2,k)-F168*f(i+2,j-2,k)+F672*f(i+1,j-2,k)) & + -F672*( THR*f(i-4,j-1,k)-F32*f(i-3,j-1,k)+F168*f(i-2,j-1,k)-F672*f(i-1,j-1,k) & + -THR*f(i+4,j-1,k)+F32*f(i+3,j-1,k)-F168*f(i+2,j-1,k)+F672*f(i+1,j-1,k)) & + +F672*( THR*f(i-4,j+1,k)-F32*f(i-3,j+1,k)+F168*f(i-2,j+1,k)-F672*f(i-1,j+1,k) & + -THR*f(i+4,j+1,k)+F32*f(i+3,j+1,k)-F168*f(i+2,j+1,k)+F672*f(i+1,j+1,k)) & + -F168*( THR*f(i-4,j+2,k)-F32*f(i-3,j+2,k)+F168*f(i-2,j+2,k)-F672*f(i-1,j+2,k) & + -THR*f(i+4,j+2,k)+F32*f(i+3,j+2,k)-F168*f(i+2,j+2,k)+F672*f(i+1,j+2,k)) & + +F32 *( THR*f(i-4,j+3,k)-F32*f(i-3,j+3,k)+F168*f(i-2,j+3,k)-F672*f(i-1,j+3,k) & + -THR*f(i+4,j+3,k)+F32*f(i+3,j+3,k)-F168*f(i+2,j+3,k)+F672*f(i+1,j+3,k)) & + -THR *( THR*f(i-4,j+4,k)-F32*f(i-3,j+4,k)+F168*f(i-2,j+4,k)-F672*f(i-1,j+4,k) & + -THR*f(i+4,j+4,k)+F32*f(i+3,j+4,k)-F168*f(i+2,j+4,k)+F672*f(i+1,j+4,k)) ) + + fxz = Edxdz*( THR *( THR*f(i-4,j,k-4)-F32*f(i-3,j,k-4)+F168*f(i-2,j,k-4)-F672*f(i-1,j,k-4) & + -THR*f(i+4,j,k-4)+F32*f(i+3,j,k-4)-F168*f(i+2,j,k-4)+F672*f(i+1,j,k-4)) & + -F32 *( THR*f(i-4,j,k-3)-F32*f(i-3,j,k-3)+F168*f(i-2,j,k-3)-F672*f(i-1,j,k-3) & + -THR*f(i+4,j,k-3)+F32*f(i+3,j,k-3)-F168*f(i+2,j,k-3)+F672*f(i+1,j,k-3)) & + +F168*( THR*f(i-4,j,k-2)-F32*f(i-3,j,k-2)+F168*f(i-2,j,k-2)-F672*f(i-1,j,k-2) & + -THR*f(i+4,j,k-2)+F32*f(i+3,j,k-2)-F168*f(i+2,j,k-2)+F672*f(i+1,j,k-2)) & + -F672*( THR*f(i-4,j,k-1)-F32*f(i-3,j,k-1)+F168*f(i-2,j,k-1)-F672*f(i-1,j,k-1) & + -THR*f(i+4,j,k-1)+F32*f(i+3,j,k-1)-F168*f(i+2,j,k-1)+F672*f(i+1,j,k-1)) & + +F672*( THR*f(i-4,j,k+1)-F32*f(i-3,j,k+1)+F168*f(i-2,j,k+1)-F672*f(i-1,j,k+1) & + -THR*f(i+4,j,k+1)+F32*f(i+3,j,k+1)-F168*f(i+2,j,k+1)+F672*f(i+1,j,k+1)) & + -F168*( THR*f(i-4,j,k+2)-F32*f(i-3,j,k+2)+F168*f(i-2,j,k+2)-F672*f(i-1,j,k+2) & + -THR*f(i+4,j,k+2)+F32*f(i+3,j,k+2)-F168*f(i+2,j,k+2)+F672*f(i+1,j,k+2)) & + +F32 *( THR*f(i-4,j,k+3)-F32*f(i-3,j,k+3)+F168*f(i-2,j,k+3)-F672*f(i-1,j,k+3) & + -THR*f(i+4,j,k+3)+F32*f(i+3,j,k+3)-F168*f(i+2,j,k+3)+F672*f(i+1,j,k+3)) & + -THR *( THR*f(i-4,j,k+4)-F32*f(i-3,j,k+4)+F168*f(i-2,j,k+4)-F672*f(i-1,j,k+4) & + -THR*f(i+4,j,k+4)+F32*f(i+3,j,k+4)-F168*f(i+2,j,k+4)+F672*f(i+1,j,k+4)) ) + + fyz = Edydz*( THR *( THR*f(i,j-4,k-4)-F32*f(i,j-3,k-4)+F168*f(i,j-2,k-4)-F672*f(i,j-1,k-4) & + -THR*f(i,j+4,k-4)+F32*f(i,j+3,k-4)-F168*f(i,j+2,k-4)+F672*f(i,j+1,k-4)) & + -F32 *( THR*f(i,j-4,k-3)-F32*f(i,j-3,k-3)+F168*f(i,j-2,k-3)-F672*f(i,j-1,k-3) & + -THR*f(i,j+4,k-3)+F32*f(i,j+3,k-3)-F168*f(i,j+2,k-3)+F672*f(i,j+1,k-3)) & + +F168*( THR*f(i,j-4,k-2)-F32*f(i,j-3,k-2)+F168*f(i,j-2,k-2)-F672*f(i,j-1,k-2) & + -THR*f(i,j+4,k-2)+F32*f(i,j+3,k-2)-F168*f(i,j+2,k-2)+F672*f(i,j+1,k-2)) & + -F672*( THR*f(i,j-4,k-1)-F32*f(i,j-3,k-1)+F168*f(i,j-2,k-1)-F672*f(i,j-1,k-1) & + -THR*f(i,j+4,k-1)+F32*f(i,j+3,k-1)-F168*f(i,j+2,k-1)+F672*f(i,j+1,k-1)) & + +F672*( THR*f(i,j-4,k+1)-F32*f(i,j-3,k+1)+F168*f(i,j-2,k+1)-F672*f(i,j-1,k+1) & + -THR*f(i,j+4,k+1)+F32*f(i,j+3,k+1)-F168*f(i,j+2,k+1)+F672*f(i,j+1,k+1)) & + -F168*( THR*f(i,j-4,k+2)-F32*f(i,j-3,k+2)+F168*f(i,j-2,k+2)-F672*f(i,j-1,k+2) & + -THR*f(i,j+4,k+2)+F32*f(i,j+3,k+2)-F168*f(i,j+2,k+2)+F672*f(i,j+1,k+2)) & + +F32 *( THR*f(i,j-4,k+3)-F32*f(i,j-3,k+3)+F168*f(i,j-2,k+3)-F672*f(i,j-1,k+3) & + -THR*f(i,j+4,k+3)+F32*f(i,j+3,k+3)-F168*f(i,j+2,k+3)+F672*f(i,j+1,k+3)) & + -THR *( THR*f(i,j-4,k+4)-F32*f(i,j-3,k+4)+F168*f(i,j-2,k+4)-F672*f(i,j-1,k+4) & + -THR*f(i,j+4,k+4)+F32*f(i,j+3,k+4)-F168*f(i,j+2,k+4)+F672*f(i,j+1,k+4)) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + +! 2 f(i-3) - 27 f(i-2) + 270 f(i-1) - 490 f(i) + 270 f(i+1) - 27 f(i+2) + 2 f(i+3) +! fxx(i) = ----------------------------------------------------------------------------------- +! 180 dx^2 + fxx = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then +! +! - f(i-2) + 16 f(i-1) - 30 f(i) + 16 f(i+1) - f(i+2) +! fxx(i) = ---------------------------------------------------------- +! 12 dx^2 + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then +! +! f(i-1) - 2 f(i) + f(i+1) +! fxx(i) = -------------------------------- +! dx^2 + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then +! +! - ( - f(i-3,j-3) + 9 f(i-2,j-3) - 45 f(i-1,j-3) + 45 f(i+1,j-3) - 9 f(i+2,j-3) + f(i+3,j-3) ) +! + 9 ( - f(i-3,j-2) + 9 f(i-2,j-2) - 45 f(i-1,j-2) + 45 f(i+1,j-2) - 9 f(i+2,j-2) + f(i+3,j-2) ) +! - 45 ( - f(i-3,j-1) + 9 f(i-2,j-1) - 45 f(i-1,j-1) + 45 f(i+1,j-1) - 9 f(i+2,j-1) + f(i+3,j-1) ) +! + 45 ( - f(i-3,j+1) + 9 f(i-2,j+1) - 45 f(i-1,j+1) + 45 f(i+1,j+1) - 9 f(i+2,j+1) + f(i+3,j+1) ) +! - 9 ( - f(i-3,j+2) + 9 f(i-2,j+2) - 45 f(i-1,j+2) + 45 f(i+1,j+2) - 9 f(i+2,j+2) + f(i+3,j+2) ) +! + ( - f(i-3,j+3) + 9 f(i-2,j+3) - 45 f(i-1,j+3) + 45 f(i+1,j+3) - 9 f(i+2,j+3) + f(i+3,j+3) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------ +! 3600 dx dy + fxy = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then +! +! ( f(i-2,j-2) - 8 f(i-1,j-2) + 8 f(i+1,j-2) - f(i+2,j-2) ) +! - 8 ( f(i-2,j-1) - 8 f(i-1,j-1) + 8 f(i+1,j-1) - f(i+2,j-1) ) +! + 8 ( f(i-2,j+1) - 8 f(i-1,j+1) + 8 f(i+1,j+1) - f(i+2,j+1) ) +! - ( f(i-2,j+2) - 8 f(i-1,j+2) + 8 f(i+1,j+2) - f(i+2,j+2) ) +! fxy(i,j) = ---------------------------------------------------------------- +! 144 dx dy + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then +! f(i-1,j-1) - f(i+1,j-1) - f(i-1,j+1) + f(i+1,j+1) +! fxy(i,j) = ----------------------------------------------------------- +! 4 dx dy + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + !! enddo + !! enddo + !! enddo + + return + + end subroutine point_fdderivs_sh +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! only for compute_ricci.f90 usage +!----------------------------------------------------------------------------- + subroutine point_fddxx_sh(ex,f,fxx,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxx + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdx,Fdxdx,Xdxdx,Edxdx + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdx = ONE /( dX * dX ) + + Fdxdx = F1o12 /( dX * dX ) + + Xdxdx = F1o180 /( dX * dX ) + + Edxdx = F1o5040 /( dX * dX ) + + fxx = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin )then +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + fxx = Edxdx*(-F9*f(i-4,j,k)+F128*f(i-3,j,k)-F1008*f(i-2,j,k)+F8064*f(i-1,j,k)-F14350*f(i,j,k) & + -F9*f(i+4,j,k)+F128*f(i+3,j,k)-F1008*f(i+2,j,k)+F8064*f(i+1,j,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fxx + if(i+4 <= imax .and. i-4 >= imin)then + + fxx = Edxdx*(-F9*fh(i-4,j,k)+F128*fh(i-3,j,k)-F1008*fh(i-2,j,k)+F8064*fh(i-1,j,k)-F14350*fh(i,j,k) & + -F9*fh(i+4,j,k)+F128*fh(i+3,j,k)-F1008*fh(i+2,j,k)+F8064*fh(i+1,j,k) ) + + elseif(i+3 <= imax .and. i-3 >= imin)then + fxx = Xdxdx*(TWO*fh(i-3,j,k)-F27*fh(i-2,j,k)+F270*fh(i-1,j,k)-F490*fh(i,j,k) & + +TWO*fh(i+3,j,k)-F27*fh(i+2,j,k)+F270*fh(i+1,j,k) ) + elseif(i+2 <= imax .and. i-2 >= imin)then + fxx = Fdxdx*(-fh(i-2,j,k)+F16*fh(i-1,j,k)-F30*fh(i,j,k) & + -fh(i+2,j,k)+F16*fh(i+1,j,k) ) + elseif(i+1 <= imax .and. i-1 >= imin)then + fxx = Sdxdx*(fh(i-1,j,k)-TWO*fh(i,j,k) & + +fh(i+1,j,k) ) + endif + + return + + end subroutine point_fddxx_sh + + subroutine point_fddyy_sh(ex,f,fyy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydy,Fdydy,Xdydy,Edydy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydy = ONE /( dY * dY ) + + Fdydy = F1o12 /( dY * dY ) + + Xdydy = F1o180 /( dY * dY ) + + Edydy = F1o5040 /( dY * dY ) + + fyy = ZEO + +! if inner point + if(j+4 <= jmax .and. j-4 >= jmin )then +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + + fyy = Edydy*(-F9*f(i,j-4,k)+F128*f(i,j-3,k)-F1008*f(i,j-2,k)+F8064*f(i,j-1,k)-F14350*f(i,j,k) & + -F9*f(i,j+4,k)+F128*f(i,j+3,k)-F1008*f(i,j+2,k)+F8064*f(i,j+1,k) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fyy + if(j+4 <= jmax .and. j-4 >= jmin)then + + fyy = Edydy*(-F9*fh(i,j-4,k)+F128*fh(i,j-3,k)-F1008*fh(i,j-2,k)+F8064*fh(i,j-1,k)-F14350*fh(i,j,k) & + -F9*fh(i,j+4,k)+F128*fh(i,j+3,k)-F1008*fh(i,j+2,k)+F8064*fh(i,j+1,k) ) + + elseif(j+3 <= jmax .and. j-3 >= jmin)then + + fyy = Xdydy*(TWO*fh(i,j-3,k)-F27*fh(i,j-2,k)+F270*fh(i,j-1,k)-F490*fh(i,j,k) & + +TWO*fh(i,j+3,k)-F27*fh(i,j+2,k)+F270*fh(i,j+1,k) ) + elseif(j+2 <= jmax .and. j-2 >= jmin)then + + fyy = Fdydy*(-fh(i,j-2,k)+F16*fh(i,j-1,k)-F30*fh(i,j,k) & + -fh(i,j+2,k)+F16*fh(i,j+1,k) ) + elseif(j+1 <= jmax .and. j-1 >= jmin)then + + fyy = Sdydy*(fh(i,j-1,k)-TWO*fh(i,j,k) & + +fh(i,j+1,k) ) + endif + + return + + end subroutine point_fddyy_sh + + subroutine point_fddzz_sh(ex,f,fzz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fzz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdzdz,Fdzdz,Xdzdz,Edzdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdzdz = ONE /( dZ * dZ ) + + Fdzdz = F1o12 /( dZ * dZ ) + + Xdzdz = F1o180 /( dZ * dZ ) + + Edzdz = F1o5040 /( dZ * dZ ) + + fzz = ZEO + +! if inner point + if( k+4 <= kmax .and. k-4 >= kmin )then +! - 9 f(i-4) + 128 f(i-3) - 1008 f(i-2) + 8064 f(i-1) - 14350 f(i) + 8064 f(i+1) - 1008 f(i+2) + 128 f(i+3) - 9 f(i+4) +! fxx(i) = ---------------------------------------------------------------------------------------------------------------------- +! 5040 dx^2 + + fzz = Edzdz*(-F9*f(i,j,k-4)+F128*f(i,j,k-3)-F1008*f(i,j,k-2)+F8064*f(i,j,k-1)-F14350*f(i,j,k) & + -F9*f(i,j,k+4)+F128*f(i,j,k+3)-F1008*f(i,j,k+2)+F8064*f(i,j,k+1) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fzz + if(k+4 <= kmax .and. k-4 >= kmin)then + + fzz = Edzdz*(-F9*fh(i,j,k-4)+F128*fh(i,j,k-3)-F1008*fh(i,j,k-2)+F8064*fh(i,j,k-1)-F14350*fh(i,j,k) & + -F9*fh(i,j,k+4)+F128*fh(i,j,k+3)-F1008*fh(i,j,k+2)+F8064*fh(i,j,k+1) ) + + elseif(k+3 <= kmax .and. k-3 >= kmin)then + + fzz = Xdzdz*(TWO*fh(i,j,k-3)-F27*fh(i,j,k-2)+F270*fh(i,j,k-1)-F490*fh(i,j,k) & + +TWO*fh(i,j,k+3)-F27*fh(i,j,k+2)+F270*fh(i,j,k+1) ) + elseif(k+2 <= kmax .and. k-2 >= kmin)then + + fzz = Fdzdz*(-fh(i,j,k-2)+F16*fh(i,j,k-1)-F30*fh(i,j,k) & + -fh(i,j,k+2)+F16*fh(i,j,k+1) ) + elseif(k+1 <= kmax .and. k-1 >= kmin)then + + fzz = Sdzdz*(fh(i,j,k-1)-TWO*fh(i,j,k) & + +fh(i,j,k+1) ) + endif + + return + + end subroutine point_fddzz_sh + + subroutine point_fddxy_sh(ex,f,fxy,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxy + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdy,Fdxdy,Xdxdy,Edxdy + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdy = F1o4 /( dX * dY ) + + Fdxdy = F1o144 /( dX * dY ) + + Xdxdy = F1o3600 /( dX * dY ) + + Edxdy = F1o705600 /( dX * dY ) + + fxy = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin & + .and. j+4 <= jmax .and. j-4 >= jmin )then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + fxy = Edxdy*( THR *( THR*f(i-4,j-4,k)-F32*f(i-3,j-4,k)+F168*f(i-2,j-4,k)-F672*f(i-1,j-4,k) & + -THR*f(i+4,j-4,k)+F32*f(i+3,j-4,k)-F168*f(i+2,j-4,k)+F672*f(i+1,j-4,k)) & + -F32 *( THR*f(i-4,j-3,k)-F32*f(i-3,j-3,k)+F168*f(i-2,j-3,k)-F672*f(i-1,j-3,k) & + -THR*f(i+4,j-3,k)+F32*f(i+3,j-3,k)-F168*f(i+2,j-3,k)+F672*f(i+1,j-3,k)) & + +F168*( THR*f(i-4,j-2,k)-F32*f(i-3,j-2,k)+F168*f(i-2,j-2,k)-F672*f(i-1,j-2,k) & + -THR*f(i+4,j-2,k)+F32*f(i+3,j-2,k)-F168*f(i+2,j-2,k)+F672*f(i+1,j-2,k)) & + -F672*( THR*f(i-4,j-1,k)-F32*f(i-3,j-1,k)+F168*f(i-2,j-1,k)-F672*f(i-1,j-1,k) & + -THR*f(i+4,j-1,k)+F32*f(i+3,j-1,k)-F168*f(i+2,j-1,k)+F672*f(i+1,j-1,k)) & + +F672*( THR*f(i-4,j+1,k)-F32*f(i-3,j+1,k)+F168*f(i-2,j+1,k)-F672*f(i-1,j+1,k) & + -THR*f(i+4,j+1,k)+F32*f(i+3,j+1,k)-F168*f(i+2,j+1,k)+F672*f(i+1,j+1,k)) & + -F168*( THR*f(i-4,j+2,k)-F32*f(i-3,j+2,k)+F168*f(i-2,j+2,k)-F672*f(i-1,j+2,k) & + -THR*f(i+4,j+2,k)+F32*f(i+3,j+2,k)-F168*f(i+2,j+2,k)+F672*f(i+1,j+2,k)) & + +F32 *( THR*f(i-4,j+3,k)-F32*f(i-3,j+3,k)+F168*f(i-2,j+3,k)-F672*f(i-1,j+3,k) & + -THR*f(i+4,j+3,k)+F32*f(i+3,j+3,k)-F168*f(i+2,j+3,k)+F672*f(i+1,j+3,k)) & + -THR *( THR*f(i-4,j+4,k)-F32*f(i-3,j+4,k)+F168*f(i-2,j+4,k)-F672*f(i-1,j+4,k) & + -THR*f(i+4,j+4,k)+F32*f(i+3,j+4,k)-F168*f(i+2,j+4,k)+F672*f(i+1,j+4,k)) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fxy + if(i+4 <= imax .and. i-4 >= imin .and. j+4 <= jmax .and. j-4 >= jmin)then + + fxy = Edxdy*( THR *( THR*fh(i-4,j-4,k)-F32*fh(i-3,j-4,k)+F168*fh(i-2,j-4,k)-F672*fh(i-1,j-4,k) & + -THR*fh(i+4,j-4,k)+F32*fh(i+3,j-4,k)-F168*fh(i+2,j-4,k)+F672*fh(i+1,j-4,k)) & + -F32 *( THR*fh(i-4,j-3,k)-F32*fh(i-3,j-3,k)+F168*fh(i-2,j-3,k)-F672*fh(i-1,j-3,k) & + -THR*fh(i+4,j-3,k)+F32*fh(i+3,j-3,k)-F168*fh(i+2,j-3,k)+F672*fh(i+1,j-3,k)) & + +F168*( THR*fh(i-4,j-2,k)-F32*fh(i-3,j-2,k)+F168*fh(i-2,j-2,k)-F672*fh(i-1,j-2,k) & + -THR*fh(i+4,j-2,k)+F32*fh(i+3,j-2,k)-F168*fh(i+2,j-2,k)+F672*fh(i+1,j-2,k)) & + -F672*( THR*fh(i-4,j-1,k)-F32*fh(i-3,j-1,k)+F168*fh(i-2,j-1,k)-F672*fh(i-1,j-1,k) & + -THR*fh(i+4,j-1,k)+F32*fh(i+3,j-1,k)-F168*fh(i+2,j-1,k)+F672*fh(i+1,j-1,k)) & + +F672*( THR*fh(i-4,j+1,k)-F32*fh(i-3,j+1,k)+F168*fh(i-2,j+1,k)-F672*fh(i-1,j+1,k) & + -THR*fh(i+4,j+1,k)+F32*fh(i+3,j+1,k)-F168*fh(i+2,j+1,k)+F672*fh(i+1,j+1,k)) & + -F168*( THR*fh(i-4,j+2,k)-F32*fh(i-3,j+2,k)+F168*fh(i-2,j+2,k)-F672*fh(i-1,j+2,k) & + -THR*fh(i+4,j+2,k)+F32*fh(i+3,j+2,k)-F168*fh(i+2,j+2,k)+F672*fh(i+1,j+2,k)) & + +F32 *( THR*fh(i-4,j+3,k)-F32*fh(i-3,j+3,k)+F168*fh(i-2,j+3,k)-F672*fh(i-1,j+3,k) & + -THR*fh(i+4,j+3,k)+F32*fh(i+3,j+3,k)-F168*fh(i+2,j+3,k)+F672*fh(i+1,j+3,k)) & + -THR *( THR*fh(i-4,j+4,k)-F32*fh(i-3,j+4,k)+F168*fh(i-2,j+4,k)-F672*fh(i-1,j+4,k) & + -THR*fh(i+4,j+4,k)+F32*fh(i+3,j+4,k)-F168*fh(i+2,j+4,k)+F672*fh(i+1,j+4,k)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. j+3 <= jmax .and. j-3 >= jmin)then + + fxy = Xdxdy*(- (-fh(i-3,j-3,k)+F9*fh(i-2,j-3,k)-F45*fh(i-1,j-3,k)+F45*fh(i+1,j-3,k)-F9*fh(i+2,j-3,k)+fh(i+3,j-3,k)) & + +F9 *(-fh(i-3,j-2,k)+F9*fh(i-2,j-2,k)-F45*fh(i-1,j-2,k)+F45*fh(i+1,j-2,k)-F9*fh(i+2,j-2,k)+fh(i+3,j-2,k)) & + -F45*(-fh(i-3,j-1,k)+F9*fh(i-2,j-1,k)-F45*fh(i-1,j-1,k)+F45*fh(i+1,j-1,k)-F9*fh(i+2,j-1,k)+fh(i+3,j-1,k)) & + +F45*(-fh(i-3,j+1,k)+F9*fh(i-2,j+1,k)-F45*fh(i-1,j+1,k)+F45*fh(i+1,j+1,k)-F9*fh(i+2,j+1,k)+fh(i+3,j+1,k)) & + -F9 *(-fh(i-3,j+2,k)+F9*fh(i-2,j+2,k)-F45*fh(i-1,j+2,k)+F45*fh(i+1,j+2,k)-F9*fh(i+2,j+2,k)+fh(i+3,j+2,k)) & + + (-fh(i-3,j+3,k)+F9*fh(i-2,j+3,k)-F45*fh(i-1,j+3,k)+F45*fh(i+1,j+3,k)-F9*fh(i+2,j+3,k)+fh(i+3,j+3,k))) + elseif(i+2 <= imax .and. i-2 >= imin .and. j+2 <= jmax .and. j-2 >= jmin)then + + fxy = Fdxdy*( (fh(i-2,j-2,k)-F8*fh(i-1,j-2,k)+F8*fh(i+1,j-2,k)-fh(i+2,j-2,k)) & + -F8 *(fh(i-2,j-1,k)-F8*fh(i-1,j-1,k)+F8*fh(i+1,j-1,k)-fh(i+2,j-1,k)) & + +F8 *(fh(i-2,j+1,k)-F8*fh(i-1,j+1,k)+F8*fh(i+1,j+1,k)-fh(i+2,j+1,k)) & + - (fh(i-2,j+2,k)-F8*fh(i-1,j+2,k)+F8*fh(i+1,j+2,k)-fh(i+2,j+2,k))) + elseif(i+1 <= imax .and. i-1 >= imin .and. j+1 <= jmax .and. j-1 >= jmin)then + + fxy = Sdxdy*(fh(i-1,j-1,k)-fh(i+1,j-1,k)-fh(i-1,j+1,k)+fh(i+1,j+1,k)) + endif + + return + + end subroutine point_fddxy_sh + + subroutine point_fddxz_sh(ex,f,fxz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fxz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdxdz,Fdxdz,Xdxdz,Edxdz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdxdz = F1o4 /( dX * dZ ) + + Fdxdz = F1o144 /( dX * dZ ) + + Xdxdz = F1o3600 /( dX * dZ ) + + Edxdz = F1o705600 /( dX * dZ ) + + fxz = ZEO + +! if inner point + if(i+4 <= imax .and. i-4 >= imin & + .and. k+4 <= kmax .and. k-4 >= kmin )then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + + fxz = Edxdz*( THR *( THR*f(i-4,j,k-4)-F32*f(i-3,j,k-4)+F168*f(i-2,j,k-4)-F672*f(i-1,j,k-4) & + -THR*f(i+4,j,k-4)+F32*f(i+3,j,k-4)-F168*f(i+2,j,k-4)+F672*f(i+1,j,k-4)) & + -F32 *( THR*f(i-4,j,k-3)-F32*f(i-3,j,k-3)+F168*f(i-2,j,k-3)-F672*f(i-1,j,k-3) & + -THR*f(i+4,j,k-3)+F32*f(i+3,j,k-3)-F168*f(i+2,j,k-3)+F672*f(i+1,j,k-3)) & + +F168*( THR*f(i-4,j,k-2)-F32*f(i-3,j,k-2)+F168*f(i-2,j,k-2)-F672*f(i-1,j,k-2) & + -THR*f(i+4,j,k-2)+F32*f(i+3,j,k-2)-F168*f(i+2,j,k-2)+F672*f(i+1,j,k-2)) & + -F672*( THR*f(i-4,j,k-1)-F32*f(i-3,j,k-1)+F168*f(i-2,j,k-1)-F672*f(i-1,j,k-1) & + -THR*f(i+4,j,k-1)+F32*f(i+3,j,k-1)-F168*f(i+2,j,k-1)+F672*f(i+1,j,k-1)) & + +F672*( THR*f(i-4,j,k+1)-F32*f(i-3,j,k+1)+F168*f(i-2,j,k+1)-F672*f(i-1,j,k+1) & + -THR*f(i+4,j,k+1)+F32*f(i+3,j,k+1)-F168*f(i+2,j,k+1)+F672*f(i+1,j,k+1)) & + -F168*( THR*f(i-4,j,k+2)-F32*f(i-3,j,k+2)+F168*f(i-2,j,k+2)-F672*f(i-1,j,k+2) & + -THR*f(i+4,j,k+2)+F32*f(i+3,j,k+2)-F168*f(i+2,j,k+2)+F672*f(i+1,j,k+2)) & + +F32 *( THR*f(i-4,j,k+3)-F32*f(i-3,j,k+3)+F168*f(i-2,j,k+3)-F672*f(i-1,j,k+3) & + -THR*f(i+4,j,k+3)+F32*f(i+3,j,k+3)-F168*f(i+2,j,k+3)+F672*f(i+1,j,k+3)) & + -THR *( THR*f(i-4,j,k+4)-F32*f(i-3,j,k+4)+F168*f(i-2,j,k+4)-F672*f(i-1,j,k+4) & + -THR*f(i+4,j,k+4)+F32*f(i+3,j,k+4)-F168*f(i+2,j,k+4)+F672*f(i+1,j,k+4)) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fxz + if(i+4 <= imax .and. i-4 >= imin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fxz = Edxdz*( THR *( THR*fh(i-4,j,k-4)-F32*fh(i-3,j,k-4)+F168*fh(i-2,j,k-4)-F672*fh(i-1,j,k-4) & + -THR*fh(i+4,j,k-4)+F32*fh(i+3,j,k-4)-F168*fh(i+2,j,k-4)+F672*fh(i+1,j,k-4)) & + -F32 *( THR*fh(i-4,j,k-3)-F32*fh(i-3,j,k-3)+F168*fh(i-2,j,k-3)-F672*fh(i-1,j,k-3) & + -THR*fh(i+4,j,k-3)+F32*fh(i+3,j,k-3)-F168*fh(i+2,j,k-3)+F672*fh(i+1,j,k-3)) & + +F168*( THR*fh(i-4,j,k-2)-F32*fh(i-3,j,k-2)+F168*fh(i-2,j,k-2)-F672*fh(i-1,j,k-2) & + -THR*fh(i+4,j,k-2)+F32*fh(i+3,j,k-2)-F168*fh(i+2,j,k-2)+F672*fh(i+1,j,k-2)) & + -F672*( THR*fh(i-4,j,k-1)-F32*fh(i-3,j,k-1)+F168*fh(i-2,j,k-1)-F672*fh(i-1,j,k-1) & + -THR*fh(i+4,j,k-1)+F32*fh(i+3,j,k-1)-F168*fh(i+2,j,k-1)+F672*fh(i+1,j,k-1)) & + +F672*( THR*fh(i-4,j,k+1)-F32*fh(i-3,j,k+1)+F168*fh(i-2,j,k+1)-F672*fh(i-1,j,k+1) & + -THR*fh(i+4,j,k+1)+F32*fh(i+3,j,k+1)-F168*fh(i+2,j,k+1)+F672*fh(i+1,j,k+1)) & + -F168*( THR*fh(i-4,j,k+2)-F32*fh(i-3,j,k+2)+F168*fh(i-2,j,k+2)-F672*fh(i-1,j,k+2) & + -THR*fh(i+4,j,k+2)+F32*fh(i+3,j,k+2)-F168*fh(i+2,j,k+2)+F672*fh(i+1,j,k+2)) & + +F32 *( THR*fh(i-4,j,k+3)-F32*fh(i-3,j,k+3)+F168*fh(i-2,j,k+3)-F672*fh(i-1,j,k+3) & + -THR*fh(i+4,j,k+3)+F32*fh(i+3,j,k+3)-F168*fh(i+2,j,k+3)+F672*fh(i+1,j,k+3)) & + -THR *( THR*fh(i-4,j,k+4)-F32*fh(i-3,j,k+4)+F168*fh(i-2,j,k+4)-F672*fh(i-1,j,k+4) & + -THR*fh(i+4,j,k+4)+F32*fh(i+3,j,k+4)-F168*fh(i+2,j,k+4)+F672*fh(i+1,j,k+4)) ) + elseif(i+3 <= imax .and. i-3 >= imin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fxz = Xdxdz*(- (-fh(i-3,j,k-3)+F9*fh(i-2,j,k-3)-F45*fh(i-1,j,k-3)+F45*fh(i+1,j,k-3)-F9*fh(i+2,j,k-3)+fh(i+3,j,k-3)) & + +F9 *(-fh(i-3,j,k-2)+F9*fh(i-2,j,k-2)-F45*fh(i-1,j,k-2)+F45*fh(i+1,j,k-2)-F9*fh(i+2,j,k-2)+fh(i+3,j,k-2)) & + -F45*(-fh(i-3,j,k-1)+F9*fh(i-2,j,k-1)-F45*fh(i-1,j,k-1)+F45*fh(i+1,j,k-1)-F9*fh(i+2,j,k-1)+fh(i+3,j,k-1)) & + +F45*(-fh(i-3,j,k+1)+F9*fh(i-2,j,k+1)-F45*fh(i-1,j,k+1)+F45*fh(i+1,j,k+1)-F9*fh(i+2,j,k+1)+fh(i+3,j,k+1)) & + -F9 *(-fh(i-3,j,k+2)+F9*fh(i-2,j,k+2)-F45*fh(i-1,j,k+2)+F45*fh(i+1,j,k+2)-F9*fh(i+2,j,k+2)+fh(i+3,j,k+2)) & + + (-fh(i-3,j,k+3)+F9*fh(i-2,j,k+3)-F45*fh(i-1,j,k+3)+F45*fh(i+1,j,k+3)-F9*fh(i+2,j,k+3)+fh(i+3,j,k+3))) + elseif(i+2 <= imax .and. i-2 >= imin .and. k+2 <= kmax .and. k-2 >= kmin)then + fxz = Fdxdz*( (fh(i-2,j,k-2)-F8*fh(i-1,j,k-2)+F8*fh(i+1,j,k-2)-fh(i+2,j,k-2)) & + -F8 *(fh(i-2,j,k-1)-F8*fh(i-1,j,k-1)+F8*fh(i+1,j,k-1)-fh(i+2,j,k-1)) & + +F8 *(fh(i-2,j,k+1)-F8*fh(i-1,j,k+1)+F8*fh(i+1,j,k+1)-fh(i+2,j,k+1)) & + - (fh(i-2,j,k+2)-F8*fh(i-1,j,k+2)+F8*fh(i+1,j,k+2)-fh(i+2,j,k+2))) + elseif(i+1 <= imax .and. i-1 >= imin .and. k+1 <= kmax .and. k-1 >= kmin)then + fxz = Sdxdz*(fh(i-1,j,k-1)-fh(i+1,j,k-1)-fh(i-1,j,k+1)+fh(i+1,j,k+1)) + endif + + return + + end subroutine point_fddxz_sh + + subroutine point_fddyz_sh(ex,f,fyz,X,Y,Z,SYM1,SYM2,SYM3,symmetry,sst,i,j,k) + implicit none + + integer, intent(in ):: ex(1:3),symmetry,sst,i,j,k + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ):: f + real*8, intent(out):: fyz + real*8, intent(in ):: X(ex(1)),Y(ex(2)),Z(ex(3)),SYM1,SYM2,SYM3 + +!~~~~~~ other variables + real*8 :: dX,dY,dZ + real*8,dimension(-3:ex(1)+4,-3:ex(2)+4,ex(3)) :: fh + real*8, dimension(2) :: SoA + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: Sdydz,Fdydz,Xdydz,Edydz + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + real*8, parameter :: ZEO=0.d0, ONE=1.d0, TWO=2.d0, F1o4=2.5d-1, F9=9.d0, F45=4.5d1, F128=1.28d2 + real*8, parameter :: F8=8.d0, F16=1.6d1, F30=3.d1, F27=2.7d1, F270=2.7d2, F490=4.9d2,F1008=1.008d3 + real*8, parameter :: F8064=8.064d3,F14350=1.435d4,THR=3.d0,F32=3.2d1,F168=1.68d2,F672=6.72d2 + real*8, parameter :: F1o6=ONE/6.d0, F1o12=ONE/1.2d1, F1o144=ONE/1.44d2 + real*8, parameter :: F1o180=ONE/1.8d2,F1o3600=ONE/3.6d3 + real*8, parameter :: F1o5040=ONE/5.04d3,F1o705600=ONE/7.056d5 + + dX = X(2)-X(1) + dY = Y(2)-Y(1) + dZ = Z(2)-Z(1) + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + + Sdydz = F1o4 /( dY * dZ ) + + Fdydz = F1o144 /( dY * dZ ) + + Xdydz = F1o3600 /( dY * dZ ) + + Edydz = F1o705600 /( dY * dZ ) + + fyz = ZEO + +! if inner point + if(j+4 <= jmax .and. j-4 >= jmin & + .and. k+4 <= kmax .and. k-4 >= kmin )then + +! + 3 ( 3 f(i-4,j-4) - 32 f(i-3,j-4) + 168 f(i-2,j-4) - 672 f(i-1,j-4) + 672 f(i+1,j-4) - 168 f(i+2,j-4) + 32 f(i+3,j-4) - 3 f(i+4,j-4) ) +! - 32 ( 3 f(i-4,j-3) - 32 f(i-3,j-3) + 168 f(i-2,j-3) - 672 f(i-1,j-3) + 672 f(i+1,j-3) - 168 f(i+2,j-3) + 32 f(i+3,j-3) - 3 f(i+4,j-3) ) +! + 168 ( 3 f(i-4,j-2) - 32 f(i-3,j-2) + 168 f(i-2,j-2) - 672 f(i-1,j-2) + 672 f(i+1,j-2) - 168 f(i+2,j-2) + 32 f(i+3,j-2) - 3 f(i+4,j-2) ) +! - 672 ( 3 f(i-4,j-1) - 32 f(i-3,j-1) + 168 f(i-2,j-1) - 672 f(i-1,j-1) + 672 f(i+1,j-1) - 168 f(i+2,j-1) + 32 f(i+3,j-1) - 3 f(i+4,j-1) ) +! + 672 ( 3 f(i-4,j+1) - 32 f(i-3,j+1) + 168 f(i-2,j+1) - 672 f(i-1,j+1) + 672 f(i+1,j+1) - 168 f(i+2,j+1) + 32 f(i+3,j+1) - 3 f(i+4,j+1) ) +! - 168 ( 3 f(i-4,j+2) - 32 f(i-3,j+2) + 168 f(i-2,j+2) - 672 f(i-1,j+2) + 672 f(i+1,j+2) - 168 f(i+2,j+2) + 32 f(i+3,j+2) - 3 f(i+4,j+2) ) +! + 32 ( 3 f(i-4,j+3) - 32 f(i-3,j+3) + 168 f(i-2,j+3) - 672 f(i-1,j+3) + 672 f(i+1,j+3) - 168 f(i+2,j+3) + 32 f(i+3,j+3) - 3 f(i+4,j+3) ) +! - 3 ( 3 f(i-4,j+4) - 32 f(i-3,j+4) + 168 f(i-2,j+4) - 672 f(i-1,j+4) + 672 f(i+1,j+4) - 168 f(i+2,j+4) + 32 f(i+3,j+4) - 3 f(i+4,j+4) ) +! fxy(i,j) = ------------------------------------------------------------------------------------------------------------------------------------------ +! 705600 dx dy + + fyz = Edydz*( THR *( THR*f(i,j-4,k-4)-F32*f(i,j-3,k-4)+F168*f(i,j-2,k-4)-F672*f(i,j-1,k-4) & + -THR*f(i,j+4,k-4)+F32*f(i,j+3,k-4)-F168*f(i,j+2,k-4)+F672*f(i,j+1,k-4)) & + -F32 *( THR*f(i,j-4,k-3)-F32*f(i,j-3,k-3)+F168*f(i,j-2,k-3)-F672*f(i,j-1,k-3) & + -THR*f(i,j+4,k-3)+F32*f(i,j+3,k-3)-F168*f(i,j+2,k-3)+F672*f(i,j+1,k-3)) & + +F168*( THR*f(i,j-4,k-2)-F32*f(i,j-3,k-2)+F168*f(i,j-2,k-2)-F672*f(i,j-1,k-2) & + -THR*f(i,j+4,k-2)+F32*f(i,j+3,k-2)-F168*f(i,j+2,k-2)+F672*f(i,j+1,k-2)) & + -F672*( THR*f(i,j-4,k-1)-F32*f(i,j-3,k-1)+F168*f(i,j-2,k-1)-F672*f(i,j-1,k-1) & + -THR*f(i,j+4,k-1)+F32*f(i,j+3,k-1)-F168*f(i,j+2,k-1)+F672*f(i,j+1,k-1)) & + +F672*( THR*f(i,j-4,k+1)-F32*f(i,j-3,k+1)+F168*f(i,j-2,k+1)-F672*f(i,j-1,k+1) & + -THR*f(i,j+4,k+1)+F32*f(i,j+3,k+1)-F168*f(i,j+2,k+1)+F672*f(i,j+1,k+1)) & + -F168*( THR*f(i,j-4,k+2)-F32*f(i,j-3,k+2)+F168*f(i,j-2,k+2)-F672*f(i,j-1,k+2) & + -THR*f(i,j+4,k+2)+F32*f(i,j+3,k+2)-F168*f(i,j+2,k+2)+F672*f(i,j+1,k+2)) & + +F32 *( THR*f(i,j-4,k+3)-F32*f(i,j-3,k+3)+F168*f(i,j-2,k+3)-F672*f(i,j-1,k+3) & + -THR*f(i,j+4,k+3)+F32*f(i,j+3,k+3)-F168*f(i,j+2,k+3)+F672*f(i,j+1,k+3)) & + -THR *( THR*f(i,j-4,k+4)-F32*f(i,j-3,k+4)+F168*f(i,j-2,k+4)-F672*f(i,j-1,k+4) & + -THR*f(i,j+4,k+4)+F32*f(i,j+3,k+4)-F168*f(i,j+2,k+4)+F672*f(i,j+1,k+4)) ) + + return + endif + + if(Symmetry == OCTANT)then + if(dabs(X(1)) < dX) imin = -3 + if(dabs(Y(1)) < dY) jmin = -3 + elseif(Symmetry == EQ_SYMM)then + if((sst==2.or.sst==4).and.dabs(Y(1)) < dY) jmin = -3 + if((sst==3.or.sst==5).and.dabs(Y(ex(2))) < dY) jmax=ex(2)+4 + endif + + if(sst==0)then + SoA(1) = SYM1 + SoA(2) = SYM2 + elseif(sst==2.or.sst==3)then + SoA(1) = SYM2 + SoA(2) = SYM3 + elseif(sst==4.or.sst==5)then + SoA(1) = SYM1 + SoA(2) = SYM3 + endif + + call symmetry_stbd(4,ex,f,fh,SoA) + +!~~~~~~ fyz + if(j+4 <= jmax .and. j-4 >= jmin .and. k+4 <= kmax .and. k-4 >= kmin)then + + fyz = Edydz*( THR *( THR*fh(i,j-4,k-4)-F32*fh(i,j-3,k-4)+F168*fh(i,j-2,k-4)-F672*fh(i,j-1,k-4) & + -THR*fh(i,j+4,k-4)+F32*fh(i,j+3,k-4)-F168*fh(i,j+2,k-4)+F672*fh(i,j+1,k-4)) & + -F32 *( THR*fh(i,j-4,k-3)-F32*fh(i,j-3,k-3)+F168*fh(i,j-2,k-3)-F672*fh(i,j-1,k-3) & + -THR*fh(i,j+4,k-3)+F32*fh(i,j+3,k-3)-F168*fh(i,j+2,k-3)+F672*fh(i,j+1,k-3)) & + +F168*( THR*fh(i,j-4,k-2)-F32*fh(i,j-3,k-2)+F168*fh(i,j-2,k-2)-F672*fh(i,j-1,k-2) & + -THR*fh(i,j+4,k-2)+F32*fh(i,j+3,k-2)-F168*fh(i,j+2,k-2)+F672*fh(i,j+1,k-2)) & + -F672*( THR*fh(i,j-4,k-1)-F32*fh(i,j-3,k-1)+F168*fh(i,j-2,k-1)-F672*fh(i,j-1,k-1) & + -THR*fh(i,j+4,k-1)+F32*fh(i,j+3,k-1)-F168*fh(i,j+2,k-1)+F672*fh(i,j+1,k-1)) & + +F672*( THR*fh(i,j-4,k+1)-F32*fh(i,j-3,k+1)+F168*fh(i,j-2,k+1)-F672*fh(i,j-1,k+1) & + -THR*fh(i,j+4,k+1)+F32*fh(i,j+3,k+1)-F168*fh(i,j+2,k+1)+F672*fh(i,j+1,k+1)) & + -F168*( THR*fh(i,j-4,k+2)-F32*fh(i,j-3,k+2)+F168*fh(i,j-2,k+2)-F672*fh(i,j-1,k+2) & + -THR*fh(i,j+4,k+2)+F32*fh(i,j+3,k+2)-F168*fh(i,j+2,k+2)+F672*fh(i,j+1,k+2)) & + +F32 *( THR*fh(i,j-4,k+3)-F32*fh(i,j-3,k+3)+F168*fh(i,j-2,k+3)-F672*fh(i,j-1,k+3) & + -THR*fh(i,j+4,k+3)+F32*fh(i,j+3,k+3)-F168*fh(i,j+2,k+3)+F672*fh(i,j+1,k+3)) & + -THR *( THR*fh(i,j-4,k+4)-F32*fh(i,j-3,k+4)+F168*fh(i,j-2,k+4)-F672*fh(i,j-1,k+4) & + -THR*fh(i,j+4,k+4)+F32*fh(i,j+3,k+4)-F168*fh(i,j+2,k+4)+F672*fh(i,j+1,k+4)) ) + elseif(j+3 <= jmax .and. j-3 >= jmin .and. k+3 <= kmax .and. k-3 >= kmin)then + + fyz = Xdydz*(- (-fh(i,j-3,k-3)+F9*fh(i,j-2,k-3)-F45*fh(i,j-1,k-3)+F45*fh(i,j+1,k-3)-F9*fh(i,j+2,k-3)+fh(i,j+3,k-3)) & + +F9 *(-fh(i,j-3,k-2)+F9*fh(i,j-2,k-2)-F45*fh(i,j-1,k-2)+F45*fh(i,j+1,k-2)-F9*fh(i,j+2,k-2)+fh(i,j+3,k-2)) & + -F45*(-fh(i,j-3,k-1)+F9*fh(i,j-2,k-1)-F45*fh(i,j-1,k-1)+F45*fh(i,j+1,k-1)-F9*fh(i,j+2,k-1)+fh(i,j+3,k-1)) & + +F45*(-fh(i,j-3,k+1)+F9*fh(i,j-2,k+1)-F45*fh(i,j-1,k+1)+F45*fh(i,j+1,k+1)-F9*fh(i,j+2,k+1)+fh(i,j+3,k+1)) & + -F9 *(-fh(i,j-3,k+2)+F9*fh(i,j-2,k+2)-F45*fh(i,j-1,k+2)+F45*fh(i,j+1,k+2)-F9*fh(i,j+2,k+2)+fh(i,j+3,k+2)) & + + (-fh(i,j-3,k+3)+F9*fh(i,j-2,k+3)-F45*fh(i,j-1,k+3)+F45*fh(i,j+1,k+3)-F9*fh(i,j+2,k+3)+fh(i,j+3,k+3))) + elseif(j+2 <= jmax .and. j-2 >= jmin .and. k+2 <= kmax .and. k-2 >= kmin)then + fyz = Fdydz*( (fh(i,j-2,k-2)-F8*fh(i,j-1,k-2)+F8*fh(i,j+1,k-2)-fh(i,j+2,k-2)) & + -F8 *(fh(i,j-2,k-1)-F8*fh(i,j-1,k-1)+F8*fh(i,j+1,k-1)-fh(i,j+2,k-1)) & + +F8 *(fh(i,j-2,k+1)-F8*fh(i,j-1,k+1)+F8*fh(i,j+1,k+1)-fh(i,j+2,k+1)) & + - (fh(i,j-2,k+2)-F8*fh(i,j-1,k+2)+F8*fh(i,j+1,k+2)-fh(i,j+2,k+2))) + elseif(j+1 <= jmax .and. j-1 >= jmin .and. k+1 <= kmax .and. k-1 >= kmin)then + fyz = Sdydz*(fh(i,j-1,k-1)-fh(i,j+1,k-1)-fh(i,j-1,k+1)+fh(i,j+1,k+1)) + endif + + return + + end subroutine point_fddyz_sh + +#endif + +!common code for different finite difference order +subroutine point_fderivs_shc(ex,f,fx,fy,fz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz,i,j,k) + + implicit none + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,i,j,k + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,intent(in ):: SYM1,SYM2,SYM3 + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(out) :: fx,fy,fz + +#if 0 + double precision,dimension(ex(1),ex(2),ex(3))::gx,gy,gz + call fderivs_shc(ex,f,gx,gy,gz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + fx = gx(i,j,k) + fy = gy(i,j,k) + fz = gz(i,j,k) + +#else + double precision :: gx,gy,gz + + call point_fderivs_sh(ex,f,gx,gy,gz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst,i,j,k) + + fx = dRdx(i,j,k)*gz+drhodx(i,j,k)*gx+dsigmadx(i,j,k)*gy + fy = dRdy(i,j,k)*gz+drhody(i,j,k)*gx+dsigmady(i,j,k)*gy + fz = dRdz(i,j,k)*gz+drhodz(i,j,k)*gx+dsigmadz(i,j,k)*gy +#endif + + return + +end subroutine point_fderivs_shc + +subroutine point_fdderivs_shc(ex,f,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,i,j,k) + + implicit none + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst,i,j,k + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8,intent(in ):: SYM1,SYM2,SYM3 + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::f + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double precision,intent(out) :: fxx,fxy,fxz,fyy,fyz,fzz + real*8,parameter :: TWO = 2.d0 + +#if 0 + double precision,dimension(ex(1),ex(2),ex(3))::gxx,gxy,gxz,gyy,gyz,gzz + + call fdderivs_shc(ex,f,gxx,gxy,gxz,gyy,gyz,gzz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst,& + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = gxx(i,j,k) + fyy = gyy(i,j,k) + fzz = gzz(i,j,k) + fxy = gxy(i,j,k) + fxz = gxz(i,j,k) + fyz = gyz(i,j,k) + +#else + double precision :: gx,gy,gz,gxx,gxy,gxz,gyy,gyz,gzz + + call point_fderivs_sh(ex,f,gx,gy,gz,crho,sigma,R,SYM1, SYM2,SYM3,Symmetry,Lev,sst,i,j,k) + call point_fdderivs_sh(ex,f,gxx,gxy,gxz,gyy,gyz,gzz,crho,sigma,R,SYM1,SYM2,SYM3,Symmetry,Lev,sst,i,j,k) + + fxx = dRdxx(i,j,k)*gz+drhodxx(i,j,k)*gx+dsigmadxx(i,j,k)*gy + & + dRdx(i,j,k)*dRdx(i,j,k)*gzz+drhodx(i,j,k)*drhodx(i,j,k)*gxx+dsigmadx(i,j,k)*dsigmadx(i,j,k)*gyy + & + TWO*(dRdx(i,j,k)*drhodx(i,j,k)*gxz+dRdx(i,j,k)*dsigmadx(i,j,k)*gyz+drhodx(i,j,k)*dsigmadx(i,j,k)*gxy) + fyy = dRdyy(i,j,k)*gz+drhodyy(i,j,k)*gx+dsigmadyy(i,j,k)*gy + & + dRdy(i,j,k)*dRdy(i,j,k)*gzz+drhody(i,j,k)*drhody(i,j,k)*gxx+dsigmady(i,j,k)*dsigmady(i,j,k)*gyy + & + TWO*(dRdy(i,j,k)*drhody(i,j,k)*gxz+dRdy(i,j,k)*dsigmady(i,j,k)*gyz+drhody(i,j,k)*dsigmady(i,j,k)*gxy) + fzz = dRdzz(i,j,k)*gz+drhodzz(i,j,k)*gx+dsigmadzz(i,j,k)*gy + & + dRdz(i,j,k)*dRdz(i,j,k)*gzz+drhodz(i,j,k)*drhodz(i,j,k)*gxx+dsigmadz(i,j,k)*dsigmadz(i,j,k)*gyy + & + TWO*(dRdz(i,j,k)*drhodz(i,j,k)*gxz+dRdz(i,j,k)*dsigmadz(i,j,k)*gyz+drhodz(i,j,k)*dsigmadz(i,j,k)*gxy) + fxy = dRdxy(i,j,k)*gz+drhodxy(i,j,k)*gx+dsigmadxy(i,j,k)*gy + & + dRdx(i,j,k)*drhody(i,j,k)*gxz+dRdx(i,j,k)*dsigmady(i,j,k)*gyz+drhodx(i,j,k)*dsigmady(i,j,k)*gxy + & + dRdy(i,j,k)*drhodx(i,j,k)*gxz+dRdy(i,j,k)*dsigmadx(i,j,k)*gyz+drhody(i,j,k)*dsigmadx(i,j,k)*gxy + & + dRdx(i,j,k)*dRdy(i,j,k)*gzz+drhodx(i,j,k)*drhody(i,j,k)*gxx+dsigmadx(i,j,k)*dsigmady(i,j,k)*gyy + fxz = dRdxz(i,j,k)*gz+drhodxz(i,j,k)*gx+dsigmadxz(i,j,k)*gy + & + dRdx(i,j,k)*drhodz(i,j,k)*gxz+dRdx(i,j,k)*dsigmadz(i,j,k)*gyz+drhodx(i,j,k)*dsigmadz(i,j,k)*gxy + & + dRdz(i,j,k)*drhodx(i,j,k)*gxz+dRdz(i,j,k)*dsigmadx(i,j,k)*gyz+drhodz(i,j,k)*dsigmadx(i,j,k)*gxy + & + dRdx(i,j,k)*dRdz(i,j,k)*gzz+drhodx(i,j,k)*drhodz(i,j,k)*gxx+dsigmadx(i,j,k)*dsigmadz(i,j,k)*gyy + fyz = dRdyz(i,j,k)*gz+drhodyz(i,j,k)*gx+dsigmadyz(i,j,k)*gy + & + dRdz(i,j,k)*drhody(i,j,k)*gxz+dRdz(i,j,k)*dsigmady(i,j,k)*gyz+drhodz(i,j,k)*dsigmady(i,j,k)*gxy + & + dRdy(i,j,k)*drhodz(i,j,k)*gxz+dRdy(i,j,k)*dsigmadz(i,j,k)*gyz+drhody(i,j,k)*dsigmadz(i,j,k)*gxy + & + dRdz(i,j,k)*dRdy(i,j,k)*gzz+drhodz(i,j,k)*drhody(i,j,k)*gxx+dsigmadz(i,j,k)*dsigmady(i,j,k)*gyy +#endif + + return + +end subroutine point_fdderivs_shc diff --git a/AMSS_NCKU_source/prolongrestrict.f90 b/AMSS_NCKU_source/prolongrestrict.f90 new file mode 100644 index 0000000..46d334c --- /dev/null +++ b/AMSS_NCKU_source/prolongrestrict.f90 @@ -0,0 +1,3554 @@ + + +! old code +#if 0 +! Because of overlap determination, source region is always larger than target +! region + +#include "microdef.fh" + +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! this routine is valid for all orders finite difference +! +! 1 2 3 4 +! *---*---*---* +! ^ +! COPY directly! +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + real*8, parameter :: C1=-1.d0/1.6d1,C2=9.d0/1.6d1 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif +! it's possible a iolated point for target but not for source + FD = (uubf-llbf)/(extf-1) + CD = 2*FD + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4)+1 + ubrf = idint((uubr-base)/FD+0.4)+1 + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1).or.jmaxi.gt.extf(2).or.kmaxi.gt.extf(3))then + write(*,*)"error in restrict for" + write(*,*)"mino = ",imino,jmino,kmino + write(*,*)"maxo = ",imaxo,jmaxo,kmaxo + write(*,*)"extc = ",extc + write(*,*)"CD = ",CD + write(*,*)"mini = ",imini,jmini,kmini + write(*,*)"maxi = ",imaxi,jmaxi,kmaxi + write(*,*)"extf = ",extf + write(*,*)"FD = ",FD + write(*,*)"from" + write(*,*)lbf,ubf,extf + write(*,*)"to" + write(*,*)lbc,ubc,extc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + func(i,j,k)= funf(cxI(1),cxI(2),cxI(3)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +#endif +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! for different finite difference order usage +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#if (ghost_width == 2) +! second order code +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-1/16*f_1 + 9/16*f_2 +! -1/16*f_4 + 9/16*f_3 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-1.d0/16,C2=9.d0/16 + real*8, parameter :: C4=C1,C3=C2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-1.or.jmaxi.gt.extc(2)-1.or.kmaxi.gt.extc(3)-1)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| +! if(i/2*2 == i)then +! cxI(1) = (i+lbf(1)-1)/2 +! else +! cxI(1) = (i+lbf(1)-1)/2+1 +! endif +! if(j/2*2 == j)then +! cxI(2) = (j+lbf(2)-1)/2 +! else +! cxI(2) = (j+lbf(2)-1)/2+1 +! endif +! if(k/2*2 == k)then +! cxI(3) = (k+lbf(3)-1)/2 +! else +! cxI(3) = (k+lbf(3)-1)/2+1 +! endif +! above code segment is equivalent to + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+2 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= tmp1(2) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= tmp1(2) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= tmp1(2) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#else +#ifdef Cell + +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-1/16*(f_1+f_4) + 9/16*(f_2+f_3) +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + real*8, parameter :: C1=-1.d0/1.6d1,C2=9.d0/1.6d1 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-1.or.jmaxi.gt.extf(2)-1.or.kmaxi.gt.extf(3)-1)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+2 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*(funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2))& + +C2*(funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,4))+C2*(ya(:,:,2)+ya(:,:,3)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,4))+C2*(tmp2(:,2)+tmp2(:,3)) + func(i,j,k)= C1*(tmp1(1)+tmp1(4))+C2*(tmp1(2)+tmp1(3)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-7/128*f_1 + 105/128*f_2 +! -5/128*f_4 + 35/128*f_3 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-7.d0/1.28d2,C2=1.05d2/1.28d2 + real*8, parameter :: C4=-5.d0/1.28d2,C3= 3.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-1.or.jmaxi.gt.extc(2)-1.or.kmaxi.gt.extc(3)-1)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+2 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + + subroutine prolong3new(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-7.d0/1.28d2,C2=1.05d2/1.28d2 + real*8, parameter :: C4=-5.d0/1.28d2,C3= 3.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + real*8,dimension(3,4) :: CC + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif +!~~~~~~> prolongation start... + do i=1,3 + if(lbp(i)/2*2 == lbp(i))then + CC(i,1) = C1 + CC(i,2) = C2 + CC(i,3) = C3 + CC(i,4) = C4 + else + CC(i,1) = C4 + CC(i,2) = C3 + CC(i,3) = C2 + CC(i,4) = C1 + endif + enddo + + do k = kmino,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + + do k = kmino,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + return + + end subroutine prolong3new +#else +#error Not define Vertex nor Cell +#endif +#endif + +#elif (ghost_width == 3) +! fourth order code +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=3/256*(f_1+f_6) - 25/256*(f_2+f_5) + 75/128*(f_3+f_4) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + real*8, dimension(-1:extc(1),-1:extc(2),-1:extc(3)) :: funcc + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif + + call symmetry_bd(2,extc,func,funcc,SoA) + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference v +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+3 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + endif + else + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= tmp2(:,3) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= tmp2(:,3) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= tmp1(3) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= tmp1(3) + endif + else + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= tmp2(:,3) + funf(i,j,k)= tmp1(3) + else + funf(i,j,k)= funcc(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +#else +#ifdef Cell +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=77/8192*f_1 - 693/8192*f_2 + 3465/4096*f_3 + +! 63/8192*f_6 - 495/8192*f_5 + 1155/4096*f_4 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc +! when if=1 -> ic=0, this is different to vertex center grid + real*8, dimension(-2:extc(1),-2:extc(2),-2:extc(3)) :: funcc + integer,dimension(3) :: cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + + real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3 + real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + + call symmetry_bd(3,extc,func,funcc,SoA) + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+3 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +!-------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=3/256*(f_1+f_6) - 25/256*(f_2+f_5) + 75/128*(f_3+f_4) +!-------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + real*8, dimension(-1:extf(1),-1:extf(2),-1:extf(3)):: funff + integer,dimension(3) :: cxI + integer :: i,j,k + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-2.or.jmaxi.gt.extf(2)-2.or.kmaxi.gt.extf(3)-2)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + + call symmetry_bd(2,extf,funf,funff,SoA) + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+3 > extf)) write(*,*)"error in restrict" + tmp2= C1*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + func(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +#else +#error Not define Vertex nor Cell +#endif +#endif + +#elif (ghost_width == 4) +! sixth order code +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-5/2048*(f_1+f_8) + 49/2048*(f_2+f_7) - 245/2048*(f_3+f_6) + 1225/2048*(f_4+f_5) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + + real*8, parameter :: C1=-5.d0/2.048d3,C2=4.9d1/2.048d3,C3=-2.45d2/2.048d3,C4=1.225d3/2.048d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-3.or.jmaxi.gt.extc(2)-3.or.kmaxi.gt.extc(3)-3)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference v +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x===============x===============x| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+4 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= tmp1(4) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= tmp1(4) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#else +#ifdef Cell +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-5/2048*(f_1+f_8) + 49/2048*(f_2+f_7) - 245/2048*(f_3+f_6) + 1225/2048*(f_4+f_5) +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + real*8, parameter :: C1=-5.d0/2.048d3,C2=4.9d1/2.048d3,C3=-2.45d2/2.048d3,C4=1.225d3/2.048d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-3.or.jmaxi.gt.extf(2)-3.or.kmaxi.gt.extf(3)-3)then +!-3 is because +!|-x---x-|-x---x-|-x--- +!|- -*- -| + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + if(any(cxI+4 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + func(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-495/262144*f_1 + 5005/262144*f_2 - 27027/262144*f_3 + 225225/262144*f_4 +! -429/262144*f_8 + 4095/262144*f_7 - 19305/262144*f_6 + 75075/262144*f_5 +!-------------------------------------------------------------------------- + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + + real*8, parameter :: C1=-4.95d2/2.62144d5,C2=5.005d3/2.62144d5,C3=-2.7027d4/2.62144d5,C4=2.25225d5/2.62144d5 + real*8, parameter :: C8=-4.29d2/2.62144d5,C7=4.095d3/2.62144d5,C6=-1.9305d4/2.62144d5,C5=7.5075d4/2.62144d5 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-3.or.jmaxi.gt.extc(2)-3.or.kmaxi.gt.extc(3)-3)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+4 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +#else +#error Not define Vertex nor Cell +#endif +#endif + +#elif (ghost_width == 5) +! eighth order code +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +! f=35/65536(f_1+f_10)-405/65536*(f_2+f_9) + 567/16384*(f_3+f_8) - 2205/16384*(f_4+f_7) + 19845/32768*(f_5+f_6) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + + real*8, parameter :: C1=3.5d1/6.5536d4,C2=-4.05d2/6.5536d4,C3=5.67d2/1.6384d4 + real*8, parameter :: C4=-2.205d3/1.6384d4,C5=1.9845d4/3.2768d4 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-4.or.jmaxi.gt.extc(2)-4.or.kmaxi.gt.extc(3)-4)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+5 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= tmp1(5) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= tmp1(5) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= tmp1(5) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#else +#ifdef Cell +!--------------------------------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +! f=35/65536(f_1+f_10)-405/65536*(f_2+f_9) + 567/16384*(f_3+f_8) - 2205/16384*(f_4+f_7) + 19845/32768*(f_5+f_6) +!--------------------------------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + real*8, parameter :: C1=3.5d1/6.5536d4,C2=-4.05d2/6.5536d4,C3=5.67d2/1.6384d4 + real*8, parameter :: C4=-2.205d3/1.6384d4,C5=1.9845d4/3.2768d4 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-4.or.jmaxi.gt.extf(2)-4.or.kmaxi.gt.extf(3)-4)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+5 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + func(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +!f= 13585/33554432*f_1-159885/33554432*f_2+230945/8388608*f_3- 969969/8388608*f_4+14549535/16777216*f_5 +! +4849845/16777216*f_6- 692835/8388608*f_7+188955/8388608*f_8-138567/33554432*f_9+ 12155/33554432*f_10 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + + real*8, parameter :: C1=1.3585d4/3.3554432d7,C2=-1.59885d5/3.3554432d7,C3=2.30945d5/8.388608d6 + real*8, parameter :: C4=-9.69969d5/8.388608d6,C5=1.4549535d7/1.6777216d7,C6=4.849845d6/1.6777216d7 + real*8, parameter :: C7=-6.92835d5/8.388608d6,C8=1.88955d5/8.388608d6,C9=-1.38567d5/3.3554432d7 + real*8, parameter :: C10=1.2155d4/3.3554432d7 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-4.or.jmaxi.gt.extc(2)-4.or.kmaxi.gt.extc(3)-4)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+5 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+ C5*tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +#else +#error Not define Vertex nor Cell +#endif + +#endif + +#endif + +#endif diff --git a/AMSS_NCKU_source/prolongrestrict.h b/AMSS_NCKU_source/prolongrestrict.h new file mode 100644 index 0000000..85fed60 --- /dev/null +++ b/AMSS_NCKU_source/prolongrestrict.h @@ -0,0 +1,55 @@ + +#ifndef PROLONGRESTRICT_H +#define PROLONGRESTRICT_H + +#ifdef fortran1 +#define f_prolong3 prolong3 +#define f_prolongmix3 prolongmix3 +#define f_prolongcopy3 prolongcopy3 +#define f_restrict3 restrict3 +#endif + +#ifdef fortran2 +#define f_prolong3 PROLONG3 +#define f_prolongmix3 PROLONGMIX3 +#define f_prolongcopy3 PROLONGCOPY3 +#define f_restrict3 RESTRICT3 +#endif + +#ifdef fortran3 +#define f_prolong3 prolong3_ +#define f_prolongmix3 prolongmix3_ +#define f_prolongcopy3 prolongcopy3_ +#define f_restrict3 restrict3_ +#endif + +extern "C" +{ + int f_prolong3(int &, double *, double *, int *, double *, + double *, double *, int *, double *, + double *, double *, double *, int &); +} + +extern "C" +{ + void f_restrict3(int &, double *, double *, int *, double *, + double *, double *, int *, double *, + double *, double *, double *, int &); +} + +extern "C" +{ + int f_prolongmix3(int &, double *, double *, int *, double *, + double *, double *, int *, double *, + double *, double *, double *, int &, + double *, double *); +} + +extern "C" +{ + int f_prolongcopy3(int &, double *, double *, int *, double *, + double *, double *, int *, double *, + double *, double *, double *, int &); +} + +#endif /* PROLONGRESTRICT_H */ diff --git a/AMSS_NCKU_source/prolongrestrict_cell.f90 b/AMSS_NCKU_source/prolongrestrict_cell.f90 new file mode 100644 index 0000000..17fc43d --- /dev/null +++ b/AMSS_NCKU_source/prolongrestrict_cell.f90 @@ -0,0 +1,3649 @@ + + +! Because of overlap determination, source region is always larger than target +! region + +#include "macrodef.fh" + +#ifdef Cell +#ifdef Vertex +#error Both Cell and Vertex are defined +#endif + +!-------------------------------------------------------------------------- +! +! Prepare the data on coarse level for prolong +! valid for all finite difference order +!-------------------------------------------------------------------------- + + subroutine prolongcopy3(wei,llbc,uubc,extc,func,& + llbf,uubf,exto,funo,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,exto + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func +! both bounds ghost_width + real*8, dimension(exto(1)+2*ghost_width,exto(2)+2*ghost_width,exto(3)+2*ghost_width),intent(out):: funo + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8,dimension(1-ghost_width:extc(1),1-ghost_width:extc(2),1-ghost_width:extc(3)) :: fh + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc,cxI + integer :: i,j,k + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolongcopy3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/extc + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) +!sanity check +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| +! ^ ^ + imini=lbpc(1)-lbc(1) + 1 - ghost_width + imaxi=ubpc(1)-lbc(1) + 1 + ghost_width + jmini=lbpc(2)-lbc(2) + 1 - ghost_width + jmaxi=ubpc(2)-lbc(2) + 1 + ghost_width + kmini=lbpc(3)-lbc(3) + 1 - ghost_width + kmaxi=ubpc(3)-lbc(3) + 1 + ghost_width + + cxI(1) = imaxi-imini+1 + cxI(2) = jmaxi-jmini+1 + cxI(3) = kmaxi-kmini+1 + if(any(cxI.ne.exto+2*ghost_width).or. & + imaxi.gt.extc(1)+1.or.jmaxi.gt.extc(2)+1.or.kmaxi.gt.extc(3)+1)then + write(*,*)"error in prolongationcopy3 for" + if(any(cxI.ne.exto+2*ghost_width))then + write(*,*) cxI,exto+2*ghost_width + return + endif + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + return + endif + +! because some point needs 2*ghost_width +! while some point needs 2*ghost_width-1 +! so we use 0 to fill empty points + if(imini < 1.or.jmini < 1.or.kmini < 1)then + if(imini<1.and.dabs(llbp(1))>CD(1)) write(*,*)"prolongcopy3 warning: ",llbp(1) + if(jmini<1.and.dabs(llbp(2))>CD(2)) write(*,*)"prolongcopy3 warning: ",llbp(2) + if(kmini<1.and.dabs(llbp(3))>CD(3)) write(*,*)"prolongcopy3 warning: ",llbp(3) + call symmetry_bd(ghost_width,extc,func,fh,SoA) + if(imaxi<=extc(1).and.jmaxi<=extc(2).and.kmaxi<=extc(3))then + funo = fh(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + else + funo = 0.d0 + cxI = 0 + if(imaxi>extc(1))then + cxI(1) = 1 + imaxi = extc(1) + endif + if(jmaxi>extc(2))then + cxI(2) = 1 + jmaxi = extc(2) + endif + if(kmaxi>extc(3))then + cxI(3) = 1 + kmaxi = extc(3) + endif + funo(1:exto(1)+2*ghost_width-cxI(1), & + 1:exto(2)+2*ghost_width-cxI(2), & + 1:exto(3)+2*ghost_width-cxI(3)) = fh(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + endif + else + if(imaxi<=extc(1).and.jmaxi<=extc(2).and.kmaxi<=extc(3))then + funo = func(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + else + funo = 0.d0 + cxI = 0 + if(imaxi>extc(1))then + cxI(1) = 1 + imaxi = extc(1) + endif + if(jmaxi>extc(2))then + cxI(2) = 1 + jmaxi = extc(2) + endif + if(kmaxi>extc(3))then + cxI(3) = 1 + kmaxi = extc(3) + endif + funo(1:exto(1)+2*ghost_width-cxI(1), & + 1:exto(2)+2*ghost_width-cxI(2), & + 1:exto(3)+2*ghost_width-cxI(3)) = func(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + endif + endif + + return + + end subroutine prolongcopy3 +!================================================================================================= +#define MIX 0 +!-------------------------------------------------------------------------- +! +! Prolong data throug mix data of fine and coarse levels +!-------------------------------------------------------------------------- + + subroutine prolongmix3(wei,llbf,uubf,extf,funf,& + llbc,uubc,exti,funi,& + llbp,uubp,SoA,Symmetry, & + illb,iuub) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse fine (real inner points) + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp,illb,iuub + integer,dimension(3), intent(in) :: exti,extf + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout) :: funf +! lower bound ghost_width; upper bound ghost_width-1 + real*8, dimension(exti(1)+2*ghost_width,exti(2)+2*ghost_width,exti(3)+2*ghost_width),intent(in):: funi + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc,ilb,iub + integer :: i,j,k,n,ii,jj,kk + + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + integer,dimension(3) :: cxI,cxB,cxT,fg + + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + real*8,dimension(2*ghost_width,2*ghost_width,2*ghost_width) :: ya + real*8,dimension(2*ghost_width) :: X,Y,Z + real*8, dimension(2*ghost_width,2*ghost_width) :: tmp2 + real*8, dimension(2*ghost_width) :: tmp1 + real*8 :: ddy + real*8,dimension(3) :: ccp + +#if (ghost_width == 2) + real*8, parameter :: C1=-7.d0/1.28d2,C2=1.05d2/1.28d2 + real*8, parameter :: C4=-5.d0/1.28d2,C3= 3.5d1/1.28d2 +#elif (ghost_width == 3) + real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3 + real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3 +#elif (ghost_width == 4) + real*8, parameter :: C1=-4.95d2/2.62144d5,C2=5.005d3/2.62144d5,C3=-2.7027d4/2.62144d5,C4=2.25225d5/2.62144d5 + real*8, parameter :: C8=-4.29d2/2.62144d5,C7=4.095d3/2.62144d5,C6=-1.9305d4/2.62144d5,C5=7.5075d4/2.62144d5 +#elif (ghost_width == 5) + real*8, parameter :: C1=1.3585d4/3.3554432d7,C2=-1.59885d5/3.3554432d7,C3=2.30945d5/8.388608d6 + real*8, parameter :: C4=-9.69969d5/8.388608d6,C5=1.4549535d7/1.6777216d7,C6=4.849845d6/1.6777216d7 + real*8, parameter :: C7=-6.92835d5/8.388608d6,C8=1.88955d5/8.388608d6,C9=-1.38567d5/3.3554432d7 + real*8, parameter :: C10=1.2155d4/3.3554432d7 +#endif + + if(wei.ne.3)then + write(*,*)"prolongrestrict_cell.f90::prolongmix3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + FD = (uubf-llbf)/extf + CD = FD*2.d0 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + ilb = idint((illb-base)/FD+0.4)+1 + iub = idint((iuub-base)/FD+0.4) +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + +!sanity check +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| +! ^ ^ +! ghost_width for both sides + lbpc = lbpc - ghost_width + ubpc = ubpc + ghost_width +! index for real inner points + ilb = ilb - lbf+1 + iub = iub - lbf+1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3))then + write(*,*)"error in prolongmix3 for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)base,FD + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif + + do k=kmino,kmaxo + do j=jmino,jmaxo + do i=imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k + + ccp = llbf+(cxI-0.5d0)*FD + +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbpc + 1 + + ya = funi(cxI(1)-ghost_width+1:cxI(1)+ghost_width,cxI(2)-ghost_width+1:cxI(2)+ghost_width,cxI(3)-ghost_width+1:cxI(3)+ghost_width) + + fg = 0 + where((illb.lt.ccp).and.(iuub.gt.ccp)) fg = 1 + + if(sum(fg).eq.3)then + write(*,*)"1 error in in prolongmix3:" + write(*,*)ccp,illb,iuub + stop + endif + +! fix the wanted point at (0,0,0), set FD = 1 + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(sum(fg).eq.2)then + + cxI(1) = i + cxI(2) = j + cxI(3) = k + +!!!! set X + if(ii/2*2==ii)then +! v +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + do n=1,ghost_width + X(ghost_width-n+1) = -0.5d0-(n-1)*2 + X(ghost_width+n ) = 1.5d0+(n-1)*2 + enddo + if(cxI(1).gt.iub(1))then + cxB(1) = iub(1)-ghost_width+1+(cxI(1)-iub(1)+1-MIX)/2 + cxT(1) = iub(1) + elseif(cxI(1).lt.ilb(1))then + cxB(1) = ilb(1) + cxT(1) = ilb(1)+ghost_width-1-(ilb(1)-cxI(1)-MIX)/2 + elseif(fg(1).eq.0)then + write(*,*)"2 error in in prolongmix3:" + write(*,*)ccp(1),illb(1),iuub(1) + stop + endif + else +! v +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + do n=1,ghost_width + X(ghost_width-n+1) = -1.5d0-(n-1)*2 + X(ghost_width+n ) = 0.5d0+(n-1)*2 + enddo + if(cxI(1).gt.iub(1))then + cxB(1) = iub(1)-ghost_width+1+(cxI(1)-iub(1)-MIX)/2 + cxT(1) = iub(1) + elseif(cxI(1).lt.ilb(1))then + cxB(1) = ilb(1) + cxT(1) = ilb(1)+ghost_width-1-(ilb(1)-cxI(1)+1-MIX)/2 + elseif(fg(1).eq.0)then + write(*,*)"3 error in in prolongmix3:" + write(*,*)ccp(1),illb(1),iuub(1) + stop + endif + endif + +!!!! set Y + if(jj/2*2==jj)then + do n=1,ghost_width + Y(ghost_width-n+1) = -0.5d0-(n-1)*2 + Y(ghost_width+n ) = 1.5d0+(n-1)*2 + enddo + if(cxI(2).gt.iub(2))then + cxB(2) = iub(2)-ghost_width+1+(cxI(2)-iub(2)+1-MIX)/2 + cxT(2) = iub(2) + elseif(cxI(2).lt.ilb(2))then + cxB(2) = ilb(2) + cxT(2) = ilb(2)+ghost_width-1-(ilb(2)-cxI(2)-MIX)/2 + elseif(fg(2).eq.0)then + write(*,*)"4 error in in prolongmix3:" + write(*,*)ccp(2),illb(2),iuub(2) + stop + endif + else + do n=1,ghost_width + Y(ghost_width-n+1) = -1.5d0-(n-1)*2 + Y(ghost_width+n ) = 0.5d0+(n-1)*2 + enddo + if(cxI(2).gt.iub(2))then + cxB(2) = iub(2)-ghost_width+1+(cxI(2)-iub(2)-MIX)/2 + cxT(2) = iub(2) + elseif(cxI(2).lt.ilb(2))then + cxB(2) = ilb(2) + cxT(2) = ilb(2)+ghost_width-1-(ilb(2)-cxI(2)+1-MIX)/2 + elseif(fg(2).eq.0)then + write(*,*)"5 error in in prolongmix3:" + write(*,*)ccp(2),illb(2),iuub(2) + stop + endif + endif + +!!!! set Z + if(kk/2*2==kk)then + do n=1,ghost_width + Z(ghost_width-n+1) = -0.5d0-(n-1)*2 + Z(ghost_width+n ) = 1.5d0+(n-1)*2 + enddo + if(cxI(3).gt.iub(3))then + cxB(3) = iub(3)-ghost_width+1+(cxI(3)-iub(3)+1-MIX)/2 + cxT(3) = iub(3) + elseif(cxI(3).lt.ilb(3))then + cxB(3) = ilb(3) + cxT(3) = ilb(3)+ghost_width-1-(ilb(3)-cxI(3)-MIX)/2 + elseif(fg(3).eq.0)then + write(*,*)"6 error in in prolongmix3:" + write(*,*)ccp(3),illb(3),iuub(3) + stop + endif + else + do n=1,ghost_width + Z(ghost_width-n+1) = -1.5d0-(n-1)*2 + Z(ghost_width+n ) = 0.5d0+(n-1)*2 + enddo + if(cxI(3).gt.iub(3))then + cxB(3) = iub(3)-ghost_width+1+(cxI(3)-iub(3)-MIX)/2 + cxT(3) = iub(3) + elseif(cxI(3).lt.ilb(3))then + cxB(3) = ilb(3) + cxT(3) = ilb(3)+ghost_width-1-(ilb(3)-cxI(3)+1-MIX)/2 + elseif(fg(3).eq.0)then + write(*,*)"7 error in in prolongmix3:" + write(*,*)ccp(3),illb(3),iuub(3) + stop + endif + endif + + endif +! X, Y, and Z are possiblly not in order, I assume polint does not +! require this order +! because of the mismatch of points for fine level and coarse level +! we have to deal in this way + +! for x direction + if(sum(fg).eq.2.and.fg(1) .eq. 0.and. & + (((cxI(1).gt.iub(1)).and.(ghost_width-cxI(1)+cxB(1)+1.gt.0)).or. & + (cxI(1).lt.ilb(1)).and.(ghost_width-cxI(1)+cxT(1).le.2*ghost_width)))then + +#if (ghost_width == 2) + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + endif + endif +#elif (ghost_width == 3) + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + endif + endif +#elif (ghost_width == 4) + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + endif + endif +#elif (ghost_width == 5) + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + endif + endif +#endif + + if(cxI(1).gt.iub(1))then +! consistent to coarse level, always X(ghost_width+1) = 0 for left + do n=cxB(1),cxT(1) + X(ghost_width-cxI(1)+n+1) = dble(n-cxI(1)) + enddo + tmp1(ghost_width-cxI(1)+cxB(1)+1:ghost_width-cxI(1)+cxT(1)+1) = funf(cxB(1):cxT(1),j,k) + elseif(cxI(1).lt.ilb(1))then +! consistent to coarse level, always X(ghost_width ) = 0 for right + do n=cxB(1),cxT(1) + X(ghost_width-cxI(1)+n ) = dble(n-cxI(1)) + enddo + tmp1(ghost_width-cxI(1)+cxB(1) :ghost_width-cxI(1)+cxT(1) ) = funf(cxB(1):cxT(1),j,k) + endif + + call polint(X,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + +! for y direction + elseif(sum(fg).eq.2.and.fg(2) .eq. 0.and. & + (((cxI(2).gt.iub(2)).and.(ghost_width-cxI(2)+cxB(2)+1.gt.0)).or. & + (cxI(2).lt.ilb(2)).and.(ghost_width-cxI(2)+cxT(2).le.2*ghost_width)))then + +#if (ghost_width == 2) + if(ii/2*2==ii)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C4*tmp2(1,:)+C3*tmp2(2,:)+C2*tmp2(3,:)+C1*tmp2(4,:) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C4*tmp2(1,:)+C3*tmp2(2,:)+C2*tmp2(3,:)+C1*tmp2(4,:) + endif + endif +#elif (ghost_width == 3) + if(ii/2*2==ii)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5*tmp2(5,:)+C6*tmp2(6,:) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5*tmp2(5,:)+C6*tmp2(6,:) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C6*tmp2(1,:)+C5*tmp2(2,:)+C4*tmp2(3,:)+C3*tmp2(4,:)+C2*tmp2(5,:)+C1*tmp2(6,:) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C6*tmp2(1,:)+C5*tmp2(2,:)+C4*tmp2(3,:)+C3*tmp2(4,:)+C2*tmp2(5,:)+C1*tmp2(6,:) + endif + endif +#elif (ghost_width == 4) + if(ii/2*2==ii)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+& + C5*tmp2(5,:)+C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+& + C5*tmp2(5,:)+C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C8*tmp2(1,:)+C7*tmp2(2,:)+C6*tmp2(3,:)+C5*tmp2(4,:)+& + C4*tmp2(5,:)+C3*tmp2(6,:)+C2*tmp2(7,:)+C1*tmp2(8,:) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C8*tmp2(1,:)+C7*tmp2(2,:)+C6*tmp2(3,:)+C5*tmp2(4,:)+& + C4*tmp2(5,:)+C3*tmp2(6,:)+C2*tmp2(7,:)+C1*tmp2(8,:) + endif + endif +#elif (ghost_width == 5) + if(ii/2*2==ii)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5 *tmp2( 5,:)+& + C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:)+C9*tmp2(9,:)+C10*tmp2(10,:) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5 *tmp2( 5,:)+& + C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:)+C9*tmp2(9,:)+C10*tmp2(10,:) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C10*tmp2(1,:)+C9*tmp2(2,:)+C8*tmp2(3,:)+C7*tmp2(4,:)+C6*tmp2( 5,:)+& + C5 *tmp2(6,:)+C4*tmp2(7,:)+C3*tmp2(8,:)+C2*tmp2(9,:)+C1*tmp2(10,:) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C10*tmp2(1,:)+C9*tmp2(2,:)+C8*tmp2(3,:)+C7*tmp2(4,:)+C6*tmp2( 5,:)+& + C5 *tmp2(6,:)+C4*tmp2(7,:)+C3*tmp2(8,:)+C2*tmp2(9,:)+C1*tmp2(10,:) + endif + endif +#endif + if(cxI(2).gt.iub(2))then +! consistent to coarse level, always Y(ghost_width+1) = 0 for left + do n=cxB(2),cxT(2) + Y(ghost_width-cxI(2)+n+1) = dble(n-cxI(2)) + enddo + tmp1(ghost_width-cxI(2)+cxB(2)+1:ghost_width-cxI(2)+cxT(2)+1) = funf(i,cxB(2):cxT(2),k) + elseif(cxI(2).lt.ilb(2))then +! consistent to coarse level, always Y(ghost_width ) = 0 for right + do n=cxB(2),cxT(2) + Y(ghost_width-cxI(2)+n ) = dble(n-cxI(2)) + enddo + tmp1(ghost_width-cxI(2)+cxB(2) :ghost_width-cxI(2)+cxT(2) ) = funf(i,cxB(2):cxT(2),k) + endif + + call polint(Y,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + +! for z direction + elseif(sum(fg).eq.2.and.fg(3) .eq. 0.and. & + (((cxI(3).gt.iub(3)).and.(ghost_width-cxI(3)+cxB(3)+1.gt.0)).or. & + (cxI(3).lt.ilb(3)).and.(ghost_width-cxI(3)+cxT(3).le.2*ghost_width)))then + +#if (ghost_width == 2) + if(jj/2*2==jj)then + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:) + else + tmp2= C4*ya(1,:,:)+C3*ya(2,:,:)+C2*ya(3,:,:)+C1*ya(4,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:) + endif + else + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:) + tmp1= C4*tmp2(1,:)+C3*tmp2(2,:)+C2*tmp2(3,:)+C1*tmp2(4,:) + else + tmp2= C4*ya(1,:,:)+C3*ya(2,:,:)+C2*ya(3,:,:)+C1*ya(4,:,:) + tmp1= C4*tmp2(1,:)+C3*tmp2(2,:)+C2*tmp2(3,:)+C1*tmp2(4,:) + endif + endif +#elif (ghost_width == 3) + if(jj/2*2==jj)then + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+C5*ya(5,:,:)+C6*ya(6,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5*tmp2(5,:)+C6*tmp2(6,:) + else + tmp2= C6*ya(1,:,:)+C5*ya(2,:,:)+C4*ya(3,:,:)+C3*ya(4,:,:)+C2*ya(5,:,:)+C1*ya(6,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5*tmp2(5,:)+C6*tmp2(6,:) + endif + else + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+C5*ya(5,:,:)+C6*ya(6,:,:) + tmp1= C6*tmp2(1,:)+C5*tmp2(2,:)+C4*tmp2(3,:)+C3*tmp2(4,:)+C2*tmp2(5,:)+C1*tmp2(6,:) + else + tmp2= C6*ya(1,:,:)+C5*ya(2,:,:)+C4*ya(3,:,:)+C3*ya(4,:,:)+C2*ya(5,:,:)+C1*ya(6,:,:) + tmp1= C6*tmp2(1,:)+C5*tmp2(2,:)+C4*tmp2(3,:)+C3*tmp2(4,:)+C2*tmp2(5,:)+C1*tmp2(6,:) + endif + endif +#elif (ghost_width == 4) + if(jj/2*2==jj)then + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+& + C5*ya(5,:,:)+C6*ya(6,:,:)+C7*ya(7,:,:)+C8*ya(8,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+& + C5*tmp2(5,:)+C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:) + else + tmp2= C8*ya(1,:,:)+C7*ya(2,:,:)+C6*ya(3,:,:)+C5*ya(4,:,:)+& + C4*ya(5,:,:)+C3*ya(6,:,:)+C2*ya(7,:,:)+C1*ya(8,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+& + C5*tmp2(5,:)+C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:) + endif + else + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+& + C5*ya(5,:,:)+C6*ya(6,:,:)+C7*ya(7,:,:)+C8*ya(8,:,:) + tmp1= C8*tmp2(1,:)+C7*tmp2(2,:)+C6*tmp2(3,:)+C5*tmp2(4,:)+& + C4*tmp2(5,:)+C3*tmp2(6,:)+C2*tmp2(7,:)+C1*tmp2(8,:) + else + tmp2= C8*ya(1,:,:)+C7*ya(2,:,:)+C6*ya(3,:,:)+C5*ya(4,:,:)+& + C4*ya(5,:,:)+C3*ya(6,:,:)+C2*ya(7,:,:)+C1*ya(8,:,:) + tmp1= C8*tmp2(1,:)+C7*tmp2(2,:)+C6*tmp2(3,:)+C5*tmp2(4,:)+& + C4*tmp2(5,:)+C3*tmp2(6,:)+C2*tmp2(7,:)+C1*tmp2(8,:) + endif + endif +#elif (ghost_width == 5) + if(jj/2*2==jj)then + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+C5 *ya( 5,:,:)+& + C6*ya(6,:,:)+C7*ya(7,:,:)+C8*ya(8,:,:)+C9*ya(9,:,:)+C10*ya(10,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5 *tmp2( 5,:)+& + C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:)+C9*tmp2(9,:)+C10*tmp2(10,:) + else + tmp2= C10*ya(1,:,:)+C9*ya(2,:,:)+C8*ya(3,:,:)+C7*ya(4,:,:)+C6*ya( 5,:,:)+& + C5 *ya(6,:,:)+C4*ya(7,:,:)+C3*ya(8,:,:)+C2*ya(9,:,:)+C1*ya(10,:,:) + tmp1= C1*tmp2(1,:)+C2*tmp2(2,:)+C3*tmp2(3,:)+C4*tmp2(4,:)+C5 *tmp2( 5,:)+& + C6*tmp2(6,:)+C7*tmp2(7,:)+C8*tmp2(8,:)+C9*tmp2(9,:)+C10*tmp2(10,:) + endif + else + if(ii/2*2==ii)then + tmp2= C1*ya(1,:,:)+C2*ya(2,:,:)+C3*ya(3,:,:)+C4*ya(4,:,:)+C5 *ya( 5,:,:)+& + C6*ya(6,:,:)+C7*ya(7,:,:)+C8*ya(8,:,:)+C9*ya(9,:,:)+C10*ya(10,:,:) + tmp1= C10*tmp2(1,:)+C9*tmp2(2,:)+C8*tmp2(3,:)+C7*tmp2(4,:)+C6*tmp2( 5,:)+& + C5 *tmp2(6,:)+C4*tmp2(7,:)+C3*tmp2(8,:)+C2*tmp2(9,:)+C1*tmp2(10,:) + else + tmp2= C10*ya(1,:,:)+C9*ya(2,:,:)+C8*ya(3,:,:)+C7*ya(4,:,:)+C6*ya( 5,:,:)+& + C5 *ya(6,:,:)+C4*ya(7,:,:)+C3*ya(8,:,:)+C2*ya(9,:,:)+C1*ya(10,:,:) + tmp1= C10*tmp2(1,:)+C9*tmp2(2,:)+C8*tmp2(3,:)+C7*tmp2(4,:)+C6*tmp2( 5,:)+& + C5 *tmp2(6,:)+C4*tmp2(7,:)+C3*tmp2(8,:)+C2*tmp2(9,:)+C1*tmp2(10,:) + endif + endif +#endif + +#if 1 + if(cxI(3).gt.iub(3))then +! consistent to coarse level, always Z(ghost_width+1) = 0 for left + do n=cxB(3),cxT(3) + Z(ghost_width-cxI(3)+n+1) = dble(n-cxI(3)) + enddo + tmp1(ghost_width-cxI(3)+cxB(3)+1:ghost_width-cxI(3)+cxT(3)+1) = funf(i,j,cxB(3):cxT(3)) + elseif(cxI(3).lt.ilb(3))then +! consistent to coarse level, always Z(ghost_width ) = 0 for right + do n=cxB(3),cxT(3) + Z(ghost_width-cxI(3)+n ) = dble(n-cxI(3)) + enddo + tmp1(ghost_width-cxI(3)+cxB(3) :ghost_width-cxI(3)+cxT(3) ) = funf(i,j,cxB(3):cxT(3)) + endif + + call polint(Z,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + +#else + + if(kk/2*2==kk)then + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif +#endif + else + +#if (ghost_width == 2) + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + endif + endif +#elif (ghost_width == 3) + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5*ya(:,:,5)+C6*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*ya(:,:,1)+C5*ya(:,:,2)+C4*ya(:,:,3)+C3*ya(:,:,4)+C2*ya(:,:,5)+C1*ya(:,:,6) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + endif + endif +#elif (ghost_width == 4) + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + endif + endif +#elif (ghost_width == 5) + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+ C5*tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + else + if(kk/2*2==kk)then + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + endif + endif +#endif + endif + + enddo + enddo + enddo + + return + + end subroutine prolongmix3 +!/////////////////////////////////////////////////////////////////////////////////////////////// +! for different finite differnce order +#if (ghost_width == 2) +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-1/16*(f_1+f_4) + 9/16*(f_2+f_3) +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + real*8, parameter :: C1=-1.d0/1.6d1,C2=9.d0/1.6d1 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-1.or.jmaxi.gt.extf(2)-1.or.kmaxi.gt.extf(3)-1)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+2 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*(funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2))& + +C2*(funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+funf(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,4))+C2*(ya(:,:,2)+ya(:,:,3)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,4))+C2*(tmp2(:,2)+tmp2(:,3)) + func(i,j,k)= C1*(tmp1(1)+tmp1(4))+C2*(tmp1(2)+tmp1(3)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-7/128*f_1 + 105/128*f_2 +! -5/128*f_4 + 35/128*f_3 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-7.d0/1.28d2,C2=1.05d2/1.28d2 + real*8, parameter :: C4=-5.d0/1.28d2,C3= 3.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-1.or.jmaxi.gt.extc(2)-1.or.kmaxi.gt.extc(3)-1)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+2 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C4*ya(:,:,1)+C3*ya(:,:,2)+C2*ya(:,:,3)+C1*ya(:,:,4) + endif + tmp1= C4*tmp2(:,1)+C3*tmp2(:,2)+C2*tmp2(:,3)+C1*tmp2(:,4) + funf(i,j,k)= C4*tmp1(1)+C3*tmp1(2)+C2*tmp1(3)+C1*tmp1(4) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + + subroutine prolong3new(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-7.d0/1.28d2,C2=1.05d2/1.28d2 + real*8, parameter :: C4=-5.d0/1.28d2,C3= 3.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + real*8,dimension(3,4) :: CC + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif +!~~~~~~> prolongation start... + do i=1,3 + if(lbp(i)/2*2 == lbp(i))then + CC(i,1) = C1 + CC(i,2) = C2 + CC(i,3) = C3 + CC(i,4) = C4 + else + CC(i,1) = C4 + CC(i,2) = C3 + CC(i,3) = C2 + CC(i,4) = C1 + endif + enddo + + do k = kmino,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,1)*tmp1(1)+CC(1,2)*tmp1(2)+CC(1,3)*tmp1(3)+CC(1,4)*tmp1(4) + enddo + enddo + enddo + + do k = kmino,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,1)*tmp2(:,1)+CC(2,2)*tmp2(:,2)+CC(2,3)*tmp2(:,3)+CC(2,4)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + + do k = kmino,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,1)*ya(:,:,1)+CC(3,2)*ya(:,:,2)+CC(3,3)*ya(:,:,3)+CC(3,4)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + do k = kmino+1,kmaxo,2 + do j = jmino+1,jmaxo,2 + do i = imino+1,imaxo,2 + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= CC(3,4)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + CC(3,3)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + CC(3,2)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + CC(3,1)*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= CC(3,4)*ya(:,:,1)+CC(3,3)*ya(:,:,2)+CC(3,2)*ya(:,:,3)+CC(3,1)*ya(:,:,4) + endif + tmp1= CC(2,4)*tmp2(:,1)+CC(2,3)*tmp2(:,2)+CC(2,2)*tmp2(:,3)+CC(2,1)*tmp2(:,4) + funf(i,j,k)= CC(1,4)*tmp1(1)+CC(1,3)*tmp1(2)+CC(1,2)*tmp1(3)+CC(1,1)*tmp1(4) + enddo + enddo + enddo + + return + + end subroutine prolong3new + +#elif (ghost_width == 3) +! fourth order code +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=77/8192*f_1 - 693/8192*f_2 + 3465/4096*f_3 + +! 63/8192*f_6 - 495/8192*f_5 + 1155/4096*f_4 +!-------------------------------------------------------------------------- +#if 1 + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine fine + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc +! when if=1 -> ic=0, this is different to vertex center grid + real*8, dimension(-2:extc(1),-2:extc(2),-2:extc(3)) :: funcc + integer,dimension(3) :: cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + + real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3 + real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + + if(any(dabs(CD-2*FD)>1.d-10))then + write(*,*)"prolong:",CD,FD + stop + endif + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 ! this is wrong, but not essential + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) ! this is wrong, but not essential + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + + call symmetry_bd(3,extc,func,funcc,SoA) + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+3 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 +#if 0 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + else + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + endif + endif +#else + if(kk/2*2==kk)then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + endif + + if(jj/2*2==jj)then + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + else + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + endif + + if(ii/2*2==ii)then + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif +#endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#else + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine fine + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(extc(1)) :: cX + real*8, dimension(extc(2)) :: cY + real*8, dimension(extc(3)) :: cZ + real*8, dimension(extf(1)) :: fX + real*8, dimension(extf(2)) :: fY + real*8, dimension(extf(3)) :: fZ +! when if=1 -> ic=0, this is different to vertex center grid + real*8, dimension(-2:extc(1),-2:extc(2),-2:extc(3)) :: funcc + integer,dimension(3) :: cxI + integer :: i,j,k + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + + real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3 + real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + real*8 :: tr + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + + do i=1,extc(1) + cX(i) = llbc(1) + (i-0.5d0)*CD(1) + enddo + do i=1,extc(2) + cY(i) = llbc(2) + (i-0.5d0)*CD(2) + enddo + do i=1,extc(3) + cZ(i) = llbc(3) + (i-0.5d0)*CD(3) + enddo + + do i=1,extf(1) + fX(i) = llbf(1) + (i-0.5d0)*FD(1) + enddo + do i=1,extf(2) + fY(i) = llbf(2) + (i-0.5d0)*FD(2) + enddo + do i=1,extf(3) + fZ(i) = llbf(3) + (i-0.5d0)*FD(3) + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +!sanity check, 0.4 is for round off error + imino=idint((llbp(1)-fX(1))/FD(1)+0.5+0.4)+1 + imaxo=idint((uubp(1)-fX(1))/FD(1)-0.5+0.4)+1 + jmino=idint((llbp(2)-fY(1))/FD(2)+0.5+0.4)+1 + jmaxo=idint((uubp(2)-fY(1))/FD(2)-0.5+0.4)+1 + kmino=idint((llbp(3)-fZ(1))/FD(3)+0.5+0.4)+1 + kmaxo=idint((uubp(3)-fZ(1))/FD(3)-0.5+0.4)+1 + +! these are wrong, butnot essential + imini=idint((llbp(1)-cX(1))/CD(1)+0.5)+1 + imaxi=idint((uubp(1)-cX(1))/CD(1)-0.5)+1 + jmini=idint((llbp(2)-cY(1))/CD(2)+0.5)+1 + jmaxi=idint((uubp(2)-cY(1))/CD(2)-0.5)+1 + kmini=idint((llbp(3)-cZ(1))/CD(3)+0.5)+1 + kmaxi=idint((uubp(3)-cZ(1))/CD(3)-0.5)+1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)"want" + write(*,*)llbp,uubp + return + endif + + call symmetry_bd(3,extc,func,funcc,SoA) + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! floor(4.8)= 4,floor(-5.6)= - 6 + cxI(1) = floor((fX(i)-cX(1))/CD(1))+1 + cxI(2) = floor((fY(j)-cY(1))/CD(2))+1 + cxI(3) = floor((fZ(k)-cZ(1))/CD(3))+1 + + tr = cZ(1)+(cxI(3)-1)*CD(3) + if(fZ(k)-tr < FD(3))then + tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + else + tmp2= C6*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+& + C5*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+& + C4*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+& + C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)+& + C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2)+& + C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3) + endif + + tr = cY(1)+(cxI(2)-1)*CD(2) + if(fY(j)-tr < FD(2))then + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6) + else + tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6) + endif + + tr = cX(1)+(cxI(1)-1)*CD(1) + if(fX(i)-tr < FD(1))then + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6) + else + funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6) + endif + + enddo + enddo + enddo + + return + + end subroutine prolong3 +#endif +!-------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=3/256*(f_1+f_6) - 25/256*(f_2+f_5) + 75/128*(f_3+f_4) +!-------------------------------------------------------------------------- +#if 1 + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + real*8, dimension(-1:extf(1),-1:extf(2),-1:extf(3)):: funff + integer,dimension(3) :: cxI + integer :: i,j,k + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + + if(any(dabs(CD-2*FD)>1.d-10))then + write(*,*)"restrict:",CD,FD + stop + endif +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 !this is wrong but not essential + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) !this is wrong but not essential + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-2.or.jmaxi.gt.extf(2)-2.or.kmaxi.gt.extf(3)-2)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + + call symmetry_bd(2,extf,funf,funff,SoA) + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+3 > extf)) write(*,*)"error in restrict" + tmp2= C1*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + func(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +#else + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(extc(1)) :: cX + real*8, dimension(extc(2)) :: cY + real*8, dimension(extc(3)) :: cZ + real*8, dimension(extf(1)) :: fX + real*8, dimension(extf(2)) :: fY + real*8, dimension(extf(3)) :: fZ + real*8, dimension(-1:extf(1),-1:extf(2),-1:extf(3)):: funff + integer,dimension(3) :: cxI + integer :: i,j,k + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + + do i=1,extc(1) + cX(i) = llbc(1) + (i-0.5)*CD(1) + enddo + do i=1,extc(2) + cY(i) = llbc(2) + (i-0.5)*CD(2) + enddo + do i=1,extc(3) + cZ(i) = llbc(3) + (i-0.5)*CD(3) + enddo + + do i=1,extf(1) + fX(i) = llbf(1) + (i-0.5)*FD(1) + enddo + do i=1,extf(2) + fY(i) = llbf(2) + (i-0.5)*FD(2) + enddo + do i=1,extf(3) + fZ(i) = llbf(3) + (i-0.5)*FD(3) + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +!sanity check +!these are wrong but not essential + imini=idint((llbr(1)-fX(1))/FD(1)+0.5)+1 + imaxi=idint((uubr(1)-fX(1))/FD(1)-0.5)+1 + jmini=idint((llbr(2)-fY(1))/FD(2)+0.5)+1 + jmaxi=idint((uubr(2)-fY(1))/FD(2)-0.5)+1 + kmini=idint((llbr(3)-fZ(1))/FD(3)+0.5)+1 + kmaxi=idint((uubr(3)-fZ(1))/FD(3)-0.5)+1 + + imino=idint((llbr(1)-cX(1))/CD(1)+0.5+0.4)+1 + imaxo=idint((uubr(1)-cX(1))/CD(1)-0.5+0.4)+1 + jmino=idint((llbr(2)-cY(1))/CD(2)+0.5+0.4)+1 + jmaxo=idint((uubr(2)-cY(1))/CD(2)-0.5+0.4)+1 + kmino=idint((llbr(3)-cZ(1))/CD(3)+0.5+0.4)+1 + kmaxo=idint((uubr(3)-cZ(1))/CD(3)-0.5+0.4)+1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-2.or.jmaxi.gt.extf(2)-2.or.kmaxi.gt.extf(3)-2)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)llbf,uubf + write(*,*)"to" + write(*,*)llbc,uubc + write(*,*)"want" + write(*,*)llbr,uubr + stop + endif + + call symmetry_bd(2,extf,funf,funff,SoA) + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + +! floor(4.8)= 4,floor(-5.6)= - 6 + cxI(1) = floor((CX(i)-fX(1))/FD(1))+1 + cxI(2) = floor((CY(j)-fY(1))/FD(2))+1 + cxI(3) = floor((CZ(k)-fZ(1))/FD(3))+1 + + tmp2= C1*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funff(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + func(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +#endif +#elif (ghost_width == 4) +! sixth order code +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-5/2048*(f_1+f_8) + 49/2048*(f_2+f_7) - 245/2048*(f_3+f_6) + 1225/2048*(f_4+f_5) +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + real*8, parameter :: C1=-5.d0/2.048d3,C2=4.9d1/2.048d3,C3=-2.45d2/2.048d3,C4=1.225d3/2.048d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-3.or.jmaxi.gt.extf(2)-3.or.kmaxi.gt.extf(3)-3)then +!-3 is because +!|-x---x-|-x---x-|-x--- +!|- -*- -| + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + if(any(cxI+4 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+funf(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + func(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-495/262144*f_1 + 5005/262144*f_2 - 27027/262144*f_3 + 225225/262144*f_4 +! -429/262144*f_8 + 4095/262144*f_7 - 19305/262144*f_6 + 75075/262144*f_5 +!-------------------------------------------------------------------------- + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + + real*8, parameter :: C1=-4.95d2/2.62144d5,C2=5.005d3/2.62144d5,C3=-2.7027d4/2.62144d5,C4=2.25225d5/2.62144d5 + real*8, parameter :: C8=-4.29d2/2.62144d5,C7=4.095d3/2.62144d5,C6=-1.9305d4/2.62144d5,C5=7.5075d4/2.62144d5 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-3.or.jmaxi.gt.extc(2)-3.or.kmaxi.gt.extc(3)-3)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+4 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+& + C5*tmp1(5)+C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+& + C5*tmp2(:,5)+C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+& + C5*ya(:,:,5)+C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C8*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+& + C7*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+& + C6*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+& + C5*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+& + C4*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)+& + C3*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2)+& + C2*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3)+& + C1*func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-0.5)*FD(1),llbf(2)+(j-0.5)*FD(2),llbf(3)+(k-0.5)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= C8*ya(:,:,1)+C7*ya(:,:,2)+C6*ya(:,:,3)+C5*ya(:,:,4)+& + C4*ya(:,:,5)+C3*ya(:,:,6)+C2*ya(:,:,7)+C1*ya(:,:,8) + endif + tmp1= C8*tmp2(:,1)+C7*tmp2(:,2)+C6*tmp2(:,3)+C5*tmp2(:,4)+& + C4*tmp2(:,5)+C3*tmp2(:,6)+C2*tmp2(:,7)+C1*tmp2(:,8) + funf(i,j,k)= C8*tmp1(1)+C7*tmp1(2)+C6*tmp1(3)+C5*tmp1(4)+& + C4*tmp1(5)+C3*tmp1(6)+C2*tmp1(7)+C1*tmp1(8) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#elif (ghost_width == 5) +! eighth order code +!--------------------------------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +! f=35/65536(f_1+f_10)-405/65536*(f_2+f_9) + 567/16384*(f_3+f_8) - 2205/16384*(f_4+f_7) + 19845/32768*(f_5+f_6) +!--------------------------------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in)::wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + real*8, parameter :: C1=3.5d1/6.5536d4,C2=-4.05d2/6.5536d4,C3=5.67d2/1.6384d4 + real*8, parameter :: C4=-2.205d3/1.6384d4,C5=1.9845d4/3.2768d4 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + +! note say base = 0, llbf = 0, uubf = 2 +! llbf->1 and uubf->2 + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4) + ubrf = idint((uubr-base)/FD+0.4) + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1)-4.or.jmaxi.gt.extf(2)-4.or.kmaxi.gt.extf(3)-4)then + write(*,*)"error in restrict for" + write(*,*)"from" + write(*,*)lbf,ubf + write(*,*)"to" + write(*,*)lbc,ubc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + write(*,*)"base = ",base + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + if(any(cxI+5 > extf)) write(*,*)"error in restrict" +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+funf(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extf,funf,funf,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"restrict3 position index: ",i+lbc(1)-1,j+lbc(2)-1,k+lbc(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + func(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +!f= 13585/33554432*f_1-159885/33554432*f_2+230945/8388608*f_3- 969969/8388608*f_4+14549535/16777216*f_5 +! +4849845/16777216*f_6- 692835/8388608*f_7+188955/8388608*f_8-138567/33554432*f_9+ 12155/33554432*f_10 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + + real*8, parameter :: C1=1.3585d4/3.3554432d7,C2=-1.59885d5/3.3554432d7,C3=2.30945d5/8.388608d6 + real*8, parameter :: C4=-9.69969d5/8.388608d6,C5=1.4549535d7/1.6777216d7,C6=4.849845d6/1.6777216d7 + real*8, parameter :: C7=-6.92835d5/8.388608d6,C8=1.88955d5/8.388608d6,C9=-1.38567d5/3.3554432d7 + real*8, parameter :: C10=1.2155d4/3.3554432d7 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + + CD = (uubc-llbc)/extc + FD = (uubf-llbf)/extf + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4) + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4) + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4) + ubpc = idint((uubp-base)/CD+0.4) + +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-4.or.jmaxi.gt.extc(2)-4.or.kmaxi.gt.extc(3)-4)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + return + endif + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to coarse level reference +!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| +!|=======x===============x===============x===============x=======| + cxI = (cxI+lbf-1)/2 +! change to array index + cxI = cxI - lbc + 1 + + if(any(cxI+5 > extc)) write(*,*)"error in prolong" + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+ C5*tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5 *tmp1( 5)+& + C6*tmp1(6)+C7*tmp1(7)+C8*tmp1(8)+C9*tmp1(9)+C10*tmp1(10) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5 *tmp2(:, 5)+& + C6*tmp2(:,6)+C7*tmp2(:,7)+C8*tmp2(:,8)+C9*tmp2(:,9)+C10*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4)+C5 *ya(:,:, 5)+& + C6*ya(:,:,6)+C7*ya(:,:,7)+C8*ya(:,:,8)+C9*ya(:,:,9)+C10*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C10*func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+& + C9 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+& + C8 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+& + C7 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+& + C6 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+& + C5 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)+& + C4 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2)+& + C3 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3)+& + C2 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4)+& + C1 *func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C10*ya(:,:,1)+C9*ya(:,:,2)+C8*ya(:,:,3)+C7*ya(:,:,4)+C6*ya(:,:, 5)+& + C5 *ya(:,:,6)+C4*ya(:,:,7)+C3*ya(:,:,8)+C2*ya(:,:,9)+C1*ya(:,:,10) + endif + tmp1= C10*tmp2(:,1)+C9*tmp2(:,2)+C8*tmp2(:,3)+C7*tmp2(:,4)+C6*tmp2(:, 5)+& + C5 *tmp2(:,6)+C4*tmp2(:,7)+C3*tmp2(:,8)+C2*tmp2(:,9)+C1*tmp2(:,10) + funf(i,j,k)= C10*tmp1(1)+C9*tmp1(2)+C8*tmp1(3)+C7*tmp1(4)+C6*tmp1( 5)+& + C5 *tmp1(6)+C4*tmp1(7)+C3*tmp1(8)+C2*tmp1(9)+C1*tmp1(10) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +#endif + +#else +#ifndef Vertex +#error Not define Vertex nor Cell +#endif +#endif diff --git a/AMSS_NCKU_source/prolongrestrict_vertex.f90 b/AMSS_NCKU_source/prolongrestrict_vertex.f90 new file mode 100644 index 0000000..5cfb1f9 --- /dev/null +++ b/AMSS_NCKU_source/prolongrestrict_vertex.f90 @@ -0,0 +1,1925 @@ + + +! Because of overlap determination, source region is always larger than target +! region + +#include "macrodef.fh" + +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + +!-------------------------------------------------------------------------- +! +! Prepare the data on coarse level for prolong +! valid for all finite difference order +!-------------------------------------------------------------------------- + + subroutine prolongcopy3(wei,llbc,uubc,extc,func,& + llbf,uubf,exto,funo,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,exto + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func +! both bounds ghost_width + real*8, dimension(exto(1)+2*ghost_width,exto(2)+2*ghost_width,exto(3)+2*ghost_width),intent(out):: funo + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8,dimension(1-ghost_width:extc(1),1-ghost_width:extc(2),1-ghost_width:extc(3)) :: fh + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc,cxI + integer :: i,j,k + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolongcopy3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| +! ^ ^ + imini=lbpc(1)-lbc(1) + 1 - ghost_width + imaxi=ubpc(1)-lbc(1) + 1 + ghost_width + jmini=lbpc(2)-lbc(2) + 1 - ghost_width + jmaxi=ubpc(2)-lbc(2) + 1 + ghost_width + kmini=lbpc(3)-lbc(3) + 1 - ghost_width + kmaxi=ubpc(3)-lbc(3) + 1 + ghost_width + + cxI(1) = imaxi-imini+1 + cxI(2) = jmaxi-jmini+1 + cxI(3) = kmaxi-kmini+1 + if(any(cxI.ne.exto+2*ghost_width).or. & + imaxi.gt.extc(1)+1.or.jmaxi.gt.extc(2)+1.or.kmaxi.gt.extc(3)+1)then + write(*,*)"error in prolongationcopy3 for" + if(any(cxI.ne.exto+2*ghost_width))then + write(*,*) cxI,exto+2*ghost_width + return + endif + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + return + endif + +! because some point needs 2*ghost_width +! while some point needs 2*ghost_width-1 +! so we use 0 to fill empty points + if(imini < 1.or.jmini < 1.or.kmini < 1)then + if(imini<1.and.dabs(llbp(1))>CD(1)) write(*,*)"prolongcopy3 warning: ",llbp(1) + if(jmini<1.and.dabs(llbp(2))>CD(2)) write(*,*)"prolongcopy3 warning: ",llbp(2) + if(kmini<1.and.dabs(llbp(3))>CD(3)) write(*,*)"prolongcopy3 warning: ",llbp(3) + call symmetry_bd(ghost_width,extc,func,fh,SoA) + if(imaxi<=extc(1).and.jmaxi<=extc(2).and.kmaxi<=extc(3))then + funo = fh(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + else + funo = 0.d0 + cxI = 0 + if(imaxi>extc(1))then + cxI(1) = 1 + imaxi = extc(1) + endif + if(jmaxi>extc(2))then + cxI(2) = 1 + jmaxi = extc(2) + endif + if(kmaxi>extc(3))then + cxI(3) = 1 + kmaxi = extc(3) + endif + funo(1:exto(1)+2*ghost_width-cxI(1), & + 1:exto(2)+2*ghost_width-cxI(2), & + 1:exto(3)+2*ghost_width-cxI(3)) = fh(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + endif + else + if(imaxi<=extc(1).and.jmaxi<=extc(2).and.kmaxi<=extc(3))then + funo = func(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + else + funo = 0.d0 + cxI = 0 + if(imaxi>extc(1))then + cxI(1) = 1 + imaxi = extc(1) + endif + if(jmaxi>extc(2))then + cxI(2) = 1 + jmaxi = extc(2) + endif + if(kmaxi>extc(3))then + cxI(3) = 1 + kmaxi = extc(3) + endif + funo(1:exto(1)+2*ghost_width-cxI(1), & + 1:exto(2)+2*ghost_width-cxI(2), & + 1:exto(3)+2*ghost_width-cxI(3)) = func(imini:imaxi,jmini:jmaxi,kmini:kmaxi) + endif + endif + + return + + end subroutine prolongcopy3 +!================================================================================================= +!-------------------------------------------------------------------------- +! +! Prolong data throug mix data of fine and coarse levels +!-------------------------------------------------------------------------- + + subroutine prolongmix3(wei,llbf,uubf,extf,funf,& + llbc,uubc,exti,funi,& + llbp,uubp,SoA,Symmetry, & + illb,iuub) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse fine (real inner points) + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp,illb,iuub + integer,dimension(3), intent(in) :: exti,extf + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout) :: funf +! lower bound ghost_width; upper bound ghost_width-1 + real*8, dimension(exti(1)+2*ghost_width,exti(2)+2*ghost_width,exti(3)+2*ghost_width),intent(in):: funi + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8,dimension(1-ghost_width:extf(1),1-ghost_width:extf(2),1-ghost_width:extf(3)) :: fh + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc,ilb,iub + integer :: i,j,k,n,ii,jj,kk + + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + + real*8,dimension(3) :: CD,FD + integer,dimension(3) :: cxI,cxB,cxT,fg + + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + real*8,dimension(2*ghost_width,2*ghost_width,2*ghost_width) :: ya + real*8,dimension(2*ghost_width) :: X,Y,Z + real*8, dimension(2*ghost_width,2*ghost_width) :: tmp2 + real*8, dimension(2*ghost_width) :: tmp1 + real*8 :: ddy + +#if (ghost_width == 2) + real*8, parameter :: C1=-1.d0/16,C2=9.d0/16 +#elif (ghost_width == 3) + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 +#elif (ghost_width == 4) + real*8, parameter :: C1=-5.d0/2.048d3,C2=4.9d1/2.048d3,C3=-2.45d2/2.048d3,C4=1.225d3/2.048d3 +#elif (ghost_width == 5) + real*8, parameter :: C1=3.5d1/6.5536d4,C2=-4.05d2/6.5536d4,C3=5.67d2/1.6384d4 + real*8, parameter :: C4=-2.205d3/1.6384d4,C5=1.9845d4/3.2768d4 +#endif + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolongmix3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + FD = (uubf-llbf)/(extf-1) + CD = FD*2.d0 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 + ilb = idint((illb-base)/FD+0.4)+1 + iub = idint((iuub-base)/FD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + +!sanity check +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x| +! ^ ^ +! ghost_width for both sides + lbpc = lbpc - ghost_width + ubpc = ubpc + ghost_width +! index for real inner points + ilb = ilb - lbf+1 + iub = iub - lbf+1 + +! because of domain division by parallelization + ilb = max(ilb,1) + iub = min(iub,extf) + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3))then + write(*,*)"error in prolongmix3 for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)base,FD + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif + + if(Symmetry > NO_SYMM .and. dabs(illb(3)) < FD(3)) ilb(3) = 1-ghost_width + if(Symmetry > EQ_SYMM .and. dabs(illb(1)) < FD(1)) ilb(1) = 1-ghost_width + if(Symmetry > EQ_SYMM .and. dabs(illb(2)) < FD(2)) ilb(2) = 1-ghost_width + + if(any(ilb<1))then + call symmetry_bd(ghost_width,extf,funf,fh,SoA) + else + fh(1:extf(1),1:extf(2),1:extf(3)) = funf + endif + + do k=kmino,kmaxo + do j=jmino,jmaxo + do i=imino,imaxo + cxI(1) = i + cxI(2) = j + cxI(3) = k + +! for fine level we use cxI-ghost_width,....cxI,....cxI+ghost_width-1 + cxB = max(cxI-ghost_width ,ilb) + cxT = min(cxI+ghost_width-1,iub) +! change to coarse level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x| + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbpc + 1 + + ya = funi(cxI(1)-ghost_width+1:cxI(1)+ghost_width,cxI(2)-ghost_width+1:cxI(2)+ghost_width,cxI(3)-ghost_width+1:cxI(3)+ghost_width) + + fg = 0 + if(cxT(1)>=i.and.cxB(1)<=i) fg(1) = 1 + if(cxT(2)>=j.and.cxB(2)<=j) fg(2) = 1 + if(cxT(3)>=k.and.cxB(3)<=k) fg(3) = 1 + + if(cxT(1)>=cxB(1) .and. cxT(2)>=cxB(2) .and. cxT(3)>=cxB(3).and. sum(fg).eq.2)then + if(any(cxB<1-ghost_width).or.any(cxT>extf))then + write(*,*) "error in prolongmix3: " + if(any(cxB<1-ghost_width)) write(*,*) cxB,1-ghost_width + if(any(cxT>extf) ) write(*,*) cxT,extf,iuub,uubf + stop + endif + +! fix the wanted point at (0,0,0), set FD = 1 + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(ii/2*2==ii)then + do n=1,ghost_width + X(ghost_width-n+1) = -1.d0-(n-1)*2 + X(ghost_width+n ) = 1.d0+(n-1)*2 + enddo + else + do n=1,ghost_width + X(ghost_width-n+1) = -(n-1)*2.d0 + X(ghost_width+n ) = n *2.d0 + enddo + endif + + if(jj/2*2==jj)then + do n=1,ghost_width + Y(ghost_width-n+1) = -1.d0-(n-1)*2 + Y(ghost_width+n ) = 1.d0+(n-1)*2 + enddo + else + do n=1,ghost_width + Y(ghost_width-n+1) = -(n-1)*2.d0 + Y(ghost_width+n ) = n *2.d0 + enddo + endif + + if(kk/2*2==kk)then + do n=1,ghost_width + Z(ghost_width-n+1) = -1.d0-(n-1)*2 + Z(ghost_width+n ) = 1.d0+(n-1)*2 + enddo + else + do n=1,ghost_width + Z(ghost_width-n+1) = -(n-1)*2.d0 + Z(ghost_width+n ) = n *2.d0 + enddo + endif + +! i=>(ghost_width,0), i-ghost_width=>(1,1-ghost_width) + do n=cxB(1)+ghost_width-i+1,cxT(1)+ghost_width-i+1 + X(n) = n-ghost_width + enddo + + do n=cxB(2)+ghost_width-j+1,cxT(2)+ghost_width-j+1 + Y(n) = n-ghost_width + enddo + + do n=cxB(3)+ghost_width-k+1,cxT(3)+ghost_width-k+1 + Z(n) = n-ghost_width + enddo + +! because of the mismatch of points for fine level and coarse level +! we have to deal in this way + +! for x direction + if(fg(1) .eq. 0)then + +#if (ghost_width == 2) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,4))+C2*(ya(:,:,2)+ya(:,:,3)) + else + tmp2= ya(:,:,2) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,4))+C2*(tmp2(:,2)+tmp2(:,3)) + else + tmp1= tmp2(:,2) + endif +#elif (ghost_width == 3) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,6))+C2*(ya(:,:,2)+ya(:,:,5))+C3*(ya(:,:,3)+ya(:,:,4)) + else + tmp2= ya(:,:,3) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + else + tmp1= tmp2(:,3) + endif +#elif (ghost_width == 4) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7)) & + +C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + else + tmp2= ya(:,:,4) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7)) & + +C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + else + tmp1= tmp2(:,4) + endif +#elif (ghost_width == 5) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9)) & + +C3*(ya(:,:,3)+ya(:,:,8 ))+C4*(ya(:,:,4)+ya(:,:,7)) & + +C5*(ya(:,:,5)+ya(:,:,6 )) + else + tmp2= ya(:,:,5) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9)) & + +C3*(tmp2(:,3)+tmp2(:,8 ))+C4*(tmp2(:,4)+tmp2(:,7)) & + +C5*(tmp2(:,5)+tmp2(:,6 )) + else + tmp1= tmp2(:,5) + endif +#endif + + tmp1(cxB(1)+ghost_width-i+1:cxT(1)+ghost_width-i+1) = fh(cxB(1):cxT(1),j,k) + + call polint(X,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + +! for y direction + elseif (fg(2) .eq. 0)then + +#if (ghost_width == 2) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,4))+C2*(ya(:,:,2)+ya(:,:,3)) + else + tmp2= ya(:,:,2) + endif + if(ii/2*2==ii)then + tmp1= C1*(tmp2(1,:)+tmp2(4,:))+C2*(tmp2(2,:)+tmp2(3,:)) + else + tmp1= tmp2(2,:) + endif +#elif (ghost_width == 3) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,6))+C2*(ya(:,:,2)+ya(:,:,5))+C3*(ya(:,:,3)+ya(:,:,4)) + else + tmp2= ya(:,:,3) + endif + if(ii/2*2==ii)then + tmp1= C1*(tmp2(1,:)+tmp2(6,:))+C2*(tmp2(2,:)+tmp2(5,:))+C3*(tmp2(3,:)+tmp2(4,:)) + else + tmp1= tmp2(3,:) + endif +#elif (ghost_width == 4) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7)) & + +C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + else + tmp2= ya(:,:,4) + endif + if(ii/2*2==ii)then + tmp1= C1*(tmp2(1,:)+tmp2(8,:))+C2*(tmp2(2,:)+tmp2(7,:)) & + +C3*(tmp2(3,:)+tmp2(6,:))+C4*(tmp2(4,:)+tmp2(5,:)) + else + tmp1= tmp2(4,:) + endif +#elif (ghost_width == 5) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9)) & + +C3*(ya(:,:,3)+ya(:,:,8 ))+C4*(ya(:,:,4)+ya(:,:,7)) & + +C5*(ya(:,:,5)+ya(:,:,6 )) + else + tmp2= ya(:,:,5) + endif + if(ii/2*2==ii)then + tmp1= C1*(tmp2(1,:)+tmp2(10,:))+C2*(tmp2(2,:)+tmp2(9,:)) & + +C3*(tmp2(3,:)+tmp2(8 ,:))+C4*(tmp2(4,:)+tmp2(7,:)) & + +C5*(tmp2(5,:)+tmp2(6 ,:)) + else + tmp1= tmp2(5,:) + endif +#endif + + tmp1(cxB(2)+ghost_width-j+1:cxT(2)+ghost_width-j+1) = fh(i,cxB(2):cxT(2),k) + + call polint(Y,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + +! for z direction + else + +#if (ghost_width == 2) + if(ii/2*2==ii)then + tmp2= C1*(ya(1,:,:)+ya(4,:,:))+C2*(ya(2,:,:)+ya(3,:,:)) + else + tmp2= ya(2,:,:) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(1,:)+tmp2(4,:))+C2*(tmp2(2,:)+tmp2(3,:)) + else + tmp1= tmp2(2,:) + endif +#elif (ghost_width == 3) + if(ii/2*2==ii)then + tmp2= C1*(ya(1,:,:)+ya(6,:,:))+C2*(ya(6,:,:)+ya(5,:,:))+C3*(ya(3,:,:)+ya(4,:,:)) + else + tmp2= ya(3,:,:) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(1,:)+tmp2(6,:))+C2*(tmp2(2,:)+tmp2(5,:))+C3*(tmp2(3,:)+tmp2(4,:)) + else + tmp1= tmp2(3,:) + endif +#elif (ghost_width == 4) + if(ii/2*2==ii)then + tmp2= C1*(ya(1,:,:)+ya(8,:,:))+C2*(ya(2,:,:)+ya(7,:,:)) & + +C3*(ya(3,:,:)+ya(6,:,:))+C4*(ya(4,:,:)+ya(5,:,:)) + else + tmp2= ya(4,:,:) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(1,:)+tmp2(8,:))+C2*(tmp2(2,:)+tmp2(7,:)) & + +C3*(tmp2(3,:)+tmp2(6,:))+C4*(tmp2(4,:)+tmp2(5,:)) + else + tmp1= tmp2(4,:) + endif +#elif (ghost_width == 5) + if(ii/2*2==ii)then + tmp2= C1*(ya(1,:,:)+ya(10,:,:))+C2*(ya(2,:,:)+ya(9,:,:)) & + +C3*(ya(3,:,:)+ya(8 ,:,:))+C4*(ya(4,:,:)+ya(7,:,:)) & + +C5*(ya(5,:,:)+ya(6 ,:,:)) + else + tmp2= ya(5,:,:) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(1,:)+tmp2(10,:))+C2*(tmp2(2,:)+tmp2(9,:)) & + +C3*(tmp2(3,:)+tmp2(8 ,:))+C4*(tmp2(4,:)+tmp2(7,:)) & + +C5*(tmp2(5,:)+tmp2(6 ,:)) + else + tmp1= tmp2(5,:) + endif +#endif + + tmp1(cxB(3)+ghost_width-k+1:cxT(3)+ghost_width-k+1) = fh(i,j,cxB(3):cxT(3)) + + call polint(Z,tmp1,0.d0,funf(i,j,k),ddy,2*ghost_width) + + endif + + else + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + +#if (ghost_width == 2) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,4))+C2*(ya(:,:,2)+ya(:,:,3)) + else + tmp2= ya(:,:,2) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,4))+C2*(tmp2(:,2)+tmp2(:,3)) + else + tmp1= tmp2(:,2) + endif + if(ii/2*2==ii)then + funf(i,j,k)= C1*(tmp1(1)+tmp1(4))+C2*(tmp1(2)+tmp1(3)) + else + funf(i,j,k)= tmp1(2) + endif +#elif (ghost_width == 3) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,6))+C2*(ya(:,:,2)+ya(:,:,5))+C3*(ya(:,:,3)+ya(:,:,4)) + else + tmp2= ya(:,:,3) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + else + tmp1= tmp2(:,3) + endif + if(ii/2*2==ii)then + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + else + funf(i,j,k)= tmp1(3) + endif +#elif (ghost_width == 4) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7)) & + +C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + else + tmp2= ya(:,:,4) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7)) & + +C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + else + tmp1= tmp2(:,4) + endif + if(ii/2*2==ii)then + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7)) & + +C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + else + funf(i,j,k)= tmp1(4) + endif +#elif (ghost_width == 5) + if(kk/2*2==kk)then + tmp2= C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9)) & + +C3*(ya(:,:,3)+ya(:,:,8 ))+C4*(ya(:,:,4)+ya(:,:,7)) & + +C5*(ya(:,:,5)+ya(:,:,6 )) + else + tmp2= ya(:,:,5) + endif + if(jj/2*2==jj)then + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9)) & + +C3*(tmp2(:,3)+tmp2(:,8 ))+C4*(tmp2(:,4)+tmp2(:,7)) & + +C5*(tmp2(:,5)+tmp2(:,6 )) + else + tmp1= tmp2(:,5) + endif + if(ii/2*2==ii)then + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9)) & + +C3*(tmp1(3)+tmp1(8 ))+C4*(tmp1(4)+tmp1(7)) & + +C5*(tmp1(5)+tmp1(6 )) + else + funf(i,j,k)= tmp1(5) + endif +#endif + endif + + enddo + enddo + enddo + + return + + end subroutine prolongmix3 +!/////////////////////////////////////////////////////////////////////////////////////////////// +!-------------------------------------------------------------------------------------- +! +! Restrict from finner grids to coarser grids ignore the boundary point +! this routine is valid for all orders finite difference +! +! 1 2 3 4 +! *---*---*---* +! ^ +! COPY directly! +!-------------------------------------------------------------------------------------- + + subroutine restrict3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbr,uubr,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbr,uubr + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(inout):: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(in):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbr,ubr,lbrf,ubrf + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + real*8, parameter :: C1=-1.d0/1.6d1,C2=9.d0/1.6d1 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::restrict3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif +! it's possible a iolated point for target but not for source + FD = (uubf-llbf)/(extf-1) + CD = 2*FD + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbr = idint((llbr-base)/CD+0.4)+1 + lbrf = idint((llbr-base)/FD+0.4)+1 + ubr = idint((uubr-base)/CD+0.4)+1 + ubrf = idint((uubr-base)/FD+0.4)+1 + +!sanity check + imino=lbr(1)-lbc(1) + 1 + imaxo=ubr(1)-lbc(1) + 1 + jmino=lbr(2)-lbc(2) + 1 + jmaxo=ubr(2)-lbc(2) + 1 + kmino=lbr(3)-lbc(3) + 1 + kmaxo=ubr(3)-lbc(3) + 1 + + imini=lbrf(1)-lbf(1) + 1 + imaxi=ubrf(1)-lbf(1) + 1 + jmini=lbrf(2)-lbf(2) + 1 + jmaxi=ubrf(2)-lbf(2) + 1 + kmini=lbrf(3)-lbf(3) + 1 + kmaxi=ubrf(3)-lbf(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extc(1).or.jmaxo.gt.extc(2).or.kmaxo.gt.extc(3).or.& + imaxi.gt.extf(1).or.jmaxi.gt.extf(2).or.kmaxi.gt.extf(3))then + write(*,*)"error in restrict for" + write(*,*)"mino = ",imino,jmino,kmino + write(*,*)"maxo = ",imaxo,jmaxo,kmaxo + write(*,*)"extc = ",extc + write(*,*)"CD = ",CD + write(*,*)"mini = ",imini,jmini,kmini + write(*,*)"maxi = ",imaxi,jmaxi,kmaxi + write(*,*)"extf = ",extf + write(*,*)"FD = ",FD + write(*,*)"from" + write(*,*)lbf,ubf,extf + write(*,*)"to" + write(*,*)lbc,ubc,extc + write(*,*)"want" + write(*,*)lbr,ubr,lbrf,ubrf + write(*,*)"llbf = ",llbf + write(*,*)"uubf = ",uubf + write(*,*)"llbc = ",llbc + write(*,*)"uubc = ",uubc + write(*,*)"llbr = ",llbr + write(*,*)"uubr = ",uubr + stop + endif + +!~~~~~~> restriction start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo + + cxI(1) = i + cxI(2) = j + cxI(3) = k +! change to fine level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| + cxI = 2*(cxI+lbc-1) - 1 +! change to array index + cxI = cxI - lbf + 1 + + func(i,j,k)= funf(cxI(1),cxI(2),cxI(3)) + enddo + enddo + enddo + + return + + end subroutine restrict3 +!=========================================================================================== + +! for different finite differnce order +#if (ghost_width == 2) +! 2nd order +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 4 points, 3rd order interpolation +! 1 2 3 4 +! *---*---*---* +! ^ +! f=-1/16*f_1 + 9/16*f_2 +! -1/16*f_4 + 9/16*f_3 +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(4,4,4) :: ya + real*8, dimension(4,4) :: tmp2 + real*8, dimension(4) :: tmp1 + + real*8, parameter :: C1=-1.d0/16,C2=9.d0/16 + real*8, parameter :: C4=C1,C3=C2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-1.or.jmaxi.gt.extc(2)-1.or.kmaxi.gt.extc(3)-1)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| +! if(i/2*2 == i)then +! cxI(1) = (i+lbf(1)-1)/2 +! else +! cxI(1) = (i+lbf(1)-1)/2+1 +! endif +! if(j/2*2 == j)then +! cxI(2) = (j+lbf(2)-1)/2 +! else +! cxI(2) = (j+lbf(2)-1)/2+1 +! endif +! if(k/2*2 == k)then +! cxI(3) = (k+lbf(3)-1)/2 +! else +! cxI(3) = (k+lbf(3)-1)/2+1 +! endif +! above code segment is equivalent to + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+2 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= tmp1(2) + else + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,2) + endif + tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4) + funf(i,j,k)= tmp1(2) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>1.and.cxI(2)>1.and.cxI(3)>1)then + tmp2= C1*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)-1)+& + C2*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3) )+& + C3*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+1)+& + C4*func(cxI(1)-1:cxI(1)+2,cxI(2)-1:cxI(2)+2,cxI(3)+2) + else + cxB=cxI-1 + cxT=cxI+2 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,4,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= C1*ya(:,:,1)+C2*ya(:,:,2)+C3*ya(:,:,3)+C4*ya(:,:,4) + endif + tmp1= tmp2(:,2) + funf(i,j,k)= tmp1(2) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#elif (ghost_width == 3) +! fourth order code +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 6 points, 5th order interpolation +! 1 2 3 4 5 6 +! *---*---*---*---*---* +! ^ +! f=3/256*(f_1+f_6) - 25/256*(f_2+f_5) + 75/128*(f_3+f_4) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(6,6) :: tmp2 + real*8, dimension(6) :: tmp1 + + real*8, parameter :: C1=3.d0/2.56d2,C2=-2.5d1/2.56d2,C3=7.5d1/1.28d2 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + real*8, dimension(-1:extc(1),-1:extc(2),-1:extc(3)) :: funcc + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-2.or.jmaxi.gt.extc(2)-2.or.kmaxi.gt.extc(3)-2)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif + + call symmetry_bd(2,extc,func,funcc,SoA) + +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference v +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+3 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + endif + else + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= tmp2(:,3) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= tmp2(:,3) + funf(i,j,k)= C1*(tmp1(1)+tmp1(6))+C2*(tmp1(2)+tmp1(5))+C3*(tmp1(3)+tmp1(4)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= tmp1(3) + else + tmp2= funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)) + tmp1= C1*(tmp2(:,1)+tmp2(:,6))+C2*(tmp2(:,2)+tmp2(:,5))+C3*(tmp2(:,3)+tmp2(:,4)) + funf(i,j,k)= tmp1(3) + endif + else + if(kk/2*2==kk)then + tmp2= C1*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3))& + +C2*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+2))& + +C3*(funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+1)) + tmp1= tmp2(:,3) + funf(i,j,k)= tmp1(3) + else + funf(i,j,k)= funcc(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#elif (ghost_width == 4) +! sixth order code +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 8 points, 7th order interpolation +! 1 2 3 4 5 6 7 8 +! *---*---*---*---*---*---*---* +! ^ +! f=-5/2048*(f_1+f_8) + 49/2048*(f_2+f_7) - 245/2048*(f_3+f_6) + 1225/2048*(f_4+f_5) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(8,8,8) :: ya + real*8, dimension(8,8) :: tmp2 + real*8, dimension(8) :: tmp1 + + real*8, parameter :: C1=-5.d0/2.048d3,C2=4.9d1/2.048d3,C3=-2.45d2/2.048d3,C4=1.225d3/2.048d3 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-3.or.jmaxi.gt.extc(2)-3.or.kmaxi.gt.extc(3)-3)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference v +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x===============x===============x===============x===============x| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+4 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= C1*(tmp1(1)+tmp1(8))+C2*(tmp1(2)+tmp1(7))+C3*(tmp1(3)+tmp1(6))+C4*(tmp1(4)+tmp1(5)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= tmp1(4) + else + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2= ya(:,:,4) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,8))+C2*(tmp2(:,2)+tmp2(:,7))+C3*(tmp2(:,3)+tmp2(:,6))+C4*(tmp2(:,4)+tmp2(:,5)) + funf(i,j,k)= tmp1(4) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>3.and.cxI(2)>3.and.cxI(3)>3)then + tmp2= C1*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-3)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+4))& + +C2*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-2)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+3))& + +C3*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)-1)+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+2))& + +C4*(func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3) )+func(cxI(1)-3:cxI(1)+4,cxI(2)-3:cxI(2)+4,cxI(3)+1)) + else + cxB=cxI-3 + cxT=cxI+4 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,8,Symmetry))then + write(*,*)"prolong3 position: " + write(*,*)llbf(1)+(i-1)*FD(1),llbf(2)+(j-1)*FD(2),llbf(3)+(k-1)*FD(3) + write(*,*)"llbf = ",llbf + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,8))+C2*(ya(:,:,2)+ya(:,:,7))+C3*(ya(:,:,3)+ya(:,:,6))+C4*(ya(:,:,4)+ya(:,:,5)) + endif + tmp1= tmp2(:,4) + funf(i,j,k)= tmp1(4) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 + +#elif (ghost_width == 5) +! eighth order code +!-------------------------------------------------------------------------- +! +! Prolongation from coarser grids to finer grids +! 10 points, 9th order interpolation +! 1 2 3 4 5 6 7 8 9 10 +! *---*---*---*---*---*---*---*---*---* +! ^ +! f=35/65536(f_1+f_10)-405/65536*(f_2+f_9) + 567/16384*(f_3+f_8) - 2205/16384*(f_4+f_7) + 19845/32768*(f_5+f_6) +!-------------------------------------------------------------------------- + + subroutine prolong3(wei,llbc,uubc,extc,func,& + llbf,uubf,extf,funf,& + llbp,uubp,SoA,Symmetry) + implicit none + +!~~~~~~> input arguments + integer,intent(in) :: wei +! coarse fine coarse + real*8,dimension(3), intent(in) :: llbc,uubc,llbf,uubf,llbp,uubp + integer,dimension(3), intent(in) :: extc,extf + real*8, dimension(extc(1),extc(2),extc(3)),intent(in) :: func + real*8, dimension(extf(1),extf(2),extf(3)),intent(inout):: funf + real*8, dimension(1:3), intent(in) :: SoA + integer,intent(in)::Symmetry + +!~~~~~~> local variables + + real*8, dimension(1:3) :: base + integer,dimension(3) :: lbc,ubc,lbf,ubf,lbp,ubp,lbpc,ubpc + integer,dimension(3) :: cxB,cxT,cxI + integer :: i,j,k,ii,jj,kk + real*8, dimension(10,10,10) :: ya + real*8, dimension(10,10) :: tmp2 + real*8, dimension(10) :: tmp1 + + real*8, parameter :: C1=3.5d1/6.5536d4,C2=-4.05d2/6.5536d4,C3=5.67d2/1.6384d4 + real*8, parameter :: C4=-2.205d3/1.6384d4,C5=1.9845d4/3.2768d4 + + integer::imini,imaxi,jmini,jmaxi,kmini,kmaxi + integer::imino,imaxo,jmino,jmaxo,kmino,kmaxo + logical::decide3d + + real*8,dimension(3) :: CD,FD + + if(wei.ne.3)then + write(*,*)"prolongrestrict.f90::prolong3: this routine only surport 3 dimension" + write(*,*)"dim = ",wei + stop + endif + +! it's possible a iolated point for target but not for source + CD = (uubc-llbc)/(extc-1) + FD = CD/2 + +!take care the mismatch of the two segments of grid + do i=1,3 + if(llbc(i) <= llbf(i))then + base(i) = llbc(i) + else + j=idint((llbc(i)-llbf(i))/FD(i)+0.4) + if(j/2*2 == j)then + base(i) = llbf(i) + else + base(i) = llbf(i) - CD(i)/2 + endif + endif + enddo + +!!! function idint: +!If A is of type REAL and |A| < 1, INT(A) equals 0. If |A| \geq 1, +!then INT(A) equals the largest integer that does not exceed the range of A +!and whose sign is the same as the sign of A. + + lbf = idint((llbf-base)/FD+0.4)+1 + ubf = idint((uubf-base)/FD+0.4)+1 + lbc = idint((llbc-base)/CD+0.4)+1 + ubc = idint((uubc-base)/CD+0.4)+1 + lbp = idint((llbp-base)/FD+0.4)+1 + lbpc = idint((llbp-base)/CD+0.4)+1 + ubp = idint((uubp-base)/FD+0.4)+1 + ubpc = idint((uubp-base)/CD+0.4)+1 +!sanity check + imino=lbp(1)-lbf(1) + 1 + imaxo=ubp(1)-lbf(1) + 1 + jmino=lbp(2)-lbf(2) + 1 + jmaxo=ubp(2)-lbf(2) + 1 + kmino=lbp(3)-lbf(3) + 1 + kmaxo=ubp(3)-lbf(3) + 1 + + imini=lbpc(1)-lbc(1) + 1 + imaxi=ubpc(1)-lbc(1) + 1 + jmini=lbpc(2)-lbc(2) + 1 + jmaxi=ubpc(2)-lbc(2) + 1 + kmini=lbpc(3)-lbc(3) + 1 + kmaxi=ubpc(3)-lbc(3) + 1 + + if(imino.lt.1.or.jmino.lt.1.or.kmino.lt.1.or.& + imini.lt.1.or.jmini.lt.1.or.kmini.lt.1.or.& + imaxo.gt.extf(1).or.jmaxo.gt.extf(2).or.kmaxo.gt.extf(3).or.& + imaxi.gt.extc(1)-4.or.jmaxi.gt.extc(2)-4.or.kmaxi.gt.extc(3)-4)then + write(*,*)"error in prolongation for" + write(*,*)"from" + write(*,*)llbc,uubc + write(*,*)lbc,ubc + write(*,*)"to" + write(*,*)llbf,uubf + write(*,*)lbf,ubf + write(*,*)"want" + write(*,*)llbp,uubp + write(*,*)lbp,ubp,lbpc,ubpc + if(imini.lt.1) write(*,*)"imini = ",imini + if(jmini.lt.1) write(*,*)"jmini = ",jmini + if(kmini.lt.1) write(*,*)"kmini = ",kmini + if(imino.lt.1) write(*,*)"imino = ",imino + if(jmino.lt.1) write(*,*)"jmino = ",jmino + if(kmino.lt.1) write(*,*)"kmino = ",kmino + if(imaxi.gt.extc(1)) write(*,*)"imaxi = ",imaxi,"extc(1) = ",extc(1) + if(jmaxi.gt.extc(2)) write(*,*)"jmaxi = ",jmaxi,"extc(2) = ",extc(2) + if(kmaxi.gt.extc(3)) write(*,*)"kmaxi = ",kmaxi,"extc(3) = ",extc(3) + if(imaxo.gt.extf(1)) write(*,*)"imaxo = ",imaxo,"extf(1) = ",extf(1) + if(jmaxo.gt.extf(2)) write(*,*)"jmaxo = ",jmaxo,"extf(2) = ",extf(2) + if(kmaxo.gt.extf(3)) write(*,*)"kmaxo = ",kmaxo,"extf(3) = ",extf(3) + return + endif +!~~~~~~> prolongation start... + do k = kmino,kmaxo + do j = jmino,jmaxo + do i = imino,imaxo +! change to coarse level reference +!|*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*| +!|x===============x===============x===============x========| + cxI(1) = i + cxI(2) = j + cxI(3) = k + cxI = (cxI+lbf)/2 +! change to array index + cxI = cxI - lbc + 1 + + ii=i+lbf(1)-1 + jj=j+lbf(2)-1 + kk=k+lbf(3)-1 + + if(any(cxI+5 > extc)) write(*,*)"error in prolong" + if(ii/2*2==ii)then + if(jj/2*2==jj)then + if(kk/2*2==kk)then +! due to ghost zone, we can deal with symmetry boundary like this + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + stop + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= C1*(tmp1(1)+tmp1(10))+C2*(tmp1(2)+tmp1(9))+C3*(tmp1(3)+tmp1(8)) & + +C4*(tmp1(4)+tmp1( 7))+C5*(tmp1(5)+tmp1(6)) + endif + endif + else + if(jj/2*2==jj)then + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= tmp1(5) + else + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2= ya(:,:,5) + endif + tmp1= C1*(tmp2(:,1)+tmp2(:,10))+C2*(tmp2(:,2)+tmp2(:,9))+C3*(tmp2(:,3)+tmp2(:,8)) & + +C4*(tmp2(:,4)+tmp2(:, 7))+C5*(tmp2(:,5)+tmp2(:,6)) + funf(i,j,k)= tmp1(5) + endif + else + if(kk/2*2==kk)then + if(cxI(1)>4.and.cxI(2)>4.and.cxI(3)>4)then + tmp2= C1*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-4)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+5))& + +C2*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-3)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+4))& + +C3*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-2)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+3))& + +C4*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)-1)+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+2))& + +C5*(func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3) )+func(cxI(1)-4:cxI(1)+5,cxI(2)-4:cxI(2)+5,cxI(3)+1)) + else + cxB=cxI-4 + cxT=cxI+5 + if(decide3d(extc,func,func,cxB,cxT,SoA,ya,10,Symmetry))then + write(*,*)"prolong3 position index: ",i+lbf(1)-1,j+lbf(2)-1,k+lbf(3)-1 + return + endif + tmp2=C1*(ya(:,:,1)+ya(:,:,10))+C2*(ya(:,:,2)+ya(:,:,9))+C3*(ya(:,:,3)+ya(:,:,8)) & + +C4*(ya(:,:,4)+ya(:,:, 7))+C5*(ya(:,:,5)+ya(:,:,6)) + endif + tmp1= tmp2(:,5) + funf(i,j,k)= tmp1(5) + else + funf(i,j,k)= func(cxI(1),cxI(2),cxI(3)) + endif + endif + endif + enddo + enddo + enddo + + return + + end subroutine prolong3 +#endif + +#else +#ifndef Cell +#error Not define Vertex nor Cell +#endif +#endif diff --git a/AMSS_NCKU_source/ricci_gamma.f90 b/AMSS_NCKU_source/ricci_gamma.f90 new file mode 100644 index 0000000..24ed7f0 --- /dev/null +++ b/AMSS_NCKU_source/ricci_gamma.f90 @@ -0,0 +1,908 @@ + + subroutine ricci_gamma(ex, X, Y, Z, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry + real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8 :: dX, dY, dZ + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: HALF = 0.5D0, F2o3 = 2.d0/3.d0, F3o2 = 1.5d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + + call fderivs(ex,dxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + call fderivs(ex,gxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + call fderivs(ex,dyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + call fderivs(ex,gyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0) + call fderivs(ex,dzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs(ex,Gamx,Gamxx,Gamxy,Gamxz,X,Y,Z,ANTI,SYM ,SYM ,Symmetry,0) + call fderivs(ex,Gamy,Gamyx,Gamyy,Gamyz,X,Y,Z,SYM ,ANTI,SYM ,Symmetry,0) + call fderivs(ex,Gamz,Gamzx,Gamzy,Gamzz,X,Y,Z,SYM ,SYM ,ANTI,Symmetry,0) + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,ANTI,ANTI ,Symmetry,0) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,SYM,SYM,Symmetry,0) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) + +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + + return + + end subroutine ricci_gamma +!---------------------------------------------------------------------------- + subroutine ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + chi, & + dxx , gxy , gxz , dyy , gyz , dzz,& + Gamx , Gamy , Gamz , & + Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,& + Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,& + Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,& + Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,& + Symmetry,Lev,sst) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: chi + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz +! when out, physical second kind of connection + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz +! when out, physical Ricci tensor + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz + real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx,gyyx,gyzx,gzzx + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy,gyyy,gyzy,gzzy + real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz,gyyz,gyzz,gzzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxx,Gamxy,Gamxz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyx,Gamyy,Gamyz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzx,Gamzy,Gamzz + real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz + real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxa,Gamya,Gamza,chin1 + real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz + real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz + + real*8, parameter :: ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: HALF = 0.5D0, F2o3 = 2.d0/3.d0, F3o2 = 1.5d0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + + chin1 = chi + ONE + gxx = dxx + ONE + gyy = dyy + ONE + gzz = dzz + ONE + + call fderivs_shc(ex,chi,chix,chiy,chiz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + + call fderivs_shc(ex,dxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,gyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,dzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +! invert tilted metric + gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - & + gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz + gupxx = ( gyy * gzz - gyz * gyz ) / gupzz + gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz + gupxz = ( gxy * gyz - gyy * gxz ) / gupzz + gupyy = ( gxx * gzz - gxz * gxz ) / gupzz + gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz + gupzz = ( gxx * gyy - gxy * gxy ) / gupzz + +! second kind of connection + Gamxxx =HALF*( gupxx*gxxx + gupxy*(TWO*gxyx - gxxy ) + gupxz*(TWO*gxzx - gxxz )) + Gamyxx =HALF*( gupxy*gxxx + gupyy*(TWO*gxyx - gxxy ) + gupyz*(TWO*gxzx - gxxz )) + Gamzxx =HALF*( gupxz*gxxx + gupyz*(TWO*gxyx - gxxy ) + gupzz*(TWO*gxzx - gxxz )) + + Gamxyy =HALF*( gupxx*(TWO*gxyy - gyyx ) + gupxy*gyyy + gupxz*(TWO*gyzy - gyyz )) + Gamyyy =HALF*( gupxy*(TWO*gxyy - gyyx ) + gupyy*gyyy + gupyz*(TWO*gyzy - gyyz )) + Gamzyy =HALF*( gupxz*(TWO*gxyy - gyyx ) + gupyz*gyyy + gupzz*(TWO*gyzy - gyyz )) + + Gamxzz =HALF*( gupxx*(TWO*gxzz - gzzx ) + gupxy*(TWO*gyzz - gzzy ) + gupxz*gzzz) + Gamyzz =HALF*( gupxy*(TWO*gxzz - gzzx ) + gupyy*(TWO*gyzz - gzzy ) + gupyz*gzzz) + Gamzzz =HALF*( gupxz*(TWO*gxzz - gzzx ) + gupyz*(TWO*gyzz - gzzy ) + gupzz*gzzz) + + Gamxxy =HALF*( gupxx*gxxy + gupxy*gyyx + gupxz*( gxzy + gyzx - gxyz ) ) + Gamyxy =HALF*( gupxy*gxxy + gupyy*gyyx + gupyz*( gxzy + gyzx - gxyz ) ) + Gamzxy =HALF*( gupxz*gxxy + gupyz*gyyx + gupzz*( gxzy + gyzx - gxyz ) ) + + Gamxxz =HALF*( gupxx*gxxz + gupxy*( gxyz + gyzx - gxzy ) + gupxz*gzzx ) + Gamyxz =HALF*( gupxy*gxxz + gupyy*( gxyz + gyzx - gxzy ) + gupyz*gzzx ) + Gamzxz =HALF*( gupxz*gxxz + gupyz*( gxyz + gyzx - gxzy ) + gupzz*gzzx ) + + Gamxyz =HALF*( gupxx*( gxyz + gxzy - gyzx ) + gupxy*gyyz + gupxz*gzzy ) + Gamyyz =HALF*( gupxy*( gxyz + gxzy - gyzx ) + gupyy*gyyz + gupyz*gzzy ) + Gamzyz =HALF*( gupxz*( gxyz + gxzy - gyzx ) + gupyz*gyyz + gupzz*gzzy ) + + Gamxa = gupxx * Gamxxx + gupyy * Gamxyy + gupzz * Gamxzz + & + TWO*( gupxy * Gamxxy + gupxz * Gamxxz + gupyz * Gamxyz ) + Gamya = gupxx * Gamyxx + gupyy * Gamyyy + gupzz * Gamyzz + & + TWO*( gupxy * Gamyxy + gupxz * Gamyxz + gupyz * Gamyyz ) + Gamza = gupxx * Gamzxx + gupyy * Gamzyy + gupzz * Gamzzz + & + TWO*( gupxy * Gamzxy + gupxz * Gamzxz + gupyz * Gamzyz ) + + call fderivs_shc(ex,Gamx,Gamxx,Gamxy,Gamxz,crho,sigma,R,ANTI,SYM ,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamy,Gamyx,Gamyy,Gamyz,crho,sigma,R,SYM ,ANTI,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + call fderivs_shc(ex,Gamz,Gamzx,Gamzy,Gamzz,crho,sigma,R,SYM ,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + +!first kind of connection stored in gij,k + gxxx = gxx * Gamxxx + gxy * Gamyxx + gxz * Gamzxx + gxyx = gxx * Gamxxy + gxy * Gamyxy + gxz * Gamzxy + gxzx = gxx * Gamxxz + gxy * Gamyxz + gxz * Gamzxz + gyyx = gxx * Gamxyy + gxy * Gamyyy + gxz * Gamzyy + gyzx = gxx * Gamxyz + gxy * Gamyyz + gxz * Gamzyz + gzzx = gxx * Gamxzz + gxy * Gamyzz + gxz * Gamzzz + + gxxy = gxy * Gamxxx + gyy * Gamyxx + gyz * Gamzxx + gxyy = gxy * Gamxxy + gyy * Gamyxy + gyz * Gamzxy + gxzy = gxy * Gamxxz + gyy * Gamyxz + gyz * Gamzxz + gyyy = gxy * Gamxyy + gyy * Gamyyy + gyz * Gamzyy + gyzy = gxy * Gamxyz + gyy * Gamyyz + gyz * Gamzyz + gzzy = gxy * Gamxzz + gyy * Gamyzz + gyz * Gamzzz + + gxxz = gxz * Gamxxx + gyz * Gamyxx + gzz * Gamzxx + gxyz = gxz * Gamxxy + gyz * Gamyxy + gzz * Gamzxy + gxzz = gxz * Gamxxz + gyz * Gamyxz + gzz * Gamzxz + gyyz = gxz * Gamxyy + gyz * Gamyyy + gzz * Gamzyy + gyzz = gxz * Gamxyz + gyz * Gamyyz + gzz * Gamzyz + gzzz = gxz * Gamxzz + gyz * Gamyzz + gzz * Gamzzz + +!compute Ricci tensor for tilted metric + call fdderivs_shc(ex,dxx,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxx = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dyy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,dzz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R, SYM, SYM,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rzz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxy,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,ANTI,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxy = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gxz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Rxz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + call fdderivs_shc(ex,gyz,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Ryz = gupxx * fxx + gupyy * fyy + gupzz * fzz + & + ( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO + + Rxx = - HALF * Rxx + & + gxx * Gamxx+ gxy * Gamyx + gxz * Gamzx + & + Gamxa * gxxx + Gamya * gxyx + Gamza * gxzx + & + gupxx *( & + TWO*(Gamxxx * gxxx + Gamyxx * gxyx + Gamzxx * gxzx) + & + Gamxxx * gxxx + Gamyxx * gxxy + Gamzxx * gxxz )+ & + gupxy *( & + TWO*(Gamxxx * gxyx + Gamyxx * gyyx + Gamzxx * gyzx + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx) + & + Gamxxy * gxxx + Gamyxy * gxxy + Gamzxy * gxxz + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxz *( & + TWO*(Gamxxx * gxzx + Gamyxx * gyzx + Gamzxx * gzzx + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx) + & + Gamxxz * gxxx + Gamyxz * gxxy + Gamzxz * gxxz + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupyy *( & + TWO*(Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupyz *( & + TWO*(Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx) + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupzz *( & + TWO*(Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz ) + + Ryy = - HALF * Ryy + & + gxy * Gamxy+ gyy * Gamyy + gyz * Gamzy + & + Gamxa * gxyy + Gamya * gyyy + Gamza * gyzy + & + gupxx *( & + TWO*(Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy) + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz )+ & + gupxy *( & + TWO*(Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxxy + Gamyyy * gxyy + Gamzyy * gxzy) + & + Gamxyy * gxyx + Gamyyy * gxyy + Gamzyy * gxyz + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupxz *( & + TWO*(Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy) + & + Gamxyz * gxyx + Gamyyz * gxyy + Gamzyz * gxyz + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyy *( & + TWO*(Gamxyy * gxyy + Gamyyy * gyyy + Gamzyy * gyzy) + & + Gamxyy * gyyx + Gamyyy * gyyy + Gamzyy * gyyz )+ & + gupyz *( & + TWO*(Gamxyy * gxzy + Gamyyy * gyzy + Gamzyy * gzzy + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy) + & + Gamxyz * gyyx + Gamyyz * gyyy + Gamzyz * gyyz + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupzz *( & + TWO*(Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz ) + + Rzz = - HALF * Rzz + & + gxz * Gamxz+ gyz * Gamyz + gzz * Gamzz + & + Gamxa * gxzz + Gamya * gyzz + Gamza * gzzz + & + gupxx *( & + TWO*(Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz) + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz )+ & + gupxy *( & + TWO*(Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz) + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz )+ & + gupxz *( & + TWO*(Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxxz + Gamyzz * gxyz + Gamzzz * gxzz) + & + Gamxzz * gxzx + Gamyzz * gxzy + Gamzzz * gxzz + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz )+ & + gupyy *( & + TWO*(Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz) + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz )+ & + gupyz *( & + TWO*(Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxyz + Gamyzz * gyyz + Gamzzz * gyzz) + & + Gamxzz * gyzx + Gamyzz * gyzy + Gamzzz * gyzz + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz )+ & + gupzz *( & + TWO*(Gamxzz * gxzz + Gamyzz * gyzz + Gamzzz * gzzz) + & + Gamxzz * gzzx + Gamyzz * gzzy + Gamzzz * gzzz ) + + Rxy = HALF*( - Rxy + & + gxx * Gamxy + gxy * Gamyy + gxz * Gamzy + & + gxy * Gamxx + gyy * Gamyx + gyz * Gamzx + & + Gamxa * gxyx + Gamya * gyyx + Gamza * gyzx + & + Gamxa * gxxy + Gamya * gxyy + Gamza * gxzy )+ & + gupxx *( & + Gamxxx * gxxy + Gamyxx * gxyy + Gamzxx * gxzy + & + Gamxxy * gxxx + Gamyxy * gxyx + Gamzxy * gxzx + & + Gamxxx * gxyx + Gamyxx * gxyy + Gamzxx * gxyz )+ & + gupxy *( & + Gamxxx * gxyy + Gamyxx * gyyy + Gamzxx * gyzy + & + Gamxxy * gxyx + Gamyxy * gyyx + Gamzxy * gyzx + & + Gamxxy * gxyx + Gamyxy * gxyy + Gamzxy * gxyz + & + Gamxxy * gxxy + Gamyxy * gxyy + Gamzxy * gxzy + & + Gamxyy * gxxx + Gamyyy * gxyx + Gamzyy * gxzx + & + Gamxxx * gyyx + Gamyxx * gyyy + Gamzxx * gyyz )+ & + gupxz *( & + Gamxxx * gxzy + Gamyxx * gyzy + Gamzxx * gzzy + & + Gamxxy * gxzx + Gamyxy * gyzx + Gamzxy * gzzx + & + Gamxxz * gxyx + Gamyxz * gxyy + Gamzxz * gxyz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupyy *( & + Gamxxy * gxyy + Gamyxy * gyyy + Gamzxy * gyzy + & + Gamxyy * gxyx + Gamyyy * gyyx + Gamzyy * gyzx + & + Gamxxy * gyyx + Gamyxy * gyyy + Gamzxy * gyyz )+ & + gupyz *( & + Gamxxy * gxzy + Gamyxy * gyzy + Gamzxy * gzzy + & + Gamxyy * gxzx + Gamyyy * gyzx + Gamzyy * gzzx + & + Gamxxz * gyyx + Gamyxz * gyyy + Gamzxz * gyyz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupzz *( & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz ) + + Rxz = HALF*( - Rxz + & + gxx * Gamxz + gxy * Gamyz + gxz * Gamzz + & + gxz * Gamxx + gyz * Gamyx + gzz * Gamzx + & + Gamxa * gxzx + Gamya * gyzx + Gamza * gzzx + & + Gamxa * gxxz + Gamya * gxyz + Gamza * gxzz )+ & + gupxx *( & + Gamxxx * gxxz + Gamyxx * gxyz + Gamzxx * gxzz + & + Gamxxz * gxxx + Gamyxz * gxyx + Gamzxz * gxzx + & + Gamxxx * gxzx + Gamyxx * gxzy + Gamzxx * gxzz )+ & + gupxy *( & + Gamxxx * gxyz + Gamyxx * gyyz + Gamzxx * gyzz + & + Gamxxz * gxyx + Gamyxz * gyyx + Gamzxz * gyzx + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz + & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxyz * gxxx + Gamyyz * gxyx + Gamzyz * gxzx + & + Gamxxx * gyzx + Gamyxx * gyzy + Gamzxx * gyzz )+ & + gupxz *( & + Gamxxx * gxzz + Gamyxx * gyzz + Gamzxx * gzzz + & + Gamxxz * gxzx + Gamyxz * gyzx + Gamzxz * gzzx + & + Gamxxz * gxzx + Gamyxz * gxzy + Gamzxz * gxzz + & + Gamxxz * gxxz + Gamyxz * gxyz + Gamzxz * gxzz + & + Gamxzz * gxxx + Gamyzz * gxyx + Gamzzz * gxzx + & + Gamxxx * gzzx + Gamyxx * gzzy + Gamzxx * gzzz )+ & + gupyy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxyz * gxyx + Gamyyz * gyyx + Gamzyz * gyzx + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupyz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxyz * gxzx + Gamyyz * gyzx + Gamzyz * gzzx + & + Gamxxz * gyzx + Gamyxz * gyzy + Gamzxz * gyzz + & + Gamxxz * gxyz + Gamyxz * gyyz + Gamzxz * gyzz + & + Gamxzz * gxyx + Gamyzz * gyyx + Gamzzz * gyzx + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupzz *( & + Gamxxz * gxzz + Gamyxz * gyzz + Gamzxz * gzzz + & + Gamxzz * gxzx + Gamyzz * gyzx + Gamzzz * gzzx + & + Gamxxz * gzzx + Gamyxz * gzzy + Gamzxz * gzzz ) + + Ryz = HALF*( - Ryz + & + gxy * Gamxz + gyy * Gamyz + gyz * Gamzz + & + gxz * Gamxy + gyz * Gamyy + gzz * Gamzy + & + Gamxa * gxzy + Gamya * gyzy + Gamza * gzzy + & + Gamxa * gxyz + Gamya * gyyz + Gamza * gyzz )+ & + gupxx *( & + Gamxxy * gxxz + Gamyxy * gxyz + Gamzxy * gxzz + & + Gamxxz * gxxy + Gamyxz * gxyy + Gamzxz * gxzy + & + Gamxxy * gxzx + Gamyxy * gxzy + Gamzxy * gxzz )+ & + gupxy *( & + Gamxxy * gxyz + Gamyxy * gyyz + Gamzxy * gyzz + & + Gamxxz * gxyy + Gamyxz * gyyy + Gamzxz * gyzy + & + Gamxyy * gxzx + Gamyyy * gxzy + Gamzyy * gxzz + & + Gamxyy * gxxz + Gamyyy * gxyz + Gamzyy * gxzz + & + Gamxyz * gxxy + Gamyyz * gxyy + Gamzyz * gxzy + & + Gamxxy * gyzx + Gamyxy * gyzy + Gamzxy * gyzz )+ & + gupxz *( & + Gamxxy * gxzz + Gamyxy * gyzz + Gamzxy * gzzz + & + Gamxxz * gxzy + Gamyxz * gyzy + Gamzxz * gzzy + & + Gamxyz * gxzx + Gamyyz * gxzy + Gamzyz * gxzz + & + Gamxyz * gxxz + Gamyyz * gxyz + Gamzyz * gxzz + & + Gamxzz * gxxy + Gamyzz * gxyy + Gamzzz * gxzy + & + Gamxxy * gzzx + Gamyxy * gzzy + Gamzxy * gzzz )+ & + gupyy *( & + Gamxyy * gxyz + Gamyyy * gyyz + Gamzyy * gyzz + & + Gamxyz * gxyy + Gamyyz * gyyy + Gamzyz * gyzy + & + Gamxyy * gyzx + Gamyyy * gyzy + Gamzyy * gyzz )+ & + gupyz *( & + Gamxyy * gxzz + Gamyyy * gyzz + Gamzyy * gzzz + & + Gamxyz * gxzy + Gamyyz * gyzy + Gamzyz * gzzy + & + Gamxyz * gyzx + Gamyyz * gyzy + Gamzyz * gyzz + & + Gamxyz * gxyz + Gamyyz * gyyz + Gamzyz * gyzz + & + Gamxzz * gxyy + Gamyzz * gyyy + Gamzzz * gyzy + & + Gamxyy * gzzx + Gamyyy * gzzy + Gamzyy * gzzz )+ & + gupzz *( & + Gamxyz * gxzz + Gamyyz * gyzz + Gamzyz * gzzz + & + Gamxzz * gxzy + Gamyzz * gyzy + Gamzzz * gzzy + & + Gamxyz * gzzx + Gamyyz * gzzy + Gamzyz * gzzz ) +!covariant second derivative of chi respect to tilted metric + call fdderivs_shc(ex,chi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + fxx = fxx - Gamxxx * chix - Gamyxx * chiy - Gamzxx * chiz + fxy = fxy - Gamxxy * chix - Gamyxy * chiy - Gamzxy * chiz + fxz = fxz - Gamxxz * chix - Gamyxz * chiy - Gamzxz * chiz + fyy = fyy - Gamxyy * chix - Gamyyy * chiy - Gamzyy * chiz + fyz = fyz - Gamxyz * chix - Gamyyz * chiy - Gamzyz * chiz + fzz = fzz - Gamxzz * chix - Gamyzz * chiy - Gamzzz * chiz +! Store D^l D_l chi - 3/(2*chi) D^l chi D_l chi in f + + f = gupxx * ( fxx - F3o2/chin1 * chix * chix ) + & + gupyy * ( fyy - F3o2/chin1 * chiy * chiy ) + & + gupzz * ( fzz - F3o2/chin1 * chiz * chiz ) + & + TWO * gupxy * ( fxy - F3o2/chin1 * chix * chiy ) + & + TWO * gupxz * ( fxz - F3o2/chin1 * chix * chiz ) + & + TWO * gupyz * ( fyz - F3o2/chin1 * chiy * chiz ) + +! Add chi part to Ricci tensor: + + Rxx = Rxx + (fxx - chix*chix/chin1/TWO + gxx * f)/chin1/TWO + Ryy = Ryy + (fyy - chiy*chiy/chin1/TWO + gyy * f)/chin1/TWO + Rzz = Rzz + (fzz - chiz*chiz/chin1/TWO + gzz * f)/chin1/TWO + Rxy = Rxy + (fxy - chix*chiy/chin1/TWO + gxy * f)/chin1/TWO + Rxz = Rxz + (fxz - chix*chiz/chin1/TWO + gxz * f)/chin1/TWO + Ryz = Ryz + (fyz - chiy*chiz/chin1/TWO + gyz * f)/chin1/TWO + + gxxx = (gupxx * chix + gupxy * chiy + gupxz * chiz)/chin1 + gxxy = (gupxy * chix + gupyy * chiy + gupyz * chiz)/chin1 + gxxz = (gupxz * chix + gupyz * chiy + gupzz * chiz)/chin1 +! now get physical second kind of connection + Gamxxx = Gamxxx - ( (chix + chix)/chin1 - gxx * gxxx )*HALF + Gamyxx = Gamyxx - ( - gxx * gxxy )*HALF + Gamzxx = Gamzxx - ( - gxx * gxxz )*HALF + Gamxyy = Gamxyy - ( - gyy * gxxx )*HALF + Gamyyy = Gamyyy - ( (chiy + chiy)/chin1 - gyy * gxxy )*HALF + Gamzyy = Gamzyy - ( - gyy * gxxz )*HALF + Gamxzz = Gamxzz - ( - gzz * gxxx )*HALF + Gamyzz = Gamyzz - ( - gzz * gxxy )*HALF + Gamzzz = Gamzzz - ( (chiz + chiz)/chin1 - gzz * gxxz )*HALF + Gamxxy = Gamxxy - ( chiy /chin1 - gxy * gxxx )*HALF + Gamyxy = Gamyxy - ( chix /chin1 - gxy * gxxy )*HALF + Gamzxy = Gamzxy - ( - gxy * gxxz )*HALF + Gamxxz = Gamxxz - ( chiz /chin1 - gxz * gxxx )*HALF + Gamyxz = Gamyxz - ( - gxz * gxxy )*HALF + Gamzxz = Gamzxz - ( chix /chin1 - gxz * gxxz )*HALF + Gamxyz = Gamxyz - ( - gyz * gxxx )*HALF + Gamyyz = Gamyyz - ( chiz /chin1 - gyz * gxxy )*HALF + Gamzyz = Gamzyz - ( chiy /chin1 - gyz * gxxz )*HALF + + return + + end subroutine ricci_gamma_ss diff --git a/AMSS_NCKU_source/ricci_gamma.h b/AMSS_NCKU_source/ricci_gamma.h new file mode 100644 index 0000000..585fe0b --- /dev/null +++ b/AMSS_NCKU_source/ricci_gamma.h @@ -0,0 +1,48 @@ + +#ifndef RICCI_GAMMA_H +#define RICCI_GAMMA_H + +#ifdef fortran1 +#define f_ricci_gamma ricci_gamma +#define f_ricci_gamma_ss ricci_gamma_ss +#endif +#ifdef fortran2 +#define f_ricci_gamma RICCI_GAMMA +#define f_ricci_gamma_ss RICCI_GAMMA_SS +#endif +#ifdef fortran3 +#define f_ricci_gamma ricci_gamma_ +#define f_ricci_gamma_ss ricci_gamma_ss_ +#endif +extern "C" +{ + void f_ricci_gamma(int *, double *, double *, double *, + double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + int &); +} + +extern "C" +{ + void f_ricci_gamma_ss(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + int &, int &, int &); +} +#endif /* RICCI_GAMMA_H */ diff --git a/AMSS_NCKU_source/round.C b/AMSS_NCKU_source/round.C new file mode 100644 index 0000000..1c21ee4 --- /dev/null +++ b/AMSS_NCKU_source/round.C @@ -0,0 +1,38 @@ +#include + +#include "stdc.h" +#include "util.h" + +namespace AHFinderDirect +{ + namespace jtutil + { + template + int round::to_integer(fp_t x) + { + return (x >= 0.0) + ? int(x + 0.5) // eg 3.6 --> int(4.1) = 4 + : -int((-x) + 0.5); // eg -3.6 --> - int(4.1) = -4 + } + + template + int round::floor(fp_t x) + { + return (x >= 0.0) + ? int(x) + : -ceiling(-x); + } + + template + int round::ceiling(fp_t x) + { + return (x >= 0.0) + ? int(x) + (x != fp_t(int(x))) + : -floor(-x); + } + + template class round; + template class round; + + } // namespace jtutil +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/rungekutta4_rout.f90 b/AMSS_NCKU_source/rungekutta4_rout.f90 new file mode 100644 index 0000000..1156c8c --- /dev/null +++ b/AMSS_NCKU_source/rungekutta4_rout.f90 @@ -0,0 +1,246 @@ +!----------------------------------------------------------------------------- +! $Id: rungekutta4_rout.f90,v 1.6 2012/12/26 11:47:43 zjcao Exp $ +! Carry out 4th-order Runge-Kutta method +!----------------------------------------------------------------------------- +! rk4 for scalar + subroutine rungekutta4_scalar(dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: RK4 + real*8 ,intent(in):: dT,f0 + real*8 ,intent(inout):: f1,f_rhs + +!~~~~~~% Local parameter + + real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0 + + if( RK4 == 0 ) then + + f1 = f0 + HLF * dT * f_rhs + + elseif(RK4 == 1 ) then + + f_rhs = f_rhs + TWO * f1 + f1 = f0 + HLF * dT * f1 + + elseif(RK4 == 2 ) then + + f_rhs = f_rhs + TWO * f1 + f1 = f0 + dT * f1 + + elseif( RK4 == 3 ) then + + f1 = f0 +F1o6 * dT *(f1 + f_rhs) + + else + + write(*,*) "rungekutta4_scalar: something is wrong in RK4 counting!!" + stop + + endif + + return + + end subroutine rungekutta4_scalar +!~~~~~~~~~~~~~~~~~~ +! rk4 for complex scalar + subroutine rungekutta4_cplxscalar(dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: RK4 + real*8 ,intent(in):: dT + double complex ,intent(in):: f0 + double complex ,intent(inout):: f1,f_rhs + +!~~~~~~% Local parameter + + real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0 + + if( RK4 == 0 ) then + + f1 = f0 + HLF * dT * f_rhs + + elseif(RK4 == 1 ) then + + f_rhs = f_rhs + TWO * f1 + f1 = f0 + HLF * dT * f1 + + elseif(RK4 == 2 ) then + + f_rhs = f_rhs + TWO * f1 + f1 = f0 + dT * f1 + + elseif( RK4 == 3 ) then + + f1 = f0 +F1o6 * dT *(f1 + f_rhs) + + else + + write(*,*) "rungekutta4_cplxscalar: something is wrong in RK4 counting!!" + stop + + endif + + return + + end subroutine rungekutta4_cplxscalar +!~~~~~~~~~~~~~~~~~~ + subroutine rungekutta4_rout(ex,dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: ex(1:3),RK4 + real*8 ,intent(in):: dT + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f1 + +!~~~~~~% Local parameter + + real*8, parameter :: F1o6=1.d0/6.d0, HLF=5.d-1, TWO=2.d0 + + if( RK4 == 0 ) then + + f1 = f0 + HLF * dT * f_rhs + + elseif(RK4 == 1 ) then + + f_rhs = f_rhs + TWO * f1 + + f1 = f0 + HLF * dT * f1 + + elseif(RK4 == 2 ) then + + f_rhs = f_rhs + TWO * f1 + + f1 = f0 + dT * f1 + + elseif( RK4 == 3 ) then + + f1 = f0 +F1o6 * dT *(f1 + f_rhs) + + else + + write(*,*) "rungekutta4_rout: something is wrong in RK4 counting!!" + stop + + endif + + return + + end subroutine rungekutta4_rout +!----------------------------------------------------------------------------- +! icn for scalar + subroutine icn_scalar(dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: RK4 + real*8 ,intent(in):: dT,f0 + real*8 ,intent(inout):: f1,f_rhs + +!~~~~~~% Local parameter + + real*8, parameter :: HLF=5.d-1 + + if( RK4 == 0 ) then + + f1 = f0 + dT * f_rhs + + else + + f1 = f0 + HLF * dT * (f1+f_rhs) + + endif + + return + + end subroutine icn_scalar +!~~~~~~~~~~~~~~~~~~ +! icn for complex scalar + subroutine icn_cplxscalar(dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: RK4 + real*8 ,intent(in):: dT + double complex ,intent(in):: f0 + double complex ,intent(inout):: f1,f_rhs + +!~~~~~~% Local parameter + + real*8, parameter :: HLF=5.d-1 + + if( RK4 == 0 ) then + + f1 = f0 + dT * f_rhs + + else + + f1 = f0 + HLF * dT * (f1+f_rhs) + + endif + + return + + end subroutine icn_cplxscalar +!~~~~~~~~~~~~~~~~~~ + subroutine icn_rout(ex,dT,f0,f1,f_rhs,RK4) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: ex(1:3),RK4 + real*8 ,intent(in):: dT + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) ::f1 + +!~~~~~~% Local parameter + + real*8, parameter :: HLF=5.d-1 + + if( RK4 == 0 ) then + + f1 = f0 + dT * f_rhs + + else + + f1 = f0 + HLF * dT * (f1+f_rhs) + + endif + + return + + end subroutine icn_rout +!~~~~~~~~~~~~~~~~~~ + subroutine euler_rout(ex,dT,f0,f1,f_rhs) + + implicit none + +!~~~~~~% Input parameters: + + integer ,intent(in):: ex(1:3) + real*8 ,intent(in):: dT + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(in) ::f_rhs + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) ::f1 + + f1 = f0 + dT * f_rhs + + return + + end subroutine euler_rout diff --git a/AMSS_NCKU_source/rungekutta4_rout.h b/AMSS_NCKU_source/rungekutta4_rout.h new file mode 100644 index 0000000..1ae2e1e --- /dev/null +++ b/AMSS_NCKU_source/rungekutta4_rout.h @@ -0,0 +1,57 @@ + +#ifndef RUNGEKUTTA4_H +#define RUNGEKUTTA4_H + +#ifdef fortran1 +#define f_euler_rout euler_rout +#define f_rungekutta4_rout rungekutta4_rout +#define f_rungekutta4_scalar rungekutta4_scalar +#define f_icn_rout icn_rout +#define f_icn_scalar icn_scalar +#endif +#ifdef fortran2 +#define f_euler_rout EULER_ROUT +#define f_rungekutta4_rout RUNGEKUTTA4_ROUT +#define f_rungekutta4_scalar RUNGEKUTTA4_SCALAR +#define f_icn_rout ICN_ROUT +#define f_icn_scalar ICN_SCALAR +#endif +#ifdef fortran3 +#define f_euler_rout euler_rout_ +#define f_rungekutta4_rout rungekutta4_rout_ +#define f_rungekutta4_scalar rungekutta4_scalar_ +#define f_icn_rout icn_rout_ +#define f_icn_scalar icn_scalar_ +#endif + +extern "C" +{ + void f_rungekutta4_scalar(double &, double &, double &, double &, int &); +} + +extern "C" +{ + int f_rungekutta4_rout(int *, double &, + double *, double *, double *, + int &); +} + +extern "C" +{ + void f_icn_scalar(double &, double &, double &, double &, int &); +} + +extern "C" +{ + int f_icn_rout(int *, double &, + double *, double *, double *, + int &); +} + +extern "C" +{ + int f_euler_rout(int *, double &, + double *, double *, double *); +} + +#endif /* RUNGEKUTTA4_H */ diff --git a/AMSS_NCKU_source/scalar_class.C b/AMSS_NCKU_source/scalar_class.C new file mode 100644 index 0000000..d0cdec0 --- /dev/null +++ b/AMSS_NCKU_source/scalar_class.C @@ -0,0 +1,1195 @@ + +#ifdef newc +#include +#include +#include +using namespace std; +#else +#include +#include +#endif + +#include + +#include "macrodef.h" +#include "misc.h" +#include "fmisc.h" +#include "Parallel.h" +#include "scalar_class.h" +#include "scalar_rhs.h" +#include "initial_scalar.h" +#include "rungekutta4_rout.h" +#include "sommerfeld_rout.h" +#include "shellfunctions.h" +#include "parameters.h" + +scalar_class::scalar_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, + int a_levi) : Courant(Couranti), StartTime(StartTimei), TotalTime(TotalTimei), DumpTime(DumpTimei), CheckTime(CheckTimei), AnasTime(AnasTimei), + Symmetry(Symmetryi), checkrun(checkruni), numepss(numepssi), numepsb(numepsbi), + a_lev(a_levi) +{ + int nprocs; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + if (checkrun) + { + } + else + { + PhysTime = StartTime; + } + // setup Monitors + { + stringstream a_stream; + a_stream.setf(ios::left); + a_stream << "# Error log information"; + ErrorMonitor = new monitor("Error.log", myrank, a_stream.str()); + } + + trfls = 0; + // read parameter from file + { + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "SCALAR" && skey == "time refinement start from level") + trfls = atoi(sval.c_str()); + } + inf.close(); + } + // echo read-in information + if (myrank == 0) + { + cout << "time refinement start from level #" << trfls << endl; + } + + strcpy(checkfilename, checkfilenamei); + + int ngfs = 0; + Sphio = new var("Sphio", ngfs++, 1, 1, 1); + Spio = new var("Spio", ngfs++, 1, 1, 1); + Sphi0 = new var("Sphi0", ngfs++, 1, 1, 1); + Spi0 = new var("Spi0", ngfs++, 1, 1, 1); + Sphi = new var("Sphi", ngfs++, 1, 1, 1); + Spi = new var("Spi", ngfs++, 1, 1, 1); + Sphi1 = new var("Sphi1", ngfs++, 1, 1, 1); + Spi1 = new var("Spi1", ngfs++, 1, 1, 1); + Sphi_rhs = new var("Sphi_rhs", ngfs++, 1, 1, 1); + Spi_rhs = new var("Spi_rhs", ngfs++, 1, 1, 1); + + if (myrank == 0) + cout << "you have setted " << ngfs << " grid functions." << endl; + + OldStateList = new MyList(Sphio); + OldStateList->insert(Spio); + + StateList = new MyList(Sphi0); + StateList->insert(Spi0); + + RHSList = new MyList(Sphi_rhs); + RHSList->insert(Spi_rhs); + + SynchList_pre = new MyList(Sphi); + SynchList_pre->insert(Spi); + + SynchList_cor = new MyList(Sphi1); + SynchList_cor->insert(Spi1); + + DumpList = new MyList(Sphi0); + DumpList->insert(Spi0); + + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + GH = new cgh(0, ngfs, Symmetry, pname, checkrun, ErrorMonitor); + GH->compose_cgh(nprocs); +#ifdef WithShell + SH = new ShellPatch(0, ngfs, pname, Symmetry, myrank, ErrorMonitor); + SH->matchcheck(GH->PatL[0]); + SH->compose_sh(nprocs); + // SH->compose_shr(nprocs); //sh is faster than shr + SH->setupcordtrans(); + SH->Dump_xyz(0, 0, 1); + SH->setupintintstuff(nprocs, GH->PatL[0], Symmetry); +#else + SH = 0; +#endif + + double h = GH->PatL[0]->data->blb->data->getdX(0); + for (int i = 1; i < dim; i++) + h = Mymin(h, GH->PatL[0]->data->blb->data->getdX(i)); + dT = Courant * h; +} +scalar_class::~scalar_class() +{ + StateList->clearList(); + RHSList->clearList(); + OldStateList->clearList(); + SynchList_pre->clearList(); + SynchList_cor->clearList(); + DumpList->clearList(); + + delete Sphio; + delete Spio; + delete Sphi0; + delete Spi0; + delete Sphi; + delete Spi; + delete Sphi1; + delete Spi1; + delete Sphi_rhs; + delete Spi_rhs; + + delete GH; +#ifdef WithShell + delete SH; +#endif + + delete ErrorMonitor; +} +void scalar_class::Setup_Initial_Data() +{ + if (checkrun) + { + } + else + { + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + double R0, WD, A; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good() && myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "Can not open parameter file " << filename << " for inputing information of black holes" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "SCALAR") + { + if (skey == "center of Gauss") + R0 = atof(sval.c_str()); + else if (skey == "width of Gauss") + WD = atof(sval.c_str()); + else if (skey == "amplitude of Gauss") + A = atof(sval.c_str()); + } + } + inf.close(); + } + // echo read-in information + if (myrank == 0) + { + cout << "Setup initial scalar with Gauss profile " << A << "*exp[-(r-" << R0 << ")^2/2/" << WD << "^2]" << endl; + } + // set initial data + for (int lev = 0; lev < GH->levels; lev++) + { + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_scalar(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], R0, WD, A); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + } + + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT); +#ifdef WithShell + // ShellPatch part + MyList *Pp = SH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_get_initial_scalar_sh(cg->shape, cg->fgfs[Pp->data->fngfs + ShellPatch::gx], cg->fgfs[Pp->data->fngfs + ShellPatch::gy], + cg->fgfs[Pp->data->fngfs + ShellPatch::gz], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], R0, WD, A); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } +// dump read_in initial data +// SH->Synch(GH->PatL[0],StateList,Symmetry); +// for(int lev=0;levlevels;lev++) Parallel::Dump_Data(GH->PatL[lev],StateList,0,PhysTime,dT); +// SH->Dump_Data(StateList,0,PhysTime,dT); +// exit(0); +#endif + } +} +void scalar_class::Evolve(int Steps) +{ + clock_t prev_clock, curr_clock; + double LastDump = 0.0, LastCheck = 0.0; + LastAnas = 0; + + double dT_mon = dT * pow(0.5, Mymax(0, trfls)); + + for (int ncount = 1; ncount < Steps + 1; ncount++) + { + if (myrank == 0) + curr_clock = clock(); + RecursiveStep(0); + + LastDump += dT_mon; + LastCheck += dT_mon; + + if (LastDump >= DumpTime) + { + for (int lev = 0; lev < GH->levels; lev++) + Parallel::Dump_Data(GH->PatL[lev], DumpList, 0, PhysTime, dT_mon); +#ifdef WithShell + SH->Dump_Data(DumpList, 0, PhysTime, dT_mon); +#endif + LastDump = 0; + } + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Timestep # " << ncount << ": integrating to time: " << PhysTime + << " Computer used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + if (PhysTime >= TotalTime) + break; + } +} +void scalar_class::RecursiveStep(int lev) +{ + int NoIterations = 1, YN; + if (lev <= trfls) + NoIterations = 1; + else + NoIterations = 2; + + for (int i = 0; i < NoIterations; i++) + { + // if(myrank==0) cout<<"level now = "<bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[Sphi0->sgfn], + cg->fgfs[Spi0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // if(lev==1) Parallel::Dump_Data(GH->PatL[lev],RHSList,0,PhysTime,dT_lev); + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_compute_rhs_scalar_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + Symmetry, lev, ndeps, sPp->data->sst)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + // sommerfeld indeed for outter boudary while fix BD for inner boundary + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varlrhs->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_pre, Symmetry); +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_pre, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + // data analysis part + // Warning NOTE: the variables1 are used as temp storege room + if (lev == a_lev) + { + if (LastAnas >= AnasTime) + { + + LastAnas = 0; + } + LastAnas += dT_lev; + } + // corrector + for (iter_count = 1; iter_count < 4; iter_count++) + { + // for RK4: t0, t0+dt/2, t0+dt/2, t0+dt; + if (iter_count == 1 || iter_count == 3) + TRK4 += dT_lev / 2; + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_compute_rhs_scalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[Sphi->sgfn], cg->fgfs[Spi->sgfn], + cg->fgfs[Sphi1->sgfn], cg->fgfs[Spi1->sgfn], + Symmetry, lev, ndeps)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[Sphi0->sgfn], + cg->fgfs[Spi0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in RK4 substep#" << iter_count << " variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_compute_rhs_scalar_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[Sphi->sgfn], cg->fgfs[Spi->sgfn], + cg->fgfs[Sphi1->sgfn], cg->fgfs[Spi1->sgfn], + Symmetry, lev, ndeps, sPp->data->sst)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl = SynchList_pre, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_rungekutta4_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn], + iter_count); + + varl0 = varl0->next; + varl = varl->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(SynchList_pre, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN on Shell Patches in RK4 substep#" << iter_count << " variables at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + // swap time level + if (iter_count < 3) + { + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(SynchList_pre, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif + } + } + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif +} +#else +// for check, using Euler method +void scalar_class::Step(int lev, int YN) +{ + double dT_lev = dT * pow(0.5, Mymax(lev, trfls)); + bool BB = fgt(PhysTime, StartTime, dT_lev / 2); + double ndeps = numepss; + if (lev < GH->movls) + ndeps = numepsb; + double TRK4 = PhysTime; + int iter_count = 0; // count RK4 substeps + int pre = 0, cor = 1; + int ERROR = 0; + + MyList *sPp; + + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_compute_rhs_scalar(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + Symmetry, lev, ndeps)) + { + cout << "find NaN in domain: (" << cg->bbox[0] << ":" << cg->bbox[3] << "," << cg->bbox[1] << ":" << cg->bbox[4] << "," + << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // rk4 substep and boundary + { + MyList *varl0 = StateList, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { +#ifndef WithShell + if (lev == 0) // sommerfeld indeed + f_sommerfeld_routbam(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); +#endif + f_euler_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn]); + +#ifndef WithShell + if (lev > 0) // fix BD point +#endif + f_sommerfeld_rout(cg->shape, cg->X[0], cg->X[1], cg->X[2], + Pp->data->bbox[0], Pp->data->bbox[1], Pp->data->bbox[2], Pp->data->bbox[3], Pp->data->bbox[4], Pp->data->bbox[5], + dT_lev, cg->fgfs[Sphi0->sgfn], + cg->fgfs[Spi0->sgfn], cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], varl0->data->SoA, + Symmetry, cor); + + varl0 = varl0->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + // if(lev==1) Parallel::Dump_Data(GH->PatL[lev],RHSList,0,PhysTime,dT_lev); + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + Parallel::Dump_Data(GH->PatL[lev], StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables at t = " << PhysTime << ", lev = " << lev << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#ifdef WithShell + // evolve Shell Patches + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + int fngfs = sPp->data->fngfs; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + if (f_compute_rhs_scalar_ss(cg->shape, TRK4, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[Sphi0->sgfn], cg->fgfs[Spi0->sgfn], + cg->fgfs[Sphi_rhs->sgfn], cg->fgfs[Spi_rhs->sgfn], + Symmetry, lev, ndeps, sPp->data->sst)) + { + cout << "find NaN in Shell domain: sst = " << sPp->data->sst << ", (" << cg->bbox[0] << ":" << cg->bbox[3] << "," + << cg->bbox[1] << ":" << cg->bbox[4] << "," << cg->bbox[2] << ":" << cg->bbox[5] << ")" << endl; + ERROR = 1; + } + + // euler step and boundary + { + MyList *varl0 = StateList, *varl1 = SynchList_cor, *varlrhs = RHSList; // we do not check the correspondence here + while (varl0) + { + f_sommerfeld_routbam_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + sPp->data->bbox[0], sPp->data->bbox[1], sPp->data->bbox[2], sPp->data->bbox[3], sPp->data->bbox[4], sPp->data->bbox[5], + cg->fgfs[varl1->data->sgfn], + cg->fgfs[varl0->data->sgfn], varl0->data->propspeed, varl0->data->SoA, + Symmetry); + + f_euler_rout(cg->shape, dT_lev, cg->fgfs[varl0->data->sgfn], cg->fgfs[varl1->data->sgfn], cg->fgfs[varlrhs->data->sgfn]); + + varl0 = varl0->next; + varl1 = varl1->next; + varlrhs = varlrhs->next; + } + } + } + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } + // check error information + { + int erh = ERROR; + MPI_Allreduce(&erh, &ERROR, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + } + if (ERROR) + { + SH->Dump_Data(StateList, 0, PhysTime, dT_lev); + if (myrank == 0) + { + if (ErrorMonitor->outfile) + ErrorMonitor->outfile << "find NaN in state variables on Shell Patches at t = " << PhysTime << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + } +#endif + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->Synch(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " Shell stuff synchronization used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + // mesh refinement boundary part + RestrictProlong(lev, YN, BB); +#ifdef WithShell + if (lev == 0) + { + clock_t prev_clock, curr_clock; + if (myrank == 0) + curr_clock = clock(); + SH->CS_Inter(SynchList_cor, Symmetry); + if (myrank == 0) + { + prev_clock = curr_clock; + curr_clock = clock(); + cout << " CS_Inter used " << (double)(curr_clock - prev_clock) / ((double)CLOCKS_PER_SEC) << " seconds! " << endl; + } + } +#endif + // note the data structure before update + // SynchList_cor 1 ----------- + // + // StateList 0 ----------- + // + // OldStateList old ----------- + // update + Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } +#ifdef WithShell + if (lev == 0) + { + sPp = SH->PatL; + while (sPp) + { + MyList *BP = sPp->data->blb; + while (BP) + { + Block *cg = BP->data; + cg->swapList(StateList, SynchList_cor, myrank); + cg->swapList(OldStateList, SynchList_cor, myrank); + if (BP == sPp->data->ble) + break; + BP = BP->next; + } + sPp = sPp->next; + } + } +#endif +} +#endif +void scalar_class::RestrictProlong(int lev, int YN, bool BB) +{ + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, SynchList_pre, Symmetry); + + Parallel::Sync(GH->PatL[lev - 1], SynchList_pre, Symmetry); + + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + } + else // no time refinement levels and for all same time levels + { + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); + + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} +void scalar_class::ProlongRestrict(int lev, int YN, bool BB) +{ + if (lev > 0) + { + MyList *Pp, *Ppc; + if (lev > trfls && YN == 0) // time refinement levels and for intermediat time level + { + Pp = GH->PatL[lev - 1]; + while (Pp) + { + if (BB) + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, SynchList_cor, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + else + Parallel::prepare_inter_time_level(Pp->data, StateList, OldStateList, + SynchList_pre, 0); // use SynchList_pre as temporal storage space + Pp = Pp->next; + } + + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, SynchList_pre, SynchList_cor, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + } + else // no time refinement levels and for all same time levels + { + Ppc = GH->PatL[lev - 1]; + while (Ppc) + { + Pp = GH->PatL[lev]; + while (Pp) + { + Parallel::OutBdLow2Hi(Ppc->data, Pp->data, StateList, SynchList_cor, Symmetry); + Pp = Pp->next; + } + Ppc = Ppc->next; + } + + Parallel::Restrict(GH->PatL[lev - 1], GH->PatL[lev], SynchList_cor, StateList, Symmetry); + + Parallel::Sync(GH->PatL[lev - 1], StateList, Symmetry); + } + + Parallel::Sync(GH->PatL[lev], SynchList_cor, Symmetry); + } +} diff --git a/AMSS_NCKU_source/scalar_class.h b/AMSS_NCKU_source/scalar_class.h new file mode 100644 index 0000000..aab5aa4 --- /dev/null +++ b/AMSS_NCKU_source/scalar_class.h @@ -0,0 +1,75 @@ + +#ifndef SCALAR_CLASS_H +#define SCALAR_CLASS_H + +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "cgh.h" +#include "ShellPatch.h" +#include "misc.h" +#include "var.h" +#include "MyList.h" +#include "monitor.h" + +class scalar_class +{ +protected: + int myrank; + cgh *GH; + ShellPatch *SH; + double PhysTime; + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, CheckTime; + double LastAnas; + double Courant; + double numepss, numepsb; + int Symmetry; + int trfls, a_lev; + + double dT; + + var *Sphio, *Spio; + var *Sphi0, *Spi0; + var *Sphi, *Spi; + var *Sphi1, *Spi1; + var *Sphi_rhs, *Spi_rhs; + + MyList *StateList, *SynchList_pre, *SynchList_cor, *RHSList; + MyList *OldStateList, *DumpList, *CheckList; + + monitor *ErrorMonitor; + +public: + scalar_class(double Couranti, double StartTimei, double TotalTimei, double DumpTimei, double CheckTimei, double AnasTimei, + int Symmetryi, int checkruni, char *checkfilenamei, double numepssi, double numepsbi, + int a_levi); + ~scalar_class(); + void Setup_Initial_Data(); + void Evolve(int Steps); + void RecursiveStep(int lev); + void Step(int lev, int YN); + void RestrictProlong(int lev, int YN, bool BB); + void ProlongRestrict(int lev, int YN, bool BB); +}; +#endif /* SCALAR_CLASS_H */ diff --git a/AMSS_NCKU_source/scalar_rhs.f90 b/AMSS_NCKU_source/scalar_rhs.f90 new file mode 100644 index 0000000..43c5e2f --- /dev/null +++ b/AMSS_NCKU_source/scalar_rhs.f90 @@ -0,0 +1,155 @@ + +! PIN==0: standard scalar wave +! PIN==1: \block phi = \eta(dphi,dphi) +#define PIN 0 + + function compute_rhs_scalar(ex, T, X, Y, Z, & + Sphi,Spi,Sphi_rhs,Spi_rhs, & + Symmetry,Lev,eps) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev + real*8, intent(in ):: T,X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3)) + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: fxx,fxy,fxz,fyy,fyz,fzz + real*8,dimension(3) ::SSS + real*8, parameter :: HALF = 0.5d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: tt + +!!! sanity check + tt = sum(Sphi)+sum(Spi) + if(tt.ne.tt) then + if(sum(Sphi).ne.sum(Sphi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar find NaN in Sphi" + if(sum(Spi).ne.sum(Spi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar find NaN in Spi" + gont = 1 + return + endif + + Sphi_rhs = Spi !rhs for phi + +#if (PIN == 0) + call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + Spi_rhs = fxx + fyy + fzz +#elif (PIN == 1) + call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + Spi_rhs = Spi*Spi + fxx + fyy + fzz + call fderivs(ex,Sphi,fxx,fyy,fzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,Lev) + Spi_rhs = Spi_rhs - (fxx*fxx+fyy*fyy+fzz*fzz) +#endif + if(eps>0)then +! usual Kreiss-Oliger dissipation + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + call kodis(ex,X,Y,Z,Sphi,Sphi_rhs,SSS,Symmetry,eps) + call kodis(ex,X,Y,Z,Spi,Spi_rhs,SSS,Symmetry,eps) + endif + + gont = 0 + + return + + end function compute_rhs_scalar +! for shell + function compute_rhs_scalar_ss(ex, T,crho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz, & + Sphi,Spi,Sphi_rhs,Spi_rhs, & + Symmetry,Lev,eps,sst) result(gont) + implicit none + +!~~~~~~> Input parameters: + + integer,intent(in ):: ex(1:3), Symmetry,Lev,sst + real*8, intent(in ):: T + double precision,intent(in),dimension(ex(1))::crho + double precision,intent(in),dimension(ex(2))::sigma + double precision,intent(in),dimension(ex(3))::R + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Sphi,Spi + real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Sphi_rhs,Spi_rhs + real*8,intent(in) :: eps +! gont = 0: success; gont = 1: something wrong + integer::gont + +!~~~~~~> Other variables: + + real*8, dimension(ex(1),ex(2),ex(3)) :: fxx,fxy,fxz,fyy,fyz,fzz + real*8,dimension(3) ::SSS + real*8, parameter :: HALF = 0.5d0, ONE = 1.D0, TWO = 2.D0, FOUR = 4.D0 + real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0 + real*8 :: tt + +!!! sanity check + tt = sum(Sphi)+sum(Spi) + if(tt.ne.tt) then + if(sum(Sphi).ne.sum(Sphi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar_ss find NaN in Sphi" + if(sum(Spi).ne.sum(Spi))write(*,*)"scalar_rhs.f90:compute_rhs_scalar_ss find NaN in Spi" + gont = 1 + return + endif + + Sphi_rhs = Spi !rhs for phi + +#if (PIN == 0) + call fdderivs_shc(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + + Spi_rhs = fxx+fyy+fzz +#elif (PIN == 1) + call fdderivs_shc(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,crho,sigma,R,SYM ,SYM ,SYM ,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + Spi_rhs = Spi*Spi + fxx + fyy + fzz + call fderivs_shc(ex,Sphi,fxx,fyy,fzz,crho,sigma,R,SYM,SYM,SYM,Symmetry,Lev,sst, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz) + Spi_rhs = Spi_rhs - (fxx*fxx+fyy*fyy+fzz*fzz) +#endif + + if(eps>0)then +! usual Kreiss-Oliger dissipation + SSS(1)=SYM + SSS(2)=SYM + SSS(3)=SYM + + call kodis_sh(ex,crho,sigma,R,Sphi,Sphi_rhs,SSS,Symmetry,eps,sst) + call kodis_sh(ex,crho,sigma,R,Spi,Spi_rhs,SSS,Symmetry,eps,sst) + endif + + gont = 0 + + return + + end function compute_rhs_scalar_ss diff --git a/AMSS_NCKU_source/scalar_rhs.h b/AMSS_NCKU_source/scalar_rhs.h new file mode 100644 index 0000000..492d137 --- /dev/null +++ b/AMSS_NCKU_source/scalar_rhs.h @@ -0,0 +1,39 @@ + +#ifndef SCALAR_RHS_H +#define SCALAR_RHS_H + +#ifdef fortran1 +#define f_compute_rhs_scalar compute_rhs_scalar +#define f_compute_rhs_scalar_ss compute_rhs_scalar_ss +#endif +#ifdef fortran2 +#define f_compute_rhs_scalar COMPUTE_RHS_SCALAR +#define f_compute_rhs_scalar_ss COMPUTE_RHS_SCALAR_SS +#endif +#ifdef fortran3 +#define f_compute_rhs_scalar compute_rhs_scalar_ +#define f_compute_rhs_scalar_ss compute_rhs_scalar_ss_ +#endif +extern "C" +{ + int f_compute_rhs_scalar(int *, double &, double *, double *, double *, // ex,T,X,Y,Z + double *, double *, // Sphi,Spi + double *, double *, // Sphi_rhs,Spi_rhs + int &, int &, double &); +} + +extern "C" +{ + int f_compute_rhs_scalar_ss(int *, double &, double *, double *, double *, // ex,T,rho,sigma,R + double *, double *, double *, // X,Y,Z + double *, double *, double *, // drhodx,drhody,drhodz + double *, double *, double *, // dsigmadx,dsigmady,dsigmadz + double *, double *, double *, // dRdx,dRdy,dRdz + double *, double *, double *, double *, double *, double *, // drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz + double *, double *, double *, double *, double *, double *, // dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz + double *, double *, double *, double *, double *, double *, // dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz + double *, double *, // Sphi,Spi + double *, double *, // Sphi_rhs,Spi_rhs + int &, int &, double &, int &); +} +#endif /* SCALAR_RHS_H */ diff --git a/AMSS_NCKU_source/scalarwaves.C b/AMSS_NCKU_source/scalarwaves.C new file mode 100644 index 0000000..9f465d9 --- /dev/null +++ b/AMSS_NCKU_source/scalarwaves.C @@ -0,0 +1,213 @@ + +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "misc.h" +#include "microdef.h" +#include "scalar_class.h" + +//======================================= +int main(int argc, char *argv[]) +{ + int myrank = 0, nprocs = 1; + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, d2DumpTime, CheckTime; + double Courant; + double numepss, numepsb, numepsh; + int Symmetry; + int a_lev, maxl, decn; + double maxrex, drex; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "ABE") + { + if (skey == "checkrun") + checkrun = atoi(sval.c_str()); + else if (skey == "checkfile") + strcpy(checkfilename, sval.c_str()); + else if (skey == "Steps") + Steps = atoi(sval.c_str()); + else if (skey == "StartTime") + StartTime = atof(sval.c_str()); + else if (skey == "TotalTime") + TotalTime = atof(sval.c_str()); + else if (skey == "DumpTime") + DumpTime = atof(sval.c_str()); + else if (skey == "d2DumpTime") + d2DumpTime = atof(sval.c_str()); + else if (skey == "CheckTime") + CheckTime = atof(sval.c_str()); + else if (skey == "AnalysisTime") + AnasTime = atof(sval.c_str()); + else if (skey == "Courant") + Courant = atof(sval.c_str()); + else if (skey == "Symmetry") + Symmetry = atoi(sval.c_str()); + else if (skey == "small dissipation") + numepss = atof(sval.c_str()); + else if (skey == "big dissipation") + numepsb = atof(sval.c_str()); + else if (skey == "shell dissipation") + numepsh = atof(sval.c_str()); + else if (skey == "Analysis Level") + a_lev = atoi(sval.c_str()); + else if (skey == "Max mode l") + maxl = atoi(sval.c_str()); + else if (skey == "detector number") + decn = atoi(sval.c_str()); + else if (skey == "farest detector position") + maxrex = atof(sval.c_str()); + else if (skey == "detector distance") + drex = atof(sval.c_str()); + } + } + inf.close(); + } + // echo parameters + if (myrank == 0) + { + cout << "///////////////////////////////////////////////////////////////" << endl; +#ifdef Cell + cout << "Cell center numerical grid structure" << endl; +#endif +#ifdef Vertex + cout << "Vertex center numerical grid structure" << endl; +#endif + if (checkrun) + cout << " checked run" << endl; + else + cout << " new run" << endl; + cout << " simulation with cpu numbers = " << nprocs << endl; + cout << " simulation time = (" << StartTime << ", " << TotalTime << ")" << endl; + cout << "simulation steps for this run = " << Steps << endl; + cout << " Courant number = " << Courant << endl; + cout << " ghost zone = " << ghost_width << endl; + cout << " buffer zone = " << buffer_width << endl; + switch (Symmetry) + { + case 0: + cout << " Symmetry setting: No_Symmetry" << endl; + break; + case 1: + cout << " Symmetry setting: Equatorial" << endl; + break; + case 2: + cout << " Symmetry setting: Octant" << endl; + break; + default: + cout << "OOOOps, not supported Symmetry setting!" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + cout << "Courant = " << Courant << endl; + cout << "artificial dissipation for shell patches = " << numepsh << endl; + cout << "artificial dissipation for fixed levels = " << numepsb << endl; + cout << "artificial dissipation for moving levels = " << numepss << endl; + cout << "Dumpt Time = " << DumpTime << endl; + cout << "Check Time = " << CheckTime << endl; + cout << "Analysis Time = " << AnasTime << endl; + cout << "Analysis level = " << a_lev << endl; + cout << "checkfile = " << checkfilename << endl; + switch (ghost_width) + { + case 2: + cout << "second order finite difference is used" << endl; + break; + case 3: + cout << "fourth order finite difference is used" << endl; + break; + case 4: + cout << "sixth order finite difference is used" << endl; + break; + case 5: + cout << "eighth order finite difference is used" << endl; + break; + default: + cout << "Why are you using ghost width = " << ghost_width << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + cout << "///////////////////////////////////////////////////////////////" << endl; + } + //===========================the computation body==================================================== + scalar_class *ADM; + + ADM = new scalar_class(Courant, StartTime, TotalTime, DumpTime, CheckTime, AnasTime, + Symmetry, checkrun, checkfilename, numepss, numepsb, + a_lev); + + ADM->Setup_Initial_Data(); + + ADM->Evolve(Steps); + + delete ADM; + //=======================caculation done============================================================= + if (myrank == 0) + cout << "===============================================================" << endl; + if (myrank == 0) + cout << "Simulation is successfully done!!" << endl; + MPI_Finalize(); + + exit(0); +} diff --git a/AMSS_NCKU_source/setup.C b/AMSS_NCKU_source/setup.C new file mode 100644 index 0000000..e760067 --- /dev/null +++ b/AMSS_NCKU_source/setup.C @@ -0,0 +1,188 @@ +#include +#include +#include +#include + +#include + +#include "util_Table.h" +#include "cctk.h" +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "cpm_map.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" +#include "fd_grid.h" +#include "patch.h" +#include "patch_edge.h" +#include "patch_interp.h" +#include "ghost_zone.h" +#include "patch_system.h" + +#include "Jacobian.h" + +#include "gfns.h" +#include "gr.h" + +#include "horizon_sequence.h" +#include "BH_diagnostics.h" +#include "driver.h" +using namespace std; + +#include "myglobal.h" +#include "bssn_class.h" + +namespace AHFinderDirect +{ + struct state state; + + using jtutil::error_exit; + + namespace + { + int allocate_horizons_to_processor(int N_procs, int my_proc, + int N_horizons, bool multiproc_flag, + horizon_sequence &my_hs) + { + const int N_active_procs = multiproc_flag ? Mymin(N_procs, N_horizons) + : 1; + // Implementation note: + // We allocate the horizons to active processors in round-robin order. + // + int proc = 0; + for (int hn = 1; hn <= N_horizons; ++hn) + { + if (proc == my_proc) + my_hs.append_hn(hn); + if (++proc >= N_active_procs) + proc = 0; + } + + return N_active_procs; + } + } + + extern struct state state; + + void AHFinderDirect_setup(MyList *AHList, MyList *GaugeList, bssn_class *ADM, + int Symmetry, int HN, double *PhysTime) + { + enum patch_system::patch_system_type ps_type; + + switch (Symmetry) + { + case 2: + ps_type = patch_system::patch_system__plus_xyz_octant_mirrored; + break; + case 1: + ps_type = patch_system::patch_system__plus_z_hemisphere; + break; + case 0: + ps_type = patch_system::patch_system__full_sphere; + break; + default: + jtutil::error_exit(ERROR_EXIT, "** Symmetry=%d is not support by AHFD yet.", Symmetry); + } + + int nprocs = 1, myrank = 0; + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + state.PhysTime = PhysTime; // Synchonize the PhysTime + state.Symmetry = Symmetry; + state.AHList = AHList; + state.GaugeList = GaugeList; + state.ADM = ADM; + state.N_procs = nprocs; + state.my_proc = myrank; + + state.N_horizons = HN; + + // + // (genuine) horizon sequence for this processor + // + state.my_hs = new horizon_sequence(state.N_horizons); + horizon_sequence &hs = *state.my_hs; + + const bool multiproc_flag = true; + state.N_active_procs = allocate_horizons_to_processor(state.N_procs, state.my_proc, + state.N_horizons, multiproc_flag, + hs); + + // ... horizon numbers run from 1 to N_horizons inclusive + // so the array size is N_horizons+1 + state.AH_data_array = new AH_data *[HN + 1]; + for (int hn = 0; hn <= HN; ++hn) + { + state.AH_data_array[hn] = NULL; + } + + int NNP = 0, NNP_out; + for (int hn = 1; hn <= hs.N_horizons(); ++hn) + { + const bool genuine_flag = hs.is_hn_genuine(hn); + state.AH_data_array[hn] = new AH_data; + struct AH_data &AH_data = *state.AH_data_array[hn]; + + AH_data.recentering_flag = false; + AH_data.stop_finding = false; + + // create the patch system + AH_data.ps_ptr = new patch_system(0, 0, 0, // just dummy set, we will recenter it when setting initial guess + ps_type, 2, 1, + 20, 1, + // (genuine_flag ? 53 : 0), + (genuine_flag ? gfns::nominal_max_gfn + : gfns::skeletal_nominal_max_gfn), + -1, -1, + 1, 1, + 1, 1, + true, false); + patch_system &ps = *AH_data.ps_ptr; + + if (genuine_flag) + ps.set_gridfn_to_constant(1.0, gfns::gfn__one); + + AH_data.Jac_ptr = genuine_flag ? new Jacobian(ps) : NULL; + + AH_data.surface_expansion = 0; + + AH_data.initial_find_flag = genuine_flag; + + AH_data.found_flag = false; + AH_data.BH_diagnostics_fileptr = NULL; + + NNP = Mymax(NNP, AH_data.ps_ptr->N_grid_points()); + } // end of for hn + + MPI_Allreduce(&NNP, &NNP_out, 1, MPI_INT, MPI_MAX, MPI_COMM_WORLD); + + state.Data = new double[NNP_out * 35]; + state.oX = new double[NNP_out]; + state.oY = new double[NNP_out]; + state.oZ = new double[NNP_out]; + } + void AHFinderDirect_cleanup() + { + horizon_sequence &hs = *state.my_hs; + for (int hn = 1; hn <= hs.N_horizons(); ++hn) + { + struct AH_data &AH_data = *state.AH_data_array[hn]; + if (AH_data.ps_ptr) + delete AH_data.ps_ptr; + if (AH_data.Jac_ptr) + delete AH_data.Jac_ptr; + delete state.AH_data_array[hn]; + } // end of for hn + delete[] state.AH_data_array; + delete state.my_hs; + delete[] state.oX; + delete[] state.oY; + delete[] state.oZ; + delete[] state.Data; + } +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/shellfunctions.f90 b/AMSS_NCKU_source/shellfunctions.f90 new file mode 100644 index 0000000..a88ea05 --- /dev/null +++ b/AMSS_NCKU_source/shellfunctions.f90 @@ -0,0 +1,723 @@ + + +!----------------------------------------------------------------------------------- +! +!Set up approximate puncture initial data for n black holes with lousto's +!formula PRD 77, 024034 (2008) +! +!----------------------------------------------------------------------------------- + + subroutine get_initial_nbhs_sh(ex,X,Y,Z, & + chi, trK, & + gxx, gxy, gxz, gyy, gyz, gzz,& + Axx, Axy, Axz, Ayy, Ayz, Azz,& + Gmx, Gmy, Gmz, & + Lap, Sfx, Sfy, Sfz,& + dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N) + + implicit none + +!------= input arguments + + integer,intent(in) :: N + integer, dimension(3), intent(in) :: ex + real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: X,Y,Z + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz + real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz + real*8, dimension(N), intent(in) :: Mass + real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin + +!------= local variables + real*8,dimension(ex(1),ex(2),ex(3))::psi + integer :: i,j,k,bhi + real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS + real*8 :: nx,ny,nz,rr,tmp + real*8 :: u,u1,u2,u3,u4,u5 + real*8 :: mup,mus,b,ell + real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0 + real*8,parameter::TINYRR=1.d-14 + + do k = 1,ex(3) + do j = 1,ex(2) + do i = 1,ex(1) +! black hole 1 + M = mass(1) + nx = x(i,j,k) - Porg(1) + ny = y(i,j,k) - Porg(2) + nz = z(i,j,k) - Porg(3) + Px = Pmom(1) + Py = Pmom(2) + Pz = Pmom(3) + Sx = Spin(1) + Sy = Spin(2) + Sz = Spin(3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2,1,1)-X(1,1,1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5 + u4 = -b**2*ell**5 + u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1 + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + & + u5*tmp + + psi(i,j,k) = ONE + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) +! black hole 2 and 3, ... + do bhi=2,N + M = Mass(bhi) + nx = x(i,j,k) - Porg(3*(bhi-1)+1) + ny = y(i,j,k) - Porg(3*(bhi-1)+2) + nz = z(i,j,k) - Porg(3*(bhi-1)+3) + Px = Pmom(3*(bhi-1)+1) + Py = Pmom(3*(bhi-1)+2) + Pz = Pmom(3*(bhi-1)+3) + Sx = Spin(3*(bhi-1)+1) + Sy = Spin(3*(bhi-1)+2) + Sz = Spin(3*(bhi-1)+3) + + rr = dsqrt(nx*nx+ny*ny+nz*nz) + if(rr.lt.TINYRR) rr=(X(2,1,1)-X(1,1,1))/2.d0 + nx = nx / rr + ny = ny / rr + nz = nz / rr + PP = dsqrt(Px**2 + Py**2 + Pz**2) + if(PP .gt. 0.d0) then + mup = (Px*nx+Py*ny+Pz*nz)/PP + else + mup = 0.0 + endif + SS = dsqrt(Sx**2 + Sy**2 + Sz**2) + if(SS .gt. 0.d0) then + mus = (Sx*nx+Sy*ny+Sz*nz)/SS + else + mus = 0.0 + endif + b = 2.d0*rr/M + ell = 1.d0/(1.d0+b) + + u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0) + u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 & + +8.4d1*dlog(ell)/b)/4.d1/b**2 + u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5 + u4 = -b**2*ell**5 + u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1 + + tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz + + u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + & + 2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + & + u5*tmp + + psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr + + tmp = Px * nx + Py * ny + Pz * nz + + Axx(i,j,k) = Axx(i,j,k) + & + (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + & + ( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayy(i,j,k) = Ayy(i,j,k) + & + (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + & + ( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + + Azz(i,j,k) = Azz(i,j,k) + & + (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + & + ( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * & + THR / ( rr * rr ) + + Axy(i,j,k) = Axy(i,j,k) + & + (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + & + ( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Axz(i,j,k) = Axz(i,j,k) + & + (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + & + ( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * & + THR / ( rr * rr ) + + Ayz(i,j,k) = Ayz(i,j,k) + & + (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + & + ( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * & + THR / ( rr * rr ) + enddo + enddo + enddo + enddo + + chi = ONE / psi **4 - ONE + + Lap = ONE / ( psi * psi ) - ONE + +!~~~~~~ tilde Aij = Aij / Psi^6 + psi = psi * psi * psi * psi * psi * psi + + Axx = Axx / psi + Ayy = Ayy / psi + Azz = Azz / psi + Axy = Axy / psi + Axz = Axz / psi + Ayz = Ayz / psi + + gxx = ZEO + gyy = ZEO + gzz = ZEO + gxy = ZEO + gxz = ZEO + gyz = ZEO + + trK = ZEO + + Gmx = ZEO + Gmy = ZEO + Gmz = ZEO + + Sfx = ZEO + Sfy = ZEO + Sfz = ZEO + + dtSfx = ZEO + dtSfy = ZEO + dtSfz = ZEO + + return + + end subroutine get_initial_nbhs_sh +!---------------------------------------------------- +! I use this routine to unify the parameters +subroutine shellcordpar(A,B,r0,eps) +implicit none +! argument variables +double precision,intent(out)::A,B,r0,eps + +A=1.d0 +B=0.d0 +r0=0.d0 +eps=1.d0 + +return + +end subroutine shellcordpar +!---------------------------------------------------- +! R = f(r)-f(0) +subroutine getcartr(ex,R,cartr) +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::R +double precision,intent(out),dimension(ex)::cartr + +!~~~~~~ local variables +double precision,dimension(ex)::f +double precision :: A,B,r0,eps + +call shellcordpar(A,B,r0,eps) +f = R+B +cartr = r0+(A*f-B*dsqrt(A*A+(f*f-B*B)/eps))/(A*A-B*B/eps) + +return +end subroutine getcartr +! dR/dr = ... +subroutine getdRdcartr(ex,R,dRdcartr) +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::R +double precision,intent(out),dimension(ex)::dRdcartr + +!~~~~~~ local variables +double precision,dimension(ex)::cartr +double precision :: A,B,r0,eps + + call shellcordpar(A,B,r0,eps) + + call getcartr(ex,R,cartr) + dRdcartr = A + B*(cartr-r0)/dsqrt(eps*eps+eps*(cartr-r0)*(cartr-r0)) + +return +end subroutine getdRdcartr +! dR/drdr = ... +subroutine getdRdcartrcartr(ex,R,dRdcartrcartr) +implicit none +! argument variables +integer,intent(in)::ex +double precision,intent(in),dimension(ex)::R +double precision,intent(out),dimension(ex)::dRdcartrcartr + +!~~~~~~ local variables +double precision,dimension(ex)::cartr + +double precision :: A,B,r0,eps + + call shellcordpar(A,B,r0,eps) + + call getcartr(ex,R,cartr) + dRdcartrcartr = B*dsqrt(eps)/(dsqrt(eps+(cartr-r0)*(cartr-r0)))**3 + + return + +end subroutine getdRdcartrcartr + +subroutine zp_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + z(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + x(i,j,k) = z(i,j,k)*tgrho(i) + y(i,j,k) = z(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine zp_getxyz + +subroutine zm_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + z(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + x(i,j,k) = z(i,j,k)*tgrho(i) + y(i,j,k) = z(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine zm_getxyz + +subroutine yp_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + y(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + x(i,j,k) = y(i,j,k)*tgrho(i) + z(i,j,k) = y(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine yp_getxyz + +subroutine ym_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + y(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + x(i,j,k) = y(i,j,k)*tgrho(i) + z(i,j,k) = y(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine ym_getxyz + +subroutine xp_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + x(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + y(i,j,k) = x(i,j,k)*tgrho(i) + z(i,j,k) = x(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine xp_getxyz + +subroutine xm_getxyz(ex,rho,sigma,R,x,y,z) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1))::tgrho +double precision,dimension(ex(2))::tgsigma +integer :: i,j,k + + call getcartr(ex(3),R,cartr) + tgrho = dtan(rho) + tgsigma = dtan(sigma) + + do k=1,ex(3) + do j=1,ex(2) + do i=1,ex(1) + x(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j)) + y(i,j,k) = x(i,j,k)*tgrho(i) + z(i,j,k) = x(i,j,k)*tgsigma(j) + enddo + enddo + enddo + + return + +end subroutine xm_getxyz +!------------------------------------------------------------------------------------------ +! calculate Jacobians +subroutine xpm_getjacobian(ex,rho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1),ex(2),ex(3))::srt,xxyy,xxzz,dRdcartr,dRdcartrcartr +integer :: i,j,k +real*8,parameter :: ZEO=0.d0 + + xxyy = x*x + y*y + xxzz = x*x + z*z + srt = dsqrt(xxyy + z*z) + call getdRdcartr(ex(3),R,dRdcartr(1,1,:)) + call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:)) + do k=1,ex(3) + dRdcartr(:,:,k) = dRdcartr(1,1,k) + dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k) + enddo + + dRdx = x/srt*dRdcartr + dRdy = y/srt*dRdcartr + dRdz = z/srt*dRdcartr + drhodx = -y/xxyy + drhody = x/xxyy + drhodz = ZEO + dsigmadx = -z/xxzz + dsigmady = ZEO + dsigmadz = x/xxzz + + dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3 + dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3 + dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3 + dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3 + dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3 + dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3 + drhodxx = 2*x*y/xxyy**2 + drhodxy = (-x*x + y*y)/xxyy**2 + drhodxz = ZEO + drhodyy = -drhodxx + drhodyz = ZEO + drhodzz = ZEO + dsigmadxx = (2*x*z)/xxzz**2 + dsigmadxy = ZEO + dsigmadxz = (-x*x + z*z)/xxzz**2 + dsigmadyy = ZEO + dsigmadyz = ZEO + dsigmadzz = -dsigmadxx + + return + +end subroutine xpm_getjacobian +!~~~~ +subroutine ypm_getjacobian(ex,rho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1),ex(2),ex(3))::srt,xxyy,yyzz,dRdcartr,dRdcartrcartr +integer :: i,j,k +real*8,parameter :: ZEO=0.d0 + + xxyy = x*x + y*y + yyzz = y*y + z*z + srt = dsqrt(xxyy + z*z) + call getdRdcartr(ex(3),R,dRdcartr(1,1,:)) + call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:)) + do k=1,ex(3) + dRdcartr(:,:,k) = dRdcartr(1,1,k) + dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k) + enddo + + dRdx = x/srt*dRdcartr + dRdy = y/srt*dRdcartr + dRdz = z/srt*dRdcartr + drhodx = y/xxyy + drhody = -x/xxyy + drhodz = ZEO + dsigmadx = ZEO + dsigmady = -z/yyzz + dsigmadz = y/yyzz + + dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3 + dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3 + dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3 + dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3 + dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3 + dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3 + drhodxx = -2*x*y/xxyy**2 + drhodxy = (x*x - y*y)/xxyy**2 + drhodxz = ZEO + drhodyy = -drhodxx + drhodyz = ZEO + drhodzz = ZEO + dsigmadxx = ZEO + dsigmadxy = ZEO + dsigmadxz = ZEO + dsigmadyy = (2*y*z)/yyzz**2 + dsigmadyz = (-y*y + z*z)/yyzz**2 + dsigmadzz = -dsigmadyy + + return + +end subroutine ypm_getjacobian +!~~~~ +subroutine zpm_getjacobian(ex,rho,sigma,R,x,y,z, & + drhodx, drhody, drhodz, & + dsigmadx,dsigmady,dsigmadz, & + dRdx,dRdy,dRdz, & + drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, & + dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, & + dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz) + +implicit none +! argument variables +integer,dimension(3),intent(in)::ex +double precision,intent(in),dimension(ex(1))::rho +double precision,intent(in),dimension(ex(2))::sigma +double precision,intent(in),dimension(ex(3))::R +double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz +double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz +!~~~~~~ other variables +double precision,dimension(ex(3))::cartr +double precision,dimension(ex(1),ex(2),ex(3))::srt,xxzz,yyzz,dRdcartr,dRdcartrcartr +integer :: i,j,k +real*8,parameter :: ZEO=0.d0 + + xxzz = x*x + z*z + yyzz = y*y + z*z + srt = dsqrt(xxzz + y*y) + call getdRdcartr(ex(3),R,dRdcartr(1,1,:)) + call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:)) + do k=1,ex(3) + dRdcartr(:,:,k) = dRdcartr(1,1,k) + dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k) + enddo + + dRdx = x/srt*dRdcartr + dRdy = y/srt*dRdcartr + dRdz = z/srt*dRdcartr + drhodx = z/xxzz + drhody = ZEO + drhodz = -x/xxzz + dsigmadx = ZEO + dsigmady = z/yyzz + dsigmadz = -y/yyzz + + dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3 + dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3 + dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3 + dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3 + dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3 + dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3 + drhodxx = -2*x*z/xxzz**2 + drhodxy = ZEO + drhodxz = (x*x - z*z)/xxzz**2 + drhodyy = ZEO + drhodyz = ZEO + drhodzz = -drhodxx + dsigmadxx = ZEO + dsigmadxy = ZEO + dsigmadxz = ZEO + dsigmadyy = -(2*y*z)/yyzz**2 + dsigmadyz = (y*y - z*z)/yyzz**2 + dsigmadzz = -dsigmadyy + + return + +end subroutine zpm_getjacobian diff --git a/AMSS_NCKU_source/shellfunctions.h b/AMSS_NCKU_source/shellfunctions.h new file mode 100644 index 0000000..7b5f058 --- /dev/null +++ b/AMSS_NCKU_source/shellfunctions.h @@ -0,0 +1,112 @@ + +#ifndef SHELLFUNCTIONS_H +#define SHELLFUNCTIONS_H + +#ifdef fortran1 +#define f_get_initial_nbhs_sh get_initial_nbhs_sh +#define f_xp_getxyz xp_getxyz +#define f_xm_getxyz xm_getxyz +#define f_yp_getxyz yp_getxyz +#define f_ym_getxyz ym_getxyz +#define f_zp_getxyz zp_getxyz +#define f_zm_getxyz zm_getxyz +#define f_xpm_getjacobian xpm_getjacobian +#define f_ypm_getjacobian ypm_getjacobian +#define f_zpm_getjacobian zpm_getjacobian +#define f_shellcordpar shellcordpar +#endif +#ifdef fortran2 +#define f_get_initial_nbhs_sh GET_INITIAL_NBHS_SH +#define f_xp_getxyz XP_GETXYZ +#define f_xm_getxyz XM_GETXYZ +#define f_yp_getxyz YP_GETXYZ +#define f_ym_getxyz YM_GETXYZ +#define f_zp_getxyz ZP_GETXYZ +#define f_zm_getxyz ZM_GETXYZ +#define f_xpm_getjacobian XPM_GETJACOBIAN +#define f_ypm_getjacobian YPM_GETJACOBIAN +#define f_zpm_getjacobian ZPM_GETJACOBIAN +#define f_shellcordpar SHELLCORDPAR +#endif +#ifdef fortran3 +#define f_get_initial_nbhs_sh get_initial_nbhs_sh_ +#define f_xp_getxyz xp_getxyz_ +#define f_xm_getxyz xm_getxyz_ +#define f_yp_getxyz yp_getxyz_ +#define f_ym_getxyz ym_getxyz_ +#define f_zp_getxyz zp_getxyz_ +#define f_zm_getxyz zm_getxyz_ +#define f_xpm_getjacobian xpm_getjacobian_ +#define f_ypm_getjacobian ypm_getjacobian_ +#define f_zpm_getjacobian zpm_getjacobian_ +#define f_shellcordpar shellcordpar_ +#endif + +extern "C" +{ + void f_get_initial_nbhs_sh(int *, double *, double *, double *, + double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, + double *, double *, double *, + double *, double *, double *, double *, int &); +} + +extern "C" +{ + void f_xp_getxyz(int *, double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_xm_getxyz(int *, double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_yp_getxyz(int *, double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_ym_getxyz(int *, double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_zp_getxyz(int *, double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_zm_getxyz(int *, double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_xpm_getjacobian(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_ypm_getjacobian(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} +extern "C" +{ + void f_zpm_getjacobian(int *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *, + double *, double *, double *, double *, double *, double *); +} + +extern "C" +{ + void f_shellcordpar(double &, double &, double &, double &); +} + +#endif /* SHELLFUNCTIONS_H */ diff --git a/AMSS_NCKU_source/sommerfeld_rout.f90 b/AMSS_NCKU_source/sommerfeld_rout.f90 new file mode 100644 index 0000000..5bd8361 --- /dev/null +++ b/AMSS_NCKU_source/sommerfeld_rout.f90 @@ -0,0 +1,647 @@ + + +#include "macrodef.fh" + +! Update outer boundaries with Sommerfeld boundary condition +! +!----------------------------------------------------------------------------- +!5th order interpolation + subroutine sommerfeld_rout(ex,X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,dT,chi0,& + Lap0,f0,f,SoA,Symmetry,precor) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,precor + real*8, dimension(ex(1)) :: X + real*8, dimension(ex(2)) :: Y + real*8, dimension(ex(3)) :: Z + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax,dT + real*8, dimension(ex(1),ex(2),ex(3)),intent(in)::chi0,Lap0,f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::f + real*8, dimension(3),intent(in) ::SoA +!~~~~~~> Other variables: + real*8 :: dX,dY,dZ,r,fac + integer :: i, j, k,m + logical :: gont,nouse + integer,dimension(3) :: cxB,cxT + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer,parameter::ordn = 6, CORRECTSTEP=1 + real*8 :: ddy + real*8, dimension(1:ordn) :: xa + real*8, dimension(1:3) :: cx + real*8, dimension(1:ordn,1:ordn,1:ordn) :: ya + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, SYM = 1.d0, ANT = -1.d0 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 +!~~~~~~> Interface + + interface + + function decide3d(ex,f,fpi,cxB,cxT,SoA,ya,ORDN,Symmetry) result(gont) + implicit none + + integer, intent(in) :: ORDN,Symmetry + integer,dimension(1:3) , intent(in) :: ex,cxB,cxT + real*8, dimension(1:3) , intent(in) :: SoA + real*8, dimension(ex(1),ex(2),ex(3)) , intent(in) :: f,fpi + real*8, dimension(cxB(1):cxT(1),cxB(2):cxT(2),cxB(3):cxT(3)), intent(out):: ya + logical::gont + end function decide3d + + end interface + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(X(ex(1))-xmax) < dX)then + layer(1,1) = ex(1) + layer(2,1) = 1 + layer(3,1) = 1 + layer(4,1) = ex(1) + layer(5,1) = ex(2) + layer(6,1) = ex(3) +endif + +if(dabs(Y(ex(2))-ymax) < dY)then + layer(1,2) = 1 + layer(2,2) = ex(2) + layer(3,2) = 1 + layer(4,2) = ex(1) + layer(5,2) = ex(2) + layer(6,2) = ex(3) +endif + + +if(dabs(Z(ex(3))-zmax) < dZ)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) +endif +! lower boundary but not symmetry boundary +if(dabs(X(1)-xmin) < dX .and. (.not.(Symmetry==OCTANT.and.dabs(xmin)NO_SYMM.and.dabs(zmin) boundary calculations start... + if( precor == CORRECTSTEP ) then + + do gp = 1, 6, 1 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp), 1 + do j = layer(2,gp), layer(5,gp), 1 + do i = layer(1,gp), layer(4,gp), 1 + + f(i,j,k) = f0(i,j,k) + + enddo + enddo + enddo + endif + enddo + + else + + do gp = 1, 6 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! tc/sc*dT/r + r = (Lap0(i,j,k) + ONE)*dsqrt(ONE+chi0(i,j,k))*dT/dsqrt(X(i)**2+Y(j)**2+Z(k)**2) + fac=ONE-r + cx(1) = r*X(i)/dX + cx(2) = r*Y(j)/dY + cx(3) = r*Z(k)/dZ + if(cx(1)>ZEO)then + cxB(1) = i-dint(cx(1))-ordn/2 + else + cxB(1) = i-dint(cx(1))-ordn/2+1 + endif + if(cx(2)>ZEO)then + cxB(2) = j-dint(cx(2))-ordn/2 + else + cxB(2) = j-dint(cx(2))-ordn/2+1 + endif + if(cx(3)>ZEO)then + cxB(3) = k-dint(cx(3))-ordn/2 + else + cxB(3) = k-dint(cx(3))-ordn/2+1 + endif + + where(cx>ZEO) + cx = dint(cx)-cx+ordn/2 + elsewhere + cx = dint(cx)-cx+ordn/2-1 + end where + + cxT = cxB+ordn-1 + + if(Symmetry==NO_SYMM.and.cxB(3)<1)then + cx(3)=cx(3)+(cxB(3)-1) + cxT(3)=cxT(3)-(cxB(3)-1) + cxB(3)=1 + endif + if(Symmetryex(m))then + cx(m)=cx(m)+(cxT(m)-ex(m)) + cxB(m)=cxB(m)-(cxT(m)-ex(m)) + cxT(m)=ex(m) + endif + enddo + +!~~~~~~> Interpolate + nouse=decide3d(ex,f0,f0,cxB,cxT,SoA,ya,ordn,Symmetry) + call polin3(xa,xa,xa,ya,cx(1),cx(2),cx(3),r,ddy,ordn) + f(i,j,k)=r*fac + + enddo + enddo + enddo + endif + enddo + + endif + + return + + end subroutine sommerfeld_rout +!sommerfeld condition following BAM code + subroutine sommerfeld_routbam(ex,X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,f_rhs,& + f0,velocity,SoA,Symmetry) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry + real*8, intent(in) :: velocity + real*8, dimension(ex(1)) :: X + real*8, dimension(ex(2)) :: Y + real*8, dimension(ex(3)) :: Z + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8, dimension(ex(1),ex(2),ex(3)),intent(in)::f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::f_rhs + real*8,dimension(3),intent(in) ::SoA +!~~~~~~> Other variables: + real*8,dimension(0:ex(1),0:ex(2),0:ex(3)) :: fh + logical :: gont + real*8 :: dX,dY,dZ,R + integer :: i, j, k + real*8 :: d2dx,d2dy,d2dz + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: imin,jmin,kmin,imax,jmax,kmax + real*8 :: fx,fy,fz + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + integer, parameter :: NO_SYMM = 0, EQ_SYMM = 1, OCTANT = 2 + + real*8 :: wx,wy,wz + + dX = X(2) - X(1) + dY = Y(2) - Y(1) + dZ = Z(2) - Z(1) + + d2dx = ONE/TWO/dX + d2dy = ONE/TWO/dY + d2dz = ONE/TWO/dZ + + imax = ex(1) + jmax = ex(2) + kmax = ex(3) + + imin = 1 + jmin = 1 + kmin = 1 + if(Symmetry > NO_SYMM .and. dabs(Z(1)) < dZ) kmin = 0 + if(Symmetry > EQ_SYMM .and. dabs(X(1)) < dX) imin = 0 + if(Symmetry > EQ_SYMM .and. dabs(Y(1)) < dY) jmin = 0 + + call symmetry_bd(1,ex,f0,fh,SoA) + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(X(ex(1))-xmax) < dX)then + layer(1,1) = ex(1) + layer(2,1) = 1 + layer(3,1) = 1 + layer(4,1) = ex(1) + layer(5,1) = ex(2) + layer(6,1) = ex(3) +endif + +if(dabs(Y(ex(2))-ymax) < dY)then + layer(1,2) = 1 + layer(2,2) = ex(2) + layer(3,2) = 1 + layer(4,2) = ex(1) + layer(5,2) = ex(2) + layer(6,2) = ex(3) +endif + +if(dabs(Z(ex(3))-zmax) < dZ)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(3,3) = ex(3) + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(6,3) = ex(3) +endif +! lower boundary but not symmetry boundary +if(dabs(X(1)-xmin) < dX .and. (.not.(Symmetry==OCTANT.and.dabs(xmin)NO_SYMM.and.dabs(zmin)= imin)then + fx=d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + + elseif(i==imin)then + fx=(-fh(i,j,k)+fh(i+1,j,k))/dX + + elseif(i==imax)then + fx=(-fh(i-1,j,k)+fh(i,j,k))/dX + + endif +! y direction + if(j+1 <= jmax .and. j-1 >= jmin)then + fy=d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + + elseif(j==jmin)then + fy=(-fh(i,j,k)+fh(i,j+1,k))/dY + + elseif(j==jmax)then + fy=(-fh(i,j-1,k)+fh(i,j,k))/dY + + endif +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + fz=d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + + elseif(k==kmin)then + fz=(-fh(i,j,k)+fh(i,j,k+1))/dZ + + elseif(k==kmax)then + fz=(-fh(i,j,k-1)+fh(i,j,k))/dZ + + endif + + R = dsqrt(X(i)**2+Y(j)**2+Z(k)**2) + f_rhs(i,j,k) = -velocity*(fx*X(i) + fy*Y(j) + fz*Z(k) + f0(i,j,k))/R +#else +!! new code, 2012dec26, based on bam +!! we always assume var0 = 0 + R = dsqrt(X(i)**2+Y(j)**2+Z(k)**2) + wx = velocity*X(i)/R + wy = velocity*Y(j)/R + wz = velocity*Z(k)/R + if(wx > 0)then + if(i-2>=imin)then + fx = d2dx*(3*fh(i,j,k)-4*fh(i-1,j,k)+fh(i-2,j,k)) + elseif(i-1>=imin)then + fx = d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + else + fx = d2dx*(-fh(i+2,j,k)+4*fh(i+1,j,k)-3*fh(i,j,k)) + endif + elseif(wx < 0)then + if(i+2<=imax)then + fx = d2dx*(-fh(i+2,j,k)+4*fh(i+1,j,k)-3*fh(i,j,k)) + elseif(i+1<=imax)then + fx = d2dx*(-fh(i-1,j,k)+fh(i+1,j,k)) + else + fx = d2dx*(3*fh(i,j,k)-4*fh(i-1,j,k)+fh(i-2,j,k)) + endif + endif + + if(wy > 0)then + if(j-2>=jmin)then + fy = d2dy*(3*fh(i,j,k)-4*fh(i,j-1,k)+fh(i,j-2,k)) + elseif(j-1>=jmin)then + fy = d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + else + fy = d2dy*(-fh(i,j+2,k)+4*fh(i,j+1,k)-3*fh(i,j,k)) + endif + elseif(wy < 0)then + if(j+2<=jmax)then + fy = d2dy*(-fh(i,j+2,k)+4*fh(i,j+1,k)-3*fh(i,j,k)) + elseif(j+1<=jmax)then + fy = d2dy*(-fh(i,j-1,k)+fh(i,j+1,k)) + else + fy = d2dy*(3*fh(i,j,k)-4*fh(i,j-1,k)+fh(i,j-2,k)) + endif + endif + + if(wz > 0)then + if(k-2>=kmin)then + fz = d2dz*(3*fh(i,j,k)-4*fh(i,j,k-1)+fh(i,j,k-2)) + elseif(k-1>=kmin)then + fz = d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + else + fz = d2dz*(-fh(i,j,k+2)+4*fh(i,j,k+1)-3*fh(i,j,k)) + endif + elseif(wz < 0)then + if(k+2<=kmax)then + fz = d2dz*(-fh(i,j,k+2)+4*fh(i,j,k+1)-3*fh(i,j,k)) + elseif(k+1<=kmax)then + fz = d2dz*(-fh(i,j,k-1)+fh(i,j,k+1)) + else + fz = d2dz*(3*fh(i,j,k)-4*fh(i,j,k-1)+fh(i,j,k-2)) + endif + endif + + f_rhs(i,j,k) = -velocity*(fx*X(i) + fy*Y(j) + fz*Z(k) + f0(i,j,k))/R +#endif + enddo + enddo + enddo + endif + enddo + + return + + end subroutine sommerfeld_routbam +!sommerfeld condition following BAM code for shell + subroutine sommerfeld_routbam_ss(ex,X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,f_rhs,& + f0,velocity,SoA,Symmetry) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry + real*8, intent(in) :: velocity + real*8, dimension(ex(1)) :: X + real*8, dimension(ex(2)) :: Y +! Z-> R + real*8, dimension(ex(3)) :: Z + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8, dimension(ex(1),ex(2),ex(3)),intent(in)::f0 + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::f_rhs + real*8,dimension(3),intent(in) ::SoA +!~~~~~~> Other variables: + logical :: gont + real*8 :: dZ + integer :: i, j, k + real*8 :: d2dz + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8 :: fz + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + + dZ = Z(2) - Z(1) + + d2dz = ONE/TWO/dZ + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(Z(ex(3))-zmax) < dZ)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) +#if 1 +! do not consider buffer points near boundary + layer(3,3) = ex(3) + layer(6,3) = ex(3) +#else +! consider buffer points near boundary + layer(3,3) = ex(3) - ghost_width + layer(6,3) = ex(3) - ghost_width +#endif +endif + +if(dabs(Z(1)-zmin) < dZ)then + layer(1,6) = 1 + layer(2,6) = 1 + layer(3,6) = 1 + layer(4,6) = ex(1) + layer(5,6) = ex(2) + layer(6,6) = 1 +endif + +! outgoing BD + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +#if 0 +!! old code +! z direction + if(k+1 <= kmax .and. k-1 >= kmin)then + fz=d2dz*(-f0(i,j,k-1)+f0(i,j,k+1)) + + elseif(k==kmin)then + fz=(-f0(i,j,k)+f0(i,j,k+1))/dZ + + elseif(k==kmax)then + fz=(-f0(i,j,k-1)+f0(i,j,k))/dZ + + endif +#else +!! new code, 2012dec16, based on bam + if(velocity > 0)then + if(k-2>=kmin)then + fz = d2dz*(3*f0(i,j,k)-4*f0(i,j,k-1)+f0(i,j,k-2)) + elseif(k-1>=kmin)then + fz = d2dz*(-f0(i,j,k-1)+f0(i,j,k+1)) + else + fz = d2dz*(-f0(i,j,k+2)+4*f0(i,j,k+1)-3*f0(i,j,k)) + endif + elseif(velocity < 0)then + if(k+2<=kmax)then + fz = d2dz*(-f0(i,j,k+2)+4*f0(i,j,k+1)-3*f0(i,j,k)) + elseif(k+1<=kmax)then + fz = d2dz*(-f0(i,j,k-1)+f0(i,j,k+1)) + else + fz = d2dz*(3*f0(i,j,k)-4*f0(i,j,k-1)+f0(i,j,k-2)) + endif + endif +#endif + f_rhs(i,j,k) = -velocity*(fz+f0(i,j,k)/Z(k)) + enddo + enddo + enddo + endif + +! fix BD + gp = 6 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! z direction + f_rhs(i,j,k) = ZEO + enddo + enddo + enddo + endif + + return + + end subroutine sommerfeld_routbam_ss +! falloff boundary condition + subroutine falloff_ss(ex,X, Y, Z,xmin,ymin,zmin,xmax,ymax,zmax,f,n,SoA,Symmetry) + + implicit none + +!~~~~~~> Input parameters: + integer, intent(in):: ex(1:3),Symmetry,n + real*8, dimension(ex(1)) :: X + real*8, dimension(ex(2)) :: Y +! Z-> R + real*8, dimension(ex(3)) :: Z + real*8, intent(in):: xmin,ymin,zmin,xmax,ymax,zmax + real*8, dimension(ex(1),ex(2),ex(3)),intent(inout)::f + real*8,dimension(3),intent(in) ::SoA +!~~~~~~> Other variables: + logical :: gont + real*8 :: dZ + integer :: i, j, k + real*8 :: d2dz + integer :: layer(1:6,1:6),gp +! index of layer, first one: i,j,k; second one: front back etc. boundary + integer :: kmin,kmax + real*8 :: fz + real*8, parameter :: ZEO = 0.d0, ONE = 1.d0, TWO=2.d0 + + dZ = Z(2) - Z(1) + + d2dz = ONE/TWO/dZ + + kmax = ex(3) + + kmin = 1 + +layer(1:3,:) = 1 +layer(4:6,:) =-1 + +if(dabs(Z(ex(3))-zmax) < dZ)then + layer(1,3) = 1 + layer(2,3) = 1 + layer(4,3) = ex(1) + layer(5,3) = ex(2) + layer(3,3) = ex(3) + layer(6,3) = ex(3) +endif + +! falloff BD + gp = 3 + + gont = any( layer(:,gp) == - 1 ) + + if( .not. gont ) then + + do k = layer(3,gp), layer(6,gp) + do j = layer(2,gp), layer(5,gp) + do i = layer(1,gp), layer(4,gp) +! z direction + f(i,j,k) = f(i,j,k-1)*((Z(k)+Z(k-1))/n/dZ-1)/((Z(k)+Z(k-1))/n/dZ+1) + enddo + enddo + enddo + endif + + return + + end subroutine falloff_ss diff --git a/AMSS_NCKU_source/sommerfeld_rout.h b/AMSS_NCKU_source/sommerfeld_rout.h new file mode 100644 index 0000000..1331a9f --- /dev/null +++ b/AMSS_NCKU_source/sommerfeld_rout.h @@ -0,0 +1,53 @@ + +#ifndef SOMMERFELD_ROUT_H +#define SOMMERFELD_ROUT_H + +#ifdef fortran1 +#define f_sommerfeld_rout sommerfeld_rout +#define f_sommerfeld_routbam sommerfeld_routbam +#define f_sommerfeld_routbam_ss sommerfeld_routbam_ss +#define f_falloff_ss falloff_ss +#endif +#ifdef fortran2 +#define f_sommerfeld_rout SOMMERFELD_ROUT +#define f_sommerfeld_rout SOMMERFELD_ROUTBAM +#define f_sommerfeld_rout_ss SOMMERFELD_ROUTBAM_SS +#define f_falloff_ss FALLOFF_SS +#endif +#ifdef fortran3 +#define f_sommerfeld_rout sommerfeld_rout_ +#define f_sommerfeld_routbam sommerfeld_routbam_ +#define f_sommerfeld_routbam_ss sommerfeld_routbam_ss_ +#define f_falloff_ss falloff_ss_ +#endif + +extern "C" +{ + void f_sommerfeld_rout(int *, double *, double *, double *, + double &, double &, double &, double &, double &, double &, double &, double *, + double *, double *, double *, double *, + int &, int &); +} + +extern "C" +{ + void f_sommerfeld_routbam(int *, double *, double *, double *, + double &, double &, double &, double &, double &, double &, double *, + double *, double &, double *, int &); +} + +extern "C" +{ + void f_sommerfeld_routbam_ss(int *, double *, double *, double *, + double &, double &, double &, double &, double &, double &, double *, + double *, double &, double *, int &); +} + +extern "C" +{ + void f_falloff_ss(int *, double *, double *, double *, + double &, double &, double &, double &, double &, double &, double *, + int &, double *, int &); +} + +#endif /* SOMMERFELD_ROUT_H */ diff --git a/AMSS_NCKU_source/stdc.h b/AMSS_NCKU_source/stdc.h new file mode 100644 index 0000000..745e75c --- /dev/null +++ b/AMSS_NCKU_source/stdc.h @@ -0,0 +1,24 @@ +#ifndef AHFINDERDIRECT__STDC_H +#define AHFINDERDIRECT__STDC_H + +#define then /* empty */ + +#ifdef M_PI +#define PI M_PI +#endif + +#define iabs(x_) abs(x_) + +namespace AHFinderDirect +{ + namespace jtutil + { + + int error_exit(int msg_level, const char *format, ...); + +#define ERROR_EXIT (-1) +#define PANIC_EXIT (-2) + } +} + +#endif /* AHFINDERDIRECT__STDC_H */ diff --git a/AMSS_NCKU_source/surface_integral.C b/AMSS_NCKU_source/surface_integral.C new file mode 100644 index 0000000..410aee2 --- /dev/null +++ b/AMSS_NCKU_source/surface_integral.C @@ -0,0 +1,3680 @@ + +//---------------------------------------------------------------- +// Using Gauss-Legendre quadrature in theta direction +// and trapezoidal rule in phi direction (from Second Euler-Maclaurin summation formula, we can see that +// this method gives expolential convergence for periodic function) +//---------------------------------------------------------------- +#ifdef newc +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#endif +#include + +#include "misc.h" +#include "cgh.h" +#include "Parallel.h" +#include "surface_integral.h" +#include "fadmquantites_bssn.h" +#include "getnpem2.h" +#include "getnp4.h" +#include "parameters.h" + +#define PI M_PI +//|============================================================================ +//| Constructor +//|============================================================================ + +surface_integral::surface_integral(int iSymmetry) : Symmetry(iSymmetry) +{ + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + MPI_Comm_size(MPI_COMM_WORLD, &cpusize); + int N = 40; + // read parameter from file + { + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + char pname[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(pname, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + ifstream inf(pname, ifstream::in); + if (!inf.good() && myrank == 0) + { + cout << "Can not open parameter file " << pname << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << pname << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "SurfaceIntegral") + { + if (skey == "number of points for quarter sphere") + N = atoi(sval.c_str()); + } + } + inf.close(); + } + //|-----number of points for whole [0,pi] x [0,2pi] + N_phi = 4 * N; // for simplicity, we require this number must be 4*N + N_theta = 2 * N; // 2*N + + if (myrank == 0) + { + cout << "-----------------------------------------------------------------------" << endl; +#ifdef GaussInt + cout << " spherical integration for wave form extraction with Gauss method " << endl; +#else + cout << " spherical integration for wave form extraction with mid point method " << endl; +#endif + cout << " N_phi = " << N_phi << endl; + cout << " N_theta = " << N_theta << endl; + cout << "-----------------------------------------------------------------------" << endl; + } + +#ifdef GaussInt + // weight function cover all of [0,pi] + arcostheta = new double[N_theta]; + wtcostheta = new double[N_theta]; + + // note: theta in [0,pi/2], upper half sphere, corresponds to 1 < costheta < 0 + misc::gaulegf(-1.0, 1.0, arcostheta, wtcostheta, N_theta); + // due to symmetry, I need first half array corresponds to upper sphere, note these two arrays must match each other + misc::inversearray(arcostheta, N_theta); + misc::inversearray(wtcostheta, N_theta); +#endif + + if (Symmetry == 2) + { + N_phi = N_phi / 4; + N_theta = N_theta / 2; + dphi = PI / (2.0 * N_phi); + dcostheta = 1.0 / N_theta; + factor = 8; + } + else if (Symmetry == 1) + { + N_theta = N_theta / 2; + dphi = 2.0 * PI / N_phi; + dcostheta = 1.0 / N_theta; + factor = 2; + } + else if (Symmetry == 0) + { + dphi = 2.0 * PI / N_phi; + dcostheta = 2.0 / N_theta; + factor = 1; + } + else if (myrank == 0) + { + cout << "surface_integral::surface_integral: not supported Symmetry setting!" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + +#ifndef GaussInt + // weight function cover all of [0,pi] + arcostheta = new double[N_theta]; +#endif + n_tot = N_theta * N_phi; + nx_g = new double[n_tot]; + ny_g = new double[n_tot]; + nz_g = new double[n_tot]; + + int n = 0; + double costheta, sintheta, ph; + + for (int i = 0; i < N_theta; ++i) + { +#ifndef GaussInt + arcostheta[i] = 1.0 - (i + 0.5) * dcostheta; +#endif + costheta = arcostheta[i]; + sintheta = sqrt(1.0 - costheta * costheta); + + for (int j = 0; j < N_phi; ++j) + { + ph = (j + 0.5) * dphi; + // normal vector respect to the constant R sphere + nx_g[n] = sintheta * cos(ph); + ny_g[n] = sintheta * sin(ph); + nz_g[n] = costheta; + n++; + } + } +} + +//|============================================================================ +//| Destructor +//|============================================================================ +surface_integral::~surface_integral() +{ + delete[] nx_g; + delete[] ny_g; + delete[] nz_g; + delete[] arcostheta; +#ifdef GaussInt + delete[] wtcostheta; +#endif +} +//|---------------------------------------------------------------- +// spin weighted spinw component of psi4, general routine +// l takes from spinw to maxl; m takes from -l to l +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, int lev, cgh *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +{ + if (myrank == 0 && GH->grids[lev] != 1) + if (Monitor->outfile) + Monitor->outfile << "WARNING: surface integral on multipatches" << endl; + else + cout << "WARNING: surface integral on multipatches" << endl; + + const int InList = 2; + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->PatL[lev]->data->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * shellf[InList * n + 1]; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + } + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +void surface_integral::surf_Wave(double rex, int lev, cgh *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, MPI_Comm Comm_here) // NN is the length of RP and IP +{ + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"start surface_integral::surf_Wave"); + + int lmyrank; + MPI_Comm_rank(Comm_here, &lmyrank); + if (lmyrank == 0 && GH->grids[lev] != 1) + if (Monitor->outfile) + Monitor->outfile << "WARNING: surface integral on multipatches" << endl; + else + cout << "WARNING: surface integral on multipatches" << endl; + + const int InList = 2; + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"before Interp_Points"); + + GH->PatL[lev]->data->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry, Comm_here); + + // misc::tillherecheck(GH->Commlev[lev],GH->start_rank[lev],"after Interp_Points"); + + int mp, Lp, Nmin, Nmax; + + int cpusize_here; + MPI_Comm_size(Comm_here, &cpusize_here); + + mp = n_tot / cpusize_here; + Lp = n_tot - cpusize_here * mp; + + if (Lp > lmyrank) + { + Nmin = lmyrank * mp + lmyrank; + Nmax = Nmin + mp; + } + else + { + Nmin = lmyrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * shellf[InList * n + 1]; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + } + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, Comm_here); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, Comm_here); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for shell patch +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, int lev, ShellPatch *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +{ + const int InList = 2; + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * shellf[InList * n + 1]; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * shellf[InList * n + 1]; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = Rpsi4->SoA[2] * Rpsi4->SoA[1] * Rpsi4->SoA[0] * shellf[InList * n]; + psi4II = Ipsi4->SoA[2] * Ipsi4->SoA[1] * Ipsi4->SoA[0] * shellf[InList * n + 1]; + } + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for shell patch +// for EM wave specially symmetric case +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, int lev, ShellPatch *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +{ + const int InList = 13; + + MyList *DG_List = new MyList(Ex); + DG_List->insert(Ey); + DG_List->insert(Ez); + DG_List->insert(Bx); + DG_List->insert(By); + DG_List->insert(Bz); + DG_List->insert(chi); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + double px, py, pz; + double pEx, pEy, pEz, pBx, pBy, pBz; + double pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + px = pox[0][n]; + py = pox[1][n]; + pz = pox[2][n]; + pEx = shellf[InList * n]; + pEy = shellf[InList * n + 1]; + pEz = shellf[InList * n + 2]; + pBx = shellf[InList * n + 3]; + pBy = shellf[InList * n + 4]; + pBz = shellf[InList * n + 5]; + pchi = shellf[InList * n + 6]; + pgxx = shellf[InList * n + 7]; + pgxy = shellf[InList * n + 8]; + pgxz = shellf[InList * n + 9]; + pgyy = shellf[InList * n + 10]; + pgyz = shellf[InList * n + 11]; + pgzz = shellf[InList * n + 12]; + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + pz = -pz; + pEz = -pEz; + pBx = -pBx; + pBy = -pBy; + pgxz = -pgxz; + pgyz = -pgyz; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pEy = -pEy; + pBx = -pBx; + pBz = -pBz; + pgxy = -pgxy; + pgyz = -pgyz; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pz = -pz; + pEz = -pEz; + pBz = -pBz; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgxy = -pgxy; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + px = -px; + pEx = -pEx; + pBy = -pBy; + pBz = -pBz; + pgxy = -pgxy; + pgxz = -pgxz; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + pz = -pz; + px = -px; + pEz = -pEz; + pBz = -pBz; + pgyz = -pgyz; + pEx = -pEx; + pBx = -pBx; + pgxy = -pgxy; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pEx = -pEx; + pBx = -pBx; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgyz = -pgyz; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pz = -pz; + pEx = -pEx; + pEy = -pEy; + pEz = -pEz; + } + + f_getnpem2_point(px, py, pz, pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz, pEx, pEy, pEz, pBx, pBy, pBz, + psi4RR, psi4II); + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + + // find back the one + pchi = pchi + 1; +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for shell patch +// for EM wave specially symmetric case +// unify for phi1 and phi2 +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, int lev, ShellPatch *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, + void (*funcs)(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &)) // NN is the length of RP and IP +{ + const int InList = 13; + + MyList *DG_List = new MyList(Ex); + DG_List->insert(Ey); + DG_List->insert(Ez); + DG_List->insert(Bx); + DG_List->insert(By); + DG_List->insert(Bz); + DG_List->insert(chi); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + +#if 0 +// for debug + if(myrank==0) + { + double costheta, thetap; + double cosmphi,sinmphi; + + int i,j; + int lpsy=0; + if( Symmetry == 0 ) lpsy=1; + else if( Symmetry == 1 ) lpsy=2; + else if( Symmetry == 2 ) lpsy=8; + + double psi4RR,psi4II; + double px,py,pz; + double pEx,pEy,pEz,pBx,pBy,pBz; + double pchi,pgxx,pgxy,pgxz,pgyy,pgyz,pgzz; + for( n = 0; n <= n_tot-1; n++) + { +// need round off always + i = int(n/N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + for(int lp=0;lp myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + double px, py, pz; + double pEx, pEy, pEz, pBx, pBy, pBz; + double pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + px = pox[0][n]; + py = pox[1][n]; + pz = pox[2][n]; + pEx = shellf[InList * n]; + pEy = shellf[InList * n + 1]; + pEz = shellf[InList * n + 2]; + pBx = shellf[InList * n + 3]; + pBy = shellf[InList * n + 4]; + pBz = shellf[InList * n + 5]; + pchi = shellf[InList * n + 6]; + pgxx = shellf[InList * n + 7]; + pgxy = shellf[InList * n + 8]; + pgxz = shellf[InList * n + 9]; + pgyy = shellf[InList * n + 10]; + pgyz = shellf[InList * n + 11]; + pgzz = shellf[InList * n + 12]; + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + pz = -pz; + pEz = -pEz; + pBx = -pBx; + pBy = -pBy; + pgxz = -pgxz; + pgyz = -pgyz; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pEy = -pEy; + pBx = -pBx; + pBz = -pBz; + pgxy = -pgxy; + pgyz = -pgyz; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pz = -pz; + pEz = -pEz; + pBz = -pBz; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgxy = -pgxy; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + px = -px; + pEx = -pEx; + pBy = -pBy; + pBz = -pBz; + pgxy = -pgxy; + pgxz = -pgxz; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + pz = -pz; + px = -px; + pEz = -pEz; + pBz = -pBz; + pgyz = -pgyz; + pEx = -pEx; + pBx = -pBx; + pgxy = -pgxy; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pEx = -pEx; + pBx = -pBx; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgyz = -pgyz; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pz = -pz; + pEx = -pEx; + pEy = -pEy; + pEz = -pEz; + } + + funcs(px, py, pz, pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz, pEx, pEy, pEz, pBx, pBy, pBz, + psi4RR, psi4II); + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + + // find back the one + pchi = pchi + 1; +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } +#endif + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for box +// for EM wave specially symmetric case +// unify for phi1 and phi2 +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, int lev, cgh *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, + void (*funcs)(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &)) // NN is the length of RP and IP +{ + const int InList = 13; + + MyList *DG_List = new MyList(Ex); + DG_List->insert(Ey); + DG_List->insert(Ez); + DG_List->insert(Bx); + DG_List->insert(By); + DG_List->insert(Bz); + DG_List->insert(chi); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->PatL[lev]->data->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + +#if 0 +// for debug + if(myrank==0) + { + double costheta, thetap; + double cosmphi,sinmphi; + + int i,j; + int lpsy=0; + if( Symmetry == 0 ) lpsy=1; + else if( Symmetry == 1 ) lpsy=2; + else if( Symmetry == 2 ) lpsy=8; + + double psi4RR,psi4II; + double px,py,pz; + double pEx,pEy,pEz,pBx,pBy,pBz; + double pchi,pgxx,pgxy,pgxz,pgyy,pgyz,pgzz; + for( n = 0; n <= n_tot-1; n++) + { +// need round off always + i = int(n/N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + for(int lp=0;lp myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + double px, py, pz; + double pEx, pEy, pEz, pBx, pBy, pBz; + double pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + px = pox[0][n]; + py = pox[1][n]; + pz = pox[2][n]; + pEx = shellf[InList * n]; + pEy = shellf[InList * n + 1]; + pEz = shellf[InList * n + 2]; + pBx = shellf[InList * n + 3]; + pBy = shellf[InList * n + 4]; + pBz = shellf[InList * n + 5]; + pchi = shellf[InList * n + 6]; + pgxx = shellf[InList * n + 7]; + pgxy = shellf[InList * n + 8]; + pgxz = shellf[InList * n + 9]; + pgyy = shellf[InList * n + 10]; + pgyz = shellf[InList * n + 11]; + pgzz = shellf[InList * n + 12]; + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + pz = -pz; + pEz = -pEz; + pBx = -pBx; + pBy = -pBy; + pgxz = -pgxz; + pgyz = -pgyz; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pEy = -pEy; + pBx = -pBx; + pBz = -pBz; + pgxy = -pgxy; + pgyz = -pgyz; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pz = -pz; + pEz = -pEz; + pBz = -pBz; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgxy = -pgxy; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + px = -px; + pEx = -pEx; + pBy = -pBy; + pBz = -pBz; + pgxy = -pgxy; + pgxz = -pgxz; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + pz = -pz; + px = -px; + pEz = -pEz; + pBz = -pBz; + pgyz = -pgyz; + pEx = -pEx; + pBx = -pBx; + pgxy = -pgxy; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pEx = -pEx; + pBx = -pBx; + pgxz = -pgxz; + pEy = -pEy; + pBy = -pBy; + pgyz = -pgyz; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pz = -pz; + pEx = -pEx; + pEy = -pEy; + pEz = -pEz; + } + + funcs(px, py, pz, pchi, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz, pEx, pEy, pEz, pBx, pBy, pBz, + psi4RR, psi4II); + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + + // find back the one + pchi = pchi + 1; +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } +#endif + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for null shell patch2 +//|---------------------------------------------------------------- +// rex is x instead of r +void surface_integral::surf_Wave(double rex, int lev, NullShellPatch2 *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +// spinw 0 for scalar; 1 for electricmagnetic wave; 2 for gravitaitonal wave +// we always assume spinw >= 0 +{ + const int InList = 2; + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + + int n; + // since we used x instead of r, these global coordinates are fake + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->Interp_Points_2D(DG_List, n_tot, pox, shellf, Symmetry); + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + } + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + // based on Eq.(41) of PRD 77, 024027 (2008) +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi); // + is because \bar of \bar{Y^s_lm} in Eq.(40) + // of PRD 77, 024027 (2008) + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +// do not need multiply with rex for null shell +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * dphi; + IP_out[ii] = IP_out[ii] * dphi; +#else + RP_out[ii] = RP_out[ii] * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for null shell patch +//|---------------------------------------------------------------- +// rex is x instead of r +void surface_integral::surf_Wave(double rex, int lev, NullShellPatch *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +// spinw 0 for scalar; 1 for electricmagnetic wave; 2 for gravitaitonal wave +// we always assume spinw >= 0 +{ + const int InList = 2; + + MyList *DG_List = new MyList(Rpsi4); + DG_List->insert(Ipsi4); + + int n; + // since we used x instead of r, these global coordinates are fake + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + GH->Interp_Points_2D(DG_List, n_tot, pox, shellf, Symmetry); + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + //|~~~~~> Integrate the dot product of Dphi with the surface normal. + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = shellf[InList * n + 1]; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + psi4RR = shellf[InList * n]; + psi4II = -shellf[InList * n + 1]; + } + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + // based on Eq.(41) of PRD 77, 024027 (2008) +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap * (psi4RR * cosmphi + psi4II * sinmphi); // + is because \bar of \bar{Y^s_lm} in Eq.(40) + // of PRD 77, 024027 (2008) + IP_out[countlm] = IP_out[countlm] + thetap * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +// do not need multiply with rex for null shell +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * dphi; + IP_out[ii] = IP_out[ii] * dphi; +#else + RP_out[ii] = RP_out[ii] * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------- +//| +//| ADM mass, linear momentum and angular momentum +//| +//|---------------------------------------------------- +void surface_integral::surf_MassPAng(double rex, int lev, cgh *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, // temparay memory for mass^i + double *Rout, monitor *Monitor) +{ + if (myrank == 0 && GH->grids[lev] != 1) + if (Monitor && Monitor->outfile) + Monitor->outfile << "WARNING: surface integral on multipatches" << endl; + else + cout << "WARNING: surface integral on multipatches" << endl; + + double mass, px, py, pz, sx, sy, sz; + + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_admmass_bssn(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[chi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + Symmetry); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + const int InList = 17; + + MyList *DG_List = new MyList(Sfx_rhs); + DG_List->insert(Sfy_rhs); + DG_List->insert(Sfz_rhs); + DG_List->insert(chi); + DG_List->insert(trK); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + DG_List->insert(Axx); + DG_List->insert(Axy); + DG_List->insert(Axz); + DG_List->insert(Ayy); + DG_List->insert(Ayz); + DG_List->insert(Azz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + // we have assumed there is only one box on this level, + // so we do not need loop boxes + GH->PatL[lev]->data->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + double Mass_out = 0; + double ang_outx, ang_outy, ang_outz; + double p_outx, p_outy, p_outz; + ang_outx = ang_outy = ang_outz = 0.0; + p_outx = p_outy = p_outz = 0.0; + const double f1o8 = 0.125; + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + double Chi, Psi; + double Gxx, Gxy, Gxz, Gyy, Gyz, Gzz; + double gupxx, gupxy, gupxz, gupyy, gupyz, gupzz; + double TRK, axx, axy, axz, ayy, ayz, azz; + double aupxx, aupxy, aupxz, aupyx, aupyy, aupyz, aupzx, aupzy, aupzz; + int i; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + + Chi = shellf[InList * n + 3]; // chi in fact + TRK = shellf[InList * n + 4]; + Gxx = shellf[InList * n + 5] + 1.0; + Gxy = shellf[InList * n + 6]; + Gxz = shellf[InList * n + 7]; + Gyy = shellf[InList * n + 8] + 1.0; + Gyz = shellf[InList * n + 9]; + Gzz = shellf[InList * n + 10] + 1.0; + axx = shellf[InList * n + 11]; + axy = shellf[InList * n + 12]; + axz = shellf[InList * n + 13]; + ayy = shellf[InList * n + 14]; + ayz = shellf[InList * n + 15]; + azz = shellf[InList * n + 16]; + + Chi = 1.0 / (1.0 + Chi); // exp(4*phi) + Psi = Chi * sqrt(Chi); // Psi^6 + +// Chi^2 corresponds to metric determinant +// but this factor has been considered in f_admmass_bssn +#ifdef GaussInt + // wtcostheta is even function respect costheta + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]) * wtcostheta[i]; +#else + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]); +#endif + + gupzz = Gxx * Gyy * Gzz + Gxy * Gyz * Gxz + Gxz * Gxy * Gyz - + Gxz * Gyy * Gxz - Gxy * Gxy * Gzz - Gxx * Gyz * Gyz; + gupxx = (Gyy * Gzz - Gyz * Gyz) / gupzz; + gupxy = -(Gxy * Gzz - Gyz * Gxz) / gupzz; + gupxz = (Gxy * Gyz - Gyy * Gxz) / gupzz; + gupyy = (Gxx * Gzz - Gxz * Gxz) / gupzz; + gupyz = -(Gxx * Gyz - Gxy * Gxz) / gupzz; + gupzz = (Gxx * Gyy - Gxy * Gxy) / gupzz; + + aupxx = gupxx * axx + gupxy * axy + gupxz * axz; + aupxy = gupxx * axy + gupxy * ayy + gupxz * ayz; + aupxz = gupxx * axz + gupxy * ayz + gupxz * azz; + aupyx = gupxy * axx + gupyy * axy + gupyz * axz; + aupyy = gupxy * axy + gupyy * ayy + gupyz * ayz; + aupyz = gupxy * axz + gupyy * ayz + gupyz * azz; + aupzx = gupxz * axx + gupyz * axy + gupzz * axz; + aupzy = gupxz * axy + gupyz * ayy + gupzz * ayz; + aupzz = gupxz * axz + gupyz * ayz + gupzz * azz; + if (Symmetry == 0) + { +#ifdef GaussInt + // wtcostheta is even function respect costheta + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)); + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)); + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + + axx = Chi * (axx + Gxx * TRK / 3.0); + axy = Chi * (axy + Gxy * TRK / 3.0); + axz = Chi * (axz + Gxz * TRK / 3.0); + ayy = Chi * (ayy + Gyy * TRK / 3.0); + ayz = Chi * (ayz + Gyz * TRK / 3.0); + azz = Chi * (azz + Gzz * TRK / 3.0); + + axx = axx - TRK; + ayy = ayy - TRK; + azz = azz - TRK; + + // 1/8\pi \int \psi^6 (K_mi - \delta_mi trK) dS^m: lower index linear momentum + if (Symmetry == 0) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); +#endif + } + } + + MPI_Allreduce(&Mass_out, &mass, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + MPI_Allreduce(&ang_outx, &sx, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&ang_outy, &sy, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&ang_outz, &sz, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + MPI_Allreduce(&p_outx, &px, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&p_outy, &py, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&p_outz, &pz, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + +#ifdef GaussInt + mass = mass * rex * rex * dphi * factor; + + sx = sx * rex * rex * dphi * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * (1.0 / PI) * factor; + py = py * rex * rex * dphi * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * (1.0 / PI) * factor; +#else + mass = mass * rex * rex * dphi * dcostheta * factor; + + sx = sx * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + py = py * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; +#endif + + Rout[0] = mass; + Rout[1] = px; + Rout[2] = py; + Rout[3] = pz; + Rout[4] = sx; + Rout[5] = sy; + Rout[6] = sz; + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + DG_List->clearList(); +} +void surface_integral::surf_MassPAng(double rex, int lev, cgh *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, // temparay memory for mass^i + double *Rout, monitor *Monitor, MPI_Comm Comm_here) +{ + int lmyrank; + MPI_Comm_rank(Comm_here, &lmyrank); + if (lmyrank == 0 && GH->grids[lev] != 1) + if (Monitor && Monitor->outfile) + Monitor->outfile << "WARNING: surface integral on multipatches" << endl; + else + cout << "WARNING: surface integral on multipatches" << endl; + + double mass, px, py, pz, sx, sy, sz; + + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + MyList *BP = Pp->data->blb; + while (BP) + { + Block *cg = BP->data; + if (myrank == cg->rank) + { + f_admmass_bssn(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[chi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + Symmetry); + } + if (BP == Pp->data->ble) + break; + BP = BP->next; + } + Pp = Pp->next; + } + + const int InList = 17; + + MyList *DG_List = new MyList(Sfx_rhs); + DG_List->insert(Sfy_rhs); + DG_List->insert(Sfz_rhs); + DG_List->insert(chi); + DG_List->insert(trK); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + DG_List->insert(Axx); + DG_List->insert(Axy); + DG_List->insert(Axz); + DG_List->insert(Ayy); + DG_List->insert(Ayz); + DG_List->insert(Azz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + // we have assumed there is only one box on this level, + // so we do not need loop boxes + GH->PatL[lev]->data->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry, Comm_here); + + double Mass_out = 0; + double ang_outx, ang_outy, ang_outz; + double p_outx, p_outy, p_outz; + ang_outx = ang_outy = ang_outz = 0.0; + p_outx = p_outy = p_outz = 0.0; + const double f1o8 = 0.125; + + int mp, Lp, Nmin, Nmax; + + int cpusize_here; + MPI_Comm_size(Comm_here, &cpusize_here); + + mp = n_tot / cpusize_here; + Lp = n_tot - cpusize_here * mp; + + if (Lp > lmyrank) + { + Nmin = lmyrank * mp + lmyrank; + Nmax = Nmin + mp; + } + else + { + Nmin = lmyrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + double Chi, Psi; + double Gxx, Gxy, Gxz, Gyy, Gyz, Gzz; + double gupxx, gupxy, gupxz, gupyy, gupyz, gupzz; + double TRK, axx, axy, axz, ayy, ayz, azz; + double aupxx, aupxy, aupxz, aupyx, aupyy, aupyz, aupzx, aupzy, aupzz; + int i; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + + Chi = shellf[InList * n + 3]; // chi in fact + TRK = shellf[InList * n + 4]; + Gxx = shellf[InList * n + 5] + 1.0; + Gxy = shellf[InList * n + 6]; + Gxz = shellf[InList * n + 7]; + Gyy = shellf[InList * n + 8] + 1.0; + Gyz = shellf[InList * n + 9]; + Gzz = shellf[InList * n + 10] + 1.0; + axx = shellf[InList * n + 11]; + axy = shellf[InList * n + 12]; + axz = shellf[InList * n + 13]; + ayy = shellf[InList * n + 14]; + ayz = shellf[InList * n + 15]; + azz = shellf[InList * n + 16]; + + Chi = 1.0 / (1.0 + Chi); // exp(4*phi) + Psi = Chi * sqrt(Chi); // Psi^6 + +// Chi^2 corresponds to metric determinant +// but this factor has been considered in f_admmass_bssn +#ifdef GaussInt + // wtcostheta is even function respect costheta + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]) * wtcostheta[i]; +#else + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]); +#endif + + gupzz = Gxx * Gyy * Gzz + Gxy * Gyz * Gxz + Gxz * Gxy * Gyz - + Gxz * Gyy * Gxz - Gxy * Gxy * Gzz - Gxx * Gyz * Gyz; + gupxx = (Gyy * Gzz - Gyz * Gyz) / gupzz; + gupxy = -(Gxy * Gzz - Gyz * Gxz) / gupzz; + gupxz = (Gxy * Gyz - Gyy * Gxz) / gupzz; + gupyy = (Gxx * Gzz - Gxz * Gxz) / gupzz; + gupyz = -(Gxx * Gyz - Gxy * Gxz) / gupzz; + gupzz = (Gxx * Gyy - Gxy * Gxy) / gupzz; + + aupxx = gupxx * axx + gupxy * axy + gupxz * axz; + aupxy = gupxx * axy + gupxy * ayy + gupxz * ayz; + aupxz = gupxx * axz + gupxy * ayz + gupxz * azz; + aupyx = gupxy * axx + gupyy * axy + gupyz * axz; + aupyy = gupxy * axy + gupyy * ayy + gupyz * ayz; + aupyz = gupxy * axz + gupyy * ayz + gupyz * azz; + aupzx = gupxz * axx + gupyz * axy + gupzz * axz; + aupzy = gupxz * axy + gupyz * ayy + gupzz * ayz; + aupzz = gupxz * axz + gupyz * ayz + gupzz * azz; + if (Symmetry == 0) + { +#ifdef GaussInt + // wtcostheta is even function respect costheta + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)); + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)); + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + + axx = Chi * (axx + Gxx * TRK / 3.0); + axy = Chi * (axy + Gxy * TRK / 3.0); + axz = Chi * (axz + Gxz * TRK / 3.0); + ayy = Chi * (ayy + Gyy * TRK / 3.0); + ayz = Chi * (ayz + Gyz * TRK / 3.0); + azz = Chi * (azz + Gzz * TRK / 3.0); + + axx = axx - TRK; + ayy = ayy - TRK; + azz = azz - TRK; + + // 1/8\pi \int \psi^6 (K_mi - \delta_mi trK) dS^m: lower index linear momentum + if (Symmetry == 0) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); +#endif + } + } + + MPI_Allreduce(&Mass_out, &mass, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + + MPI_Allreduce(&ang_outx, &sx, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + MPI_Allreduce(&ang_outy, &sy, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + MPI_Allreduce(&ang_outz, &sz, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + + MPI_Allreduce(&p_outx, &px, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + MPI_Allreduce(&p_outy, &py, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + MPI_Allreduce(&p_outz, &pz, 1, MPI_DOUBLE, MPI_SUM, Comm_here); + +#ifdef GaussInt + mass = mass * rex * rex * dphi * factor; + + sx = sx * rex * rex * dphi * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * (1.0 / PI) * factor; + py = py * rex * rex * dphi * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * (1.0 / PI) * factor; +#else + mass = mass * rex * rex * dphi * dcostheta * factor; + + sx = sx * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + py = py * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; +#endif + + Rout[0] = mass; + Rout[1] = px; + Rout[2] = py; + Rout[3] = pz; + Rout[4] = sx; + Rout[5] = sy; + Rout[6] = sz; + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// for shell patch +//|---------------------------------------------------------------- +void surface_integral::surf_MassPAng(double rex, int lev, ShellPatch *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, // temparay memory for mass^i + double *Rout, monitor *Monitor) +{ + if (lev != 0) + { + if (myrank == 0) + { + if (Monitor && Monitor->outfile) + Monitor->outfile << "WARNING: shell surface integral not on level 0" << endl; + else + cout << "WARNING: shell surface integral not on level 0" << endl; + } + return; + } + + double mass, px, py, pz, sx, sy, sz; + + MyList *Pp = GH->PatL; + while (Pp) + { + MyList *BL = Pp->data->blb; + int fngfs = Pp->data->fngfs; + while (BL) + { + Block *cg = BL->data; + if (myrank == cg->rank) + { + f_admmass_bssn_ss(cg->shape, cg->X[0], cg->X[1], cg->X[2], + cg->fgfs[fngfs + ShellPatch::gx], cg->fgfs[fngfs + ShellPatch::gy], cg->fgfs[fngfs + ShellPatch::gz], + cg->fgfs[fngfs + ShellPatch::drhodx], cg->fgfs[fngfs + ShellPatch::drhody], cg->fgfs[fngfs + ShellPatch::drhodz], + cg->fgfs[fngfs + ShellPatch::dsigmadx], cg->fgfs[fngfs + ShellPatch::dsigmady], cg->fgfs[fngfs + ShellPatch::dsigmadz], + cg->fgfs[fngfs + ShellPatch::dRdx], cg->fgfs[fngfs + ShellPatch::dRdy], cg->fgfs[fngfs + ShellPatch::dRdz], + cg->fgfs[fngfs + ShellPatch::drhodxx], cg->fgfs[fngfs + ShellPatch::drhodxy], cg->fgfs[fngfs + ShellPatch::drhodxz], + cg->fgfs[fngfs + ShellPatch::drhodyy], cg->fgfs[fngfs + ShellPatch::drhodyz], cg->fgfs[fngfs + ShellPatch::drhodzz], + cg->fgfs[fngfs + ShellPatch::dsigmadxx], cg->fgfs[fngfs + ShellPatch::dsigmadxy], cg->fgfs[fngfs + ShellPatch::dsigmadxz], + cg->fgfs[fngfs + ShellPatch::dsigmadyy], cg->fgfs[fngfs + ShellPatch::dsigmadyz], cg->fgfs[fngfs + ShellPatch::dsigmadzz], + cg->fgfs[fngfs + ShellPatch::dRdxx], cg->fgfs[fngfs + ShellPatch::dRdxy], cg->fgfs[fngfs + ShellPatch::dRdxz], + cg->fgfs[fngfs + ShellPatch::dRdyy], cg->fgfs[fngfs + ShellPatch::dRdyz], cg->fgfs[fngfs + ShellPatch::dRdzz], + cg->fgfs[chi->sgfn], cg->fgfs[trK->sgfn], + cg->fgfs[gxx->sgfn], cg->fgfs[gxy->sgfn], cg->fgfs[gxz->sgfn], cg->fgfs[gyy->sgfn], cg->fgfs[gyz->sgfn], cg->fgfs[gzz->sgfn], + cg->fgfs[Axx->sgfn], cg->fgfs[Axy->sgfn], cg->fgfs[Axz->sgfn], cg->fgfs[Ayy->sgfn], cg->fgfs[Ayz->sgfn], cg->fgfs[Azz->sgfn], + cg->fgfs[Gmx->sgfn], cg->fgfs[Gmy->sgfn], cg->fgfs[Gmz->sgfn], + cg->fgfs[Sfx_rhs->sgfn], cg->fgfs[Sfy_rhs->sgfn], cg->fgfs[Sfz_rhs->sgfn], + Symmetry, Pp->data->sst); + } + if (BL == Pp->data->ble) + break; + BL = BL->next; + } + Pp = Pp->next; + } + + const int InList = 17; + + MyList *DG_List = new MyList(Sfx_rhs); + DG_List->insert(Sfy_rhs); + DG_List->insert(Sfz_rhs); + DG_List->insert(chi); + DG_List->insert(trK); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + DG_List->insert(Axx); + DG_List->insert(Axy); + DG_List->insert(Axz); + DG_List->insert(Ayy); + DG_List->insert(Ayz); + DG_List->insert(Azz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + // we have assumed there is only one box on this level, + // so we do not need loop boxes + GH->Interp_Points(DG_List, n_tot, pox, shellf, Symmetry); + + double Mass_out = 0; + double ang_outx, ang_outy, ang_outz; + double p_outx, p_outy, p_outz; + ang_outx = ang_outy = ang_outz = 0.0; + p_outx = p_outy = p_outz = 0.0; + const double f1o8 = 0.125; + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + double Chi, Psi; + double Gxx, Gxy, Gxz, Gyy, Gyz, Gzz; + double gupxx, gupxy, gupxz, gupyy, gupyz, gupzz; + double TRK, axx, axy, axz, ayy, ayz, azz; + double aupxx, aupxy, aupxz, aupyx, aupyy, aupyz, aupzx, aupzy, aupzz; + int i; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + + Chi = shellf[InList * n + 3]; // chi in fact + TRK = shellf[InList * n + 4]; + Gxx = shellf[InList * n + 5] + 1.0; + Gxy = shellf[InList * n + 6]; + Gxz = shellf[InList * n + 7]; + Gyy = shellf[InList * n + 8] + 1.0; + Gyz = shellf[InList * n + 9]; + Gzz = shellf[InList * n + 10] + 1.0; + axx = shellf[InList * n + 11]; + axy = shellf[InList * n + 12]; + axz = shellf[InList * n + 13]; + ayy = shellf[InList * n + 14]; + ayz = shellf[InList * n + 15]; + azz = shellf[InList * n + 16]; + + Chi = 1.0 / (1.0 + Chi); // exp(4*phi) + Psi = Chi * sqrt(Chi); // Psi^6 +// Chi^2 corresponds to metric determinant +// but this factor has been considered in f_admmass_bssn +#ifdef GaussInt + // wtcostheta is even function respect costheta + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]) * wtcostheta[i]; +#else + Mass_out = Mass_out + (shellf[InList * n] * nx_g[n] + shellf[InList * n + 1] * ny_g[n] + shellf[InList * n + 2] * nz_g[n]); +#endif + + gupzz = Gxx * Gyy * Gzz + Gxy * Gyz * Gxz + Gxz * Gxy * Gyz - + Gxz * Gyy * Gxz - Gxy * Gxy * Gzz - Gxx * Gyz * Gyz; + gupxx = (Gyy * Gzz - Gyz * Gyz) / gupzz; + gupxy = -(Gxy * Gzz - Gyz * Gxz) / gupzz; + gupxz = (Gxy * Gyz - Gyy * Gxz) / gupzz; + gupyy = (Gxx * Gzz - Gxz * Gxz) / gupzz; + gupyz = -(Gxx * Gyz - Gxy * Gxz) / gupzz; + gupzz = (Gxx * Gyy - Gxy * Gxy) / gupzz; + + aupxx = gupxx * axx + gupxy * axy + gupxz * axz; + aupxy = gupxx * axy + gupxy * ayy + gupxz * ayz; + aupxz = gupxx * axz + gupxy * ayz + gupxz * azz; + aupyx = gupxy * axx + gupyy * axy + gupyz * axz; + aupyy = gupxy * axy + gupyy * ayy + gupyz * ayz; + aupyz = gupxy * axz + gupyy * ayz + gupyz * azz; + aupzx = gupxz * axx + gupyz * axy + gupzz * axz; + aupzy = gupxz * axy + gupyz * ayy + gupzz * ayz; + aupzz = gupxz * axz + gupyz * ayz + gupzz * azz; + if (Symmetry == 0) + { +#ifdef GaussInt + // wtcostheta is even function respect costheta + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)) * wtcostheta[i]; + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + // 1/8\pi \int \psi^6 (y A^m_z - zA^m_y) dS_m + ang_outx = ang_outx + f1o8 * Psi * (nx_g[n] * (pox[1][n] * aupxz - pox[2][n] * aupxy) + ny_g[n] * (pox[1][n] * aupyz - pox[2][n] * aupyy) + nz_g[n] * (pox[1][n] * aupzz - pox[2][n] * aupzy)); + // 1/8\pi \int \psi^6 (z A^m_x - xA^m_z) dS_m + ang_outy = ang_outy + f1o8 * Psi * (nx_g[n] * (pox[2][n] * aupxx - pox[0][n] * aupxz) + ny_g[n] * (pox[2][n] * aupyx - pox[0][n] * aupyz) + nz_g[n] * (pox[2][n] * aupzx - pox[0][n] * aupzz)); + // 1/8\pi \int \psi^6 (x A^m_y - yA^m_x) dS_m + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)) * wtcostheta[i]; +#else + ang_outz = ang_outz + f1o8 * Psi * (nx_g[n] * (pox[0][n] * aupxy - pox[1][n] * aupxx) + ny_g[n] * (pox[0][n] * aupyy - pox[1][n] * aupyx) + nz_g[n] * (pox[0][n] * aupzy - pox[1][n] * aupzx)); +#endif + } + + axx = Chi * (axx + Gxx * TRK / 3.0); + axy = Chi * (axy + Gxy * TRK / 3.0); + axz = Chi * (axz + Gxz * TRK / 3.0); + ayy = Chi * (ayy + Gyy * TRK / 3.0); + ayz = Chi * (ayz + Gyz * TRK / 3.0); + azz = Chi * (azz + Gzz * TRK / 3.0); + + axx = axx - TRK; + ayy = ayy - TRK; + azz = azz - TRK; + + // 1/8\pi \int \psi^6 (K_mi - \delta_mi trK) dS^m: lower index linear momentum + if (Symmetry == 0) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); + p_outz = p_outz + f1o8 * Psi * (nx_g[n] * axz + ny_g[n] * ayz + nz_g[n] * azz); +#endif + } + else if (Symmetry == 1) + { +#ifdef GaussInt + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz) * wtcostheta[i]; + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz) * wtcostheta[i]; +#else + p_outx = p_outx + f1o8 * Psi * (nx_g[n] * axx + ny_g[n] * axy + nz_g[n] * axz); + p_outy = p_outy + f1o8 * Psi * (nx_g[n] * axy + ny_g[n] * ayy + nz_g[n] * ayz); +#endif + } + } + + MPI_Allreduce(&Mass_out, &mass, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + MPI_Allreduce(&ang_outx, &sx, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&ang_outy, &sy, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&ang_outz, &sz, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + MPI_Allreduce(&p_outx, &px, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&p_outy, &py, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(&p_outz, &pz, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + +#ifdef GaussInt + mass = mass * rex * rex * dphi * factor; + + sx = sx * rex * rex * dphi * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * (1.0 / PI) * factor; + py = py * rex * rex * dphi * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * (1.0 / PI) * factor; +#else + mass = mass * rex * rex * dphi * dcostheta * factor; + + sx = sx * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sy = sy * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + sz = sz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + + px = px * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + py = py * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; + pz = pz * rex * rex * dphi * dcostheta * (1.0 / PI) * factor; +#endif + + Rout[0] = mass; + Rout[1] = px; + Rout[2] = py; + Rout[3] = pz; + Rout[4] = sx; + Rout[5] = sy; + Rout[6] = sz; + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// do not discriminate box and shell +// for Gravitational wave specially symmetric case +//|---------------------------------------------------------------- +void surface_integral::surf_Wave(double rex, cgh *GH, ShellPatch *SH, + var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *chix, var *chiy, var *chiz, + var *trKx, var *trKy, var *trKz, + var *Axxx, var *Axxy, var *Axxz, + var *Axyx, var *Axyy, var *Axyz, + var *Axzx, var *Axzy, var *Axzz, + var *Ayyx, var *Ayyy, var *Ayyz, + var *Ayzx, var *Ayzy, var *Ayzz, + var *Azzx, var *Azzy, var *Azzz, + var *Gamxxx, var *Gamxxy, var *Gamxxz, var *Gamxyy, var *Gamxyz, var *Gamxzz, + var *Gamyxx, var *Gamyxy, var *Gamyxz, var *Gamyyy, var *Gamyyz, var *Gamyzz, + var *Gamzxx, var *Gamzxy, var *Gamzxz, var *Gamzyy, var *Gamzyz, var *Gamzzz, + var *Rxx, var *Rxy, var *Rxz, var *Ryy, var *Ryz, var *Rzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor) // NN is the length of RP and IP +{ + const int InList = 62; + + MyList *DG_List = new MyList(chi); + DG_List->insert(trK); + DG_List->insert(gxx); + DG_List->insert(gxy); + DG_List->insert(gxz); + DG_List->insert(gyy); + DG_List->insert(gyz); + DG_List->insert(gzz); + DG_List->insert(Axx); + DG_List->insert(Axy); + DG_List->insert(Axz); + DG_List->insert(Ayy); + DG_List->insert(Ayz); + DG_List->insert(Azz); + DG_List->insert(chix); + DG_List->insert(chiy); + DG_List->insert(chiz); + DG_List->insert(trKx); + DG_List->insert(trKy); + DG_List->insert(trKz); + DG_List->insert(Axxx); + DG_List->insert(Axxy); + DG_List->insert(Axxz); + DG_List->insert(Axyx); + DG_List->insert(Axyy); + DG_List->insert(Axyz); + DG_List->insert(Axzx); + DG_List->insert(Axzy); + DG_List->insert(Axzz); + DG_List->insert(Ayyx); + DG_List->insert(Ayyy); + DG_List->insert(Ayyz); + DG_List->insert(Ayzx); + DG_List->insert(Ayzy); + DG_List->insert(Ayzz); + DG_List->insert(Azzx); + DG_List->insert(Azzy); + DG_List->insert(Azzz); + DG_List->insert(Gamxxx); + DG_List->insert(Gamxxy); + DG_List->insert(Gamxxz); + DG_List->insert(Gamxyy); + DG_List->insert(Gamxyz); + DG_List->insert(Gamxzz); + DG_List->insert(Gamyxx); + DG_List->insert(Gamyxy); + DG_List->insert(Gamyxz); + DG_List->insert(Gamyyy); + DG_List->insert(Gamyyz); + DG_List->insert(Gamyzz); + DG_List->insert(Gamzxx); + DG_List->insert(Gamzxy); + DG_List->insert(Gamzxz); + DG_List->insert(Gamzyy); + DG_List->insert(Gamzyz); + DG_List->insert(Gamzzz); + DG_List->insert(Rxx); + DG_List->insert(Rxy); + DG_List->insert(Rxz); + DG_List->insert(Ryy); + DG_List->insert(Ryz); + DG_List->insert(Rzz); + + int n; + double *pox[3]; + for (int i = 0; i < 3; i++) + pox[i] = new double[n_tot]; + for (n = 0; n < n_tot; n++) + { + pox[0][n] = rex * nx_g[n]; + pox[1][n] = rex * ny_g[n]; + pox[2][n] = rex * nz_g[n]; + } + + double *shellf; + shellf = new double[n_tot * InList]; + + SR_Interp_Points(DG_List, GH, SH, n_tot, pox, shellf); + + double *RP_out, *IP_out; + RP_out = new double[NN]; + IP_out = new double[NN]; + + for (int ii = 0; ii < NN; ii++) + { + RP_out[ii] = 0; + IP_out[ii] = 0; + } + + int mp, Lp, Nmin, Nmax; + + mp = n_tot / cpusize; + Lp = n_tot - cpusize * mp; + + if (Lp > myrank) + { + Nmin = myrank * mp + myrank; + Nmax = Nmin + mp; + } + else + { + Nmin = myrank * mp + Lp; + Nmax = Nmin + mp - 1; + } + + // theta part + double costheta, thetap; + double cosmphi, sinmphi; + + int i, j; + int lpsy = 0; + if (Symmetry == 0) + lpsy = 1; + else if (Symmetry == 1) + lpsy = 2; + else if (Symmetry == 2) + lpsy = 8; + + double psi4RR, psi4II; + double px, py, pz; + double pchi, ptrK, pgxx, pgxy, pgxz, pgyy, pgyz, pgzz; + double pAxx, pAxy, pAxz, pAyy, pAyz, pAzz; + double pchix, pchiy, pchiz; + double ptrKx, ptrKy, ptrKz; + double pAxxx, pAxxy, pAxxz; + double pAxyx, pAxyy, pAxyz; + double pAxzx, pAxzy, pAxzz; + double pAyyx, pAyyy, pAyyz; + double pAyzx, pAyzy, pAyzz; + double pAzzx, pAzzy, pAzzz; + double pGamxxx, pGamxxy, pGamxxz, pGamxyy, pGamxyz, pGamxzz; + double pGamyxx, pGamyxy, pGamyxz, pGamyyy, pGamyyz, pGamyzz; + double pGamzxx, pGamzxy, pGamzxz, pGamzyy, pGamzyz, pGamzzz; + double pRxx, pRxy, pRxz, pRyy, pRyz, pRzz; + for (n = Nmin; n <= Nmax; n++) + { + // need round off always + i = int(n / N_phi); // int(1.723) = 1, int(-1.732) = -1 + j = n - i * N_phi; + + int countlm = 0; + for (int pl = spinw; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + for (int lp = 0; lp < lpsy; lp++) + { + px = pox[0][n]; + py = pox[1][n]; + pz = pox[2][n]; + pchi = shellf[InList * n]; + ptrK = shellf[InList * n + 1]; + pgxx = shellf[InList * n + 2]; + pgxy = shellf[InList * n + 3]; + pgxz = shellf[InList * n + 4]; + pgyy = shellf[InList * n + 5]; + pgyz = shellf[InList * n + 6]; + pgzz = shellf[InList * n + 7]; + pAxx = shellf[InList * n + 8]; + pAxy = shellf[InList * n + 9]; + pAxz = shellf[InList * n + 10]; + pAyy = shellf[InList * n + 11]; + pAyz = shellf[InList * n + 12]; + pAzz = shellf[InList * n + 13]; + pchix = shellf[InList * n + 14]; + pchiy = shellf[InList * n + 15]; + pchiz = shellf[InList * n + 16]; + ptrKx = shellf[InList * n + 17]; + ptrKy = shellf[InList * n + 18]; + ptrKz = shellf[InList * n + 19]; + pAxxx = shellf[InList * n + 20]; + pAxxy = shellf[InList * n + 21]; + pAxxz = shellf[InList * n + 22]; + pAxyx = shellf[InList * n + 23]; + pAxyy = shellf[InList * n + 24]; + pAxyz = shellf[InList * n + 25]; + pAxzx = shellf[InList * n + 26]; + pAxzy = shellf[InList * n + 27]; + pAxzz = shellf[InList * n + 28]; + pAyyx = shellf[InList * n + 29]; + pAyyy = shellf[InList * n + 30]; + pAyyz = shellf[InList * n + 31]; + pAyzx = shellf[InList * n + 32]; + pAyzy = shellf[InList * n + 33]; + pAyzz = shellf[InList * n + 34]; + pAzzx = shellf[InList * n + 35]; + pAzzy = shellf[InList * n + 36]; + pAzzz = shellf[InList * n + 37]; + pGamxxx = shellf[InList * n + 38]; + pGamxxy = shellf[InList * n + 39]; + pGamxxz = shellf[InList * n + 40]; + pGamxyy = shellf[InList * n + 41]; + pGamxyz = shellf[InList * n + 42]; + pGamxzz = shellf[InList * n + 43]; + pGamyxx = shellf[InList * n + 44]; + pGamyxy = shellf[InList * n + 45]; + pGamyxz = shellf[InList * n + 46]; + pGamyyy = shellf[InList * n + 47]; + pGamyyz = shellf[InList * n + 48]; + pGamyzz = shellf[InList * n + 49]; + pGamzxx = shellf[InList * n + 50]; + pGamzxy = shellf[InList * n + 51]; + pGamzxz = shellf[InList * n + 52]; + pGamzyy = shellf[InList * n + 53]; + pGamzyz = shellf[InList * n + 54]; + pGamzzz = shellf[InList * n + 55]; + pRxx = shellf[InList * n + 56]; + pRxy = shellf[InList * n + 57]; + pRxz = shellf[InList * n + 58]; + pRyy = shellf[InList * n + 59]; + pRyz = shellf[InList * n + 60]; + pRzz = shellf[InList * n + 61]; + switch (lp) + { + case 0: //+++ (theta, phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + break; + case 1: //++- (pi-theta, phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = sin(pm * (j + 0.5) * dphi); + pz = -pz; + pgxz = -pgxz; + pgyz = -pgyz; + pAxz = -pAxz; + pAyz = -pAyz; + pchiz = -pchiz; + ptrKz = -ptrKz; + pAxxz = -pAxxz; + pAxyz = -pAxyz; + pAxzx = -pAxzx; + pAxzy = -pAxzy; + pAyyz = -pAyyz; + pAyzx = -pAyzx; + pAyzy = -pAyzy; + pAzzz = -pAzzz; + pGamxxz = -pGamxxz; + pGamxyz = -pGamxyz; + pGamyxz = -pGamyxz; + pGamyyz = -pGamyyz; + pGamzxx = -pGamzxx; + pGamzxy = -pGamzxy; + pGamzyy = -pGamzyy; + pGamzzz = -pGamzzz; + pRxz = -pRxz; + pRyz = -pRyz; + break; + case 2: //+-+ (theta, 2*pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pgxy = -pgxy; + pgyz = -pgyz; + pAxy = -pAxy; + pAyz = -pAyz; + pchiy = -pchiy; + ptrKy = -ptrKy; + pAxxy = -pAxxy; + pAxyx = -pAxyx; + pAxyz = -pAxyz; + pAxzy = -pAxzy; + pAyyy = -pAyyy; + pAyzx = -pAyzx; + pAyzz = -pAyzz; + pAzzy = -pAzzy; + pGamxxy = -pGamxxy; + pGamxyz = -pGamxyz; + pGamyxx = -pGamyxx; + pGamyxz = -pGamyxz; + pGamyyy = -pGamyyy; + pGamyzz = -pGamyzz; + pGamzxy = -pGamzxy; + pGamzyz = -pGamzyz; + pRxy = -pRxy; + pRyz = -pRyz; + break; + case 3: //+-- (pi-theta, 2*pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (j + 0.5) * dphi); + sinmphi = -sin(pm * (j + 0.5) * dphi); + py = -py; + pz = -pz; + pgxy = -pgxy; + pgxz = -pgxz; + pAxy = -pAxy; + pAxz = -pAxz; + pchiy = -pchiy; + pchiz = -pchiz; + ptrKy = -ptrKy; + ptrKz = -ptrKz; + pAxxy = -pAxxy; + pAxxz = -pAxxz; + pAxyx = -pAxyx; + pAxzx = -pAxzx; + pAyyy = -pAyyy; + pAyyz = -pAyyz; + pAyzy = -pAyzy; + pAyzz = -pAyzz; + pAzzy = -pAzzy; + pAzzz = -pAzzz; + pGamxxy = -pGamxxy; + pGamxxz = -pGamxxz; + pGamyxx = -pGamyxx; + pGamyyy = -pGamyyy; + pGamyyz = -pGamyyz; + pGamyzz = -pGamyzz; + pGamzxx = -pGamzxx; + pGamzyy = -pGamzyy; + pGamzyz = -pGamzyz; + pGamzzz = -pGamzzz; + pRxy = -pRxy; + pRxz = -pRxz; + break; + case 4: //-++ (theta, pi-phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + px = -px; + pgxy = -pgxy; + pgxz = -pgxz; + pAxy = -pAxy; + pAxz = -pAxz; + pchix = -pchix; + ptrKx = -ptrKx; + pAxxx = -pAxxx; + pAxyy = -pAxyy; + pAxyz = -pAxyz; + pAxzy = -pAxzy; + pAxzz = -pAxzz; + pAyyx = -pAyyx; + pAyzx = -pAyzx; + pAzzx = -pAzzx; + pGamxxx = -pGamxxx; + pGamxyy = -pGamxyy; + pGamxyz = -pGamxyz; + pGamxzz = -pGamxzz; + pGamyxy = -pGamyxy; + pGamyxz = -pGamyxz; + pGamzxy = -pGamzxy; + pGamzxz = -pGamzxz; + pRxy = -pRxy; + pRxz = -pRxz; + break; + case 5: //-+- (pi-theta, pi-phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI - (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI - (j + 0.5) * dphi)); + px = -px; + pz = -pz; + pgxy = -pgxy; + pgyz = -pgyz; + pAxy = -pAxy; + pAyz = -pAyz; + pchix = -pchix; + pchiz = -pchiz; + ptrKx = -ptrKx; + ptrKz = -ptrKz; + pAxxx = -pAxxx; + pAxxz = -pAxxz; + pAxyy = -pAxyy; + pAxzx = -pAxzx; + pAxzz = -pAxzz; + pAyyx = -pAyyx; + pAyyz = -pAyyz; + pAyzy = -pAyzy; + pAzzx = -pAzzx; + pAzzz = -pAzzz; + pGamxxx = -pGamxxx; + pGamxxz = -pGamxxz; + pGamxyy = -pGamxyy; + pGamxzz = -pGamxzz; + pGamyxy = -pGamyxy; + pGamyyz = -pGamyyz; + pGamzxx = -pGamzxx; + pGamzxz = -pGamzxz; + pGamzyy = -pGamzyy; + pGamzzz = -pGamzzz; + pRxy = -pRxy; + pRyz = -pRyz; + break; + case 6: //--+ (theta, pi+phi) + costheta = arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pgxz = -pgxz; + pgyz = -pgyz; + pAxz = -pAxz; + pAyz = -pAyz; + pchix = -pchix; + pchiy = -pchiy; + ptrKx = -ptrKx; + ptrKy = -ptrKy; + pAxxx = -pAxxx; + pAxxy = -pAxxy; + pAxyx = -pAxyx; + pAxyy = -pAxyy; + pAxzz = -pAxzz; + pAyyx = -pAyyx; + pAyyy = -pAyyy; + pAyzz = -pAyzz; + pAzzx = -pAzzx; + pAzzy = -pAzzy; + pGamxxx = -pGamxxx; + pGamxxy = -pGamxxy; + pGamxyy = -pGamxyy; + pGamxzz = -pGamxzz; + pGamyxx = -pGamyxx; + pGamyxy = -pGamyxy; + pGamyyy = -pGamyyy; + pGamyzz = -pGamyzz; + pGamzxz = -pGamzxz; + pGamzyz = -pGamzyz; + pRxz = -pRxz; + pRyz = -pRyz; + break; + case 7: //--- (pi-theta, pi+phi) + costheta = -arcostheta[i]; + cosmphi = cos(pm * (PI + (j + 0.5) * dphi)); + sinmphi = sin(pm * (PI + (j + 0.5) * dphi)); + px = -px; + py = -py; + pz = -pz; + pchix = -pchix; + pchiy = -pchiy; + pchiz = -pchiz; + ptrKx = -ptrKx; + ptrKy = -ptrKy; + ptrKz = -ptrKz; + pAxxx = -pAxxx; + pAxxy = -pAxxy; + pAxxz = -pAxxz; + pAxyx = -pAxyx; + pAxyy = -pAxyy; + pAxyz = -pAxyz; + pAxzx = -pAxzx; + pAxzy = -pAxzy; + pAxzz = -pAxzz; + pAyyx = -pAyyx; + pAyyy = -pAyyy; + pAyyz = -pAyyz; + pAyzx = -pAyzx; + pAyzy = -pAyzy; + pAyzz = -pAyzz; + pAzzx = -pAzzx; + pAzzy = -pAzzy; + pAzzz = -pAzzz; + pGamxxx = -pGamxxx; + pGamxxy = -pGamxxy; + pGamxxz = -pGamxxz; + pGamxyy = -pGamxyy; + pGamxyz = -pGamxyz; + pGamxzz = -pGamxzz; + pGamyxx = -pGamyxx; + pGamyxy = -pGamyxy; + pGamyxz = -pGamyxz; + pGamyyy = -pGamyyy; + pGamyyz = -pGamyyz; + pGamyzz = -pGamyzz; + pGamzxx = -pGamzxx; + pGamzxy = -pGamzxy; + pGamzxz = -pGamzxz; + pGamzyy = -pGamzyy; + pGamzyz = -pGamzyz; + pGamzzz = -pGamzzz; + } + + f_getnp4_point(px, py, pz, pchi, ptrK, + pgxx, pgxy, pgxz, pgyy, pgyz, pgzz, + pAxx, pAxy, pAxz, pAyy, pAyz, pAzz, + pchix, pchiy, pchiz, + ptrKx, ptrKy, ptrKz, + pAxxx, pAxxy, pAxxz, + pAxyx, pAxyy, pAxyz, + pAxzx, pAxzy, pAxzz, + pAyyx, pAyyy, pAyyz, + pAyzx, pAyzy, pAyzz, + pAzzx, pAzzy, pAzzz, + pGamxxx, pGamxxy, pGamxxz, pGamxyy, pGamxyz, pGamxzz, + pGamyxx, pGamyxy, pGamyxz, pGamyyy, pGamyyz, pGamyzz, + pGamzxx, pGamzxy, pGamzxz, pGamzyy, pGamzyz, pGamzzz, + pRxx, pRxy, pRxz, pRyy, pRyz, pRzz, + psi4RR, psi4II); + + thetap = sqrt((2 * pl + 1.0) / 4.0 / PI) * misc::Wigner_d_function(pl, pm, spinw, costheta); // note the variation from -2 to 2 + + // find back the one + pchi = pchi + 1; +#ifdef GaussInt + // wtcostheta is even function respect costheta + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi) * wtcostheta[i]; + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi) * wtcostheta[i]; +#else + RP_out[countlm] = RP_out[countlm] + thetap / pchi / pchi * (psi4RR * cosmphi + psi4II * sinmphi); + IP_out[countlm] = IP_out[countlm] + thetap / pchi / pchi * (psi4II * cosmphi - psi4RR * sinmphi); +#endif + } + countlm++; // no sanity check for countlm and NN which should be noted in the input parameters + } + } + + for (int ii = 0; ii < NN; ii++) + { +#ifdef GaussInt + RP_out[ii] = RP_out[ii] * rex * dphi; + IP_out[ii] = IP_out[ii] * rex * dphi; +#else + RP_out[ii] = RP_out[ii] * rex * dphi * dcostheta; + IP_out[ii] = IP_out[ii] * rex * dphi * dcostheta; +#endif + } + //|------+ Communicate and sum the results from each processor. + + MPI_Allreduce(RP_out, RP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + MPI_Allreduce(IP_out, IP, NN, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD); + + //|------= Free memory. + + delete[] pox[0]; + delete[] pox[1]; + delete[] pox[2]; + delete[] shellf; + delete[] RP_out; + delete[] IP_out; + DG_List->clearList(); +} +//|---------------------------------------------------------------- +// do not discriminate box and shell +//|---------------------------------------------------------------- +bool surface_integral::SR_Interp_Points(MyList *VarList, cgh *GH, ShellPatch *SH, + int NN, double **XX, double *Shellf) +{ + MyList *varl; + int num_var = 0; + varl = VarList; + while (varl) + { + num_var++; + varl = varl->next; + } + + double pox[3]; + for (int i = 0; i < NN; i++) + { + for (int j = 0; j < 3; j++) + pox[j] = XX[j][i]; + int lev = GH->levels - 1; + bool notfound = true; + + while (notfound) + { + if (lev < 0) + { + if (SH) + { + if (SH->Interp_One_Point(VarList, pox, Shellf + i * num_var, Symmetry)) + { + return true; + } + if (myrank == 0) + cout << "surface_integral::SR_Interp_Points point (" << pox[0] << "," << pox[1] << "," << pox[2] << ") is out of cgh and shell domain!" << endl; + } + else + { + if (myrank == 0) + cout << "surface_integral::SR_Interp_Points: point (" << pox[0] << "," << pox[1] << "," << pox[2] << ") is out of cgh domain!" << endl; + } + return false; + } + MyList *Pp = GH->PatL[lev]; + while (Pp) + { + if (Pp->data->Interp_ONE_Point(VarList, pox, Shellf + i * num_var, Symmetry)) + { + notfound = false; + break; + } + Pp = Pp->next; + } + lev--; + } + } + return true; +} diff --git a/AMSS_NCKU_source/surface_integral.h b/AMSS_NCKU_source/surface_integral.h new file mode 100644 index 0000000..c36f245 --- /dev/null +++ b/AMSS_NCKU_source/surface_integral.h @@ -0,0 +1,123 @@ +//$Id: surface_integral.h,v 1.9 2013/08/20 11:49:05 zjcao Exp $ +#ifndef SURFACE_INTEGRAL_H +#define SURFACE_INTEGRAL_H + +#ifdef newc +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#endif + +#include "cgh.h" +#include "ShellPatch.h" +#include "NullShellPatch.h" +#include "NullShellPatch2.h" +#include "var.h" +#include "monitor.h" + +class surface_integral +{ + +private: + int Symmetry, factor; + int N_theta, N_phi; // Number of points in Theta & Phi directions + double dphi, dcostheta; + double *arcostheta, *wtcostheta; + int n_tot; // size of arrays + + double *nx_g, *ny_g, *nz_g; // global list of unit normals + int myrank, cpusize; + +public: + surface_integral(int iSymmetry); + ~surface_integral(); + + void surf_Wave(double rex, int lev, cgh *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); // NN is the length of RP and IP + // this routine can only deal with the symmetry of Psi4 + void surf_Wave(double rex, int lev, ShellPatch *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); + void surf_Wave(double rex, int lev, NullShellPatch *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); + void surf_Wave(double rex, int lev, NullShellPatch2 *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); + void surf_Wave(double rex, int lev, ShellPatch *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); // NN is the length of RP and IP + void surf_Wave(double rex, int lev, cgh *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, + void (*funcs)(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &)); // NN is the length of RP and IP + void surf_Wave(double rex, int lev, ShellPatch *GH, + var *Ex, var *Ey, var *Ez, var *Bx, var *By, var *Bz, + var *chi, var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, + void (*funcs)(double &, double &, double &, + double &, double &, double &, double &, double &, double &, double &, + double &, double &, double &, double &, double &, double &, + double &, double &)); // NN is the length of RP and IP + void surf_MassPAng(double rex, int lev, cgh *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, + double *Rout, monitor *Monitor); + void surf_MassPAng(double rex, int lev, ShellPatch *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, + double *Rout, monitor *Monitor); + void surf_Wave(double rex, cgh *GH, ShellPatch *SH, + var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *chix, var *chiy, var *chiz, + var *trKx, var *trKy, var *trKz, + var *Axxx, var *Axxy, var *Axxz, + var *Axyx, var *Axyy, var *Axyz, + var *Axzx, var *Axzy, var *Axzz, + var *Ayyx, var *Ayyy, var *Ayyz, + var *Ayzx, var *Ayzy, var *Ayzz, + var *Azzx, var *Azzy, var *Azzz, + var *Gamxxx, var *Gamxxy, var *Gamxxz, var *Gamxyy, var *Gamxyz, var *Gamxzz, + var *Gamyxx, var *Gamyxy, var *Gamyxz, var *Gamyyy, var *Gamyyz, var *Gamyzz, + var *Gamzxx, var *Gamzxy, var *Gamzxz, var *Gamzyy, var *Gamzyz, var *Gamzzz, + var *Rxx, var *Rxy, var *Rxz, var *Ryy, var *Ryz, var *Rzz, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor); + bool SR_Interp_Points(MyList *VarList, cgh *GH, ShellPatch *SH, + int NN, double **XX, double *Shellf); + + void surf_MassPAng(double rex, int lev, cgh *GH, var *chi, var *trK, + var *gxx, var *gxy, var *gxz, var *gyy, var *gyz, var *gzz, + var *Axx, var *Axy, var *Axz, var *Ayy, var *Ayz, var *Azz, + var *Gmx, var *Gmy, var *Gmz, + var *Sfx_rhs, var *Sfy_rhs, var *Sfz_rhs, // temparay memory for mass^i + double *Rout, monitor *Monitor, MPI_Comm Comm_here); + void surf_Wave(double rex, int lev, cgh *GH, var *Rpsi4, var *Ipsi4, + int spinw, int maxl, int NN, double *RP, double *IP, + monitor *Monitor, MPI_Comm Comm_here); +}; +#endif /* SURFACE_INTEGRAL_H */ diff --git a/AMSS_NCKU_source/testNull.C b/AMSS_NCKU_source/testNull.C new file mode 100644 index 0000000..d09293e --- /dev/null +++ b/AMSS_NCKU_source/testNull.C @@ -0,0 +1,216 @@ +// $Id: testNull.C,v 1.8 2013/03/06 04:16:04 zjcao Exp $ +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "misc.h" +#include "macrodef.h" +#include "NullShellPatch.h" +#include "monitor.h" +#include "surface_integral.h" + +#define PI M_PI +//======================================= +int main(int argc, char *argv[]) +{ + int myrank = 0, nprocs = 1; + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, CheckTime; + double Courant; + double numepss, numepsb; + int Symmetry; + int a_lev, maxl, decn; + double maxrex, drex; + + int shapei[dim]; + double Rmin, xmin, xmax; + + // double RJerror[2]; + double RJerror; + // read parameter from file + { + char filename[100] = "input.par"; + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << filename + << " for inputing information of Shell patches" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN") + { + if (skey == "Shell shape") + shapei[sind] = atof(sval.c_str()); + else if (skey == "Rmin") + Rmin = atof(sval.c_str()); + else if (skey == "xmin") + xmin = atof(sval.c_str()); + else if (skey == "xmax") + xmax = atof(sval.c_str()); + } + if (sgrp == "ABE") + { + if (skey == "Symmetry") + Symmetry = atoi(sval.c_str()); + else if (skey == "Courant") + Courant = atof(sval.c_str()); + else if (skey == "DumpTime") + DumpTime = atof(sval.c_str()); + else if (skey == "TotalTime") + TotalTime = atof(sval.c_str()); + else if (skey == "AnalysisTime") + AnasTime = atof(sval.c_str()); + else if (skey == "Max mode l") + maxl = atoi(sval.c_str()); + } + } + inf.close(); + } + + monitor *ECmonitor, *NewsMonitor; + // setup Monitors + { + stringstream a_stream; + a_stream.setf(ios::left); + a_stream << "# time L2norm_of_error"; + ECmonitor = new monitor("error.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + char str[50]; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + NewsMonitor = new monitor("null_news.dat", myrank, a_stream.str()); + } + //===========================the computation body==================================================== + NullShellPatch *ADM; + surface_integral *Waveshell; + // setup sphere integration engine + Waveshell = new surface_integral(Symmetry); + + ADM = new NullShellPatch(shapei, Rmin, xmin, xmax, Symmetry, myrank); + ADM->compose_sh(nprocs); + ADM->Setup_dyad(); + ADM->Dump_xyz(0, 0, 1); + ADM->setupintintstuff(nprocs, 0, Symmetry); + + double PhysTime = 0, dT = Courant * PI / 4 / shapei[0]; + double LastDump = 0, LastAnas = 0; + + ADM->Setup_Initial_Data(false, PhysTime); + while (PhysTime < TotalTime) + { + if (LastAnas >= AnasTime) + { + double *RP, *IP; + int NN = 0; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; +// ADM->Check_News(PhysTime,dT,false); +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + Waveshell->surf_Wave(ADM->xmax, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0); +#else +#ifdef Cell + Waveshell->surf_Wave(ADM->xmax - (ADM->getdX(2)) / 2.0, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0); +#else +#error Not define Vertex nor Cell +#endif +#endif + NewsMonitor->writefile(PhysTime, NN, RP, IP); + delete[] RP; + delete[] IP; + + RJerror = ADM->Error_Check(PhysTime, dT, (LastDump >= DumpTime)); + // RJerror[1]=ADM->News_Error_Check(PhysTime,dT,(LastDump >= DumpTime)); + // RJerror[0]=ADM->EqTheta_Check(PhysTime,dT,(LastDump >= DumpTime)); + + ECmonitor->writefile(PhysTime, 1, &RJerror); + + LastAnas = 0; + } + + if (LastDump >= DumpTime) + { + ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT); + LastDump = 0; + } + + ADM->Step(dT, PhysTime, 0); + PhysTime += dT; + LastDump += dT; + LastAnas += dT; + if (myrank == 0) + cout << "Time = " << PhysTime << endl; + // ADM->Dump_Data(ADM->StateList,0,PhysTime,dT); + } + + ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT); + delete ADM; + delete ECmonitor; + delete NewsMonitor; + delete Waveshell; + //=======================caculation done============================================================= + if (myrank == 0) + cout << "===============================================================" << endl; + if (myrank == 0) + cout << "Simulation is successfully done!!" << endl; + MPI_Finalize(); + + exit(0); +} diff --git a/AMSS_NCKU_source/testNull2.C b/AMSS_NCKU_source/testNull2.C new file mode 100644 index 0000000..ef5697c --- /dev/null +++ b/AMSS_NCKU_source/testNull2.C @@ -0,0 +1,274 @@ +// $Id: testNull2.C,v 1.1 2013/08/20 11:49:05 zjcao Exp $ +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#include +#endif + +#include + +#include "misc.h" +#include "macrodef.h" +#include "NullShellPatch2.h" +#include "monitor.h" +#include "surface_integral.h" + +#define PI M_PI + +namespace parameters +{ + map int_par; + map dou_par; + map str_par; +} + +//======================================= +int main(int argc, char *argv[]) +{ + int myrank = 0, nprocs = 1; + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + int checkrun; + char checkfilename[50]; + int Steps; + double StartTime, TotalTime; + double AnasTime, DumpTime, CheckTime; + double Courant; + double numepss, numepsb; + int Symmetry; + int a_lev, maxl, decn; + double maxrex, drex; + + int shapei[dim]; + double Rmin, xmin, xmax; + + if (argc > 1) + { + string sttr(argv[1]); + parameters::str_par.insert(map::value_type("inputpar", sttr)); + } + else + { + string sttr("input.par"); + parameters::str_par.insert(map::value_type("inputpar", sttr)); + } + + // read parameter from file + { + string out_dir; + char filename[50]; + { + map::iterator iter = parameters::str_par.find("inputpar"); + if (iter != parameters::str_par.end()) + { + strcpy(filename, (iter->second).c_str()); + } + else + { + cout << "Error inputpar" << endl; + exit(0); + } + } + const int LEN = 256; + char pline[LEN]; + string str, sgrp, skey, sval; + int sind; + ifstream inf(filename, ifstream::in); + if (!inf.good()) + { + cout << "Can not open parameter file " << filename + << " for inputing information of Shell patches" << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + + for (int i = 1; inf.good(); i++) + { + inf.getline(pline, LEN); + str = pline; + + int status = misc::parse_parts(str, sgrp, skey, sval, sind); + if (status == -1) + { + cout << "error reading parameter file " << filename << " in line " << i << endl; + MPI_Abort(MPI_COMM_WORLD, 1); + } + else if (status == 0) + continue; + + if (sgrp == "BSSN") + { + if (skey == "Shell shape") + shapei[sind] = atof(sval.c_str()); + else if (skey == "Rmin") + Rmin = atof(sval.c_str()); + else if (skey == "xmin") + xmin = atof(sval.c_str()); + else if (skey == "xmax") + xmax = atof(sval.c_str()); + } + if (sgrp == "ABE") + { + if (skey == "Symmetry") + Symmetry = atoi(sval.c_str()); + else if (skey == "Courant") + Courant = atof(sval.c_str()); + else if (skey == "DumpTime") + DumpTime = atof(sval.c_str()); + else if (skey == "TotalTime") + TotalTime = atof(sval.c_str()); + else if (skey == "AnalysisTime") + AnasTime = atof(sval.c_str()); + else if (skey == "Max mode l") + maxl = atoi(sval.c_str()); + else if (skey == "output dir") + out_dir = sval; + } + } + inf.close(); + + map::iterator iter; + iter = parameters::str_par.find("output dir"); + if (iter != parameters::str_par.end()) + { + out_dir = iter->second; + } + else + { + parameters::str_par.insert(map::value_type("output dir", out_dir)); + } + + if (myrank == 0) + { + char cmd[100]; + sprintf(cmd, "rm %s -rf", out_dir.c_str()); + system(cmd); + sprintf(cmd, "mkdir %s", out_dir.c_str()); + system(cmd); + } + } + + monitor *ECmonitor, *NewsMonitor; + // setup Monitors + { + stringstream a_stream; + a_stream.setf(ios::left); + a_stream << "# time L2norm_of_error"; + ECmonitor = new monitor("error.dat", myrank, a_stream.str()); + + a_stream.clear(); + a_stream.str(""); + a_stream << setw(15) << "# time"; + char str[50]; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + { + sprintf(str, "R%02dm%03d", pl, pm); + a_stream << setw(16) << str; + sprintf(str, "I%02dm%03d", pl, pm); + a_stream << setw(16) << str; + } + NewsMonitor = new monitor("null_news.dat", myrank, a_stream.str()); + } + //===========================the computation body==================================================== + NullShellPatch2 *ADM; + surface_integral *Waveshell; + // setup sphere integration engine + Waveshell = new surface_integral(Symmetry); + + ADM = new NullShellPatch2(shapei, Rmin, xmin, xmax, Symmetry, myrank); + + ADM->compose_sh(nprocs); + ADM->Dump_xyz(0, 0, 1); + ADM->setupintintstuff(nprocs, 0, Symmetry); + + double PhysTime = 0, dT = Courant * PI / 4 / shapei[0]; + double LastDump = 0, LastAnas = 0; + + ADM->Setup_Initial_Data(false, PhysTime); + + // check Synch + // ADM->Synch(ADM->StateList,Symmetry,ADM->Thetawt,3,-1); + // ADM->Dump_Data(ADM->StateList,0,PhysTime,dT); + // exit(0); + + while (PhysTime < TotalTime) + { + ADM->Step(dT, PhysTime, 0); + PhysTime += dT; + LastDump += dT; + LastAnas += dT; + if (myrank == 0) + cout << "Time = " << PhysTime << endl; + + if (LastAnas >= AnasTime) + { + double *RP, *IP; + int NN = 0; + for (int pl = 2; pl < maxl + 1; pl++) + for (int pm = -pl; pm < pl + 1; pm++) + NN++; + RP = new double[NN]; + IP = new double[NN]; + ADM->Compute_News(PhysTime); +#ifdef Vertex +#ifdef Cell +#error Both Cell and Vertex are defined +#endif + Waveshell->surf_Wave(ADM->xmax, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0); +#else +#ifdef Cell + Waveshell->surf_Wave(ADM->xmax - (ADM->getdX(2)) / 2.0, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0); +#else +#error Not define Vertex nor Cell +#endif +#endif + NewsMonitor->writefile(PhysTime, NN, RP, IP); + delete[] RP; + delete[] IP; + + double RJerror; + RJerror = ADM->Error_Check(PhysTime); + ECmonitor->writefile(PhysTime, 1, &RJerror); + + LastAnas = 0; + } + + if (LastDump >= DumpTime) + { + ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT); + ADM->Dump_Data(ADM->g01List, 0, PhysTime, dT); + ADM->Dump_Data(ADM->pg0AList, 0, PhysTime, dT); + ADM->Dump_Data(ADM->g00List, 0, PhysTime, dT); + ADM->Dump_Data(ADM->ThetaList, 0, PhysTime, dT); + LastDump = 0; + } + } + + ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT); + delete ADM; + //=======================caculation done============================================================= + if (myrank == 0) + cout << "===============================================================" << endl; + if (myrank == 0) + cout << "Simulation is successfully done!!" << endl; + MPI_Finalize(); + + exit(0); +} diff --git a/AMSS_NCKU_source/tgrid.C b/AMSS_NCKU_source/tgrid.C new file mode 100644 index 0000000..1f3415e --- /dev/null +++ b/AMSS_NCKU_source/tgrid.C @@ -0,0 +1,128 @@ +#include +#include +#include + +#include "cctk.h" + +#include "config.h" +#include "stdc.h" +#include "util.h" +#include "array.h" +#include "linear_map.h" + +#include "coords.h" +#include "tgrid.h" + +namespace AHFinderDirect +{ + + //***************************************************************************** + //***************************************************************************** + //***************************************************************************** + + // + // This function constructs a grid_arrays object. + // + grid_arrays::grid_arrays(const grid_array_pars &grid_array_pars_in) + + : gridfn_data_(NULL), + ghosted_gridfn_data_(NULL), + + // these are all set properly by setup_gridfn_storage() + min_gfn_(0), max_gfn_(0), + ghosted_min_gfn_(0), ghosted_max_gfn_(0), + + min_irho_(grid_array_pars_in.min_irho), + max_irho_(grid_array_pars_in.max_irho), + min_isigma_(grid_array_pars_in.min_isigma), + max_isigma_(grid_array_pars_in.max_isigma), + + ghosted_min_irho_(grid_array_pars_in.min_irho - grid_array_pars_in.min_rho_ghost_zone_width), + ghosted_max_irho_(grid_array_pars_in.max_irho + grid_array_pars_in.max_rho_ghost_zone_width), + ghosted_min_isigma_(grid_array_pars_in.min_isigma - grid_array_pars_in.min_sigma_ghost_zone_width), + ghosted_max_isigma_(grid_array_pars_in.max_isigma + grid_array_pars_in.max_sigma_ghost_zone_width) + // no comma + { + } + + //***************************************************************************** + + // + // This function sets up the gridfn storage arrays in a grid_arrays object. + // + void grid_arrays::setup_gridfn_storage(const gridfn_pars &gridfn_pars_in, + const gridfn_pars &ghosted_gridfn_pars_in) + { + assert(gridfn_data_ == NULL); + gridfn_data_ = new jtutil::array3d(gridfn_pars_in.min_gfn, + gridfn_pars_in.max_gfn, + min_irho(), max_irho(), + min_isigma(), max_isigma(), + gridfn_pars_in.storage_array, + gridfn_pars_in.gfn_stride, + gridfn_pars_in.irho_stride, + gridfn_pars_in.isigma_stride); + + assert(ghosted_gridfn_data_ == NULL); + ghosted_gridfn_data_ = new jtutil::array3d(ghosted_gridfn_pars_in.min_gfn, + ghosted_gridfn_pars_in.max_gfn, + ghosted_min_irho(), ghosted_max_irho(), + ghosted_min_isigma(), ghosted_max_isigma(), + ghosted_gridfn_pars_in.storage_array, + ghosted_gridfn_pars_in.gfn_stride, + ghosted_gridfn_pars_in.irho_stride, + ghosted_gridfn_pars_in.isigma_stride); + } + + //****************************************************************************** + + // + // This function destroys a grid_arrays object. + // + grid_arrays::~grid_arrays() + { + delete ghosted_gridfn_data_; + delete gridfn_data_; + } + + //***************************************************************************** + //***************************************************************************** + //***************************************************************************** + + // + // This function constructs a grid object. + // + grid::grid(const grid_array_pars &grid_array_pars_in, + const grid_pars &grid_pars_in) + + : grid_arrays(grid_array_pars_in), + + rho_map_(grid_array_pars_in.min_irho - grid_array_pars_in.min_rho_ghost_zone_width, + grid_array_pars_in.max_irho + grid_array_pars_in.max_rho_ghost_zone_width, + jtutil::radians_of_degrees( + grid_pars_in.min_drho - grid_array_pars_in.min_rho_ghost_zone_width * grid_pars_in.delta_drho), + jtutil::radians_of_degrees(grid_pars_in.delta_drho), + jtutil::radians_of_degrees( + grid_pars_in.max_drho + grid_array_pars_in.max_rho_ghost_zone_width * grid_pars_in.delta_drho)), + + sigma_map_(grid_array_pars_in.min_isigma - grid_array_pars_in.min_sigma_ghost_zone_width, + grid_array_pars_in.max_isigma + grid_array_pars_in.max_sigma_ghost_zone_width, + jtutil::radians_of_degrees( + grid_pars_in.min_dsigma - grid_array_pars_in.min_sigma_ghost_zone_width * grid_pars_in.delta_dsigma), + jtutil::radians_of_degrees(grid_pars_in.delta_dsigma), + jtutil::radians_of_degrees( + grid_pars_in.max_dsigma + grid_array_pars_in.max_sigma_ghost_zone_width * grid_pars_in.delta_dsigma)), + + min_rho_(jtutil::radians_of_degrees(grid_pars_in.min_drho)), + max_rho_(jtutil::radians_of_degrees(grid_pars_in.max_drho)), + min_sigma_(jtutil::radians_of_degrees(grid_pars_in.min_dsigma)), + max_sigma_(jtutil::radians_of_degrees(grid_pars_in.max_dsigma)) + // no comma + { + } + + //****************************************************************************** + //****************************************************************************** + //****************************************************************************** + +} // namespace AHFinderDirect diff --git a/AMSS_NCKU_source/tgrid.h b/AMSS_NCKU_source/tgrid.h new file mode 100644 index 0000000..bd22a25 --- /dev/null +++ b/AMSS_NCKU_source/tgrid.h @@ -0,0 +1,907 @@ +#ifndef TGRID_H +#define TGRID_H +namespace AHFinderDirect +{ + + //***************************************************************************** + + // + // grid_arrays - data arrays for a 2D tensor-product grid + // + // This is a helper class for class grid (below). This class stores + // most of the actual grid function (gridfn) data arrays for a uniform + // tensor-product 2D grid. + // + // The integer grid coordinates are (irho,isigma). This class deals + // with the grid solely at the level of arrays with integer subscripts; + // the derived class grid deals with the floating-point coordinates + // related to those subscripts. + // + // The grid has a nominal extent, surrounded by "ghost zones" on each + // side for finite differencing purposes. + // + // There are separate sets of nominal-grid and ghosted-grid gridfns. + // We identify a gridfn by a small-integer "grid function number", a.k.a. + // "gfn". There are separate gfns for nominal and ghosted gridfns. + // In a very few places we refer to "unknown-grid" gridfns; these might + // be either nominal-grid or ghosted-grid. + // + // For our application (apparent horizon finding), it's useful for the + // storage for a single gridfn to be contiguous *across all patches*. + // (Note this means that the set of all our gridfns is *not* contiguous!) + // To accomplish this, we don't allocate the gridfns when we're created, + // but rather later, with a separate call setup_gridfn_storage() . + // This way higher-level code can first create all patches, then count + // the total amount of storage used, allocate it, then finally call each + // patch again to set up its gridfns appropriately. + // + + class grid_arrays + { + public: + // + // ***** {min,max}_{rho,sigma} "sides" of grid ***** + // + + // + // A grid has 4 (angular) "sides", which we identify as + // {min,max}_{rho,sigma}. Given a side, we define coordinates + // (perpendicular,parallel) to it, normally abbreviated to + // (perp,par). + // + // As well as functions directly referring to a specific side, + // we also support referring to one of these chosen at run-time, + // via Boolean flags: + // + // // generic (irho,isigma) coordinate + // iang = want_rho ? irho : isigma + // + // // opposite (irho,isigma) coordinate + // ixang = want_rho ? isigma : irho + // + // // generic (min,max) direction + // minmax = want_min ? min : max + // + // FIXME: This system of Boolean flags works ok, but it requires + // a lot of repetitive code conditional-expression functions + // in this class. Is there a cleaner solution? + + // there are precisely this many possible sides + enum + { + N_sides = 4 + }; + + // we specify {min,max} with a Boolean want_min + // ... values for want_min + // FIXME: these should really be bool, but then we couldn't + // use the "enum hack" for in-class constants + enum + { + side_is_min = true, + side_is_max = false + }; + + // we specify {rho,sigma} with a Boolean want_rho + // ... values for wanr_rho + // FIXME: these should really be bool, but then we couldn't + // use the "enum hack" for in-class constants + enum + { + side_is_rho = true, + side_is_sigma = false + }; + + // human-readable names for the sides (for debugging) + static const char *minmax_name(bool minmax) + { + return minmax ? "min" : "max"; + } + static const char *iang_name(bool want_rho) + { + return want_rho ? "irho" : "isigma"; + } + + // + // ***** array info ***** + // + public: + // nominal-grid min/max/sizes + int min_irho() const { return min_irho_; } + int max_irho() const { return max_irho_; } + int min_isigma() const { return min_isigma_; } + int max_isigma() const { return max_isigma_; } + int min_iang(bool want_rho) const + { + return want_rho ? min_irho() : min_isigma(); + } + int max_iang(bool want_rho) const + { + return want_rho ? max_irho() : max_isigma(); + } + int minmax_iang(bool want_min, bool want_rho) const + { + return want_min ? min_iang(want_rho) : max_iang(want_rho); + } + int N_irho() const + { + return jtutil::how_many_in_range(min_irho(), max_irho()); + } + int N_isigma() const + { + return jtutil::how_many_in_range(min_isigma(), max_isigma()); + } + int N_grid_points() const + { + return N_irho() * N_isigma(); + } + + // ghosted-grid min/max/sizes + int ghosted_min_irho() const { return ghosted_min_irho_; } + int ghosted_max_irho() const { return ghosted_max_irho_; } + int ghosted_min_isigma() const + { + return ghosted_min_isigma_; + } + int ghosted_max_isigma() const + { + return ghosted_max_isigma_; + } + int ghosted_min_iang(bool want_rho) const + { + return want_rho ? ghosted_min_irho() + : ghosted_min_isigma(); + } + int ghosted_max_iang(bool want_rho) const + { + return want_rho ? ghosted_max_irho() + : ghosted_max_isigma(); + } + int ghosted_minmax_iang(bool want_min, bool want_rho) const + { + return want_min ? ghosted_min_iang(want_rho) + : ghosted_max_iang(want_rho); + } + int ghosted_N_irho() const + { + return jtutil::how_many_in_range(ghosted_min_irho(), + ghosted_max_irho()); + } + int ghosted_N_isigma() const + { + return jtutil::how_many_in_range(ghosted_min_isigma(), + ghosted_max_isigma()); + } + int ghosted_N_grid_points() const + { + return ghosted_N_irho() * ghosted_N_isigma(); + } + + // "effective" grid min/max/sizes + // (= dynamic select between nominal and full grids) + int effective_min_irho(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_min_irho() : min_irho(); + } + int effective_max_irho(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_max_irho() : max_irho(); + } + int effective_min_isigma(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_min_isigma() : min_isigma(); + } + int effective_max_isigma(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_max_isigma() : max_isigma(); + } + int effective_N_irho(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_N_irho() : N_irho(); + } + int effective_N_isigma(bool want_ghost_zones) const + { + return want_ghost_zones ? ghosted_N_isigma() : N_isigma(); + } + + // + // ***** ghost zones ***** + // + public: + // ghost zone min/max perpendicular coordinates + int min_rho_ghost_zone__min_iperp() const + { + return ghosted_min_irho(); + } + int min_rho_ghost_zone__max_iperp() const + { + return min_irho() - 1; + } + int max_rho_ghost_zone__min_iperp() const + { + return max_irho() + 1; + } + int max_rho_ghost_zone__max_iperp() const + { + return ghosted_max_irho(); + } + int min_sigma_ghost_zone__min_iperp() const + { + return ghosted_min_isigma(); + } + int min_sigma_ghost_zone__max_iperp() const + { + return min_isigma() - 1; + } + int max_sigma_ghost_zone__min_iperp() const + { + return max_isigma() + 1; + } + int max_sigma_ghost_zone__max_iperp() const + { + return ghosted_max_isigma(); + } + int minmax_ang_ghost_zone__min_iperp(bool want_min, bool want_rho) const + { + return want_min + ? (want_rho ? min_rho_ghost_zone__min_iperp() + : min_sigma_ghost_zone__min_iperp()) + : (want_rho ? max_rho_ghost_zone__min_iperp() + : max_sigma_ghost_zone__min_iperp()); + } + int minmax_ang_ghost_zone__max_iperp(bool want_min, bool want_rho) const + { + return want_min + ? (want_rho ? min_rho_ghost_zone__max_iperp() + : min_sigma_ghost_zone__max_iperp()) + : (want_rho ? max_rho_ghost_zone__max_iperp() + : max_sigma_ghost_zone__max_iperp()); + } + + // ghost zone min/max parallel coordinates + // ... not including corners + int rho_ghost_zone_without_corners__min_ipar() const + { + return min_isigma(); + } + int rho_ghost_zone_without_corners__max_ipar() const + { + return max_isigma(); + } + int sigma_ghost_zone_without_corners__min_ipar() const + { + return min_irho(); + } + int sigma_ghost_zone_without_corners__max_ipar() const + { + return max_irho(); + } + int ang_ghost_zone_without_corners__min_ipar(bool want_rho) const + { + return want_rho ? rho_ghost_zone_without_corners__min_ipar() + : sigma_ghost_zone_without_corners__min_ipar(); + } + int ang_ghost_zone_without_corners__max_ipar(bool want_rho) const + { + return want_rho ? rho_ghost_zone_without_corners__max_ipar() + : sigma_ghost_zone_without_corners__max_ipar(); + } + // ... including corners + int rho_ghost_zone_with_corners__min_ipar() const + { + return ghosted_min_isigma(); + } + int rho_ghost_zone_with_corners__max_ipar() const + { + return ghosted_max_isigma(); + } + int sigma_ghost_zone_with_corners__min_ipar() const + { + return ghosted_min_irho(); + } + int sigma_ghost_zone_with_corners__max_ipar() const + { + return ghosted_max_irho(); + } + int ang_ghost_zone_with_corners__min_ipar(bool want_rho) const + { + return want_rho ? rho_ghost_zone_with_corners__min_ipar() + : sigma_ghost_zone_with_corners__min_ipar(); + } + int ang_ghost_zone_with_corners__max_ipar(bool want_rho) const + { + return want_rho ? rho_ghost_zone_with_corners__max_ipar() + : sigma_ghost_zone_with_corners__max_ipar(); + } + + // + // ***** grid-point validity and membership predicates ***** + // + public: + bool is_valid_irho(int irho) const + { + return (irho >= min_irho()) && (irho <= max_irho()); + } + bool is_valid_isigma(int isigma) const + { + return (isigma >= min_isigma()) && (isigma <= max_isigma()); + } + bool is_in_nominal_grid(int irho, int isigma) const + { + return is_valid_irho(irho) && is_valid_isigma(isigma); + } + + bool is_valid_ghosted_irho(int irho) const + { + return (irho >= ghosted_min_irho()) && (irho <= ghosted_max_irho()); + } + bool is_valid_ghosted_isigma(int isigma) const + { + return (isigma >= ghosted_min_isigma()) && (isigma <= ghosted_max_isigma()); + } + bool is_in_ghosted_grid(int irho, int isigma) const + { + return is_valid_ghosted_irho(irho) && is_valid_ghosted_isigma(isigma); + } + + bool is_in_ghost_zone(int irho, int isigma) const + { + return is_in_ghosted_grid(irho, isigma) && !is_in_nominal_grid(irho, isigma); + } + + // + // ***** gfn ranges and validity predicates ***** + // + public: + // gfn ranges + int min_gfn() const + { + assert(gridfn_data_ != NULL); + return (*gridfn_data_).min_i(); + } + int max_gfn() const + { + assert(gridfn_data_ != NULL); + return (*gridfn_data_).max_i(); + } + int N_gridfns() const + { + return jtutil::how_many_in_range(min_gfn(), max_gfn()); + } + int ghosted_min_gfn() const + { + assert(ghosted_gridfn_data_ != NULL); + return (*ghosted_gridfn_data_).min_i(); + } + int ghosted_max_gfn() const + { + assert(ghosted_gridfn_data_ != NULL); + return (*ghosted_gridfn_data_).max_i(); + } + int ghosted_N_gridfns() const + { + return jtutil::how_many_in_range(ghosted_min_gfn(), + ghosted_max_gfn()); + } + + // gfn validity predicates + bool is_valid_gfn(int gfn) const + { + return (gfn >= min_gfn()) && (gfn <= max_gfn()); + } + bool is_valid_ghosted_gfn(int gfn) const + { + return (gfn >= ghosted_min_gfn()) && (gfn <= ghosted_max_gfn()); + } + + // + // ***** gridfns ***** + // + // n.b. access to rvalue gridfn data must be via references + // in order to allow using gridfn(...) as the operand + // of a unary & (address-of) operator + // + public: + // access to nominal-grid gridfn data + // ... rvalue + const fp &gridfn(int gfn, int irho, int isigma) const + { + assert(gridfn_data_ != NULL); + return (*gridfn_data_)(gfn, irho, isigma); + } + // ... lvalue + fp &gridfn(int gfn, int irho, int isigma) + { + assert(gridfn_data_ != NULL); + return (*gridfn_data_)(gfn, irho, isigma); + } + + // access to ghosted-grid gridfn data + // ... rvalue + const fp &ghosted_gridfn(int gfn, int irho, int isigma) const + { + assert(gridfn_data_ != NULL); + return (*ghosted_gridfn_data_)(gfn, irho, isigma); + } + // ... lvalue + fp &ghosted_gridfn(int gfn, int irho, int isigma) + { + assert(gridfn_data_ != NULL); + return (*ghosted_gridfn_data_)(gfn, irho, isigma); + } + + // access to unknown-grid gridfn data + // (either nominal or ghosted, depending on Boolean flag) + // ... rvalue + const fp &unknown_gridfn(bool ghosted_flag, + int unknown_gfn, int irho, int isigma) + const + { + return ghosted_flag ? ghosted_gridfn(unknown_gfn, irho, isigma) + : gridfn(unknown_gfn, irho, isigma); + } + // ... lvalue + fp &unknown_gridfn(bool ghosted_flag, + int unknown_gfn, int irho, int isigma) + { + return ghosted_flag ? ghosted_gridfn(unknown_gfn, irho, isigma) + : gridfn(unknown_gfn, irho, isigma); + } + + // subscripting info + int gfn_stride() const + { + assert(gridfn_data_ != NULL); + return gridfn_data_->subscript_stride_i(); + } + int irho_stride() const + { + assert(gridfn_data_ != NULL); + return gridfn_data_->subscript_stride_j(); + } + int isigma_stride() const + { + assert(gridfn_data_ != NULL); + return gridfn_data_->subscript_stride_k(); + } + int iang_stride(bool want_rho) const + { + return want_rho ? irho_stride() : isigma_stride(); + } + int ghosted_gfn_stride() const + { + assert(ghosted_gridfn_data_ != NULL); + return ghosted_gridfn_data_->subscript_stride_i(); + } + int ghosted_irho_stride() const + { + assert(ghosted_gridfn_data_ != NULL); + return ghosted_gridfn_data_->subscript_stride_j(); + } + int ghosted_isigma_stride() const + { + assert(ghosted_gridfn_data_ != NULL); + return ghosted_gridfn_data_->subscript_stride_k(); + } + int ghosted_iang_stride(bool want_rho) const + { + return want_rho ? ghosted_irho_stride() + : ghosted_isigma_stride(); + } + + // validity predicates for 1-D 0-origin grid point number (gpn) + bool is_valid_gpn(int gpn) const + { + return (gpn >= 0) && (gpn < N_grid_points()); + } + bool is_valid_ghosted_gpn(int gpn) const + { + return (gpn >= 0) && (gpn < ghosted_N_grid_points()); + } + + // convert (irho,isigma) <--> 1-D 0-origin grid point number (gpn) + int gpn_of_irho_isigma(int irho, int isigma) const + { + assert(is_valid_irho(irho)); + assert(is_valid_isigma(isigma)); + + return (irho - min_irho()) * irho_stride() + (isigma - min_isigma()) * isigma_stride(); + } + int ghosted_gpn_of_irho_isigma(int irho, int isigma) const + { + assert(is_valid_ghosted_irho(irho)); + assert(is_valid_ghosted_isigma(isigma)); + return (irho - ghosted_min_irho()) * ghosted_irho_stride() + (isigma - ghosted_min_isigma()) * ghosted_isigma_stride(); + } + // ... current implementation assumes (& verifies) isigma is contiguous + void irho_isigma_of_gpn(int gpn, int &irho, int &isigma) const + { + assert(is_valid_gpn(gpn)); + assert(isigma_stride() == 1); // implementation restriction + irho = min_irho() + gpn / N_isigma(); + isigma = min_isigma() + gpn % N_isigma(); + assert(is_valid_irho(irho)); + assert(is_valid_isigma(isigma)); + } + // ... current implementation assumes (& verifies) isigma is contiguous + void ghosted_irho_isigma_of_gpn(int gpn, int &irho, int &isigma) const + { + assert(is_valid_ghosted_gpn(gpn)); + assert(ghosted_isigma_stride() == 1); // implementation + // restriction + irho = ghosted_min_irho() + gpn / ghosted_N_isigma(); + isigma = ghosted_min_isigma() + gpn % ghosted_N_isigma(); + assert(is_valid_ghosted_irho(irho)); + assert(is_valid_ghosted_isigma(isigma)); + } + + // low-level access to data arrays (!!dangerous!!) + const fp *gridfn_data_array(int gfn) const + { + return &gridfn(gfn, min_irho(), min_isigma()); + } + fp *gridfn_data_array(int gfn) + { + return &gridfn(gfn, min_irho(), min_isigma()); + } + const fp *ghosted_gridfn_data_array(int ghosted_gfn) const + { + return &ghosted_gridfn(ghosted_gfn, ghosted_min_irho(), + ghosted_min_isigma()); + } + fp *ghosted_gridfn_data_array(int ghosted_gfn) + { + return &ghosted_gridfn(ghosted_gfn, ghosted_min_irho(), + ghosted_min_isigma()); + } + + // + // ***** argument structures for constructor et al ***** + // + public: + // these structures bundle related arguments together so we don't + // have 20+ (!) separate arguments to our top-level constructors + struct grid_array_pars + { + int min_irho, max_irho; + int min_isigma, max_isigma; + int min_rho_ghost_zone_width, max_rho_ghost_zone_width; + int min_sigma_ghost_zone_width, max_sigma_ghost_zone_width; + }; + struct gridfn_pars + { + int min_gfn, max_gfn; + + // gridfn storage will be automatically allocated + // if pointer is NULL; any 0 strides are automatically + // set to C-style row-major subscripting + fp *storage_array; + int gfn_stride, irho_stride, isigma_stride; + }; + + // + // ***** constructor, gridfn setup, destructor ***** + // + public: + // construct with no gridfns + grid_arrays(const grid_array_pars &grid_array_pars_in); + + // set up storage for gridfns + void setup_gridfn_storage(const gridfn_pars &gridfn_pars_in, + const gridfn_pars &ghosted_gridfn_pars_in); + + ~grid_arrays(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + grid_arrays(const grid_arrays &rhs); + grid_arrays &operator=(const grid_arrays &rhs); + + private: + // + // ***** the actual gridfn storage arrays ***** + // + // n.b. these pointers are *first* data member in this class + // ==> possibly slightly faster access (0 offset from pointer) + // ... indices are (gfn, irho, isigma) + jtutil::array3d *gridfn_data_; + jtutil::array3d *ghosted_gridfn_data_; + + // gfn bounds + const int min_gfn_, max_gfn_; + const int ghosted_min_gfn_, ghosted_max_gfn_; + + // nominal grid min/max bounds + const int min_irho_, max_irho_; + const int min_isigma_, max_isigma_; + + // full grid min/max bounds + const int ghosted_min_irho_, ghosted_max_irho_; + const int ghosted_min_isigma_, ghosted_max_isigma_; + }; + + //****************************************************************************** + + // + // grid - uniform 2D tensor-product grid + // + // The grid is uniform in the floating point grid coordinates (rho,sigma). + // There is also some (limited) support for expressing these coordinates + // in degrees (drho,dsigma); this is useful for humans trying to specify + // things in parameter files. + // + // The nominal (not including the ghost zones) angular grid boundaries + // may coincide with grid points, or they may be at "half-integer" grid + // coordinates. That is, suppose we have a unit grid spacing, and a boundary + // at an angular coordinate of 0; then the grid may be either 0, 1, 2, ..., + // or 0.5, 1.5, 2.5, ... . + // + + class grid + : public grid_arrays + { + // + // ***** low-level access to coordinate maps ***** + // + public: + // direct (read-only) access to the underlying linear_map objects + // ... useful for (eg) passing to interpolators + const jtutil::linear_map &rho_map() const { return rho_map_; } + const jtutil::linear_map &sigma_map() const { return sigma_map_; } + const jtutil::linear_map &ang_map(bool want_rho) const + { + return want_rho ? rho_map() : sigma_map(); + } + + // + // ***** single-axis coordinate conversions ***** + // + public: + // ... angles in radians + fp rho_of_irho(int irho) const { return rho_map().fp_of_int(irho); } + fp sigma_of_isigma(int isigma) const + { + return sigma_map().fp_of_int(isigma); + } + fp ang_of_iang(bool want_rho, int iang) const + { + return want_rho ? rho_of_irho(iang) + : sigma_of_isigma(iang); + } + + fp fp_irho_of_rho(fp rho) const + { + return rho_map().fp_int_of_fp(rho); + } + int irho_of_rho(fp rho, jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + const + { + return rho_map().int_of_fp(rho, nia); + } + fp fp_isigma_of_sigma(fp sigma) const + { + return sigma_map().fp_int_of_fp(sigma); + } + int isigma_of_sigma(fp sigma, jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + const + { + return sigma_map().int_of_fp(sigma, nia); + } + fp fp_iang_of_ang(bool want_rho, fp ang) + const + { + return want_rho ? fp_irho_of_rho(ang) + : fp_isigma_of_sigma(ang); + } + int iang_of_ang(bool want_rho, + fp ang, jtutil::linear_map::noninteger_action nia = jtutil::linear_map::nia_error) + const + { + return want_rho ? irho_of_rho(ang, nia) + : isigma_of_sigma(ang, nia); + } + + // ... angles in degrees + fp rho_of_drho(fp drho) const + { + return jtutil::radians_of_degrees(drho); + } + fp sigma_of_dsigma(fp dsigma) const + { + return jtutil::radians_of_degrees(dsigma); + } + fp drho_of_rho(fp rho) const + { + return jtutil::degrees_of_radians(rho); + } + fp dsigma_of_sigma(fp sigma) const + { + return jtutil::degrees_of_radians(sigma); + } + fp drho_of_irho(int irho) const + { + return jtutil::degrees_of_radians(rho_of_irho(irho)); + } + fp dsigma_of_isigma(int isigma) const + { + return jtutil::degrees_of_radians(sigma_of_isigma(isigma)); + } + + int irho_of_drho(fp drho, jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + const + { + return irho_of_rho(jtutil::radians_of_degrees(drho), nia); + } + int isigma_of_dsigma(fp dsigma, + jtutil::linear_map::noninteger_action + nia = jtutil::linear_map::nia_error) + const + { + return isigma_of_sigma(jtutil::radians_of_degrees(dsigma), nia); + } + + // + // ***** grid info ***** + // + public: + // grid spacings + fp delta_rho() const { return rho_map().delta_fp(); } + fp delta_sigma() const { return sigma_map().delta_fp(); } + fp delta_drho() const + { + return jtutil::degrees_of_radians(delta_rho()); + } + fp delta_dsigma() const + { + return jtutil::degrees_of_radians(delta_sigma()); + } + fp delta_ang(bool want_rho) const + { + return want_rho ? delta_rho() : delta_sigma(); + } + fp delta_dang(bool want_rho) const + { + return want_rho ? delta_drho() : delta_dsigma(); + } + + // inverse grid spacings + fp inverse_delta_rho() const { return rho_map().inverse_delta_fp(); } + fp inverse_delta_sigma() const + { + return sigma_map().inverse_delta_fp(); + } + + // nominal grid min/max + fp min_rho() const { return min_rho_; } + fp max_rho() const { return max_rho_; } + fp min_sigma() const { return min_sigma_; } + fp max_sigma() const { return max_sigma_; } + fp minmax_ang(bool want_min, bool want_rho) const + { + return want_min ? (want_rho ? min_rho() : min_sigma()) + : (want_rho ? max_rho() : max_sigma()); + } + fp min_drho() const { return jtutil::degrees_of_radians(min_rho()); } + fp max_drho() const { return jtutil::degrees_of_radians(max_rho()); } + fp min_dsigma() const + { + return jtutil::degrees_of_radians(min_sigma()); + } + fp max_dsigma() const + { + return jtutil::degrees_of_radians(max_sigma()); + } + fp min_dang(bool want_rho) const + { + return want_rho ? min_drho() : min_dsigma(); + } + fp max_dang(bool want_rho) const + { + return want_rho ? max_drho() : max_dsigma(); + } + + // ghosted-grid min/max + fp ghosted_min_rho() const + { + return rho_of_irho(ghosted_min_irho()); + } + fp ghosted_max_rho() const + { + return rho_of_irho(ghosted_max_irho()); + } + fp ghosted_min_sigma() const + { + return sigma_of_isigma(ghosted_min_isigma()); + } + fp ghosted_max_sigma() const + { + return sigma_of_isigma(ghosted_max_isigma()); + } + + // is a given (drho,dsigma) within the grid? + bool is_valid_drho(fp drho) const + { + return jtutil::fuzzy::GE(drho, min_drho()) && jtutil::fuzzy::LE(drho, max_drho()); + } + bool is_valid_dsigma(fp dsigma) const + { + return jtutil::fuzzy::GE(dsigma, min_dsigma()) && jtutil::fuzzy::LE(dsigma, max_dsigma()); + } + + // reduce a rho/sigma coordinate modulo 2*pi radians (360 degrees) + // to be within the ghosted grid, + // or error_exit() if no such value exists + fp modulo_reduce_rho(fp rho_in) const + { + return local_coords ::modulo_reduce_ang(rho_in, ghosted_min_rho(), + ghosted_max_rho()); + } + fp modulo_reduce_sigma(fp sigma_in) const + { + return local_coords ::modulo_reduce_ang(sigma_in, ghosted_min_sigma(), + ghosted_max_sigma()); + } + fp modulo_reduce_ang(bool want_rho, fp ang_in) const + { + return want_rho ? modulo_reduce_rho(ang_in) + : modulo_reduce_sigma(ang_in); + } + + // + // ***** misc stuff ***** + // + public: + // human-readable names for the sides (for debugging) + static const char *ang_name(bool want_rho) + { + return want_rho ? "rho" : "sigma"; + } + static const char *dang_name(bool want_rho) + { + return want_rho ? "drho" : "dsigma"; + } + + // + // ***** argument structure for constructor ***** + // + + // this structure bundles related arguments together so we don't + // have 20+ (!) separate arguments to our top-level constructors + struct grid_pars // *** note angles in degrees *** + { + fp min_drho, delta_drho, max_drho; + fp min_dsigma, delta_dsigma, max_dsigma; + }; + + // + // ***** constructor, destructor ***** + // + grid(const grid_array_pars &grid_array_pars_in, + const grid_pars &grid_pars_in); + // compiler-generated default destructor is ok + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + grid(const grid &rhs); + grid &operator=(const grid &rhs); + + private: + // range of these is the full grid (including ghost zones) + const jtutil::linear_map rho_map_, sigma_map_; + + // angular boundaries of nominal grid + const fp min_rho_, max_rho_; + const fp min_sigma_, max_sigma_; + }; + + //****************************************************************************** + +} // namespace AHFinderDirect +#endif /* TGRID_H */ diff --git a/AMSS_NCKU_source/tool.C b/AMSS_NCKU_source/tool.C new file mode 100644 index 0000000..d43ed46 --- /dev/null +++ b/AMSS_NCKU_source/tool.C @@ -0,0 +1,51 @@ +#include +#include +// #include< +using namespace std; +/*void printss(int * a,int * b,int *c){ + int a1 = *a; + int b1 = *b; + int c1 = *c; + printf("%d,%d,%d\n",1,2,3); + printf("%d,%d,%d\n",a1,b1,c1); +}*/ +int main() +{ + ifstream fin; + ofstream fout; + fin.open("tool_input.txt"); + fout.open("tool_output.txt"); + + // ifstream fin1; + // fin1.open("input1.txt"); + char buf[20]; + char buf1[20]; + + while (fin >> buf) + { + // fin1>>buf1; + // fout<<"if("<[buf][i] != cg_gpu->[buf][i]){is_match = false; break;} + fout << "delta = cg->fgfs[" << buf << "][i] - cg_gpu->fgfs[" << buf << "][i];" << endl; + fout << "if(delta >1e-12 || delta < -1e-12){is_match = false; break;}" << endl; + } + /*int para = 167; + for(int i = para;ifgfs["< +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include "macrodef.h" + +// transmit black hole's position from bssn class + +int BHN; +double Mass[3]; +double PBH[9]; + +void setpbh(int iBHN, double **iPBH, double *iMass, int rBHN) +{ + BHN = Mymax(iBHN, rBHN); + for (int i = 0; i < iBHN; i++) + { + for (int j = 0; j < 3; j++) + PBH[3 * i + j] = iPBH[i][j]; + Mass[i] = iMass[i]; + } + if (BHN < rBHN) + { + if (rBHN > 2) + cout << "error in transpbh.C: something wrong." << endl; + else + { + for (int j = 0; j < 3; j++) + PBH[3 + j] = -iPBH[0][j]; + + Mass[1] = Mass[0]; + } + } +} +extern "C" +{ + +#ifdef fortran1 + void getpbh +#endif +#ifdef fortran2 + void GETPBH +#endif +#ifdef fortran3 + void + getpbh_ +#endif + (int &oBHN, double *oPBH, double *oMass) + { + oBHN = BHN; + for (int i = 0; i < BHN; i++) + oMass[i] = Mass[i]; + for (int i = 0; i < 3 * BHN; i++) + oPBH[i] = PBH[i]; + + // printf("have set BH_num = %d\n",oBHN); + } +} diff --git a/AMSS_NCKU_source/util.h b/AMSS_NCKU_source/util.h new file mode 100644 index 0000000..aabb4ac --- /dev/null +++ b/AMSS_NCKU_source/util.h @@ -0,0 +1,157 @@ +#ifndef AHFINDERDIRECT__UTIL_HH +#define AHFINDERDIRECT__UTIL_HH +#ifdef newc +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#endif + +#define PI M_PI + +namespace AHFinderDirect +{ + namespace jtutil + { + inline int how_many_in_range(int low, int high) { return high - low + 1; } + + inline int is_even(int i) { return !(i & 0x1); } + inline int is_odd(int i) { return (i & 0x1); } + + template + inline T tmin(T x, T y) { return (x < y) ? x : y; } + template + inline T tmax(T x, T y) { return (x > y) ? x : y; } + template + inline T abs(T x) { return (x > 0) ? x : -x; } + + template + inline T pow2(T x) { return x * x; } + template + inline T pow3(T x) { return x * x * x; } + template + inline T pow4(T x) { return pow2(pow2(x)); } + + template + inline fp_t degrees_of_radians(fp_t radians) { return (180.0 / PI) * radians; } + template + inline fp_t radians_of_degrees(fp_t degrees) { return (PI / 180.0) * degrees; } + + // in miscfp.cc + //----------------------------------------------------- + double signum(double x); + double hypot3(double x, double y, double z); + double arctan_xy(double x, double y); + + double modulo_reduce(double x, double xmod, double xmin, double xmax); + + template + void zero_C_array(int N, fp_t array[]); + + // in error_exit.cc + // ------------------------------------------------------ + int error_exit(int msg_level, const char *format, ...); + + // in norm.cc + // + template + class norm + { + public: + // get norms etc + fp_t mean() const; + fp_t two_norm() const; // sqrt(sum x_i^2) + fp_t rms_norm() const; // sqrt(average of x_i^2) + fp_t infinity_norm() const { return max_abs_value_; } + + fp_t max_abs_value() const { return max_abs_value_; } + fp_t min_abs_value() const { return min_abs_value_; } + + fp_t max_value() const { return max_value_; } + fp_t min_value() const { return min_value_; } + + // specify data point + void data(fp_t x); + + // have any data points been specified? + bool is_empty() const { return N_ == 0; } + bool is_nonempty() const { return N_ > 0; } + + // reset ==> just like newly-constructed object + void reset(); + + // constructor, destructor + // ... compiler-generated no-op destructor is ok + norm(); + + private: + // we forbid copying and passing by value + // by declaring the copy constructor and assignment operator + // private, but never defining them + norm(const norm &rhs); + norm &operator=(const norm &rhs); + + private: + long N_; // # of data points + fp_t sum_; // sum(data) + fp_t sum2_; // sum(data^2) + fp_t max_abs_value_; // max |data| + fp_t min_abs_value_; // min |data| + fp_t max_value_; // max data + fp_t min_value_; // min data + }; + + // in fuzzy.cc + template + class fuzzy + { + public: + // comparison tolerance (may be modified by user code if needed) + static fp_t get_tolerance() { return tolerance_; } + static void set_tolerance(fp_t new_tolerance) + { + tolerance_ = new_tolerance; + } + + // fuzzy commparisons + static bool EQ(fp_t x, fp_t y); + static bool NE(fp_t x, fp_t y) { return !EQ(x, y); } + static bool LT(fp_t x, fp_t y) { return EQ(x, y) ? false : (x < y); } + static bool LE(fp_t x, fp_t y) { return EQ(x, y) ? true : (x < y); } + static bool GT(fp_t x, fp_t y) { return EQ(x, y) ? false : (x > y); } + static bool GE(fp_t x, fp_t y) { return EQ(x, y) ? true : (x > y); } + + static bool is_integer(fp_t x); // is x fuzzily an integer? + static int floor(fp_t x); // round x fuzzily down to integer + static int ceiling(fp_t x); // round x fuzzily up to integer + + private: + // comparison tolerance + // ... must be explicitly initialized when instantiating + // for a new type, see "fuzzy.cc" for details/examples + static fp_t tolerance_; + }; + + // in round.cc + template + class round + { + public: + static int to_integer(fp_t x); // round to nearest integer + + static int floor(fp_t x); // round down to integer + static int ceiling(fp_t x); // round up to integer + }; + + } // namespace jtutil +} // namespace AHFinderDirect + +#endif /* AHFINDERDIRECT__UTIL_HH */ diff --git a/AMSS_NCKU_source/util_String.h b/AMSS_NCKU_source/util_String.h new file mode 100644 index 0000000..a1fa56b --- /dev/null +++ b/AMSS_NCKU_source/util_String.h @@ -0,0 +1,45 @@ +#ifndef _UTIL_STRING_H_ +#define _UTIL_STRING_H_ 1 + +#include +#include + +#ifdef __cplusplus +extern "C" +{ +#endif + + const char *Util_StrSep(const char **stringp, + const char *delim); + + int Util_SplitString(char **before, + char **after, + const char *string, + const char *sep); + + int Util_SplitFilename(char **dir, + char **file, + const char *string); + + char *Util_Strdup(const char *s); + + size_t Util_Strlcpy(char *dst, const char *src, size_t dst_size); + size_t Util_Strlcat(char *dst, const char *src, size_t dst_size); + + int Util_StrCmpi(const char *string1, + const char *string2); + int Util_StrMemCmpi(const char *string1, + const char *string2, + size_t len2); + + int Util_vsnprintf(char *str, size_t count, const char *fmt, va_list args); + int Util_snprintf(char *str, size_t count, const char *fmt, ...); + + int Util_asprintf(char **buffer, const char *fmt, ...); + int Util_asnprintf(char **buffer, size_t size, const char *fmt, ...); + +#ifdef __cplusplus +} +#endif + +#endif /* _UTIL_STRING_H_ */ diff --git a/AMSS_NCKU_source/util_Table.h b/AMSS_NCKU_source/util_Table.h new file mode 100644 index 0000000..ca377d3 --- /dev/null +++ b/AMSS_NCKU_source/util_Table.h @@ -0,0 +1,496 @@ +#ifndef _UTIL_TABLE_H_ +#define _UTIL_TABLE_H_ 1 + +#include "cctk_Types.h" + +#ifdef __cplusplus +extern "C" +{ +#endif + +/******************************************************************************/ +/***** Macros for Flags Word **************************************************/ +/******************************************************************************/ + +/* + * The hexadecimal forms are more convenient for thinking about + * bitwise-oring, but alas Fortran 77 doesn't seem to support + * hexadecimal constants, so we give the actual values in decimal. + */ + +/*@@ + @defines UTIL_TABLE_FLAGS_DEFAULT + @desc flags-word macro: no flags set (default) + @@*/ +#define UTIL_TABLE_FLAGS_DEFAULT 0 + +/*@@ + @defines UTIL_TABLE_FLAGS_CASE_INSENSITIVE + @desc flags-word macro: key comparisons are case-insensitive + @@*/ +#define UTIL_TABLE_FLAGS_CASE_INSENSITIVE 1 /* 0x1 */ + +/*@@ + @defines UTIL_TABLE_FLAGS_USER_DEFINED_BASE + @desc flags-word macro: user-defined flags word bit masks + should use only this and higher bit positions (i.e. + all bit positions below this one are reserved for + current or future Cactus use) + @@*/ +#define UTIL_TABLE_FLAGS_USER_DEFINED_BASE 65536 /* 0x10000 */ + +/******************************************************************************/ +/***** Error Codes ************************************************************/ +/******************************************************************************/ + +/* + * error codes specific to the table routines (between -100 and -199) + */ + +/*@@ + @defines UTIL_ERROR_TABLE_BAD_FLAGS + @desc error return code: flags word is invalid + @@*/ +#define UTIL_ERROR_TABLE_BAD_FLAGS (-100) + +/*@@ + @defines UTIL_ERROR_TABLE_BAD_KEY + @desc error return code: key contains '/' character + or is otherwise invalid + @@*/ +#define UTIL_ERROR_TABLE_BAD_KEY (-101) + +/*@@ + @defines UTIL_ERROR_TABLE_STRING_TRUNCATED + @desc error return code: string was truncated to fit in buffer + @@*/ +#define UTIL_ERROR_TABLE_STRING_TRUNCATED (-102) + +/*@@ + @defines UTIL_ERROR_TABLE_NO_SUCH_KEY + @desc error return code: no such key in table + @@*/ +#define UTIL_ERROR_TABLE_NO_SUCH_KEY (-103) + +/*@@ + @defines UTIL_ERROR_TABLE_WRONG_DATA_TYPE + @desc error return code: value associated with this key + has the wrong data type for this function + @@*/ +#define UTIL_ERROR_TABLE_WRONG_DATA_TYPE (-104) + +/*@@ + @defines UTIL_ERROR_TABLE_VALUE_IS_EMPTY + @desc error return code: value associated with this key + is an empty (0-element) array + @@*/ +#define UTIL_ERROR_TABLE_VALUE_IS_EMPTY (-105) + +/*@@ + @defines UTIL_ERROR_TABLE_ITERATOR_IS_NULL + @desc error return code: table iterator is in "null-pointer" state + @@*/ +#define UTIL_ERROR_TABLE_ITERATOR_IS_NULL (-106) + +/*@@ + @defines UTIL_ERROR_TABLE_NO_MIXED_TYPE_ARRAY + @desc error return code: different array values have different + datatypes + @@*/ +#define UTIL_ERROR_TABLE_NO_MIXED_TYPE_ARRAY (-107) + + +/******************************************************************************/ +/***** Main Table API *********************************************************/ +/******************************************************************************/ + +/* create/destroy */ +int Util_TableCreate(int flags); +int Util_TableClone(int handle); +int Util_TableDestroy(int handle); + +/* query */ +int Util_TableQueryFlags(int handle); +int Util_TableQueryNKeys(int handle); +int Util_TableQueryMaxKeyLength(int handle); +int Util_TableQueryValueInfo(int handle, + CCTK_INT *type_code, CCTK_INT *N_elements, + const char *key); + +/* misc stuff */ +int Util_TableDeleteKey(int handle, const char *key); + +/* convenience routines to create and/or set from a "parameter-file" string */ +int Util_TableCreateFromString(const char string[]); +int Util_TableSetFromString(int handle, const char string[]); + +/* set/get a C-style null-terminated character string */ +int Util_TableSetString(int handle, + const char *string, + const char *key); +int Util_TableGetString(int handle, + int buffer_length, char buffer[], + const char *key); + +/* set/get generic types described by CCTK_VARIABLE_* type codes */ +int Util_TableSetGeneric(int handle, + int type_code, const void *value_ptr, + const char *key); +int Util_TableSetGenericArray(int handle, + int type_code, int N_elements, const void *array, + const char *key); +int Util_TableGetGeneric(int handle, + int type_code, void *value_ptr, + const char *key); +int Util_TableGetGenericArray(int handle, + int type_code, int N_elements, void *array, + const char *key); + +/**************************************/ + +/* + * set routines + */ + +/* pointers */ +int Util_TableSetPointer(int handle, CCTK_POINTER value, const char *key); +int Util_TableSetPointerToConst(int handle, + CCTK_POINTER_TO_CONST value, + const char *key); +int Util_TableSetFPointer(int handle, CCTK_FPOINTER value, const char *key); +/* + * ... the following function (an alias for the previous one) is for + * backwards compatability only, and is deprecated as of 4.0beta13 + */ +int Util_TableSetFnPointer(int handle, CCTK_FPOINTER value, const char *key); + +/* a single character */ +int Util_TableSetChar(int handle, CCTK_CHAR value, const char *key); + +/* integers */ +int Util_TableSetByte(int handle, CCTK_BYTE value, const char *key); +int Util_TableSetInt(int handle, CCTK_INT value, const char *key); +#ifdef HAVE_CCTK_INT1 +int Util_TableSetInt1(int handle, CCTK_INT1 value, const char *key); +#endif +#ifdef HAVE_CCTK_INT2 +int Util_TableSetInt2(int handle, CCTK_INT2 value, const char *key); +#endif +#ifdef HAVE_CCTK_INT4 +int Util_TableSetInt4(int handle, CCTK_INT4 value, const char *key); +#endif +#ifdef HAVE_CCTK_INT8 +int Util_TableSetInt8(int handle, CCTK_INT8 value, const char *key); +#endif + +/* real numbers */ +int Util_TableSetReal(int handle, CCTK_REAL value, const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableSetReal4(int handle, CCTK_REAL4 value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableSetReal8(int handle, CCTK_REAL8 value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableSetReal16(int handle, CCTK_REAL16 value, const char *key); +#endif + +/* complex numbers */ +int Util_TableSetComplex(int handle, CCTK_COMPLEX value, const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableSetComplex8(int handle, CCTK_COMPLEX8 value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableSetComplex16(int handle, CCTK_COMPLEX16 value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableSetComplex32(int handle, CCTK_COMPLEX32 value, const char *key); +#endif + +/**************************************/ + +/* arrays of pointers */ +int Util_TableSetPointerArray(int handle, + int N_elements, const CCTK_POINTER array[], + const char *key); +int Util_TableSetPointerToConstArray(int handle, + int N_elements, + const CCTK_POINTER_TO_CONST array[], + const char *key); +int Util_TableSetFPointerArray(int handle, + int N_elements, const CCTK_FPOINTER array[], + const char *key); +/* + * ... the following function (an alias for the previous one) is for + * backwards compatability only, and is deprecated as of 4.0beta13 + */ +int Util_TableSetFnPointerArray(int handle, + int N_elements, const CCTK_FPOINTER array[], + const char *key); + +/* arrays of characters (i.e. character strings with known length) */ +/* note null termination is *not* required or enforced */ +int Util_TableSetCharArray(int handle, + int N_elements, const CCTK_CHAR array[], + const char *key); + +/* arrays of integers */ +int Util_TableSetByteArray(int handle, + int N_elements, const CCTK_BYTE array[], + const char *key); +int Util_TableSetIntArray(int handle, + int N_elements, const CCTK_INT array[], + const char *key); +#ifdef HAVE_CCTK_INT1 +int Util_TableSetInt1Array(int handle, + int N_elements, const CCTK_INT1 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT2 +int Util_TableSetInt2Array(int handle, + int N_elements, const CCTK_INT2 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT4 +int Util_TableSetInt4Array(int handle, + int N_elements, const CCTK_INT4 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT8 +int Util_TableSetInt8Array(int handle, + int N_elements, const CCTK_INT8 array[], + const char *key); +#endif + +/* arrays of real numbers */ +int Util_TableSetRealArray(int handle, + int N_elements, const CCTK_REAL array[], + const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableSetReal4Array(int handle, + int N_elements, const CCTK_REAL4 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableSetReal8Array(int handle, + int N_elements, const CCTK_REAL8 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableSetReal16Array(int handle, + int N_elements, const CCTK_REAL16 array[], + const char *key); +#endif + +/* arrays of complex numbers */ +int Util_TableSetComplexArray(int handle, + int N_elements, const CCTK_COMPLEX array[], + const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableSetComplex8Array(int handle, + int N_elements, const CCTK_COMPLEX8 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableSetComplex16Array(int handle, + int N_elements, const CCTK_COMPLEX16 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableSetComplex32Array(int handle, + int N_elements, const CCTK_COMPLEX32 array[], + const char *key); +#endif + +/**************************************/ + +/* + * get routines + */ + +/* pointers */ +int Util_TableGetPointer(int handle, CCTK_POINTER *value, const char *key); +int Util_TableGetPointerToConst(int handle, + CCTK_POINTER_TO_CONST *value, + const char *key); + +int Util_TableGetFPointer(int handle, CCTK_FPOINTER *value, const char *key); +/* + * ... the following function (an alias for the previous one) is for + * backwards compatability only, and is deprecated as of 4.0beta13 + */ +int Util_TableGetFnPointer(int handle, CCTK_FPOINTER *value, const char *key); + +/* a single character */ +int Util_TableGetChar(int handle, CCTK_CHAR *value, const char *key); + +/* integers */ +int Util_TableGetByte(int handle, CCTK_BYTE *value, const char *key); +int Util_TableGetInt(int handle, CCTK_INT *value, const char *key); +#ifdef HAVE_CCTK_INT1 +int Util_TableGetInt1(int handle, CCTK_INT1 *value, const char *key); +#endif +#ifdef HAVE_CCTK_INT2 +int Util_TableGetInt2(int handle, CCTK_INT2 *value, const char *key); +#endif +#ifdef HAVE_CCTK_INT4 +int Util_TableGetInt4(int handle, CCTK_INT4 *value, const char *key); +#endif +#ifdef HAVE_CCTK_INT8 +int Util_TableGetInt8(int handle, CCTK_INT8 *value, const char *key); +#endif + +/* real numbers */ +int Util_TableGetReal(int handle, CCTK_REAL *value, const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableGetReal4(int handle, CCTK_REAL4 *value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableGetReal8(int handle, CCTK_REAL8 *value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableGetReal16(int handle, CCTK_REAL16 *value, const char *key); +#endif + +/* complex numbers */ +int Util_TableGetComplex(int handle, CCTK_COMPLEX *value, const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableGetComplex8(int handle, CCTK_COMPLEX8 *value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableGetComplex16(int handle, CCTK_COMPLEX16 *value, const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableGetComplex32(int handle, CCTK_COMPLEX32 *value, const char *key); +#endif + +/**************************************/ + +/* arrays of pointers */ +int Util_TableGetPointerArray(int handle, + int N_elements, CCTK_POINTER array[], + const char *key); +int Util_TableGetPointerToConstArray(int handle, + int N_elements, + CCTK_POINTER_TO_CONST array[], + const char *key); + +int Util_TableGetFPointerArray(int handle, + int N_elements, CCTK_FPOINTER array[], + const char *key); +/* + * ... the following function (an alias for the previous one) is for + * backwards compatability only, and is deprecated as of 4.0beta13 + */ +int Util_TableGetFnPointerArray(int handle, + int N_elements, CCTK_FPOINTER array[], + const char *key); + +/* arrays of characters (i.e. character strings of known length) */ +/* note null termination is *not* required or enforced */ +int Util_TableGetCharArray(int handle, + int N_elements, CCTK_CHAR array[], + const char *key); + +/* integers */ +int Util_TableGetByteArray(int handle, + int N_elements, CCTK_BYTE array[], + const char *key); +int Util_TableGetIntArray(int handle, + int N_elements, CCTK_INT array[], + const char *key); +#ifdef HAVE_CCTK_INT1 +int Util_TableGetInt1Array(int handle, + int N_elements, CCTK_INT1 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT2 +int Util_TableGetInt2Array(int handle, + int N_elements, CCTK_INT2 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT4 +int Util_TableGetInt4Array(int handle, + int N_elements, CCTK_INT4 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_INT8 +int Util_TableGetInt8Array(int handle, + int N_elements, CCTK_INT8 array[], + const char *key); +#endif + +/* real numbers */ +int Util_TableGetRealArray(int handle, + int N_elements, CCTK_REAL array[], + const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableGetReal4Array(int handle, + int N_elements, CCTK_REAL4 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableGetReal8Array(int handle, + int N_elements, CCTK_REAL8 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableGetReal16Array(int handle, + int N_elements, CCTK_REAL16 array[], + const char *key); +#endif + +/* complex numbers */ +int Util_TableGetComplexArray(int handle, + int N_elements, CCTK_COMPLEX array[], + const char *key); +#ifdef HAVE_CCTK_REAL4 +int Util_TableGetComplex8Array(int handle, + int N_elements, CCTK_COMPLEX8 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL8 +int Util_TableGetComplex16Array(int handle, + int N_elements, CCTK_COMPLEX16 array[], + const char *key); +#endif +#ifdef HAVE_CCTK_REAL16 +int Util_TableGetComplex32Array(int handle, + int N_elements, CCTK_COMPLEX32 array[], + const char *key); +#endif + +/******************************************************************************/ +/***** Table Iterator API *****************************************************/ +/******************************************************************************/ + +/* create/destroy */ +int Util_TableItCreate(int handle); +int Util_TableItClone(int ihandle); +int Util_TableItDestroy(int ihandle); + +/* test for "null-pointer" state */ +int Util_TableItQueryIsNull(int ihandle); +int Util_TableItQueryIsNonNull(int ihandle); + +/* query what the iterator points to */ +int Util_TableItQueryTableHandle(int ihandle); +int Util_TableItQueryKeyValueInfo(int ihandle, + int key_buffer_length, char key_buffer[], + CCTK_INT *type_code, CCTK_INT *N_elements); + +/* change value of iterator */ +int Util_TableItAdvance(int ihandle); +int Util_TableItResetToStart(int ihandle); +int Util_TableItSetToNull(int ihandle); +int Util_TableItSetToKey(int ihandle, const char *key); + +/******************************************************************************/ +/******************************************************************************/ +/******************************************************************************/ + +#ifdef __cplusplus +} +#endif + +#endif /* _UTIL_TABLE_H_ */ diff --git a/AMSS_NCKU_source/var.C b/AMSS_NCKU_source/var.C new file mode 100644 index 0000000..47a98ff --- /dev/null +++ b/AMSS_NCKU_source/var.C @@ -0,0 +1,38 @@ + +#include +#include +#include +#include +#include +#include +#include +using namespace std; + +#include +#include + +#include "var.h" + +var::var(const char *namei, int sgfni, + const double SYM1, const double SYM2, const double SYM3) : sgfn(sgfni) +{ + const char *p = namei; + int i = 0; + while (*(p++)) + i++; + if (i > 20) + cout << "too long name for var: " << namei << endl; + sprintf(name, namei); + SoA[0] = SYM1; + SoA[1] = SYM2; + SoA[2] = SYM3; + + propspeed = 1; +} + +var::~var() {} + +void var::setpropspeed(const double vl) +{ + propspeed = vl; +} diff --git a/AMSS_NCKU_source/var.h b/AMSS_NCKU_source/var.h new file mode 100644 index 0000000..8d64a0c --- /dev/null +++ b/AMSS_NCKU_source/var.h @@ -0,0 +1,26 @@ + +#ifndef VAR_H +#define VAR_H + +class var +{ + +public: + char name[20]; + int sgfn; + double SoA[3]; + double propspeed; + +public: + var(const char *namei, int sgfni, + const double SYM1, const double SYM2, const double SYM3); + // original interface: + // var(char *namei, int sgfni, + // const double SYM1, const double SYM2, const double SYM3); + + ~var(); + + void setpropspeed(const double vl); +}; + +#endif /* VAR_H */ diff --git a/AMSS_NCKU_source/writefile_f.C b/AMSS_NCKU_source/writefile_f.C new file mode 100644 index 0000000..a4083b0 --- /dev/null +++ b/AMSS_NCKU_source/writefile_f.C @@ -0,0 +1,53 @@ +#include +#include +#include +#include "macrodef.h" +extern "C" +{ +#ifdef fortran1 + void writefile_f +#endif +#ifdef fortran2 + void WRITEFILE_F +#endif +#ifdef fortran3 + void + writefile_f_ +#endif + (int &filetag, double *matrix, int &msize) + { + char fname[32]; + char ftag[32]; + // itoa(filetag,ftag,10); + sprintf(ftag, "%d", filetag); + strcpy(fname, "matrix_f.out"); + strcat(fname, ftag); + + /*printf("-------------called-------------"); + printf(fname); + printf("\n"); + printf("int tag %d\n",filetag); + printf("int msize %d\n",msize); + printf(ftag);*/ + + printf("int msize %d\n", msize); + + FILE *fp; + fp = fopen(fname, "wb"); + // char buffer[1024]; + // buffer[1023]='\0'; + // int bsize; + + if (fp == NULL) + { + printf("Open file failed."); + exit(0); + } + + // msize = sizeof(double) * msize; + fwrite(matrix, sizeof(double), msize, fp); + + fclose(fp); + // return 0; + } +} diff --git a/AMSS_NCKU_source/z4c_rhs_point.C b/AMSS_NCKU_source/z4c_rhs_point.C new file mode 100644 index 0000000..73d54e1 --- /dev/null +++ b/AMSS_NCKU_source/z4c_rhs_point.C @@ -0,0 +1,2186 @@ + + +// Z4c rhs without advection term +#ifdef newc +#include +#include +#include +#include +#include +#include +#include +using namespace std; +#else +#include +#include +#include +#include +#include +#include +#include +#endif + +#include "macrodef.fh" + +#define Power(x, y) (pow((double)(x), (double)(y))) +#define Sqrt(x) sqrt(x) +#define Log(x) log((double)(x)) +#define pow2(x) ((x) * (x)) +#define pow3(x) ((x) * (x) * (x)) +#define pow4(x) ((x) * (x) * (x) * (x)) +#define pow2inv(x) (1.0 / ((x) * (x))) + +#define Cal(x, y, z) ((x) ? (y) : (z)) + +#define Tan(x) tan(x) +#define ArcTan(x) atan(x) +#define Sin(x) sin(x) +#define Cos(x) cos(x) +#define Csc(x) (1. / sin(x)) +#define Abs(x) (fabs(x)) +#define sqrt2 (sqrt(2)) +#define Tanh(x) tanh(x) +#define Sech(x) (1 / cosh(x)) + +extern "C" +{ + +#ifdef fortran1 + void z4c_rhs_point +#endif +#ifdef fortran2 + void Z4C_RHS_POINT +#endif +#ifdef fortran3 + void + z4c_rhs_point_ +#endif + (double &A11, + double &A12, + double &A13, + double &A22, + double &A23, + double &A33, + double &alpha, + double &B1, + double &B2, + double &B3, + double &beta1, + double &beta2, + double &beta3, + double &chi, + double &chiDivFloor, + double &da1, + double &dA111, + double &dA112, + double &dA113, + double &dA122, + double &dA123, + double &dA133, + double &da2, + double &dA211, + double &dA212, + double &dA213, + double &dA222, + double &dA223, + double &dA233, + double &da3, + double &dA311, + double &dA312, + double &dA313, + double &dA322, + double &dA323, + double &dA333, + double &db11, + double &dB11, + double &db12, + double &dB12, + double &db13, + double &dB13, + double &db21, + double &dB21, + double &db22, + double &dB22, + double &db23, + double &dB23, + double &db31, + double &dB31, + double &db32, + double &dB32, + double &db33, + double &dB33, + double &dchi1, + double &dchi2, + double &dchi3, + double &dda11, + double &dda12, + double &dda13, + double &dda22, + double &dda23, + double &dda33, + double &ddb111, + double &ddb112, + double &ddb113, + double &ddb121, + double &ddb122, + double &ddb123, + double &ddb131, + double &ddb132, + double &ddb133, + double &ddb221, + double &ddb222, + double &ddb223, + double &ddb231, + double &ddb232, + double &ddb233, + double &ddb331, + double &ddb332, + double &ddb333, + double &ddchi11, + double &ddchi12, + double &ddchi13, + double &ddchi22, + double &ddchi23, + double &ddchi33, + double &deldelg1111, + double &deldelg1112, + double &deldelg1113, + double &deldelg1122, + double &deldelg1123, + double &deldelg1133, + double &deldelg1211, + double &deldelg1212, + double &deldelg1213, + double &deldelg1222, + double &deldelg1223, + double &deldelg1233, + double &deldelg1311, + double &deldelg1312, + double &deldelg1313, + double &deldelg1322, + double &deldelg1323, + double &deldelg1333, + double &deldelg2211, + double &deldelg2212, + double &deldelg2213, + double &deldelg2222, + double &deldelg2223, + double &deldelg2233, + double &deldelg2311, + double &deldelg2312, + double &deldelg2313, + double &deldelg2322, + double &deldelg2323, + double &deldelg2333, + double &deldelg3311, + double &deldelg3312, + double &deldelg3313, + double &deldelg3322, + double &deldelg3323, + double &deldelg3333, + double &delG11, + double &delg111, + double &delg112, + double &delg113, + double &delG12, + double &delg122, + double &delg123, + double &delG13, + double &delg133, + double &delG21, + double &delg211, + double &delg212, + double &delg213, + double &delG22, + double &delg222, + double &delg223, + double &delG23, + double &delg233, + double &delG31, + double &delg311, + double &delg312, + double &delg313, + double &delG32, + double &delg322, + double &delg323, + double &delG33, + double &delg333, + double &dKhat1, + double &dKhat2, + double &dKhat3, + double &dTheta1, + double &dTheta2, + double &dTheta3, + double &G1, + double &g11, + double &g12, + double &g13, + double &G2, + double &g22, + double &g23, + double &G3, + double &g33, + double &kappa1, + double &kappa2, + double &Khat, + double &rA11, + double &rA12, + double &rA13, + double &rA22, + double &rA23, + double &rA33, + double &rchi, + double &rG1, + double &rg11, + double &rg12, + double &rg13, + double &rG2, + double &rg22, + double &rg23, + double &rG3, + double &rg33, + double &rKhat, + double &rTheta, + double &Theta) + { + + double AA11; + double AA12; + double AA13; + double AA22; + double AA23; + double AA33; + double Ainv11; + double Ainv12; + double Ainv13; + double Ainv22; + double Ainv23; + double Ainv33; + double cAA; + double cdda11; + double cdda12; + double cdda13; + double cdda22; + double cdda23; + double cdda33; + double cddf11; + double cddf12; + double cddf13; + double cddf22; + double cddf23; + double cddf33; + double chiguard; + double chiguarded; + double chipsipower; + double ddf11; + double ddf12; + double ddf13; + double ddf22; + double ddf23; + double ddf33; + double detginv; + double df1; + double df2; + double df3; + double dGd11; + double dGd12; + double dGd13; + double dGd21; + double dGd22; + double dGd23; + double dGd31; + double dGd32; + double dGd33; + double dginv111; + double dginv112; + double dginv113; + double dginv122; + double dginv123; + double dginv133; + double dginv211; + double dginv212; + double dginv213; + double dginv222; + double dginv223; + double dginv233; + double dginv311; + double dginv312; + double dginv313; + double dginv322; + double dginv323; + double dginv333; + double divAinv1; + double divAinv2; + double divAinv3; + double divbeta; + double dK1; + double dK2; + double dK3; + double dphi1; + double dphi2; + double dphi3; + double dZ11; + double DZ11; + double dZ12; + double DZ12; + double dZ13; + double DZ13; + double dZ21; + double DZ21; + double dZ22; + double DZ22; + double dZ23; + double DZ23; + double dZ31; + double DZ31; + double dZ32; + double DZ32; + double dZ33; + double DZ33; + double dZinv11; + double DZinv11; + double dZinv12; + double DZinv12; + double dZinv13; + double DZinv13; + double dZinv21; + double DZinv21; + double dZinv22; + double DZinv22; + double dZinv23; + double DZinv23; + double dZinv31; + double DZinv31; + double dZinv32; + double DZinv32; + double dZinv33; + double DZinv33; + double DZsym11; + double DZsym12; + double DZsym13; + double DZsym21; + double DZsym22; + double DZsym23; + double DZsym31; + double DZsym32; + double DZsym33; + double f; + double ff; + double gamma111; + double gamma112; + double gamma113; + double gamma122; + double gamma123; + double gamma133; + double gamma211; + double gamma212; + double gamma213; + double gamma222; + double gamma223; + double gamma233; + double gamma311; + double gamma312; + double gamma313; + double gamma322; + double gamma323; + double gamma333; + double gammado111; + double gammado112; + double gammado113; + double gammado122; + double gammado123; + double gammado133; + double gammado211; + double gammado212; + double gammado213; + double gammado222; + double gammado223; + double gammado233; + double gammado311; + double gammado312; + double gammado313; + double gammado322; + double gammado323; + double gammado333; + double gammaF111; + double gammaF112; + double gammaF113; + double gammaF121; + double gammaF122; + double gammaF123; + double gammaF131; + double gammaF132; + double gammaF133; + double gammaF211; + double gammaF212; + double gammaF213; + double gammaF221; + double gammaF222; + double gammaF223; + double gammaF231; + double gammaF232; + double gammaF233; + double gammaF311; + double gammaF312; + double gammaF313; + double gammaF321; + double gammaF322; + double gammaF323; + double gammaF331; + double gammaF332; + double gammaF333; + double Gd1; + double Gd2; + double Gd3; + double Gfromg1; + double Gfromg2; + double Gfromg3; + double ginv11; + double ginv12; + double ginv13; + double ginv22; + double ginv23; + double ginv33; + double Hhat; + double K; + double lieA11; + double lieA12; + double lieA13; + double lieA22; + double lieA23; + double lieA33; + double liechi; + double lieg11; + double lieg12; + double lieg13; + double lieg22; + double lieg23; + double lieg33; + double oochipsipower; + double ootddivbeta1; + double ootddivbeta2; + double ootddivbeta3; + double pseudolieG1; + double pseudolieG2; + double pseudolieG3; + double psim4; + double R11; + double R12; + double R13; + double R22; + double R23; + double R33; + double Rhat; + double Rphi11; + double Rphi12; + double Rphi13; + double Rphi22; + double Rphi23; + double Rphi33; + double totdivbeta; + double trcdda; + double trcddf; + double trDZsym; + double Z1; + double Z2; + double Z3; + double Zinv1; + double Zinv2; + double Zinv3; + + chipsipower = + -4.; + + K = + Khat + 2. * Theta; + + dK1 = + dKhat1 + 2. * dTheta1; + + dK2 = + dKhat2 + 2. * dTheta2; + + dK3 = + dKhat3 + 2. * dTheta3; + + detginv = + 1 / (2. * g12 * g13 * g23 - g33 * pow2(g12) + g22 * (g11 * g33 - pow2(g13)) - + g11 * pow2(g23)); + + ginv11 = + detginv * (g22 * g33 - pow2(g23)); + + ginv12 = + detginv * (g13 * g23 - g12 * g33); + + ginv13 = + detginv * (-(g13 * g22) + g12 * g23); + + ginv22 = + detginv * (g11 * g33 - pow2(g13)); + + ginv23 = + detginv * (g12 * g13 - g11 * g23); + + ginv33 = + detginv * (g11 * g22 - pow2(g12)); + + dginv111 = + -2. * (delg123 * ginv12 * ginv13 + ginv11 * (delg112 * ginv12 + delg113 * ginv13)) - + delg111 * pow2(ginv11) - delg122 * pow2(ginv12) - delg133 * pow2(ginv13); + + dginv112 = + -(ginv11 * (delg111 * ginv12 + delg112 * ginv22 + delg113 * ginv23)) - + ginv12 * (delg113 * ginv13 + delg122 * ginv22 + delg123 * ginv23) - + ginv13 * (delg123 * ginv22 + delg133 * ginv23) - delg112 * pow2(ginv12); + + dginv113 = + -(ginv11 * (delg111 * ginv13 + delg112 * ginv23 + delg113 * ginv33)) - + ginv12 * (delg112 * ginv13 + delg122 * ginv23 + delg123 * ginv33) - + ginv13 * (delg123 * ginv23 + delg133 * ginv33) - delg113 * pow2(ginv13); + + dginv122 = + -2. * (delg123 * ginv22 * ginv23 + ginv12 * (delg112 * ginv22 + delg113 * ginv23)) - + delg111 * pow2(ginv12) - delg122 * pow2(ginv22) - delg133 * pow2(ginv23); + + dginv123 = + -(ginv13 * (delg112 * ginv22 + delg113 * ginv23)) - delg133 * ginv23 * ginv33 - + ginv12 * (delg111 * ginv13 + delg112 * ginv23 + delg113 * ginv33) - + ginv22 * (delg122 * ginv23 + delg123 * ginv33) - delg123 * pow2(ginv23); + + dginv133 = + -2. * (delg123 * ginv23 * ginv33 + ginv13 * (delg112 * ginv23 + delg113 * ginv33)) - + delg111 * pow2(ginv13) - delg122 * pow2(ginv23) - delg133 * pow2(ginv33); + + dginv211 = + -2. * (delg223 * ginv12 * ginv13 + ginv11 * (delg212 * ginv12 + delg213 * ginv13)) - + delg211 * pow2(ginv11) - delg222 * pow2(ginv12) - delg233 * pow2(ginv13); + + dginv212 = + -(ginv11 * (delg211 * ginv12 + delg212 * ginv22 + delg213 * ginv23)) - + ginv12 * (delg213 * ginv13 + delg222 * ginv22 + delg223 * ginv23) - + ginv13 * (delg223 * ginv22 + delg233 * ginv23) - delg212 * pow2(ginv12); + + dginv213 = + -(ginv11 * (delg211 * ginv13 + delg212 * ginv23 + delg213 * ginv33)) - + ginv12 * (delg212 * ginv13 + delg222 * ginv23 + delg223 * ginv33) - + ginv13 * (delg223 * ginv23 + delg233 * ginv33) - delg213 * pow2(ginv13); + + dginv222 = + -2. * (delg223 * ginv22 * ginv23 + ginv12 * (delg212 * ginv22 + delg213 * ginv23)) - + delg211 * pow2(ginv12) - delg222 * pow2(ginv22) - delg233 * pow2(ginv23); + + dginv223 = + -(ginv13 * (delg212 * ginv22 + delg213 * ginv23)) - delg233 * ginv23 * ginv33 - + ginv12 * (delg211 * ginv13 + delg212 * ginv23 + delg213 * ginv33) - + ginv22 * (delg222 * ginv23 + delg223 * ginv33) - delg223 * pow2(ginv23); + + dginv233 = + -2. * (delg223 * ginv23 * ginv33 + ginv13 * (delg212 * ginv23 + delg213 * ginv33)) - + delg211 * pow2(ginv13) - delg222 * pow2(ginv23) - delg233 * pow2(ginv33); + + dginv311 = + -2. * (delg323 * ginv12 * ginv13 + ginv11 * (delg312 * ginv12 + delg313 * ginv13)) - + delg311 * pow2(ginv11) - delg322 * pow2(ginv12) - delg333 * pow2(ginv13); + + dginv312 = + -(ginv11 * (delg311 * ginv12 + delg312 * ginv22 + delg313 * ginv23)) - + ginv12 * (delg313 * ginv13 + delg322 * ginv22 + delg323 * ginv23) - + ginv13 * (delg323 * ginv22 + delg333 * ginv23) - delg312 * pow2(ginv12); + + dginv313 = + -(ginv11 * (delg311 * ginv13 + delg312 * ginv23 + delg313 * ginv33)) - + ginv12 * (delg312 * ginv13 + delg322 * ginv23 + delg323 * ginv33) - + ginv13 * (delg323 * ginv23 + delg333 * ginv33) - delg313 * pow2(ginv13); + + dginv322 = + -2. * (delg323 * ginv22 * ginv23 + ginv12 * (delg312 * ginv22 + delg313 * ginv23)) - + delg311 * pow2(ginv12) - delg322 * pow2(ginv22) - delg333 * pow2(ginv23); + + dginv323 = + -(ginv13 * (delg312 * ginv22 + delg313 * ginv23)) - delg333 * ginv23 * ginv33 - + ginv12 * (delg311 * ginv13 + delg312 * ginv23 + delg313 * ginv33) - + ginv22 * (delg322 * ginv23 + delg323 * ginv33) - delg323 * pow2(ginv23); + + dginv333 = + -2. * (delg323 * ginv23 * ginv33 + ginv13 * (delg312 * ginv23 + delg313 * ginv33)) - + delg311 * pow2(ginv13) - delg322 * pow2(ginv23) - delg333 * pow2(ginv33); + + gammado111 = + 0.5 * delg111; + + gammado112 = + 0.5 * delg211; + + gammado113 = + 0.5 * delg311; + + gammado122 = + -0.5 * delg122 + delg212; + + gammado123 = + 0.5 * (-delg123 + delg213 + delg312); + + gammado133 = + -0.5 * delg133 + delg313; + + gammado211 = + delg112 - 0.5 * delg211; + + gammado212 = + 0.5 * delg122; + + gammado213 = + 0.5 * (delg123 - delg213 + delg312); + + gammado222 = + 0.5 * delg222; + + gammado223 = + 0.5 * delg322; + + gammado233 = + -0.5 * delg233 + delg323; + + gammado311 = + delg113 - 0.5 * delg311; + + gammado312 = + 0.5 * (delg123 + delg213 - delg312); + + gammado313 = + 0.5 * delg133; + + gammado322 = + delg223 - 0.5 * delg322; + + gammado323 = + 0.5 * delg233; + + gammado333 = + 0.5 * delg333; + + gamma111 = + gammado111 * ginv11 + gammado211 * ginv12 + gammado311 * ginv13; + + gamma112 = + gammado112 * ginv11 + gammado212 * ginv12 + gammado312 * ginv13; + + gamma113 = + gammado113 * ginv11 + gammado213 * ginv12 + gammado313 * ginv13; + + gamma122 = + gammado122 * ginv11 + gammado222 * ginv12 + gammado322 * ginv13; + + gamma123 = + gammado123 * ginv11 + gammado223 * ginv12 + gammado323 * ginv13; + + gamma133 = + gammado133 * ginv11 + gammado233 * ginv12 + gammado333 * ginv13; + + gamma211 = + gammado111 * ginv12 + gammado211 * ginv22 + gammado311 * ginv23; + + gamma212 = + gammado112 * ginv12 + gammado212 * ginv22 + gammado312 * ginv23; + + gamma213 = + gammado113 * ginv12 + gammado213 * ginv22 + gammado313 * ginv23; + + gamma222 = + gammado122 * ginv12 + gammado222 * ginv22 + gammado322 * ginv23; + + gamma223 = + gammado123 * ginv12 + gammado223 * ginv22 + gammado323 * ginv23; + + gamma233 = + gammado133 * ginv12 + gammado233 * ginv22 + gammado333 * ginv23; + + gamma311 = + gammado111 * ginv13 + gammado211 * ginv23 + gammado311 * ginv33; + + gamma312 = + gammado112 * ginv13 + gammado212 * ginv23 + gammado312 * ginv33; + + gamma313 = + gammado113 * ginv13 + gammado213 * ginv23 + gammado313 * ginv33; + + gamma322 = + gammado122 * ginv13 + gammado222 * ginv23 + gammado322 * ginv33; + + gamma323 = + gammado123 * ginv13 + gammado223 * ginv23 + gammado323 * ginv33; + + gamma333 = + gammado133 * ginv13 + gammado233 * ginv23 + gammado333 * ginv33; + + Gfromg1 = + gamma111 * ginv11 + gamma122 * ginv22 + + 2. * (gamma112 * ginv12 + gamma113 * ginv13 + gamma123 * ginv23) + gamma133 * ginv33; + + Gfromg2 = + gamma211 * ginv11 + gamma222 * ginv22 + + 2. * (gamma212 * ginv12 + gamma213 * ginv13 + gamma223 * ginv23) + gamma233 * ginv33; + + Gfromg3 = + gamma311 * ginv11 + gamma322 * ginv22 + + 2. * (gamma312 * ginv12 + gamma313 * ginv13 + gamma323 * ginv23) + gamma333 * ginv33; + + R11 = + delG11 * g11 + delG12 * g12 + delG13 * g13 + gammado111 * Gfromg1 + + gammado112 * Gfromg2 + gammado113 * Gfromg3 + + (-0.5 * deldelg1111 + 3. * gamma111 * gammado111 + + 2. * (gamma211 * gammado112 + gamma311 * gammado113) + + gamma211 * gammado211 + gamma311 * gammado311) * + ginv11 + + (-deldelg1211 + 3. * (gamma112 * gammado111 + gamma111 * gammado112) + + 2. * (gamma212 * gammado112 + gamma312 * gammado113 + + gamma211 * gammado122 + gamma311 * gammado123) + + gamma212 * gammado211 + + gamma211 * gammado212 + gamma312 * gammado311 + gamma311 * gammado312) * + ginv12 + + (-deldelg1311 + 3. * (gamma113 * gammado111 + gamma111 * gammado113) + + 2. * (gamma213 * gammado112 + gamma313 * gammado113 + + gamma211 * gammado123 + gamma311 * gammado133) + + gamma213 * gammado211 + + gamma211 * gammado213 + gamma313 * gammado311 + gamma311 * gammado313) * + ginv13 + + (-0.5 * deldelg2211 + 3. * gamma112 * gammado112 + + 2. * (gamma212 * gammado122 + gamma312 * gammado123) + + gamma212 * gammado212 + gamma312 * gammado312) * + ginv22 + + (-deldelg2311 + 3. * (gamma113 * gammado112 + gamma112 * gammado113) + + 2. * (gamma213 * gammado122 + (gamma212 + gamma313) * gammado123 + + gamma312 * gammado133) + + gamma213 * gammado212 + gamma212 * gammado213 + + gamma313 * gammado312 + gamma312 * gammado313) * + ginv23 + + (-0.5 * deldelg3311 + 3. * gamma113 * gammado113 + + 2. * (gamma213 * gammado123 + gamma313 * gammado133) + gamma213 * gammado213 + + gamma313 * gammado313) * + ginv33; + + R12 = + 0.5 * (delG21 * g11 + (delG11 + delG22) * g12 + delG23 * g13 + delG12 * g22 + + delG13 * g23 + (gammado112 + gammado211) * Gfromg1 + + (gammado122 + gammado212) * Gfromg2 + (gammado123 + gammado213) * Gfromg3) + + (-0.5 * deldelg1112 + gamma112 * gammado111 + + (gamma111 + gamma212) * gammado112 + gamma312 * gammado113 + + gamma111 * gammado211 + 2. * gamma211 * gammado212 + + gamma311 * (gammado213 + gammado312)) * + ginv11 + + (-deldelg1212 + gamma122 * gammado111 + + (2. * gamma112 + gamma222) * gammado112 + gamma322 * gammado113 + + (gamma111 + gamma212) * gammado122 + gamma112 * gammado211 + + (gamma111 + 2. * gamma212) * gammado212 + 2. * gamma211 * gammado222 + + gamma312 * (gammado123 + gammado213 + gammado312) + + gamma311 * (gammado223 + gammado322)) * + ginv12 + + (-deldelg1312 + gamma123 * gammado111 + (gamma113 + gamma223) * gammado112 + + (gamma112 + gamma323) * gammado113 + (gamma111 + gamma212) * gammado123 + + gamma312 * gammado133 + gamma113 * gammado211 + + (gamma111 + gamma313) * gammado213 + + 2. * (gamma213 * gammado212 + gamma211 * gammado223) + + gamma313 * gammado312 + gamma311 * (gammado233 + gammado323)) * + ginv13 + + (-0.5 * deldelg2212 + gamma122 * gammado112 + + (gamma112 + gamma222) * gammado122 + gamma322 * gammado123 + + gamma112 * gammado212 + 2. * gamma212 * gammado222 + + gamma312 * (gammado223 + gammado322)) * + ginv22 + + (-deldelg2312 + gamma123 * gammado112 + gamma122 * gammado113 + + (gamma113 + gamma223) * gammado122 + + (gamma112 + gamma222 + gamma323) * gammado123 + gamma322 * gammado133 + + gamma113 * gammado212 + gamma112 * gammado213 + + 2. * (gamma213 * gammado222 + gamma212 * gammado223) + + gamma313 * (gammado223 + gammado322) + + gamma312 * (gammado233 + gammado323)) * + ginv23 + + (-0.5 * deldelg3312 + gamma123 * gammado113 + + (gamma113 + gamma223) * gammado123 + gamma323 * gammado133 + + gamma113 * gammado213 + 2. * gamma213 * gammado223 + + gamma313 * (gammado233 + gammado323)) * + ginv33; + + R13 = + 0.5 * (delG31 * g11 + delG32 * g12 + (delG11 + delG33) * g13 + delG12 * g23 + + delG13 * g33 + (gammado113 + gammado311) * Gfromg1 + + (gammado123 + gammado312) * Gfromg2 + (gammado133 + gammado313) * Gfromg3) + + (-0.5 * deldelg1113 + gamma113 * gammado111 + gamma213 * gammado112 + + (gamma111 + gamma313) * gammado113 + gamma111 * gammado311 + + gamma211 * (gammado213 + gammado312) + 2. * gamma311 * gammado313) * + ginv11 + + (-deldelg1213 + gamma123 * gammado111 + (gamma113 + gamma223) * gammado112 + + (gamma112 + gamma323) * gammado113 + gamma213 * gammado122 + + (gamma111 + gamma313) * gammado123 + gamma112 * gammado311 + + gamma111 * gammado312 + gamma212 * (gammado213 + gammado312) + + gamma211 * (gammado223 + gammado322) + + 2. * (gamma312 * gammado313 + gamma311 * gammado323)) * + ginv12 + + (-deldelg1313 + gamma133 * gammado111 + gamma233 * gammado112 + + (2. * gamma113 + gamma333) * gammado113 + + (gamma111 + gamma313) * gammado133 + gamma113 * gammado311 + + gamma213 * (gammado123 + gammado213 + gammado312) + + (gamma111 + 2. * gamma313) * gammado313 + + gamma211 * (gammado233 + gammado323) + 2. * gamma311 * gammado333) * + ginv13 + + (-0.5 * deldelg2213 + gamma123 * gammado112 + gamma223 * gammado122 + + (gamma112 + gamma323) * gammado123 + gamma112 * gammado312 + + gamma212 * (gammado223 + gammado322) + 2. * gamma312 * gammado323) * + ginv22 + + (-deldelg2313 + gamma133 * gammado112 + gamma123 * gammado113 + + gamma233 * gammado122 + (gamma113 + gamma223 + gamma333) * gammado123 + + (gamma112 + gamma323) * gammado133 + gamma113 * gammado312 + + gamma112 * gammado313 + gamma213 * (gammado223 + gammado322) + + gamma212 * (gammado233 + gammado323) + + 2. * (gamma313 * gammado323 + gamma312 * gammado333)) * + ginv23 + + (-0.5 * deldelg3313 + gamma133 * gammado113 + gamma233 * gammado123 + + (gamma113 + gamma333) * gammado133 + gamma113 * gammado313 + + gamma213 * (gammado233 + gammado323) + 2. * gamma313 * gammado333) * + ginv33; + + R22 = + delG21 * g12 + delG22 * g22 + delG23 * g23 + gammado212 * Gfromg1 + + gammado222 * Gfromg2 + gammado223 * Gfromg3 + + (-0.5 * deldelg1122 + gamma112 * (gammado112 + 2. * gammado211) + + 3. * gamma212 * gammado212 + gamma312 * (2. * gammado213 + gammado312)) * + ginv11 + + (-deldelg1222 + gamma122 * (gammado112 + 2. * gammado211) + + gamma112 * (gammado122 + 2. * gammado212) + + 3. * (gamma222 * gammado212 + gamma212 * gammado222) + + 2. * (gamma322 * gammado213 + gamma312 * gammado223) + + gamma322 * gammado312 + gamma312 * gammado322) * + ginv12 + + (-deldelg1322 + gamma123 * (gammado112 + 2. * gammado211) + + gamma112 * (gammado123 + 2. * gammado213) + + 3. * (gamma223 * gammado212 + gamma212 * gammado223) + + 2. * (gamma323 * gammado213 + gamma312 * gammado233) + + gamma323 * gammado312 + gamma312 * gammado323) * + ginv13 + + (-0.5 * deldelg2222 + gamma122 * (gammado122 + 2. * gammado212) + + 3. * gamma222 * gammado222 + gamma322 * (2. * gammado223 + gammado322)) * + ginv22 + + (-deldelg2322 + gamma123 * (gammado122 + 2. * gammado212) + + gamma122 * (gammado123 + 2. * gammado213) + + 3. * (gamma223 * gammado222 + gamma222 * gammado223) + + 2. * (gamma323 * gammado223 + gamma322 * gammado233) + + gamma323 * gammado322 + gamma322 * gammado323) * + ginv23 + + (-0.5 * deldelg3322 + gamma123 * (gammado123 + 2. * gammado213) + + 3. * gamma223 * gammado223 + gamma323 * (2. * gammado233 + gammado323)) * + ginv33; + + R23 = + 0.5 * (delG31 * g12 + delG21 * g13 + delG32 * g22 + (delG22 + delG33) * g23 + + delG23 * g33 + (gammado213 + gammado312) * Gfromg1 + + (gammado223 + gammado322) * Gfromg2 + (gammado233 + gammado323) * Gfromg3) + + (-0.5 * deldelg1123 + gamma113 * gammado211 + gamma213 * gammado212 + + (gamma212 + gamma313) * gammado213 + + gamma112 * (gammado113 + gammado311) + gamma212 * gammado312 + + 2. * gamma312 * gammado313) * + ginv11 + + (-deldelg1223 + gamma123 * gammado211 + (gamma113 + gamma223) * gammado212 + + (gamma222 + gamma323) * gammado213 + gamma213 * gammado222 + + (gamma212 + gamma313) * gammado223 + + gamma122 * (gammado113 + gammado311) + gamma222 * gammado312 + + gamma112 * (gammado123 + gammado312) + gamma212 * gammado322 + + 2. * (gamma322 * gammado313 + gamma312 * gammado323)) * + ginv12 + + (-deldelg1323 + gamma133 * gammado211 + gamma233 * gammado212 + + (gamma113 + gamma223 + gamma333) * gammado213 + gamma213 * gammado223 + + (gamma212 + gamma313) * gammado233 + + gamma123 * (gammado113 + gammado311) + gamma223 * gammado312 + + gamma112 * (gammado133 + gammado313) + gamma212 * gammado323 + + 2. * (gamma323 * gammado313 + gamma312 * gammado333)) * + ginv13 + + (-0.5 * deldelg2223 + gamma123 * gammado212 + gamma223 * gammado222 + + (gamma222 + gamma323) * gammado223 + + gamma122 * (gammado123 + gammado312) + gamma222 * gammado322 + + 2. * gamma322 * gammado323) * + ginv22 + + (-deldelg2323 + gamma133 * gammado212 + gamma233 * gammado222 + + (2. * gamma223 + gamma333) * gammado223 + + (gamma222 + gamma323) * gammado233 + + gamma123 * (gammado123 + gammado213 + gammado312) + + gamma122 * (gammado133 + gammado313) + gamma223 * gammado322 + + (gamma222 + 2. * gamma323) * gammado323 + 2. * gamma322 * gammado333) * + ginv23 + + (-0.5 * deldelg3323 + gamma133 * gammado213 + gamma233 * gammado223 + + (gamma223 + gamma333) * gammado233 + + gamma123 * (gammado133 + gammado313) + gamma223 * gammado323 + + 2. * gamma323 * gammado333) * + ginv33; + + R33 = + delG31 * g13 + delG32 * g23 + delG33 * g33 + gammado313 * Gfromg1 + + gammado323 * Gfromg2 + gammado333 * Gfromg3 + + (-0.5 * deldelg1133 + gamma113 * (gammado113 + 2. * gammado311) + + gamma213 * (gammado213 + 2. * gammado312) + 3. * gamma313 * gammado313) * + ginv11 + + (-deldelg1233 + gamma123 * (gammado113 + 2. * gammado311) + + gamma113 * (gammado123 + 2. * gammado312) + + gamma223 * (gammado213 + 2. * gammado312) + + gamma213 * (gammado223 + 2. * gammado322) + + 3. * (gamma323 * gammado313 + gamma313 * gammado323)) * + ginv12 + + (-deldelg1333 + gamma133 * (gammado113 + 2. * gammado311) + + gamma233 * (gammado213 + 2. * gammado312) + + gamma113 * (gammado133 + 2. * gammado313) + + gamma213 * (gammado233 + 2. * gammado323) + + 3. * (gamma333 * gammado313 + gamma313 * gammado333)) * + ginv13 + + (-0.5 * deldelg2233 + gamma123 * (gammado123 + 2. * gammado312) + + gamma223 * (gammado223 + 2. * gammado322) + 3. * gamma323 * gammado323) * + ginv22 + + (-deldelg2333 + gamma133 * (gammado123 + 2. * gammado312) + + gamma123 * (gammado133 + 2. * gammado313) + + gamma233 * (gammado223 + 2. * gammado322) + + gamma223 * (gammado233 + 2. * gammado323) + + 3. * (gamma333 * gammado323 + gamma323 * gammado333)) * + ginv23 + + (-0.5 * deldelg3333 + gamma133 * (gammado133 + 2. * gammado313) + + gamma233 * (gammado233 + 2. * gammado323) + 3. * gamma333 * gammado333) * + ginv33; + + chiguard = + chiDivFloor; + + chiguarded = + chi; + + if (chiguarded < chiguard) + chiguarded = chiguard; + + ff = + chiguarded; + + oochipsipower = + 1 / chipsipower; + + f = + oochipsipower * log(ff); + + psim4 = + exp(-4. * f); + + df1 = + (dchi1 * oochipsipower) / chiguarded; + + df2 = + (dchi2 * oochipsipower) / chiguarded; + + df3 = + (dchi3 * oochipsipower) / chiguarded; + + ddf11 = + (ddchi11 * oochipsipower) / chiguarded - chipsipower * pow2(df1); + + ddf12 = + -(chipsipower * df1 * df2) + (ddchi12 * oochipsipower) / chiguarded; + + ddf13 = + -(chipsipower * df1 * df3) + (ddchi13 * oochipsipower) / chiguarded; + + ddf22 = + (ddchi22 * oochipsipower) / chiguarded - chipsipower * pow2(df2); + + ddf23 = + -(chipsipower * df2 * df3) + (ddchi23 * oochipsipower) / chiguarded; + + ddf33 = + (ddchi33 * oochipsipower) / chiguarded - chipsipower * pow2(df3); + + cddf11 = + ddf11 - df1 * gamma111 - df2 * gamma211 - df3 * gamma311; + + cddf12 = + ddf12 - df1 * gamma112 - df2 * gamma212 - df3 * gamma312; + + cddf13 = + ddf13 - df1 * gamma113 - df2 * gamma213 - df3 * gamma313; + + cddf22 = + ddf22 - df1 * gamma122 - df2 * gamma222 - df3 * gamma322; + + cddf23 = + ddf23 - df1 * gamma123 - df2 * gamma223 - df3 * gamma323; + + cddf33 = + ddf33 - df1 * gamma133 - df2 * gamma233 - df3 * gamma333; + + trcddf = + cddf11 * ginv11 + cddf22 * ginv22 + + 2. * (cddf12 * ginv12 + cddf13 * ginv13 + cddf23 * ginv23) + cddf33 * ginv33; + + Rphi11 = + -2. * (cddf11 + g11 * trcddf) + (4. - 4. * g11 * ginv11) * pow2(df1) - + g11 * (8. * (df1 * (df2 * ginv12 + df3 * ginv13) + df2 * df3 * ginv23) + + 4. * (ginv22 * pow2(df2) + ginv33 * pow2(df3))); + + Rphi12 = + df1 * df2 * (4. - 8. * g12 * ginv12) - 2. * (cddf12 + g12 * trcddf) - + g12 * (8. * df3 * (df1 * ginv13 + df2 * ginv23) + + 4. * (ginv11 * pow2(df1) + ginv22 * pow2(df2) + ginv33 * pow2(df3))); + + Rphi13 = + df1 * (4. * df3 - 8. * df2 * g13 * ginv12) - 2. * (cddf13 + g13 * trcddf) - + g13 * (8. * df3 * (df1 * ginv13 + df2 * ginv23) + + 4. * (ginv11 * pow2(df1) + ginv22 * pow2(df2) + ginv33 * pow2(df3))); + + Rphi22 = + -2. * (cddf22 + g22 * trcddf) + (4. - 4. * g22 * ginv22) * pow2(df2) - + g22 * (8. * (df1 * (df2 * ginv12 + df3 * ginv13) + df2 * df3 * ginv23) + + 4. * (ginv11 * pow2(df1) + ginv33 * pow2(df3))); + + Rphi23 = + df2 * (-8. * df1 * g23 * ginv12 + df3 * (4. - 8. * g23 * ginv23)) - + 2. * (cddf23 + g23 * trcddf) - g23 * (8. * df1 * df3 * ginv13 + 4. * (ginv11 * pow2(df1) + ginv22 * pow2(df2) + ginv33 * pow2(df3))); + + Rphi33 = + -2. * (cddf33 + g33 * trcddf) - g33 * (8. * (df1 * (df2 * ginv12 + df3 * ginv13) + df2 * df3 * ginv23) + 4. * (ginv11 * pow2(df1) + ginv22 * pow2(df2))) + + (4. - 4. * g33 * ginv33) * pow2(df3); + + cdda11 = + dda11 - da2 * gamma211 - da3 * gamma311 + + da1 * (-gamma111 + df1 * (-4. + 2. * g11 * ginv11)) + + 2. * g11 * ((da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33); + + cdda12 = + dda12 - da1 * gamma112 - da2 * gamma212 - da3 * gamma312 + + 2. * (-(da2 * df1) - da1 * df2 + g12 * (da1 * df1 * ginv11 + (da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33)); + + cdda13 = + dda13 - da1 * gamma113 - da2 * gamma213 - da3 * gamma313 + + 2. * (-(da3 * df1) - da1 * df3 + g13 * (da1 * df1 * ginv11 + (da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33)); + + cdda22 = + dda22 - da1 * gamma122 - da2 * (4. * df2 + gamma222) - da3 * gamma322 + + 2. * g22 * (da1 * df1 * ginv11 + (da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33); + + cdda23 = + dda23 - da1 * gamma123 - da2 * gamma223 - da3 * gamma323 + + 2. * (-(da3 * df2) - da2 * df3 + g23 * (da1 * df1 * ginv11 + (da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33)); + + cdda33 = + dda33 - da1 * gamma133 - da2 * gamma233 - da3 * (4. * df3 + gamma333) + + 2. * g33 * (da1 * df1 * ginv11 + (da2 * df1 + da1 * df2) * ginv12 + (da3 * df1 + da1 * df3) * ginv13 + da2 * df2 * ginv22 + (da3 * df2 + da2 * df3) * ginv23 + da3 * df3 * ginv33); + + trcdda = + (cdda11 * ginv11 + cdda22 * ginv22 + + 2. * (cdda12 * ginv12 + cdda13 * ginv13 + cdda23 * ginv23) + cdda33 * ginv33) * + psim4; + + AA11 = + 2. * (A11 * (A12 * ginv12 + A13 * ginv13) + A12 * A13 * ginv23) + ginv11 * pow2(A11) + + ginv22 * pow2(A12) + ginv33 * pow2(A13); + + AA12 = + (A12 * A13 + A11 * A23) * ginv13 + A12 * (A11 * ginv11 + A22 * ginv22) + + (A13 * A22 + A12 * A23) * ginv23 + A13 * A23 * ginv33 + ginv12 * (A11 * A22 + pow2(A12)); + + AA13 = + (A12 * A13 + A11 * A23) * ginv12 + A12 * A23 * ginv22 + (A13 * A23 + A12 * A33) * ginv23 + + A13 * (A11 * ginv11 + A33 * ginv33) + ginv13 * (A11 * A33 + pow2(A13)); + + AA22 = + 2. * (A12 * (A22 * ginv12 + A23 * ginv13) + A22 * A23 * ginv23) + ginv11 * pow2(A12) + + ginv22 * pow2(A22) + ginv33 * pow2(A23); + + AA23 = + A12 * A13 * ginv11 + (A13 * A22 + A12 * A23) * ginv12 + (A13 * A23 + A12 * A33) * ginv13 + + A23 * (A22 * ginv22 + A33 * ginv33) + ginv23 * (A22 * A33 + pow2(A23)); + + AA33 = + 2. * (A13 * (A23 * ginv12 + A33 * ginv13) + A23 * A33 * ginv23) + ginv11 * pow2(A13) + + ginv22 * pow2(A23) + ginv33 * pow2(A33); + + cAA = + AA11 * ginv11 + AA22 * ginv22 + 2. * (AA12 * ginv12 + AA13 * ginv13 + AA23 * ginv23) + + AA33 * ginv33; + + Ainv11 = + 2. * (A23 * ginv12 * ginv13 + ginv11 * (A12 * ginv12 + A13 * ginv13)) + + A11 * pow2(ginv11) + A22 * pow2(ginv12) + A33 * pow2(ginv13); + + Ainv12 = + ginv11 * (A11 * ginv12 + A12 * ginv22 + A13 * ginv23) + + ginv12 * (A13 * ginv13 + A22 * ginv22 + A23 * ginv23) + + ginv13 * (A23 * ginv22 + A33 * ginv23) + A12 * pow2(ginv12); + + Ainv13 = + ginv11 * (A11 * ginv13 + A12 * ginv23 + A13 * ginv33) + + ginv12 * (A12 * ginv13 + A22 * ginv23 + A23 * ginv33) + + ginv13 * (A23 * ginv23 + A33 * ginv33) + A13 * pow2(ginv13); + + Ainv22 = + 2. * (A23 * ginv22 * ginv23 + ginv12 * (A12 * ginv22 + A13 * ginv23)) + + A11 * pow2(ginv12) + A22 * pow2(ginv22) + A33 * pow2(ginv23); + + Ainv23 = + ginv13 * (A12 * ginv22 + A13 * ginv23) + A33 * ginv23 * ginv33 + + ginv12 * (A11 * ginv13 + A12 * ginv23 + A13 * ginv33) + + ginv22 * (A22 * ginv23 + A23 * ginv33) + A23 * pow2(ginv23); + + Ainv33 = + 2. * (A23 * ginv23 * ginv33 + ginv13 * (A12 * ginv23 + A13 * ginv33)) + + A11 * pow2(ginv13) + A22 * pow2(ginv23) + A33 * pow2(ginv33); + + divAinv1 = + (-1.5 * (Ainv11 * dchi1 + Ainv12 * dchi2 + Ainv13 * dchi3)) / chiguarded + + Ainv11 * gamma111 + Ainv22 * gamma122 + + 2. * (Ainv12 * gamma112 + Ainv13 * gamma113 + Ainv23 * gamma123) + + Ainv33 * gamma133 - (0.66666666666666666667 * dKhat1 + 0.33333333333333333333 * dTheta1) * ginv11 - + (0.66666666666666666667 * dKhat2 + 0.33333333333333333333 * dTheta2) * ginv12 - + (0.66666666666666666667 * dKhat3 + 0.33333333333333333333 * dTheta3) * ginv13; + + divAinv2 = + (-1.5 * (Ainv12 * dchi1 + Ainv22 * dchi2 + Ainv23 * dchi3)) / chiguarded + + Ainv11 * gamma211 + Ainv22 * gamma222 + + 2. * (Ainv12 * gamma212 + Ainv13 * gamma213 + Ainv23 * gamma223) + + Ainv33 * gamma233 - (0.66666666666666666667 * dKhat1 + 0.33333333333333333333 * dTheta1) * ginv12 - + (0.66666666666666666667 * dKhat2 + 0.33333333333333333333 * dTheta2) * ginv22 - + (0.66666666666666666667 * dKhat3 + 0.33333333333333333333 * dTheta3) * ginv23; + + divAinv3 = + (-1.5 * (Ainv13 * dchi1 + Ainv23 * dchi2 + Ainv33 * dchi3)) / chiguarded + + Ainv11 * gamma311 + Ainv22 * gamma322 + + 2. * (Ainv12 * gamma312 + Ainv13 * gamma313 + Ainv23 * gamma323) + + Ainv33 * gamma333 - (0.66666666666666666667 * dKhat1 + 0.33333333333333333333 * dTheta1) * ginv13 - + (0.66666666666666666667 * dKhat2 + 0.33333333333333333333 * dTheta2) * ginv23 - + (0.66666666666666666667 * dKhat3 + 0.33333333333333333333 * dTheta3) * ginv33; + + Rhat = + psim4 * (ginv11 * (R11 + Rphi11) + ginv22 * (R22 + Rphi22) + + 2. * (ginv12 * (R12 + Rphi12) + ginv13 * (R13 + Rphi13) + + ginv23 * (R23 + Rphi23)) + + ginv33 * (R33 + Rphi33)); + + Hhat = + -cAA + Rhat + 0.66666666666666666667 * pow2(K); + + divbeta = + db11 + db22 + db33; + + totdivbeta = + 0.66666666666666666667 * divbeta; + + ootddivbeta1 = + 0.33333333333333333333 * (ddb111 + ddb122 + ddb133); + + ootddivbeta2 = + 0.33333333333333333333 * (ddb121 + ddb222 + ddb233); + + ootddivbeta3 = + 0.33333333333333333333 * (ddb131 + ddb232 + ddb333); + + lieg11 = + 2. * (db11 * g11 + db12 * g12 + db13 * g13) - g11 * totdivbeta; + + lieg12 = + db21 * g11 + db23 * g13 + db12 * g22 + db13 * g23 + g12 * (db11 + db22 - totdivbeta); + + lieg13 = + db31 * g11 + db32 * g12 + db12 * g23 + db13 * g33 + g13 * (db11 + db33 - totdivbeta); + + lieg22 = + 2. * (db21 * g12 + db22 * g22 + db23 * g23) - g22 * totdivbeta; + + lieg23 = + db31 * g12 + db21 * g13 + db32 * g22 + db23 * g33 + g23 * (db22 + db33 - totdivbeta); + + lieg33 = + 2. * (db31 * g13 + db32 * g23 + db33 * g33) - g33 * totdivbeta; + + lieA11 = + 2. * (A11 * db11 + A12 * db12 + A13 * db13) - A11 * totdivbeta; + + lieA12 = + A22 * db12 + A23 * db13 + A11 * db21 + A13 * db23 + A12 * (db11 + db22 - totdivbeta); + + lieA13 = + A23 * db12 + A33 * db13 + A11 * db31 + A12 * db32 + A13 * (db11 + db33 - totdivbeta); + + lieA22 = + 2. * (A12 * db21 + A22 * db22 + A23 * db23) - A22 * totdivbeta; + + lieA23 = + A13 * db21 + A33 * db23 + A12 * db31 + A22 * db32 + A23 * (db22 + db33 - totdivbeta); + + lieA33 = + 2. * (A13 * db31 + A23 * db32 + A33 * db33) - A33 * totdivbeta; + + liechi = + 0.16666666666666666667 * chiguarded * chipsipower * divbeta; + + pseudolieG1 = + -(db11 * Gfromg1) - db21 * Gfromg2 - db31 * Gfromg3 + ddb221 * ginv22 + + 2. * ddb231 * ginv23 + ddb331 * ginv33 + ginv11 * (ddb111 + ootddivbeta1) + + ginv12 * (2. * ddb121 + ootddivbeta2) + ginv13 * (2. * ddb131 + ootddivbeta3) + + Gfromg1 * totdivbeta; + + pseudolieG2 = + -(db12 * Gfromg1) - db22 * Gfromg2 - db32 * Gfromg3 + ddb112 * ginv11 + + 2. * ddb132 * ginv13 + ddb332 * ginv33 + ginv12 * (2. * ddb122 + ootddivbeta1) + + ginv22 * (ddb222 + ootddivbeta2) + ginv23 * (2. * ddb232 + ootddivbeta3) + + Gfromg2 * totdivbeta; + + pseudolieG3 = + -(db13 * Gfromg1) - db23 * Gfromg2 - db33 * Gfromg3 + ddb113 * ginv11 + + 2. * ddb123 * ginv12 + ddb223 * ginv22 + ginv13 * (2. * ddb133 + ootddivbeta1) + + ginv23 * (2. * ddb233 + ootddivbeta2) + ginv33 * (ddb333 + ootddivbeta3) + + Gfromg3 * totdivbeta; + + rg11 = + -2. * A11 * alpha + lieg11; + + rg12 = + -2. * A12 * alpha + lieg12; + + rg13 = + -2. * A13 * alpha + lieg13; + + rg22 = + -2. * A22 * alpha + lieg22; + + rg23 = + -2. * A23 * alpha + lieg23; + + rg33 = + -2. * A33 * alpha + lieg33; + + rA11 = + lieA11 + alpha * (-2. * AA11 + A11 * K + psim4 * R11 - 0.33333333333333333333 * g11 * Rhat) + psim4 * (-cdda11 + alpha * Rphi11) + + 0.33333333333333333333 * g11 * trcdda; + + rA12 = + lieA12 + alpha * (-2. * AA12 + A12 * K + psim4 * R12 - 0.33333333333333333333 * g12 * Rhat) + psim4 * (-cdda12 + alpha * Rphi12) + + 0.33333333333333333333 * g12 * trcdda; + + rA13 = + lieA13 + alpha * (-2. * AA13 + A13 * K + psim4 * R13 - 0.33333333333333333333 * g13 * Rhat) + psim4 * (-cdda13 + alpha * Rphi13) + + 0.33333333333333333333 * g13 * trcdda; + + rA22 = + lieA22 + alpha * (-2. * AA22 + A22 * K + psim4 * R22 - 0.33333333333333333333 * g22 * Rhat) + psim4 * (-cdda22 + alpha * Rphi22) + + 0.33333333333333333333 * g22 * trcdda; + + rA23 = + lieA23 + alpha * (-2. * AA23 + A23 * K + psim4 * R23 - 0.33333333333333333333 * g23 * Rhat) + psim4 * (-cdda23 + alpha * Rphi23) + + 0.33333333333333333333 * g23 * trcdda; + + rA33 = + lieA33 + alpha * (-2. * AA33 + A33 * K + psim4 * R33 - 0.33333333333333333333 * g33 * Rhat) + psim4 * (-cdda33 + alpha * Rphi33) + + 0.33333333333333333333 * g33 * trcdda; + + rG1 = + -2. * (Ainv11 * da1 + Ainv12 * da2 + Ainv13 * da3) + + alpha * (2. * divAinv1 + 2. * (-G1 + Gfromg1) * kappa1) + pseudolieG1; + + rG2 = + -2. * (Ainv12 * da1 + Ainv22 * da2 + Ainv23 * da3) + + alpha * (2. * divAinv2 + 2. * (-G2 + Gfromg2) * kappa1) + pseudolieG2; + + rG3 = + -2. * (Ainv13 * da1 + Ainv23 * da2 + Ainv33 * da3) + + alpha * (2. * divAinv3 + 2. * (-G3 + Gfromg3) * kappa1) + pseudolieG3; + + rKhat = + -trcdda + alpha * (cAA + kappa1 * (Theta - kappa2 * Theta) + + 0.33333333333333333333 * pow2(K)); + + rchi = + -0.16666666666666666667 * alpha * chiguarded * chipsipower * K + liechi; + + rTheta = + alpha * (0.5 * Hhat - kappa1 * (2. + kappa2) * Theta); + +#if 0 +// this part is for CCZ4 +dginv111 += +-2.*(delg123*ginv12*ginv13 + ginv11*(delg112*ginv12 + delg113*ginv13)) - + delg111*pow2(ginv11) - delg122*pow2(ginv12) - delg133*pow2(ginv13) +; + +dginv112 += +-(ginv11*(delg111*ginv12 + delg112*ginv22 + delg113*ginv23)) - + ginv12*(delg113*ginv13 + delg122*ginv22 + delg123*ginv23) - + ginv13*(delg123*ginv22 + delg133*ginv23) - delg112*pow2(ginv12) +; + +dginv113 += +-(ginv11*(delg111*ginv13 + delg112*ginv23 + delg113*ginv33)) - + ginv12*(delg112*ginv13 + delg122*ginv23 + delg123*ginv33) - + ginv13*(delg123*ginv23 + delg133*ginv33) - delg113*pow2(ginv13) +; + +dginv122 += +-2.*(delg123*ginv22*ginv23 + ginv12*(delg112*ginv22 + delg113*ginv23)) - + delg111*pow2(ginv12) - delg122*pow2(ginv22) - delg133*pow2(ginv23) +; + +dginv123 += +-(ginv13*(delg112*ginv22 + delg113*ginv23)) - delg133*ginv23*ginv33 - + ginv12*(delg111*ginv13 + delg112*ginv23 + delg113*ginv33) - + ginv22*(delg122*ginv23 + delg123*ginv33) - delg123*pow2(ginv23) +; + +dginv133 += +-2.*(delg123*ginv23*ginv33 + ginv13*(delg112*ginv23 + delg113*ginv33)) - + delg111*pow2(ginv13) - delg122*pow2(ginv23) - delg133*pow2(ginv33) +; + +dginv211 += +-2.*(delg223*ginv12*ginv13 + ginv11*(delg212*ginv12 + delg213*ginv13)) - + delg211*pow2(ginv11) - delg222*pow2(ginv12) - delg233*pow2(ginv13) +; + +dginv212 += +-(ginv11*(delg211*ginv12 + delg212*ginv22 + delg213*ginv23)) - + ginv12*(delg213*ginv13 + delg222*ginv22 + delg223*ginv23) - + ginv13*(delg223*ginv22 + delg233*ginv23) - delg212*pow2(ginv12) +; + +dginv213 += +-(ginv11*(delg211*ginv13 + delg212*ginv23 + delg213*ginv33)) - + ginv12*(delg212*ginv13 + delg222*ginv23 + delg223*ginv33) - + ginv13*(delg223*ginv23 + delg233*ginv33) - delg213*pow2(ginv13) +; + +dginv222 += +-2.*(delg223*ginv22*ginv23 + ginv12*(delg212*ginv22 + delg213*ginv23)) - + delg211*pow2(ginv12) - delg222*pow2(ginv22) - delg233*pow2(ginv23) +; + +dginv223 += +-(ginv13*(delg212*ginv22 + delg213*ginv23)) - delg233*ginv23*ginv33 - + ginv12*(delg211*ginv13 + delg212*ginv23 + delg213*ginv33) - + ginv22*(delg222*ginv23 + delg223*ginv33) - delg223*pow2(ginv23) +; + +dginv233 += +-2.*(delg223*ginv23*ginv33 + ginv13*(delg212*ginv23 + delg213*ginv33)) - + delg211*pow2(ginv13) - delg222*pow2(ginv23) - delg233*pow2(ginv33) +; + +dginv311 += +-2.*(delg323*ginv12*ginv13 + ginv11*(delg312*ginv12 + delg313*ginv13)) - + delg311*pow2(ginv11) - delg322*pow2(ginv12) - delg333*pow2(ginv13) +; + +dginv312 += +-(ginv11*(delg311*ginv12 + delg312*ginv22 + delg313*ginv23)) - + ginv12*(delg313*ginv13 + delg322*ginv22 + delg323*ginv23) - + ginv13*(delg323*ginv22 + delg333*ginv23) - delg312*pow2(ginv12) +; + +dginv313 += +-(ginv11*(delg311*ginv13 + delg312*ginv23 + delg313*ginv33)) - + ginv12*(delg312*ginv13 + delg322*ginv23 + delg323*ginv33) - + ginv13*(delg323*ginv23 + delg333*ginv33) - delg313*pow2(ginv13) +; + +dginv322 += +-2.*(delg323*ginv22*ginv23 + ginv12*(delg312*ginv22 + delg313*ginv23)) - + delg311*pow2(ginv12) - delg322*pow2(ginv22) - delg333*pow2(ginv23) +; + +dginv323 += +-(ginv13*(delg312*ginv22 + delg313*ginv23)) - delg333*ginv23*ginv33 - + ginv12*(delg311*ginv13 + delg312*ginv23 + delg313*ginv33) - + ginv22*(delg322*ginv23 + delg323*ginv33) - delg323*pow2(ginv23) +; + +dginv333 += +-2.*(delg323*ginv23*ginv33 + ginv13*(delg312*ginv23 + delg313*ginv33)) - + delg311*pow2(ginv13) - delg322*pow2(ginv23) - delg333*pow2(ginv33) +; + +dphi1 += +(-0.25*dchi1)/chiguarded +; + +dphi2 += +(-0.25*dchi2)/chiguarded +; + +dphi3 += +(-0.25*dchi3)/chiguarded +; + +gammaF111 += +gamma111 + dphi1*(4. - 2.*g11*ginv11) - 2.*g11*(dphi2*ginv12 + dphi3*ginv13) +; + +gammaF112 += +gamma112 + dphi2*(2. - 2.*g12*ginv12) - 2.*g12*(dphi1*ginv11 + dphi3*ginv13) +; + +gammaF113 += +gamma113 - 2.*g13*(dphi1*ginv11 + dphi2*ginv12) + dphi3*(2. - 2.*g13*ginv13) +; + +gammaF121 += +gamma112 + dphi2*(2. - 2.*g12*ginv12) - 2.*g12*(dphi1*ginv11 + dphi3*ginv13) +; + +gammaF122 += +gamma122 - 2.*g22*(dphi1*ginv11 + dphi2*ginv12 + dphi3*ginv13) +; + +gammaF123 += +gamma123 - 2.*g23*(dphi1*ginv11 + dphi2*ginv12 + dphi3*ginv13) +; + +gammaF131 += +gamma113 - 2.*g13*(dphi1*ginv11 + dphi2*ginv12) + dphi3*(2. - 2.*g13*ginv13) +; + +gammaF132 += +gamma123 - 2.*g23*(dphi1*ginv11 + dphi2*ginv12 + dphi3*ginv13) +; + +gammaF133 += +gamma133 - 2.*g33*(dphi1*ginv11 + dphi2*ginv12 + dphi3*ginv13) +; + +gammaF211 += +gamma211 - 2.*g11*(dphi1*ginv12 + dphi2*ginv22 + dphi3*ginv23) +; + +gammaF212 += +gamma212 + dphi1*(2. - 2.*g12*ginv12) - 2.*g12*(dphi2*ginv22 + dphi3*ginv23) +; + +gammaF213 += +gamma213 - 2.*g13*(dphi1*ginv12 + dphi2*ginv22 + dphi3*ginv23) +; + +gammaF221 += +gamma212 + dphi1*(2. - 2.*g12*ginv12) - 2.*g12*(dphi2*ginv22 + dphi3*ginv23) +; + +gammaF222 += +gamma222 + dphi2*(4. - 2.*g22*ginv22) - 2.*g22*(dphi1*ginv12 + dphi3*ginv23) +; + +gammaF223 += +gamma223 - 2.*g23*(dphi1*ginv12 + dphi2*ginv22) + dphi3*(2. - 2.*g23*ginv23) +; + +gammaF231 += +gamma213 - 2.*g13*(dphi1*ginv12 + dphi2*ginv22 + dphi3*ginv23) +; + +gammaF232 += +gamma223 - 2.*g23*(dphi1*ginv12 + dphi2*ginv22) + dphi3*(2. - 2.*g23*ginv23) +; + +gammaF233 += +gamma233 - 2.*g33*(dphi1*ginv12 + dphi2*ginv22 + dphi3*ginv23) +; + +gammaF311 += +gamma311 - 2.*g11*(dphi1*ginv13 + dphi2*ginv23 + dphi3*ginv33) +; + +gammaF312 += +gamma312 - 2.*g12*(dphi1*ginv13 + dphi2*ginv23 + dphi3*ginv33) +; + +gammaF313 += +gamma313 + dphi1*(2. - 2.*g13*ginv13) - 2.*g13*(dphi2*ginv23 + dphi3*ginv33) +; + +gammaF321 += +gamma312 - 2.*g12*(dphi1*ginv13 + dphi2*ginv23 + dphi3*ginv33) +; + +gammaF322 += +gamma322 - 2.*g22*(dphi1*ginv13 + dphi2*ginv23 + dphi3*ginv33) +; + +gammaF323 += +gamma323 + dphi2*(2. - 2.*g23*ginv23) - 2.*g23*(dphi1*ginv13 + dphi3*ginv33) +; + +gammaF331 += +gamma313 + dphi1*(2. - 2.*g13*ginv13) - 2.*g13*(dphi2*ginv23 + dphi3*ginv33) +; + +gammaF332 += +gamma323 + dphi2*(2. - 2.*g23*ginv23) - 2.*g23*(dphi1*ginv13 + dphi3*ginv33) +; + +gammaF333 += +gamma333 - 2.*g33*(dphi1*ginv13 + dphi2*ginv23) + dphi3*(4. - 2.*g33*ginv33) +; + +Gd1 += +ginv11*((2.*delg112 + delg211)*ginv12 + (2.*delg113 + delg311)*ginv13 + + delg212*ginv22 + (delg213 + delg312)*ginv23 + delg313*ginv33) + + ginv12*((2.*delg123 + delg213 + delg312)*ginv13 + delg222*ginv22 + + (delg223 + delg322)*ginv23 + delg323*ginv33) + + ginv13*(delg223*ginv22 + (delg233 + delg323)*ginv23 + delg333*ginv33) + + delg111*pow2(ginv11) + (delg122 + delg212)*pow2(ginv12) + + (delg133 + delg313)*pow2(ginv13) +; + +Gd2 += +ginv11*(delg111*ginv12 + delg112*ginv22 + delg113*ginv23) + + ginv13*((delg123 + delg312)*ginv22 + (delg133 + delg313)*ginv23) + + delg333*ginv23*ginv33 + ginv12* + ((delg113 + delg311)*ginv13 + (delg122 + 2.*delg212)*ginv22 + + (delg123 + 2.*delg213 + delg312)*ginv23 + delg313*ginv33) + + ginv22*((2.*delg223 + delg322)*ginv23 + delg323*ginv33) + + (delg112 + delg211)*pow2(ginv12) + delg222*pow2(ginv22) + + (delg233 + delg323)*pow2(ginv23) +; + +Gd3 += +(delg233 + 2.*delg323)*ginv23*ginv33 + + ginv11*(delg111*ginv13 + delg112*ginv23 + delg113*ginv33) + + ginv12*((delg112 + delg211)*ginv13 + (delg122 + delg212)*ginv23 + + (delg123 + delg213)*ginv33) + + ginv22*(delg222*ginv23 + delg223*ginv33) + + ginv13*(delg212*ginv22 + (delg123 + delg213 + 2.*delg312)*ginv23 + + (delg133 + 2.*delg313)*ginv33) + (delg113 + delg311)*pow2(ginv13) + + (delg223 + delg322)*pow2(ginv23) + delg333*pow2(ginv33) +; + +dGd11 += +(delg212*dginv111 + delg222*dginv112 + delg223*dginv113)*ginv22 + + ((delg213 + delg312)*dginv111 + (delg223 + delg322)*dginv112 + + (delg233 + delg323)*dginv113)*ginv23 + + (delg313*dginv111 + delg323*dginv112 + delg333*dginv113)*ginv33 + + ginv11*(delg211*dginv112 + delg311*dginv113 + + 2.*(delg111*dginv111 + delg112*dginv112 + delg113*dginv113) + + delg212*dginv122 + (delg213 + delg312)*dginv123 + delg313*dginv133 + + (2.*deldelg1112 + deldelg1211)*ginv12 + + (2.*deldelg1113 + deldelg1311)*ginv13 + deldelg1212*ginv22 + + (deldelg1213 + deldelg1312)*ginv23 + deldelg1313*ginv33) + + ginv12*((2.*delg112 + delg211)*dginv111 + (delg213 + delg312)*dginv113 + + 2.*((delg122 + delg212)*dginv112 + delg123*dginv113) + + delg222*dginv122 + (delg223 + delg322)*dginv123 + delg323*dginv133 + + (2.*deldelg1123 + deldelg1213 + deldelg1312)*ginv13 + + deldelg1222*ginv22 + (deldelg1223 + deldelg1322)*ginv23 + + deldelg1323*ginv33) + ginv13* + ((2.*delg113 + delg311)*dginv111 + + (2.*delg123 + delg213 + delg312)*dginv112 + + 2.*(delg133 + delg313)*dginv113 + delg223*dginv122 + + (delg233 + delg323)*dginv123 + delg333*dginv133 + deldelg1223*ginv22 + + (deldelg1233 + deldelg1323)*ginv23 + deldelg1333*ginv33) + + deldelg1111*pow2(ginv11) + (deldelg1122 + deldelg1212)*pow2(ginv12) + + (deldelg1133 + deldelg1313)*pow2(ginv13) +; + +dGd12 += +ginv11*(delg111*dginv112 + delg112*dginv122 + delg113*dginv123 + + deldelg1111*ginv12 + deldelg1112*ginv22 + deldelg1113*ginv23) + + ginv13*((delg113 + delg311)*dginv112 + (delg123 + delg312)*dginv122 + + (delg133 + delg313)*dginv123 + (deldelg1123 + deldelg1312)*ginv22 + + (deldelg1133 + deldelg1313)*ginv23) + + (delg313*dginv112 + delg323*dginv122 + delg333*dginv123)*ginv33 + + ginv12*(delg111*dginv111 + (delg113 + delg311)*dginv113 + + delg122*dginv122 + (delg123 + delg312)*dginv123 + + 2.*((delg112 + delg211)*dginv112 + delg212*dginv122 + + delg213*dginv123) + delg313*dginv133 + + (deldelg1113 + deldelg1311)*ginv13 + + (deldelg1122 + 2.*deldelg1212)*ginv22 + + (deldelg1123 + 2.*deldelg1213 + deldelg1312)*ginv23 + + deldelg1313*ginv33) + ginv22* + (delg112*dginv111 + (delg122 + 2.*delg212)*dginv112 + + (delg123 + delg312)*dginv113 + delg322*dginv123 + + 2.*(delg222*dginv122 + delg223*dginv123) + delg323*dginv133 + + (2.*deldelg1223 + deldelg1322)*ginv23 + deldelg1323*ginv33) + + ginv23*(delg113*dginv111 + (delg123 + 2.*delg213 + delg312)*dginv112 + + (delg133 + delg313)*dginv113 + (2.*delg223 + delg322)*dginv122 + + 2.*(delg233 + delg323)*dginv123 + delg333*dginv133 + deldelg1333*ginv33\ +) + (deldelg1112 + deldelg1211)*pow2(ginv12) + deldelg1222*pow2(ginv22) + + (deldelg1233 + deldelg1323)*pow2(ginv23) +; + +dGd13 += +(delg113*dginv111 + (delg123 + delg213)*dginv112 + + (delg133 + 2.*delg313)*dginv113 + delg223*dginv122 + + (delg233 + 2.*delg323)*dginv123 + 2.*delg333*dginv133)*ginv33 + + ginv11*(delg111*dginv113 + delg112*dginv123 + delg113*dginv133 + + deldelg1111*ginv13 + deldelg1112*ginv23 + deldelg1113*ginv33) + + ginv12*((delg112 + delg211)*dginv113 + (delg122 + delg212)*dginv123 + + (delg123 + delg213)*dginv133 + (deldelg1112 + deldelg1211)*ginv13 + + (deldelg1122 + deldelg1212)*ginv23 + (deldelg1123 + deldelg1213)*ginv33\ +) + ginv22*(delg212*dginv113 + delg222*dginv123 + delg223*dginv133 + + deldelg1222*ginv23 + deldelg1223*ginv33) + + ginv13*(delg111*dginv111 + (delg112 + delg211)*dginv112 + + delg212*dginv122 + (delg123 + delg213)*dginv123 + delg133*dginv133 + + 2.*((delg113 + delg311)*dginv113 + delg312*dginv123 + + delg313*dginv133) + deldelg1212*ginv22 + + (deldelg1123 + deldelg1213 + 2.*deldelg1312)*ginv23 + + (deldelg1133 + 2.*deldelg1313)*ginv33) + + ginv23*(delg112*dginv111 + (delg122 + delg212)*dginv112 + + (delg123 + delg213 + 2.*delg312)*dginv113 + delg222*dginv122 + + delg233*dginv133 + 2.*((delg223 + delg322)*dginv123 + + delg323*dginv133) + (deldelg1233 + 2.*deldelg1323)*ginv33) + + (deldelg1113 + deldelg1311)*pow2(ginv13) + + (deldelg1223 + deldelg1322)*pow2(ginv23) + deldelg1333*pow2(ginv33) +; + +dGd21 += +(delg212*dginv211 + delg222*dginv212 + delg223*dginv213)*ginv22 + + ((delg213 + delg312)*dginv211 + (delg223 + delg322)*dginv212 + + (delg233 + delg323)*dginv213)*ginv23 + + (delg313*dginv211 + delg323*dginv212 + delg333*dginv213)*ginv33 + + ginv11*(delg211*dginv212 + delg311*dginv213 + + 2.*(delg111*dginv211 + delg112*dginv212 + delg113*dginv213) + + delg212*dginv222 + (delg213 + delg312)*dginv223 + delg313*dginv233 + + (2.*deldelg1212 + deldelg2211)*ginv12 + + (2.*deldelg1213 + deldelg2311)*ginv13 + deldelg2212*ginv22 + + (deldelg2213 + deldelg2312)*ginv23 + deldelg2313*ginv33) + + ginv12*((2.*delg112 + delg211)*dginv211 + (delg213 + delg312)*dginv213 + + 2.*((delg122 + delg212)*dginv212 + delg123*dginv213) + + delg222*dginv222 + (delg223 + delg322)*dginv223 + delg323*dginv233 + + (2.*deldelg1223 + deldelg2213 + deldelg2312)*ginv13 + + deldelg2222*ginv22 + (deldelg2223 + deldelg2322)*ginv23 + + deldelg2323*ginv33) + ginv13* + ((2.*delg113 + delg311)*dginv211 + + (2.*delg123 + delg213 + delg312)*dginv212 + + 2.*(delg133 + delg313)*dginv213 + delg223*dginv222 + + (delg233 + delg323)*dginv223 + delg333*dginv233 + deldelg2223*ginv22 + + (deldelg2233 + deldelg2323)*ginv23 + deldelg2333*ginv33) + + deldelg1211*pow2(ginv11) + (deldelg1222 + deldelg2212)*pow2(ginv12) + + (deldelg1233 + deldelg2313)*pow2(ginv13) +; + +dGd22 += +ginv11*(delg111*dginv212 + delg112*dginv222 + delg113*dginv223 + + deldelg1211*ginv12 + deldelg1212*ginv22 + deldelg1213*ginv23) + + ginv13*((delg113 + delg311)*dginv212 + (delg123 + delg312)*dginv222 + + (delg133 + delg313)*dginv223 + (deldelg1223 + deldelg2312)*ginv22 + + (deldelg1233 + deldelg2313)*ginv23) + + (delg313*dginv212 + delg323*dginv222 + delg333*dginv223)*ginv33 + + ginv12*(delg111*dginv211 + (delg113 + delg311)*dginv213 + + delg122*dginv222 + (delg123 + delg312)*dginv223 + + 2.*((delg112 + delg211)*dginv212 + delg212*dginv222 + + delg213*dginv223) + delg313*dginv233 + + (deldelg1213 + deldelg2311)*ginv13 + + (deldelg1222 + 2.*deldelg2212)*ginv22 + + (deldelg1223 + 2.*deldelg2213 + deldelg2312)*ginv23 + + deldelg2313*ginv33) + ginv22* + (delg112*dginv211 + (delg122 + 2.*delg212)*dginv212 + + (delg123 + delg312)*dginv213 + delg322*dginv223 + + 2.*(delg222*dginv222 + delg223*dginv223) + delg323*dginv233 + + (2.*deldelg2223 + deldelg2322)*ginv23 + deldelg2323*ginv33) + + ginv23*(delg113*dginv211 + (delg123 + 2.*delg213 + delg312)*dginv212 + + (delg133 + delg313)*dginv213 + (2.*delg223 + delg322)*dginv222 + + 2.*(delg233 + delg323)*dginv223 + delg333*dginv233 + deldelg2333*ginv33\ +) + (deldelg1212 + deldelg2211)*pow2(ginv12) + deldelg2222*pow2(ginv22) + + (deldelg2233 + deldelg2323)*pow2(ginv23) +; + +dGd23 += +(delg113*dginv211 + (delg123 + delg213)*dginv212 + + (delg133 + 2.*delg313)*dginv213 + delg223*dginv222 + + (delg233 + 2.*delg323)*dginv223 + 2.*delg333*dginv233)*ginv33 + + ginv11*(delg111*dginv213 + delg112*dginv223 + delg113*dginv233 + + deldelg1211*ginv13 + deldelg1212*ginv23 + deldelg1213*ginv33) + + ginv12*((delg112 + delg211)*dginv213 + (delg122 + delg212)*dginv223 + + (delg123 + delg213)*dginv233 + (deldelg1212 + deldelg2211)*ginv13 + + (deldelg1222 + deldelg2212)*ginv23 + (deldelg1223 + deldelg2213)*ginv33\ +) + ginv22*(delg212*dginv213 + delg222*dginv223 + delg223*dginv233 + + deldelg2222*ginv23 + deldelg2223*ginv33) + + ginv13*(delg111*dginv211 + (delg112 + delg211)*dginv212 + + delg212*dginv222 + (delg123 + delg213)*dginv223 + delg133*dginv233 + + 2.*((delg113 + delg311)*dginv213 + delg312*dginv223 + + delg313*dginv233) + deldelg2212*ginv22 + + (deldelg1223 + deldelg2213 + 2.*deldelg2312)*ginv23 + + (deldelg1233 + 2.*deldelg2313)*ginv33) + + ginv23*(delg112*dginv211 + (delg122 + delg212)*dginv212 + + (delg123 + delg213 + 2.*delg312)*dginv213 + delg222*dginv222 + + delg233*dginv233 + 2.*((delg223 + delg322)*dginv223 + + delg323*dginv233) + (deldelg2233 + 2.*deldelg2323)*ginv33) + + (deldelg1213 + deldelg2311)*pow2(ginv13) + + (deldelg2223 + deldelg2322)*pow2(ginv23) + deldelg2333*pow2(ginv33) +; + +dGd31 += +(delg212*dginv311 + delg222*dginv312 + delg223*dginv313)*ginv22 + + ((delg213 + delg312)*dginv311 + (delg223 + delg322)*dginv312 + + (delg233 + delg323)*dginv313)*ginv23 + + (delg313*dginv311 + delg323*dginv312 + delg333*dginv313)*ginv33 + + ginv11*(delg211*dginv312 + delg311*dginv313 + + 2.*(delg111*dginv311 + delg112*dginv312 + delg113*dginv313) + + delg212*dginv322 + (delg213 + delg312)*dginv323 + delg313*dginv333 + + (2.*deldelg1312 + deldelg2311)*ginv12 + + (2.*deldelg1313 + deldelg3311)*ginv13 + deldelg2312*ginv22 + + (deldelg2313 + deldelg3312)*ginv23 + deldelg3313*ginv33) + + ginv12*((2.*delg112 + delg211)*dginv311 + (delg213 + delg312)*dginv313 + + 2.*((delg122 + delg212)*dginv312 + delg123*dginv313) + + delg222*dginv322 + (delg223 + delg322)*dginv323 + delg323*dginv333 + + (2.*deldelg1323 + deldelg2313 + deldelg3312)*ginv13 + + deldelg2322*ginv22 + (deldelg2323 + deldelg3322)*ginv23 + + deldelg3323*ginv33) + ginv13* + ((2.*delg113 + delg311)*dginv311 + + (2.*delg123 + delg213 + delg312)*dginv312 + + 2.*(delg133 + delg313)*dginv313 + delg223*dginv322 + + (delg233 + delg323)*dginv323 + delg333*dginv333 + deldelg2323*ginv22 + + (deldelg2333 + deldelg3323)*ginv23 + deldelg3333*ginv33) + + deldelg1311*pow2(ginv11) + (deldelg1322 + deldelg2312)*pow2(ginv12) + + (deldelg1333 + deldelg3313)*pow2(ginv13) +; + +dGd32 += +ginv11*(delg111*dginv312 + delg112*dginv322 + delg113*dginv323 + + deldelg1311*ginv12 + deldelg1312*ginv22 + deldelg1313*ginv23) + + ginv13*((delg113 + delg311)*dginv312 + (delg123 + delg312)*dginv322 + + (delg133 + delg313)*dginv323 + (deldelg1323 + deldelg3312)*ginv22 + + (deldelg1333 + deldelg3313)*ginv23) + + (delg313*dginv312 + delg323*dginv322 + delg333*dginv323)*ginv33 + + ginv12*(delg111*dginv311 + (delg113 + delg311)*dginv313 + + delg122*dginv322 + (delg123 + delg312)*dginv323 + + 2.*((delg112 + delg211)*dginv312 + delg212*dginv322 + + delg213*dginv323) + delg313*dginv333 + + (deldelg1313 + deldelg3311)*ginv13 + + (deldelg1322 + 2.*deldelg2312)*ginv22 + + (deldelg1323 + 2.*deldelg2313 + deldelg3312)*ginv23 + + deldelg3313*ginv33) + ginv22* + (delg112*dginv311 + (delg122 + 2.*delg212)*dginv312 + + (delg123 + delg312)*dginv313 + delg322*dginv323 + + 2.*(delg222*dginv322 + delg223*dginv323) + delg323*dginv333 + + (2.*deldelg2323 + deldelg3322)*ginv23 + deldelg3323*ginv33) + + ginv23*(delg113*dginv311 + (delg123 + 2.*delg213 + delg312)*dginv312 + + (delg133 + delg313)*dginv313 + (2.*delg223 + delg322)*dginv322 + + 2.*(delg233 + delg323)*dginv323 + delg333*dginv333 + deldelg3333*ginv33\ +) + (deldelg1312 + deldelg2311)*pow2(ginv12) + deldelg2322*pow2(ginv22) + + (deldelg2333 + deldelg3323)*pow2(ginv23) +; + +dGd33 += +(delg113*dginv311 + (delg123 + delg213)*dginv312 + + (delg133 + 2.*delg313)*dginv313 + delg223*dginv322 + + (delg233 + 2.*delg323)*dginv323 + 2.*delg333*dginv333)*ginv33 + + ginv11*(delg111*dginv313 + delg112*dginv323 + delg113*dginv333 + + deldelg1311*ginv13 + deldelg1312*ginv23 + deldelg1313*ginv33) + + ginv12*((delg112 + delg211)*dginv313 + (delg122 + delg212)*dginv323 + + (delg123 + delg213)*dginv333 + (deldelg1312 + deldelg2311)*ginv13 + + (deldelg1322 + deldelg2312)*ginv23 + (deldelg1323 + deldelg2313)*ginv33\ +) + ginv22*(delg212*dginv313 + delg222*dginv323 + delg223*dginv333 + + deldelg2322*ginv23 + deldelg2323*ginv33) + + ginv13*(delg111*dginv311 + (delg112 + delg211)*dginv312 + + delg212*dginv322 + (delg123 + delg213)*dginv323 + delg133*dginv333 + + 2.*((delg113 + delg311)*dginv313 + delg312*dginv323 + + delg313*dginv333) + deldelg2312*ginv22 + + (deldelg1323 + deldelg2313 + 2.*deldelg3312)*ginv23 + + (deldelg1333 + 2.*deldelg3313)*ginv33) + + ginv23*(delg112*dginv311 + (delg122 + delg212)*dginv312 + + (delg123 + delg213 + 2.*delg312)*dginv313 + delg222*dginv322 + + delg233*dginv333 + 2.*((delg223 + delg322)*dginv323 + + delg323*dginv333) + (deldelg2333 + 2.*deldelg3323)*ginv33) + + (deldelg1313 + deldelg3311)*pow2(ginv13) + + (deldelg2323 + deldelg3322)*pow2(ginv23) + deldelg3333*pow2(ginv33) +; + +Zinv1 += +0.5*(G1 - Gd1) +; + +Zinv2 += +0.5*(G2 - Gd2) +; + +Zinv3 += +0.5*(G3 - Gd3) +; + +dZinv11 += +0.5*(delG11 - dGd11) +; + +dZinv12 += +0.5*(delG12 - dGd12) +; + +dZinv13 += +0.5*(delG13 - dGd13) +; + +dZinv21 += +0.5*(delG21 - dGd21) +; + +dZinv22 += +0.5*(delG22 - dGd22) +; + +dZinv23 += +0.5*(delG23 - dGd23) +; + +dZinv31 += +0.5*(delG31 - dGd31) +; + +dZinv32 += +0.5*(delG32 - dGd32) +; + +dZinv33 += +0.5*(delG33 - dGd33) +; + +Z1 += +g11*Zinv1 + g12*Zinv2 + g13*Zinv3 +; + +Z2 += +g12*Zinv1 + g22*Zinv2 + g23*Zinv3 +; + +Z3 += +g13*Zinv1 + g23*Zinv2 + g33*Zinv3 +; + +dZ11 += +dZinv11*g11 + dZinv12*g12 + dZinv13*g13 + delg111*Zinv1 + delg112*Zinv2 + + delg113*Zinv3 +; + +dZ12 += +dZinv11*g12 + dZinv12*g22 + dZinv13*g23 + delg112*Zinv1 + delg122*Zinv2 + + delg123*Zinv3 +; + +dZ13 += +dZinv11*g13 + dZinv12*g23 + dZinv13*g33 + delg113*Zinv1 + delg123*Zinv2 + + delg133*Zinv3 +; + +dZ21 += +dZinv21*g11 + dZinv22*g12 + dZinv23*g13 + delg211*Zinv1 + delg212*Zinv2 + + delg213*Zinv3 +; + +dZ22 += +dZinv21*g12 + dZinv22*g22 + dZinv23*g23 + delg212*Zinv1 + delg222*Zinv2 + + delg223*Zinv3 +; + +dZ23 += +dZinv21*g13 + dZinv22*g23 + dZinv23*g33 + delg213*Zinv1 + delg223*Zinv2 + + delg233*Zinv3 +; + +dZ31 += +dZinv31*g11 + dZinv32*g12 + dZinv33*g13 + delg311*Zinv1 + delg312*Zinv2 + + delg313*Zinv3 +; + +dZ32 += +dZinv31*g12 + dZinv32*g22 + dZinv33*g23 + delg312*Zinv1 + delg322*Zinv2 + + delg323*Zinv3 +; + +dZ33 += +dZinv31*g13 + dZinv32*g23 + dZinv33*g33 + delg313*Zinv1 + delg323*Zinv2 + + delg333*Zinv3 +; + +DZinv11 += +dZinv11 + gammaF111*Zinv1 + gammaF112*Zinv2 + gammaF113*Zinv3 +; + +DZinv12 += +dZinv12 + gammaF211*Zinv1 + gammaF212*Zinv2 + gammaF213*Zinv3 +; + +DZinv13 += +dZinv13 + gammaF311*Zinv1 + gammaF312*Zinv2 + gammaF313*Zinv3 +; + +DZinv21 += +dZinv21 + gammaF121*Zinv1 + gammaF122*Zinv2 + gammaF123*Zinv3 +; + +DZinv22 += +dZinv22 + gammaF221*Zinv1 + gammaF222*Zinv2 + gammaF223*Zinv3 +; + +DZinv23 += +dZinv23 + gammaF321*Zinv1 + gammaF322*Zinv2 + gammaF323*Zinv3 +; + +DZinv31 += +dZinv31 + gammaF131*Zinv1 + gammaF132*Zinv2 + gammaF133*Zinv3 +; + +DZinv32 += +dZinv32 + gammaF231*Zinv1 + gammaF232*Zinv2 + gammaF233*Zinv3 +; + +DZinv33 += +dZinv33 + gammaF331*Zinv1 + gammaF332*Zinv2 + gammaF333*Zinv3 +; + +DZ11 += +dZ11 - gammaF111*Z1 - gammaF211*Z2 - gammaF311*Z3 +; + +DZ12 += +dZ12 - gammaF112*Z1 - gammaF212*Z2 - gammaF312*Z3 +; + +DZ13 += +dZ13 - gammaF113*Z1 - gammaF213*Z2 - gammaF313*Z3 +; + +DZ21 += +dZ21 - gammaF121*Z1 - gammaF221*Z2 - gammaF321*Z3 +; + +DZ22 += +dZ22 - gammaF122*Z1 - gammaF222*Z2 - gammaF322*Z3 +; + +DZ23 += +dZ23 - gammaF123*Z1 - gammaF223*Z2 - gammaF323*Z3 +; + +DZ31 += +dZ31 - gammaF131*Z1 - gammaF231*Z2 - gammaF331*Z3 +; + +DZ32 += +dZ32 - gammaF132*Z1 - gammaF232*Z2 - gammaF332*Z3 +; + +DZ33 += +dZ33 - gammaF133*Z1 - gammaF233*Z2 - gammaF333*Z3 +; + +DZsym11 += +2.*DZ11 +; + +DZsym12 += +DZ12 + DZ21 +; + +DZsym13 += +DZ13 + DZ31 +; + +DZsym21 += +DZ12 + DZ21 +; + +DZsym22 += +2.*DZ22 +; + +DZsym23 += +DZ23 + DZ32 +; + +DZsym31 += +DZ13 + DZ31 +; + +DZsym32 += +DZ23 + DZ32 +; + +DZsym33 += +2.*DZ33 +; + +trDZsym += +(DZsym11*ginv11 + (DZsym12 + DZsym21)*ginv12 + (DZsym13 + DZsym31)*ginv13 + + DZsym22*ginv22 + (DZsym23 + DZsym32)*ginv23 + DZsym33*ginv33)*psim4 +; + +rA11 += +rA11 + alpha*(-2.*A11*Theta + chi* + (DZsym11 - 0.33333333333333333333*g11*trDZsym)) +; + +rA12 += +rA12 + alpha*(-2.*A12*Theta + chi* + (DZsym21 - 0.33333333333333333333*g12*trDZsym)) +; + +rA13 += +rA13 + alpha*(-2.*A13*Theta + chi* + (DZsym31 - 0.33333333333333333333*g13*trDZsym)) +; + +rA22 += +rA22 + alpha*(-2.*A22*Theta + chi* + (DZsym22 - 0.33333333333333333333*g22*trDZsym)) +; + +rA23 += +rA23 + alpha*(-2.*A23*Theta + chi* + (DZsym32 - 0.33333333333333333333*g23*trDZsym)) +; + +rA33 += +rA33 + alpha*(-2.*A33*Theta + chi* + (DZsym33 - 0.33333333333333333333*g33*trDZsym)) +; + +rTheta += +alpha*(DZinv11 + DZinv22 + DZinv33) + rTheta - da1*Zinv1 - da2*Zinv2 - + da3*Zinv3 +; + +rG1 += +rG1 - ginv11*(1.3333333333333333333*alpha*K*Z1 + + 2.*(da1*Theta + alpha*kappa1*Z1)) - + ginv12*(1.3333333333333333333*alpha*K*Z2 + + 2.*(da2*Theta + alpha*kappa1*Z2)) - + ginv13*(1.3333333333333333333*alpha*K*Z3 + + 2.*(da3*Theta + alpha*kappa1*Z3)) +; + +rG2 += +rG2 - ginv12*(1.3333333333333333333*alpha*K*Z1 + + 2.*(da1*Theta + alpha*kappa1*Z1)) - + ginv22*(1.3333333333333333333*alpha*K*Z2 + + 2.*(da2*Theta + alpha*kappa1*Z2)) - + ginv23*(1.3333333333333333333*alpha*K*Z3 + + 2.*(da3*Theta + alpha*kappa1*Z3)) +; + +rG3 += +rG3 - ginv13*(1.3333333333333333333*alpha*K*Z1 + + 2.*(da1*Theta + alpha*kappa1*Z1)) - + ginv23*(1.3333333333333333333*alpha*K*Z2 + + 2.*(da2*Theta + alpha*kappa1*Z2)) - + ginv33*(1.3333333333333333333*alpha*K*Z3 + + 2.*(da3*Theta + alpha*kappa1*Z3)) +; +#endif + + } /* function */ +} diff --git a/AMSS_NCKU_source/zbesh.for b/AMSS_NCKU_source/zbesh.for new file mode 100644 index 0000000..0f30a2d --- /dev/null +++ b/AMSS_NCKU_source/zbesh.for @@ -0,0 +1,8217 @@ + SUBROUTINE ZBESH(ZR, ZI, FNU, KODE, M, N, CYR, CYI, NZ, IERR) +C***BEGIN PROLOGUE ZBESH +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS H-BESSEL FUNCTIONS,BESSEL FUNCTIONS OF COMPLEX ARGUMENT, +C BESSEL FUNCTIONS OF THIRD KIND,HANKEL FUNCTIONS +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE THE H-BESSEL FUNCTIONS OF A COMPLEX ARGUMENT +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C ON KODE=1, ZBESH COMPUTES AN N MEMBER SEQUENCE OF COMPLEX +C HANKEL (BESSEL) FUNCTIONS CY(J)=H(M,FNU+J-1,Z) FOR KINDS M=1 +C OR 2, REAL, NONNEGATIVE ORDERS FNU+J-1, J=1,...,N, AND COMPLEX +C Z.NE.CMPLX(0.0,0.0) IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. +C ON KODE=2, ZBESH RETURNS THE SCALED HANKEL FUNCTIONS +C +C CY(I)=EXP(-MM*Z*I)*H(M,FNU+J-1,Z) MM=3-2*M, I**2=-1. +C +C WHICH REMOVES THE EXPONENTIAL BEHAVIOR IN BOTH THE UPPER AND +C LOWER HALF PLANES. DEFINITIONS AND NOTATION ARE FOUND IN THE +C NBS HANDBOOK OF MATHEMATICAL FUNCTIONS (REF. 1). +C +C INPUT ZR,ZI,FNU ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0), +C -PT.LT.ARG(Z).LE.PI +C FNU - ORDER OF INITIAL H FUNCTION, FNU.GE.0.0D0 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C CY(J)=H(M,FNU+J-1,Z), J=1,...,N +C = 2 RETURNS +C CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) +C J=1,...,N , I**2=-1 +C M - KIND OF HANKEL FUNCTION, M=1 OR 2 +C N - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1 +C +C OUTPUT CYR,CYI ARE DOUBLE PRECISION +C CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS +C CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE +C CY(J)=H(M,FNU+J-1,Z) OR +C CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M)) J=1,...,N +C DEPENDING ON KODE, I**2=-1. +C NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, +C NZ= 0 , NORMAL RETURN +C NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE +C TO UNDERFLOW, CY(J)=CMPLX(0.0D0,0.0D0) +C J=1,...,NZ WHEN Y.GT.0.0 AND M=1 OR +C Y.LT.0.0 AND M=2. FOR THE COMPLMENTARY +C HALF PLANES, NZ STATES ONLY THE NUMBER +C OF UNDERFLOWS. +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, FNU TOO +C LARGE OR CABS(Z) TOO SMALL OR BOTH +C IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE +C BUT LOSSES OF SIGNIFCANCE BY ARGUMENT +C REDUCTION PRODUCE LESS THAN HALF OF MACHINE +C ACCURACY +C IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- +C TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- +C CANCE BY ARGUMENT REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C THE COMPUTATION IS CARRIED OUT BY THE RELATION +C +C H(M,FNU,Z)=(1/MP)*EXP(-MP*FNU)*K(FNU,Z*EXP(-MP)) +C MP=MM*HPI*I, MM=3-2*M, HPI=PI/2, I**2=-1 +C +C FOR M=1 OR 2 WHERE THE K BESSEL FUNCTION IS COMPUTED FOR THE +C RIGHT HALF PLANE RE(Z).GE.0.0. THE K FUNCTION IS CONTINUED +C TO THE LEFT HALF PLANE BY THE RELATION +C +C K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) +C MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 +C +C WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. +C +C EXPONENTIAL DECAY OF H(M,FNU,Z) OCCURS IN THE UPPER HALF Z +C PLANE FOR M=1 AND THE LOWER HALF Z PLANE FOR M=2. EXPONENTIAL +C GROWTH OCCURS IN THE COMPLEMENTARY HALF PLANES. SCALING +C BY EXP(-MM*Z*I) REMOVES THE EXPONENTIAL BEHAVIOR IN THE +C WHOLE Z PLANE FOR Z TO INFINITY. +C +C FOR NEGATIVE ORDERS,THE FORMULAE +C +C H(1,-FNU,Z) = H(1,FNU,Z)*CEXP( PI*FNU*I) +C H(2,-FNU,Z) = H(2,FNU,Z)*CEXP(-PI*FNU*I) +C I**2=-1 +C +C CAN BE USED. +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS +C LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. +C CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN +C LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG +C IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS +C LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS +C MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE +C INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS +C RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 +C ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION +C ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION +C ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN +C THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT +C TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS +C IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. +C SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0D-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,ZABS,I1MACH,D1MACH +C***END PROLOGUE ZBESH +C +C COMPLEX CY,Z,ZN,ZT,CSGN + EXTERNAL ZABS + DOUBLE PRECISION AA, ALIM, ALN, ARG, AZ, CYI, CYR, DIG, ELIM, + * FMM, FN, FNU, FNUL, HPI, RHPI, RL, R1M5, SGN, STR, TOL, UFL, ZI, + * ZNI, ZNR, ZR, ZTI, D1MACH, ZABS, BB, ASCLE, RTOL, ATOL, STI, + * CSGNR, CSGNI + INTEGER I, IERR, INU, INUH, IR, K, KODE, K1, K2, M, + * MM, MR, N, NN, NUF, NW, NZ, I1MACH + DIMENSION CYR(N), CYI(N) +C + DATA HPI /1.57079632679489662D0/ +C +C***FIRST EXECUTABLE STATEMENT ZBESH + IERR = 0 + NZ=0 + IF (ZR.EQ.0.0D0 .AND. ZI.EQ.0.0D0) IERR=1 + IF (FNU.LT.0.0D0) IERR=1 + IF (M.LT.1 .OR. M.GT.2) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (N.LT.1) IERR=1 + IF (IERR.NE.0) RETURN + NN = N +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU +C----------------------------------------------------------------------- + TOL = DMAX1(D1MACH(4),1.0D-18) + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0) + RL = 1.2D0*DIG + 3.0D0 + FN = FNU + DBLE(FLOAT(NN-1)) + MM = 3 - M - M + FMM = DBLE(FLOAT(MM)) + ZNR = FMM*ZI + ZNI = -FMM*ZR +C----------------------------------------------------------------------- +C TEST FOR PROPER RANGE +C----------------------------------------------------------------------- + AZ = ZABS(ZR,ZI) + AA = 0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA = DMIN1(AA,BB) + IF (AZ.GT.AA) GO TO 260 + IF (FN.GT.AA) GO TO 260 + AA = DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + IF (FN.GT.AA) IERR=3 +C----------------------------------------------------------------------- +C OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE +C----------------------------------------------------------------------- + UFL = D1MACH(1)*1.0D+3 + IF (AZ.LT.UFL) GO TO 230 + IF (FNU.GT.FNUL) GO TO 90 + IF (FN.LE.1.0D0) GO TO 70 + IF (FN.GT.2.0D0) GO TO 60 + IF (AZ.GT.TOL) GO TO 70 + ARG = 0.5D0*AZ + ALN = -FN*DLOG(ARG) + IF (ALN.GT.ELIM) GO TO 230 + GO TO 70 + 60 CONTINUE + CALL ZUOIK(ZNR, ZNI, FNU, KODE, 2, NN, CYR, CYI, NUF, TOL, ELIM, + * ALIM) + IF (NUF.LT.0) GO TO 230 + NZ = NZ + NUF + NN = NN - NUF +C----------------------------------------------------------------------- +C HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK +C IF NUF=NN, THEN CY(I)=CZERO FOR ALL I +C----------------------------------------------------------------------- + IF (NN.EQ.0) GO TO 140 + 70 CONTINUE + IF ((ZNR.LT.0.0D0) .OR. (ZNR.EQ.0.0D0 .AND. ZNI.LT.0.0D0 .AND. + * M.EQ.2)) GO TO 80 +C----------------------------------------------------------------------- +C RIGHT HALF PLANE COMPUTATION, XN.GE.0. .AND. (XN.NE.0. .OR. +C YN.GE.0. .OR. M=1) +C----------------------------------------------------------------------- + CALL ZBKNU(ZNR, ZNI, FNU, KODE, NN, CYR, CYI, NZ, TOL, ELIM, ALIM) + GO TO 110 +C----------------------------------------------------------------------- +C LEFT HALF PLANE COMPUTATION +C----------------------------------------------------------------------- + 80 CONTINUE + MR = -MM + CALL ZACON(ZNR, ZNI, FNU, KODE, MR, NN, CYR, CYI, NW, RL, FNUL, + * TOL, ELIM, ALIM) + IF (NW.LT.0) GO TO 240 + NZ=NW + GO TO 110 + 90 CONTINUE +C----------------------------------------------------------------------- +C UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU.GT.FNUL +C----------------------------------------------------------------------- + MR = 0 + IF ((ZNR.GE.0.0D0) .AND. (ZNR.NE.0.0D0 .OR. ZNI.GE.0.0D0 .OR. + * M.NE.2)) GO TO 100 + MR = -MM + IF (ZNR.NE.0.0D0 .OR. ZNI.GE.0.0D0) GO TO 100 + ZNR = -ZNR + ZNI = -ZNI + 100 CONTINUE + CALL ZBUNK(ZNR, ZNI, FNU, KODE, MR, NN, CYR, CYI, NW, TOL, ELIM, + * ALIM) + IF (NW.LT.0) GO TO 240 + NZ = NZ + NW + 110 CONTINUE +C----------------------------------------------------------------------- +C H(M,FNU,Z) = -FMM*(I/HPI)*(ZT**FNU)*K(FNU,-Z*ZT) +C +C ZT=EXP(-FMM*HPI*I) = CMPLX(0.0,-FMM), FMM=3-2*M, M=1,2 +C----------------------------------------------------------------------- + SGN = DSIGN(HPI,-FMM) +C----------------------------------------------------------------------- +C CALCULATE EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE +C WHEN FNU IS LARGE +C----------------------------------------------------------------------- + INU = INT(SNGL(FNU)) + INUH = INU/2 + IR = INU - 2*INUH + ARG = (FNU-DBLE(FLOAT(INU-IR)))*SGN + RHPI = 1.0D0/SGN +C ZNI = RHPI*DCOS(ARG) +C ZNR = -RHPI*DSIN(ARG) + CSGNI = RHPI*DCOS(ARG) + CSGNR = -RHPI*DSIN(ARG) + IF (MOD(INUH,2).EQ.0) GO TO 120 +C ZNR = -ZNR +C ZNI = -ZNI + CSGNR = -CSGNR + CSGNI = -CSGNI + 120 CONTINUE + ZTI = -FMM + RTOL = 1.0D0/TOL + ASCLE = UFL*RTOL + DO 130 I=1,NN +C STR = CYR(I)*ZNR - CYI(I)*ZNI +C CYI(I) = CYR(I)*ZNI + CYI(I)*ZNR +C CYR(I) = STR +C STR = -ZNI*ZTI +C ZNI = ZNR*ZTI +C ZNR = STR + AA = CYR(I) + BB = CYI(I) + ATOL = 1.0D0 + IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 135 + AA = AA*RTOL + BB = BB*RTOL + ATOL = TOL + 135 CONTINUE + STR = AA*CSGNR - BB*CSGNI + STI = AA*CSGNI + BB*CSGNR + CYR(I) = STR*ATOL + CYI(I) = STI*ATOL + STR = -CSGNI*ZTI + CSGNI = CSGNR*ZTI + CSGNR = STR + 130 CONTINUE + RETURN + 140 CONTINUE + IF (ZNR.LT.0.0D0) GO TO 230 + RETURN + 230 CONTINUE + NZ=0 + IERR=2 + RETURN + 240 CONTINUE + IF(NW.EQ.(-1)) GO TO 230 + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + NZ=0 + IERR=4 + RETURN + END + SUBROUTINE ZBESI(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR) +C***BEGIN PROLOGUE ZBESI +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS I-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, +C MODIFIED BESSEL FUNCTION OF THE FIRST KIND +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE I-BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C ON KODE=1, ZBESI COMPUTES AN N MEMBER SEQUENCE OF COMPLEX +C BESSEL FUNCTIONS CY(J)=I(FNU+J-1,Z) FOR REAL, NONNEGATIVE +C ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z IN THE CUT PLANE +C -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESI RETURNS THE SCALED +C FUNCTIONS +C +C CY(J)=EXP(-ABS(X))*I(FNU+J-1,Z) J = 1,...,N , X=REAL(Z) +C +C WITH THE EXPONENTIAL GROWTH REMOVED IN BOTH THE LEFT AND +C RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION +C ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS +C (REF. 1). +C +C INPUT ZR,ZI,FNU ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI), -PI.LT.ARG(Z).LE.PI +C FNU - ORDER OF INITIAL I FUNCTION, FNU.GE.0.0D0 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C CY(J)=I(FNU+J-1,Z), J=1,...,N +C = 2 RETURNS +C CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)), J=1,...,N +C N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 +C +C OUTPUT CYR,CYI ARE DOUBLE PRECISION +C CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS +C CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE +C CY(J)=I(FNU+J-1,Z) OR +C CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)) J=1,...,N +C DEPENDING ON KODE, X=REAL(Z) +C NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, +C NZ= 0 , NORMAL RETURN +C NZ.GT.0 , LAST NZ COMPONENTS OF CY SET TO ZERO +C TO UNDERFLOW, CY(J)=CMPLX(0.0D0,0.0D0) +C J = N-NZ+1,...,N +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) TOO +C LARGE ON KODE=1 +C IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE +C BUT LOSSES OF SIGNIFCANCE BY ARGUMENT +C REDUCTION PRODUCE LESS THAN HALF OF MACHINE +C ACCURACY +C IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- +C TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- +C CANCE BY ARGUMENT REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C THE COMPUTATION IS CARRIED OUT BY THE POWER SERIES FOR +C SMALL CABS(Z), THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z), +C THE MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN AND A +C NEUMANN SERIES FOR IMTERMEDIATE MAGNITUDES, AND THE +C UNIFORM ASYMPTOTIC EXPANSIONS FOR I(FNU,Z) AND J(FNU,Z) +C FOR LARGE ORDERS. BACKWARD RECURRENCE IS USED TO GENERATE +C SEQUENCES OR REDUCE ORDERS WHEN NECESSARY. +C +C THE CALCULATIONS ABOVE ARE DONE IN THE RIGHT HALF PLANE AND +C CONTINUED INTO THE LEFT HALF PLANE BY THE FORMULA +C +C I(FNU,Z*EXP(M*PI)) = EXP(M*PI*FNU)*I(FNU,Z) REAL(Z).GT.0.0 +C M = +I OR -I, I**2=-1 +C +C FOR NEGATIVE ORDERS,THE FORMULA +C +C I(-FNU,Z) = I(FNU,Z) + (2/PI)*SIN(PI*FNU)*K(FNU,Z) +C +C CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE +C THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE +C INTEGER,THE MAGNITUDE OF I(-FNU,Z)=I(FNU,Z) IS A LARGE +C NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, +C K(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF +C TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY +C UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN +C OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, +C LARGE MEANS FNU.GT.CABS(Z). +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS +C LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. +C CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN +C LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG +C IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS +C LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS +C MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE +C INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS +C RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 +C ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION +C ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION +C ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN +C THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT +C TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS +C IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. +C SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZBINU,ZABS,I1MACH,D1MACH +C***END PROLOGUE ZBESI +C COMPLEX CONE,CSGN,CW,CY,CZERO,Z,ZN + EXTERNAL ZABS + DOUBLE PRECISION AA, ALIM, ARG, CONEI, CONER, CSGNI, CSGNR, CYI, + * CYR, DIG, ELIM, FNU, FNUL, PI, RL, R1M5, STR, TOL, ZI, ZNI, ZNR, + * ZR, D1MACH, AZ, BB, FN, ZABS, ASCLE, RTOL, ATOL, STI + INTEGER I, IERR, INU, K, KODE, K1,K2,N,NZ,NN, I1MACH + DIMENSION CYR(N), CYI(N) + DATA PI /3.14159265358979324D0/ + DATA CONER, CONEI /1.0D0,0.0D0/ +C +C***FIRST EXECUTABLE STATEMENT ZBESI + IERR = 0 + NZ=0 + IF (FNU.LT.0.0D0) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (N.LT.1) IERR=1 + IF (IERR.NE.0) RETURN +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. +C----------------------------------------------------------------------- + TOL = DMAX1(D1MACH(4),1.0D-18) + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + RL = 1.2D0*DIG + 3.0D0 + FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0) +C----------------------------------------------------------------------------- +C TEST FOR PROPER RANGE +C----------------------------------------------------------------------- + AZ = ZABS(ZR,ZI) + FN = FNU+DBLE(FLOAT(N-1)) + AA = 0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA = DMIN1(AA,BB) + IF (AZ.GT.AA) GO TO 260 + IF (FN.GT.AA) GO TO 260 + AA = DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + IF (FN.GT.AA) IERR=3 + ZNR = ZR + ZNI = ZI + CSGNR = CONER + CSGNI = CONEI + IF (ZR.GE.0.0D0) GO TO 40 + ZNR = -ZR + ZNI = -ZI +C----------------------------------------------------------------------- +C CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE +C WHEN FNU IS LARGE +C----------------------------------------------------------------------- + INU = INT(SNGL(FNU)) + ARG = (FNU-DBLE(FLOAT(INU)))*PI + IF (ZI.LT.0.0D0) ARG = -ARG + CSGNR = DCOS(ARG) + CSGNI = DSIN(ARG) + IF (MOD(INU,2).EQ.0) GO TO 40 + CSGNR = -CSGNR + CSGNI = -CSGNI + 40 CONTINUE + CALL ZBINU(ZNR, ZNI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL, + * ELIM, ALIM) + IF (NZ.LT.0) GO TO 120 + IF (ZR.GE.0.0D0) RETURN +C----------------------------------------------------------------------- +C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE +C----------------------------------------------------------------------- + NN = N - NZ + IF (NN.EQ.0) RETURN + RTOL = 1.0D0/TOL + ASCLE = D1MACH(1)*RTOL*1.0D+3 + DO 50 I=1,NN +C STR = CYR(I)*CSGNR - CYI(I)*CSGNI +C CYI(I) = CYR(I)*CSGNI + CYI(I)*CSGNR +C CYR(I) = STR + AA = CYR(I) + BB = CYI(I) + ATOL = 1.0D0 + IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 55 + AA = AA*RTOL + BB = BB*RTOL + ATOL = TOL + 55 CONTINUE + STR = AA*CSGNR - BB*CSGNI + STI = AA*CSGNI + BB*CSGNR + CYR(I) = STR*ATOL + CYI(I) = STI*ATOL + CSGNR = -CSGNR + CSGNI = -CSGNI + 50 CONTINUE + RETURN + 120 CONTINUE + IF(NZ.EQ.(-2)) GO TO 130 + NZ = 0 + IERR=2 + RETURN + 130 CONTINUE + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + NZ=0 + IERR=4 + RETURN + END + SUBROUTINE ZBESJ(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR) +C***BEGIN PROLOGUE ZBESJ +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS J-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, +C BESSEL FUNCTION OF FIRST KIND +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE THE J-BESSEL FUNCTION OF A COMPLEX ARGUMENT +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C ON KODE=1, ZBESJ COMPUTES AN N MEMBER SEQUENCE OF COMPLEX +C BESSEL FUNCTIONS CY(I)=J(FNU+I-1,Z) FOR REAL, NONNEGATIVE +C ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE +C -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESJ RETURNS THE SCALED +C FUNCTIONS +C +C CY(I)=EXP(-ABS(Y))*J(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) +C +C WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND +C LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION +C ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS +C (REF. 1). +C +C INPUT ZR,ZI,FNU ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI), -PI.LT.ARG(Z).LE.PI +C FNU - ORDER OF INITIAL J FUNCTION, FNU.GE.0.0D0 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C CY(I)=J(FNU+I-1,Z), I=1,...,N +C = 2 RETURNS +C CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)), I=1,...,N +C N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 +C +C OUTPUT CYR,CYI ARE DOUBLE PRECISION +C CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS +C CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE +C CY(I)=J(FNU+I-1,Z) OR +C CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)) I=1,...,N +C DEPENDING ON KODE, Y=AIMAG(Z). +C NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW, +C NZ= 0 , NORMAL RETURN +C NZ.GT.0 , LAST NZ COMPONENTS OF CY SET ZERO DUE +C TO UNDERFLOW, CY(I)=CMPLX(0.0D0,0.0D0), +C I = N-NZ+1,...,N +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, AIMAG(Z) +C TOO LARGE ON KODE=1 +C IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE +C BUT LOSSES OF SIGNIFCANCE BY ARGUMENT +C REDUCTION PRODUCE LESS THAN HALF OF MACHINE +C ACCURACY +C IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- +C TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- +C CANCE BY ARGUMENT REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C THE COMPUTATION IS CARRIED OUT BY THE FORMULA +C +C J(FNU,Z)=EXP( FNU*PI*I/2)*I(FNU,-I*Z) AIMAG(Z).GE.0.0 +C +C J(FNU,Z)=EXP(-FNU*PI*I/2)*I(FNU, I*Z) AIMAG(Z).LT.0.0 +C +C WHERE I**2 = -1 AND I(FNU,Z) IS THE I BESSEL FUNCTION. +C +C FOR NEGATIVE ORDERS,THE FORMULA +C +C J(-FNU,Z) = J(FNU,Z)*COS(PI*FNU) - Y(FNU,Z)*SIN(PI*FNU) +C +C CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE +C THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE +C INTEGER,THE MAGNITUDE OF J(-FNU,Z)=J(FNU,Z)*COS(PI*FNU) IS A +C LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER, +C Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF +C TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY +C UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN +C OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE, +C LARGE MEANS FNU.GT.CABS(Z). +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS +C LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. +C CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN +C LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG +C IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS +C LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS +C MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE +C INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS +C RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 +C ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION +C ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION +C ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN +C THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT +C TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS +C IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. +C SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZBINU,ZABS,I1MACH,D1MACH +C***END PROLOGUE ZBESJ +C +C COMPLEX CI,CSGN,CY,Z,ZN + EXTERNAL ZABS + DOUBLE PRECISION AA, ALIM, ARG, CII, CSGNI, CSGNR, CYI, CYR, DIG, + * ELIM, FNU, FNUL, HPI, RL, R1M5, STR, TOL, ZI, ZNI, ZNR, ZR, + * D1MACH, BB, FN, AZ, ZABS, ASCLE, RTOL, ATOL, STI + INTEGER I, IERR, INU, INUH, IR, K, KODE, K1, K2, N, NL, NZ, I1MACH + DIMENSION CYR(N), CYI(N) + DATA HPI /1.57079632679489662D0/ +C +C***FIRST EXECUTABLE STATEMENT ZBESJ + IERR = 0 + NZ=0 + IF (FNU.LT.0.0D0) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (N.LT.1) IERR=1 + IF (IERR.NE.0) RETURN +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. +C----------------------------------------------------------------------- + TOL = DMAX1(D1MACH(4),1.0D-18) + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + RL = 1.2D0*DIG + 3.0D0 + FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0) +C----------------------------------------------------------------------- +C TEST FOR PROPER RANGE +C----------------------------------------------------------------------- + AZ = ZABS(ZR,ZI) + FN = FNU+DBLE(FLOAT(N-1)) + AA = 0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA = DMIN1(AA,BB) + IF (AZ.GT.AA) GO TO 260 + IF (FN.GT.AA) GO TO 260 + AA = DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + IF (FN.GT.AA) IERR=3 +C----------------------------------------------------------------------- +C CALCULATE CSGN=EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE +C WHEN FNU IS LARGE +C----------------------------------------------------------------------- + CII = 1.0D0 + INU = INT(SNGL(FNU)) + INUH = INU/2 + IR = INU - 2*INUH + ARG = (FNU-DBLE(FLOAT(INU-IR)))*HPI + CSGNR = DCOS(ARG) + CSGNI = DSIN(ARG) + IF (MOD(INUH,2).EQ.0) GO TO 40 + CSGNR = -CSGNR + CSGNI = -CSGNI + 40 CONTINUE +C----------------------------------------------------------------------- +C ZN IS IN THE RIGHT HALF PLANE +C----------------------------------------------------------------------- + ZNR = ZI + ZNI = -ZR + IF (ZI.GE.0.0D0) GO TO 50 + ZNR = -ZNR + ZNI = -ZNI + CSGNI = -CSGNI + CII = -CII + 50 CONTINUE + CALL ZBINU(ZNR, ZNI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL, + * ELIM, ALIM) + IF (NZ.LT.0) GO TO 130 + NL = N - NZ + IF (NL.EQ.0) RETURN + RTOL = 1.0D0/TOL + ASCLE = D1MACH(1)*RTOL*1.0D+3 + DO 60 I=1,NL +C STR = CYR(I)*CSGNR - CYI(I)*CSGNI +C CYI(I) = CYR(I)*CSGNI + CYI(I)*CSGNR +C CYR(I) = STR + AA = CYR(I) + BB = CYI(I) + ATOL = 1.0D0 + IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 55 + AA = AA*RTOL + BB = BB*RTOL + ATOL = TOL + 55 CONTINUE + STR = AA*CSGNR - BB*CSGNI + STI = AA*CSGNI + BB*CSGNR + CYR(I) = STR*ATOL + CYI(I) = STI*ATOL + STR = -CSGNI*CII + CSGNI = CSGNR*CII + CSGNR = STR + 60 CONTINUE + RETURN + 130 CONTINUE + IF(NZ.EQ.(-2)) GO TO 140 + NZ = 0 + IERR = 2 + RETURN + 140 CONTINUE + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + NZ=0 + IERR=4 + RETURN + END + SUBROUTINE ZBESK(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR) +C***BEGIN PROLOGUE ZBESK +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS K-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION, +C MODIFIED BESSEL FUNCTION OF THE SECOND KIND, +C BESSEL FUNCTION OF THE THIRD KIND +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE K-BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C +C ON KODE=1, ZBESK COMPUTES AN N MEMBER SEQUENCE OF COMPLEX +C BESSEL FUNCTIONS CY(J)=K(FNU+J-1,Z) FOR REAL, NONNEGATIVE +C ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z.NE.CMPLX(0.0,0.0) +C IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESK +C RETURNS THE SCALED K FUNCTIONS, +C +C CY(J)=EXP(Z)*K(FNU+J-1,Z) , J=1,...,N, +C +C WHICH REMOVE THE EXPONENTIAL BEHAVIOR IN BOTH THE LEFT AND +C RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND +C NOTATION ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL +C FUNCTIONS (REF. 1). +C +C INPUT ZR,ZI,FNU ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0), +C -PI.LT.ARG(Z).LE.PI +C FNU - ORDER OF INITIAL K FUNCTION, FNU.GE.0.0D0 +C N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C CY(I)=K(FNU+I-1,Z), I=1,...,N +C = 2 RETURNS +C CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N +C +C OUTPUT CYR,CYI ARE DOUBLE PRECISION +C CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS +C CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE +C CY(I)=K(FNU+I-1,Z), I=1,...,N OR +C CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N +C DEPENDING ON KODE +C NZ - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW. +C NZ= 0 , NORMAL RETURN +C NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE +C TO UNDERFLOW, CY(I)=CMPLX(0.0D0,0.0D0), +C I=1,...,N WHEN X.GE.0.0. WHEN X.LT.0.0 +C NZ STATES ONLY THE NUMBER OF UNDERFLOWS +C IN THE SEQUENCE. +C +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, FNU IS +C TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH +C IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE +C BUT LOSSES OF SIGNIFCANCE BY ARGUMENT +C REDUCTION PRODUCE LESS THAN HALF OF MACHINE +C ACCURACY +C IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- +C TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- +C CANCE BY ARGUMENT REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C EQUATIONS OF THE REFERENCE ARE IMPLEMENTED FOR SMALL ORDERS +C DNU AND DNU+1.0 IN THE RIGHT HALF PLANE X.GE.0.0. FORWARD +C RECURRENCE GENERATES HIGHER ORDERS. K IS CONTINUED TO THE LEFT +C HALF PLANE BY THE RELATION +C +C K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z) +C MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1 +C +C WHERE I(FNU,Z) IS THE I BESSEL FUNCTION. +C +C FOR LARGE ORDERS, FNU.GT.FNUL, THE K FUNCTION IS COMPUTED +C BY MEANS OF ITS UNIFORM ASYMPTOTIC EXPANSIONS. +C +C FOR NEGATIVE ORDERS, THE FORMULA +C +C K(-FNU,Z) = K(FNU,Z) +C +C CAN BE USED. +C +C ZBESK ASSUMES THAT A SIGNIFICANT DIGIT SINH(X) FUNCTION IS +C AVAILABLE. +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS +C LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. +C CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN +C LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG +C IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS +C LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS +C MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE +C INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS +C RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 +C ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION +C ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION +C ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN +C THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT +C TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS +C IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. +C SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983. +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZACON,ZBKNU,ZBUNK,ZUOIK,ZABS,I1MACH,D1MACH +C***END PROLOGUE ZBESK +C +C COMPLEX CY,Z + EXTERNAL ZABS + DOUBLE PRECISION AA, ALIM, ALN, ARG, AZ, CYI, CYR, DIG, ELIM, FN, + * FNU, FNUL, RL, R1M5, TOL, UFL, ZI, ZR, D1MACH, ZABS, BB + INTEGER IERR, K, KODE, K1, K2, MR, N, NN, NUF, NW, NZ, I1MACH + DIMENSION CYR(N), CYI(N) +C***FIRST EXECUTABLE STATEMENT ZBESK + IERR = 0 + NZ=0 + IF (ZI.EQ.0.0E0 .AND. ZR.EQ.0.0E0) IERR=1 + IF (FNU.LT.0.0D0) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (N.LT.1) IERR=1 + IF (IERR.NE.0) RETURN + NN = N +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU +C----------------------------------------------------------------------- + TOL = DMAX1(D1MACH(4),1.0D-18) + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0) + RL = 1.2D0*DIG + 3.0D0 +C----------------------------------------------------------------------------- +C TEST FOR PROPER RANGE +C----------------------------------------------------------------------- + AZ = ZABS(ZR,ZI) + FN = FNU + DBLE(FLOAT(NN-1)) + AA = 0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA = DMIN1(AA,BB) + IF (AZ.GT.AA) GO TO 260 + IF (FN.GT.AA) GO TO 260 + AA = DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + IF (FN.GT.AA) IERR=3 +C----------------------------------------------------------------------- +C OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE +C----------------------------------------------------------------------- +C UFL = DEXP(-ELIM) + UFL = D1MACH(1)*1.0D+3 + IF (AZ.LT.UFL) GO TO 180 + IF (FNU.GT.FNUL) GO TO 80 + IF (FN.LE.1.0D0) GO TO 60 + IF (FN.GT.2.0D0) GO TO 50 + IF (AZ.GT.TOL) GO TO 60 + ARG = 0.5D0*AZ + ALN = -FN*DLOG(ARG) + IF (ALN.GT.ELIM) GO TO 180 + GO TO 60 + 50 CONTINUE + CALL ZUOIK(ZR, ZI, FNU, KODE, 2, NN, CYR, CYI, NUF, TOL, ELIM, + * ALIM) + IF (NUF.LT.0) GO TO 180 + NZ = NZ + NUF + NN = NN - NUF +C----------------------------------------------------------------------- +C HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK +C IF NUF=NN, THEN CY(I)=CZERO FOR ALL I +C----------------------------------------------------------------------- + IF (NN.EQ.0) GO TO 100 + 60 CONTINUE + IF (ZR.LT.0.0D0) GO TO 70 +C----------------------------------------------------------------------- +C RIGHT HALF PLANE COMPUTATION, REAL(Z).GE.0. +C----------------------------------------------------------------------- + CALL ZBKNU(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM) + IF (NW.LT.0) GO TO 200 + NZ=NW + RETURN +C----------------------------------------------------------------------- +C LEFT HALF PLANE COMPUTATION +C PI/2.LT.ARG(Z).LE.PI AND -PI.LT.ARG(Z).LT.-PI/2. +C----------------------------------------------------------------------- + 70 CONTINUE + IF (NZ.NE.0) GO TO 180 + MR = 1 + IF (ZI.LT.0.0D0) MR = -1 + CALL ZACON(ZR, ZI, FNU, KODE, MR, NN, CYR, CYI, NW, RL, FNUL, + * TOL, ELIM, ALIM) + IF (NW.LT.0) GO TO 200 + NZ=NW + RETURN +C----------------------------------------------------------------------- +C UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU.GT.FNUL +C----------------------------------------------------------------------- + 80 CONTINUE + MR = 0 + IF (ZR.GE.0.0D0) GO TO 90 + MR = 1 + IF (ZI.LT.0.0D0) MR = -1 + 90 CONTINUE + CALL ZBUNK(ZR, ZI, FNU, KODE, MR, NN, CYR, CYI, NW, TOL, ELIM, + * ALIM) + IF (NW.LT.0) GO TO 200 + NZ = NZ + NW + RETURN + 100 CONTINUE + IF (ZR.LT.0.0D0) GO TO 180 + RETURN + 180 CONTINUE + NZ = 0 + IERR=2 + RETURN + 200 CONTINUE + IF(NW.EQ.(-1)) GO TO 180 + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + NZ=0 + IERR=4 + RETURN + END + SUBROUTINE ZBESY(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, CWRKR, + * CWRKI, IERR) +C***BEGIN PROLOGUE ZBESY +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS Y-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT, +C BESSEL FUNCTION OF SECOND KIND +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE THE Y-BESSEL FUNCTION OF A COMPLEX ARGUMENT +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C +C ON KODE=1, ZBESY COMPUTES AN N MEMBER SEQUENCE OF COMPLEX +C BESSEL FUNCTIONS CY(I)=Y(FNU+I-1,Z) FOR REAL, NONNEGATIVE +C ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE +C -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESY RETURNS THE SCALED +C FUNCTIONS +C +C CY(I)=EXP(-ABS(Y))*Y(FNU+I-1,Z) I = 1,...,N , Y=AIMAG(Z) +C +C WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND +C LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION +C ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS +C (REF. 1). +C +C INPUT ZR,ZI,FNU ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0), +C -PI.LT.ARG(Z).LE.PI +C FNU - ORDER OF INITIAL Y FUNCTION, FNU.GE.0.0D0 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C CY(I)=Y(FNU+I-1,Z), I=1,...,N +C = 2 RETURNS +C CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)), I=1,...,N +C WHERE Y=AIMAG(Z) +C N - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1 +C CWRKR, - DOUBLE PRECISION WORK VECTORS OF DIMENSION AT +C CWRKI AT LEAST N +C +C OUTPUT CYR,CYI ARE DOUBLE PRECISION +C CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS +C CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE +C CY(I)=Y(FNU+I-1,Z) OR +C CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)) I=1,...,N +C DEPENDING ON KODE. +C NZ - NZ=0 , A NORMAL RETURN +C NZ.GT.0 , NZ COMPONENTS OF CY SET TO ZERO DUE TO +C UNDERFLOW (GENERALLY ON KODE=2) +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, FNU IS +C TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH +C IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE +C BUT LOSSES OF SIGNIFCANCE BY ARGUMENT +C REDUCTION PRODUCE LESS THAN HALF OF MACHINE +C ACCURACY +C IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA- +C TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI- +C CANCE BY ARGUMENT REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C THE COMPUTATION IS CARRIED OUT IN TERMS OF THE I(FNU,Z) AND +C K(FNU,Z) BESSEL FUNCTIONS IN THE RIGHT HALF PLANE BY +C +C Y(FNU,Z) = I*CC*I(FNU,ARG) - (2/PI)*CONJG(CC)*K(FNU,ARG) +C +C Y(FNU,Z) = CONJG(Y(FNU,CONJG(Z))) +C +C FOR AIMAG(Z).GE.0 AND AIMAG(Z).LT.0 RESPECTIVELY, WHERE +C CC=EXP(I*PI*FNU/2), ARG=Z*EXP(-I*PI/2) AND I**2=-1. +C +C FOR NEGATIVE ORDERS,THE FORMULA +C +C Y(-FNU,Z) = Y(FNU,Z)*COS(PI*FNU) + J(FNU,Z)*SIN(PI*FNU) +C +C CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO HALF ODD +C INTEGERS THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE +C POSITIVE HALF ODD INTEGER,THE MAGNITUDE OF Y(-FNU,Z)=J(FNU,Z)* +C SIN(PI*FNU) IS A LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS +C NOT A HALF ODD INTEGER, Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A +C LARGE POSITIVE POWER OF TEN AND THE MOST THAT THE SECOND TERM +C CAN BE REDUCED IS BY UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, +C WIDE CHANGES CAN OCCUR WITHIN UNIT ROUNDOFF OF A LARGE HALF +C ODD INTEGER. HERE, LARGE MEANS FNU.GT.CABS(Z). +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS +C LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. +C CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN +C LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG +C IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS +C LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS +C MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE +C INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS +C RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3 +C ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION +C ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION +C ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN +C THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT +C TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS +C IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC. +C SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZBESI,ZBESK,I1MACH,D1MACH +C***END PROLOGUE ZBESY +C +C COMPLEX CWRK,CY,C1,C2,EX,HCI,Z,ZU,ZV + DOUBLE PRECISION ARG, ASCLE, CIPI, CIPR, CSGNI, CSGNR, CSPNI, + * CSPNR, CWRKI, CWRKR, CYI, CYR, D1M5, D1MACH, ELIM, EXI, EXR, EY, + * FNU, FFNU, HPI, RHPI, STR, STI, TAY, TOL, ATOL, RTOL, ZI, ZR, + * ZNI, ZNR, ZUI, ZUR, ZVI, ZVR, ZZI, ZZR + INTEGER I, IERR, IFNU, I4, K, KODE, K1, K2, N, NZ, NZ1, NZ2, + * I1MACH + DIMENSION CYR(N), CYI(N), CWRKR(N), CWRKI(N), CIPR(4), CIPI(4) + DATA CIPR(1),CIPR(2),CIPR(3),CIPR(4)/1.0D0, 0.0D0, -1.0D0, 0.0D0/ + DATA CIPI(1),CIPI(2),CIPI(3),CIPI(4)/0.0D0, 1.0D0, 0.0D0, -1.0D0/ + DATA HPI / 1.57079632679489662D0 / +C***FIRST EXECUTABLE STATEMENT ZBESY + IERR = 0 + NZ=0 + IF (ZR.EQ.0.0D0 .AND. ZI.EQ.0.0D0) IERR=1 + IF (FNU.LT.0.0D0) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (N.LT.1) IERR=1 + IF (IERR.NE.0) RETURN + ZZR = ZR + ZZI = ZI + IF (ZI.LT.0.0D0) ZZI = -ZZI + ZNR = ZZI + ZNI = -ZZR + CALL ZBESI(ZNR, ZNI, FNU, KODE, N, CYR, CYI, NZ1, IERR) + IF (IERR.NE.0.AND.IERR.NE.3) GO TO 90 + CALL ZBESK(ZNR, ZNI, FNU, KODE, N, CWRKR, CWRKI, NZ2, IERR) + IF (IERR.NE.0.AND.IERR.NE.3) GO TO 90 + NZ = MIN(NZ1,NZ2) + IFNU = INT(SNGL(FNU)) + FFNU = FNU - DBLE(FLOAT(IFNU)) + ARG = HPI*FFNU + CSGNR = COS(ARG) + CSGNI = SIN(ARG) + I4 = MOD(IFNU,4) + 1 + STR = CSGNR*CIPR(I4) - CSGNI*CIPI(I4) + CSGNI = CSGNR*CIPI(I4) + CSGNI*CIPR(I4) + CSGNR = STR + RHPI = 1.0D0/HPI + CSPNR = CSGNR*RHPI + CSPNI = -CSGNI*RHPI + STR = -CSGNI + CSGNI = CSGNR + CSGNR = STR + IF (KODE.EQ.2) GO TO 60 + DO 50 I=1,N +C CY(I) = CSGN*CY(I)-CSPN*CWRK(I) + STR = CSGNR*CYR(I) - CSGNI*CYI(I) + STR = STR - (CSPNR*CWRKR(I) - CSPNI*CWRKI(I)) + STI = CSGNR*CYI(I) + CSGNI*CYR(I) + STI = STI - (CSPNR*CWRKI(I) + CSPNI*CWRKR(I)) + CYR(I) = STR + CYI(I) = STI + STR = - CSGNI + CSGNI = CSGNR + CSGNR = STR + STR = CSPNI + CSPNI = -CSPNR + CSPNR = STR + 50 CONTINUE + IF (ZI.LT.0.0D0) THEN + DO 55 I=1,N + CYI(I) = -CYI(I) + 55 CONTINUE + ENDIF + RETURN + 60 CONTINUE + EXR = COS(ZR) + EXI = SIN(ZR) + TOL = MAX(D1MACH(4),1.0D-18) + K1 = I1MACH(15) + K2 = I1MACH(16) + K = MIN(IABS(K1),IABS(K2)) + D1M5 = D1MACH(5) +C----------------------------------------------------------------------- +C ELIM IS THE APPROXIMATE EXPONENTIAL UNDER- AND OVERFLOW LIMIT +C----------------------------------------------------------------------- + ELIM = 2.303D0*(DBLE(FLOAT(K))*D1M5-3.0D0) + EY = 0.0D0 + TAY = ABS(ZI+ZI) + IF (TAY.LT.ELIM) EY = EXP(-TAY) + STR = (EXR*CSPNR - EXI*CSPNI)*EY + CSPNI = (EXR*CSPNI + EXI*CSPNR)*EY + CSPNR = STR + NZ = 0 + RTOL = 1.0D0/TOL + ASCLE = D1MACH(1)*RTOL*1.0D+3 + DO 80 I=1,N +C---------------------------------------------------------------------- +C CY(I) = CSGN*CY(I)-CSPN*CWRK(I): PRODUCTS ARE COMPUTED IN +C SCALED MODE IF CY(I) OR CWRK(I) ARE CLOSE TO UNDERFLOW TO +C PREVENT UNDERFLOW IN AN INTERMEDIATE COMPUTATION. +C---------------------------------------------------------------------- + ZVR = CWRKR(I) + ZVI = CWRKI(I) + ATOL=1.0D0 + IF (MAX(ABS(ZVR),ABS(ZVI)).GT.ASCLE) GO TO 75 + ZVR = ZVR*RTOL + ZVI = ZVI*RTOL + ATOL = TOL + 75 CONTINUE + STR = (ZVR*CSPNR - ZVI*CSPNI)*ATOL + ZVI = (ZVR*CSPNI + ZVI*CSPNR)*ATOL + ZVR = STR + ZUR = CYR(I) + ZUI = CYI(I) + ATOL=1.0D0 + IF (MAX(ABS(ZUR),ABS(ZUI)).GT.ASCLE) GO TO 85 + ZUR = ZUR*RTOL + ZUI = ZUI*RTOL + ATOL = TOL + 85 CONTINUE + STR = (ZUR*CSGNR - ZUI*CSGNI)*ATOL + ZUI = (ZUR*CSGNI + ZUI*CSGNR)*ATOL + ZUR = STR + CYR(I) = ZUR - ZVR + CYI(I) = ZUI - ZVI + IF (ZI.LT.0.0D0) CYI(I) = -CYI(I) + IF (CYR(I).EQ.0.0D0 .AND. CYI(I).EQ.0.0D0 .AND. EY.EQ.0.0D0) + & NZ = NZ + 1 + STR = -CSGNI + CSGNI = CSGNR + CSGNR = STR + STR = CSPNI + CSPNI = -CSPNR + CSPNR = STR + 80 CONTINUE + RETURN + 90 CONTINUE + NZ = 0 + RETURN + END + SUBROUTINE ZAIRY(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR) +C***BEGIN PROLOGUE ZAIRY +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR +C ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON +C KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)* +C DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN +C -PI/3.LT.ARG(Z).LT.PI/3 AND THE EXPONENTIAL GROWTH IN +C PI/3.LT.ABS(ARG(Z)).LT.PI WHERE ZTA=(2/3)*Z*CSQRT(Z). +C +C WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN +C THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED +C FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS. +C DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF +C MATHEMATICAL FUNCTIONS (REF. 1). +C +C INPUT ZR,ZI ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI) +C ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C AI=AI(Z) ON ID=0 OR +C AI=DAI(Z)/DZ ON ID=1 +C = 2 RETURNS +C AI=CEXP(ZTA)*AI(Z) ON ID=0 OR +C AI=CEXP(ZTA)*DAI(Z)/DZ ON ID=1 WHERE +C ZTA=(2/3)*Z*CSQRT(Z) +C +C OUTPUT AIR,AII ARE DOUBLE PRECISION +C AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND +C KODE +C NZ - UNDERFLOW INDICATOR +C NZ= 0 , NORMAL RETURN +C NZ= 1 , AI=CMPLX(0.0D0,0.0D0) DUE TO UNDERFLOW IN +C -PI/3.LT.ARG(Z).LT.PI/3 ON KODE=1 +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, REAL(ZTA) +C TOO LARGE ON KODE=1 +C IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED +C LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION +C PRODUCE LESS THAN HALF OF MACHINE ACCURACY +C IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION +C COMPLETE LOSS OF ACCURACY BY ARGUMENT +C REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C AI AND DAI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE K BESSEL +C FUNCTIONS BY +C +C AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA) +C C=1.0/(PI*SQRT(3.0)) +C ZTA=(2/3)*Z**(3/2) +C +C WITH THE POWER SERIES FOR CABS(Z).LE.1.0. +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES +C OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF +C THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), +C THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR +C FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN +C ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT +C FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE +C LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA +C MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, +C AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE +C PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE +C PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- +C ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- +C NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN +C DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN +C EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, +C NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE +C PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER +C MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZACAI,ZBKNU,ZEXP,ZSQRT,ZABS,I1MACH,D1MACH +C***END PROLOGUE ZAIRY +C COMPLEX AI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3 + EXTERNAL ZABS + DOUBLE PRECISION AA, AD, AII, AIR, AK, ALIM, ATRM, AZ, AZ3, BK, + * CC, CK, COEF, CONEI, CONER, CSQI, CSQR, CYI, CYR, C1, C2, DIG, + * DK, D1, D2, ELIM, FID, FNU, PTR, RL, R1M5, SFAC, STI, STR, + * S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I, TRM2R, TTH, ZEROI, + * ZEROR, ZI, ZR, ZTAI, ZTAR, Z3I, Z3R, D1MACH, ZABS, ALAZ, BB + INTEGER ID, IERR, IFLAG, K, KODE, K1, K2, MR, NN, NZ, I1MACH + DIMENSION CYR(1), CYI(1) + DATA TTH, C1, C2, COEF /6.66666666666666667D-01, + * 3.55028053887817240D-01,2.58819403792806799D-01, + * 1.83776298473930683D-01/ + DATA ZEROR, ZEROI, CONER, CONEI /0.0D0,0.0D0,1.0D0,0.0D0/ +C***FIRST EXECUTABLE STATEMENT ZAIRY + IERR = 0 + NZ=0 + IF (ID.LT.0 .OR. ID.GT.1) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (IERR.NE.0) RETURN + AZ = ZABS(ZR,ZI) + TOL = DMAX1(D1MACH(4),1.0D-18) + FID = DBLE(FLOAT(ID)) + IF (AZ.GT.1.0D0) GO TO 70 +C----------------------------------------------------------------------- +C POWER SERIES FOR CABS(Z).LE.1. +C----------------------------------------------------------------------- + S1R = CONER + S1I = CONEI + S2R = CONER + S2I = CONEI + IF (AZ.LT.TOL) GO TO 170 + AA = AZ*AZ + IF (AA.LT.TOL/AZ) GO TO 40 + TRM1R = CONER + TRM1I = CONEI + TRM2R = CONER + TRM2I = CONEI + ATRM = 1.0D0 + STR = ZR*ZR - ZI*ZI + STI = ZR*ZI + ZI*ZR + Z3R = STR*ZR - STI*ZI + Z3I = STR*ZI + STI*ZR + AZ3 = AZ*AA + AK = 2.0D0 + FID + BK = 3.0D0 - FID - FID + CK = 4.0D0 - FID + DK = 3.0D0 + FID + FID + D1 = AK*DK + D2 = BK*CK + AD = DMIN1(D1,D2) + AK = 24.0D0 + 9.0D0*FID + BK = 30.0D0 - 9.0D0*FID + DO 30 K=1,25 + STR = (TRM1R*Z3R-TRM1I*Z3I)/D1 + TRM1I = (TRM1R*Z3I+TRM1I*Z3R)/D1 + TRM1R = STR + S1R = S1R + TRM1R + S1I = S1I + TRM1I + STR = (TRM2R*Z3R-TRM2I*Z3I)/D2 + TRM2I = (TRM2R*Z3I+TRM2I*Z3R)/D2 + TRM2R = STR + S2R = S2R + TRM2R + S2I = S2I + TRM2I + ATRM = ATRM*AZ3/AD + D1 = D1 + AK + D2 = D2 + BK + AD = DMIN1(D1,D2) + IF (ATRM.LT.TOL*AD) GO TO 40 + AK = AK + 18.0D0 + BK = BK + 18.0D0 + 30 CONTINUE + 40 CONTINUE + IF (ID.EQ.1) GO TO 50 + AIR = S1R*C1 - C2*(ZR*S2R-ZI*S2I) + AII = S1I*C1 - C2*(ZR*S2I+ZI*S2R) + IF (KODE.EQ.1) RETURN + CALL ZSQRT(ZR, ZI, STR, STI) + ZTAR = TTH*(ZR*STR-ZI*STI) + ZTAI = TTH*(ZR*STI+ZI*STR) + CALL ZEXP(ZTAR, ZTAI, STR, STI) + PTR = AIR*STR - AII*STI + AII = AIR*STI + AII*STR + AIR = PTR + RETURN + 50 CONTINUE + AIR = -S2R*C2 + AII = -S2I*C2 + IF (AZ.LE.TOL) GO TO 60 + STR = ZR*S1R - ZI*S1I + STI = ZR*S1I + ZI*S1R + CC = C1/(1.0D0+FID) + AIR = AIR + CC*(STR*ZR-STI*ZI) + AII = AII + CC*(STR*ZI+STI*ZR) + 60 CONTINUE + IF (KODE.EQ.1) RETURN + CALL ZSQRT(ZR, ZI, STR, STI) + ZTAR = TTH*(ZR*STR-ZI*STI) + ZTAI = TTH*(ZR*STI+ZI*STR) + CALL ZEXP(ZTAR, ZTAI, STR, STI) + PTR = STR*AIR - STI*AII + AII = STR*AII + STI*AIR + AIR = PTR + RETURN +C----------------------------------------------------------------------- +C CASE FOR CABS(Z).GT.1.0 +C----------------------------------------------------------------------- + 70 CONTINUE + FNU = (1.0D0+FID)/3.0D0 +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0D-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C----------------------------------------------------------------------- + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + RL = 1.2D0*DIG + 3.0D0 + ALAZ = DLOG(AZ) +C-------------------------------------------------------------------------- +C TEST FOR PROPER RANGE +C----------------------------------------------------------------------- + AA=0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA=DMIN1(AA,BB) + AA=AA**TTH + IF (AZ.GT.AA) GO TO 260 + AA=DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + CALL ZSQRT(ZR, ZI, CSQR, CSQI) + ZTAR = TTH*(ZR*CSQR-ZI*CSQI) + ZTAI = TTH*(ZR*CSQI+ZI*CSQR) +C----------------------------------------------------------------------- +C RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL +C----------------------------------------------------------------------- + IFLAG = 0 + SFAC = 1.0D0 + AK = ZTAI + IF (ZR.GE.0.0D0) GO TO 80 + BK = ZTAR + CK = -DABS(BK) + ZTAR = CK + ZTAI = AK + 80 CONTINUE + IF (ZI.NE.0.0D0) GO TO 90 + IF (ZR.GT.0.0D0) GO TO 90 + ZTAR = 0.0D0 + ZTAI = AK + 90 CONTINUE + AA = ZTAR + IF (AA.GE.0.0D0 .AND. ZR.GT.0.0D0) GO TO 110 + IF (KODE.EQ.2) GO TO 100 +C----------------------------------------------------------------------- +C OVERFLOW TEST +C----------------------------------------------------------------------- + IF (AA.GT.(-ALIM)) GO TO 100 + AA = -AA + 0.25D0*ALAZ + IFLAG = 1 + SFAC = TOL + IF (AA.GT.ELIM) GO TO 270 + 100 CONTINUE +C----------------------------------------------------------------------- +C CBKNU AND CACON RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2 +C----------------------------------------------------------------------- + MR = 1 + IF (ZI.LT.0.0D0) MR = -1 + CALL ZACAI(ZTAR, ZTAI, FNU, KODE, MR, 1, CYR, CYI, NN, RL, TOL, + * ELIM, ALIM) + IF (NN.LT.0) GO TO 280 + NZ = NZ + NN + GO TO 130 + 110 CONTINUE + IF (KODE.EQ.2) GO TO 120 +C----------------------------------------------------------------------- +C UNDERFLOW TEST +C----------------------------------------------------------------------- + IF (AA.LT.ALIM) GO TO 120 + AA = -AA - 0.25D0*ALAZ + IFLAG = 2 + SFAC = 1.0D0/TOL + IF (AA.LT.(-ELIM)) GO TO 210 + 120 CONTINUE + CALL ZBKNU(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, TOL, ELIM, + * ALIM) + 130 CONTINUE + S1R = CYR(1)*COEF + S1I = CYI(1)*COEF + IF (IFLAG.NE.0) GO TO 150 + IF (ID.EQ.1) GO TO 140 + AIR = CSQR*S1R - CSQI*S1I + AII = CSQR*S1I + CSQI*S1R + RETURN + 140 CONTINUE + AIR = -(ZR*S1R-ZI*S1I) + AII = -(ZR*S1I+ZI*S1R) + RETURN + 150 CONTINUE + S1R = S1R*SFAC + S1I = S1I*SFAC + IF (ID.EQ.1) GO TO 160 + STR = S1R*CSQR - S1I*CSQI + S1I = S1R*CSQI + S1I*CSQR + S1R = STR + AIR = S1R/SFAC + AII = S1I/SFAC + RETURN + 160 CONTINUE + STR = -(S1R*ZR-S1I*ZI) + S1I = -(S1R*ZI+S1I*ZR) + S1R = STR + AIR = S1R/SFAC + AII = S1I/SFAC + RETURN + 170 CONTINUE + AA = 1.0D+3*D1MACH(1) + S1R = ZEROR + S1I = ZEROI + IF (ID.EQ.1) GO TO 190 + IF (AZ.LE.AA) GO TO 180 + S1R = C2*ZR + S1I = C2*ZI + 180 CONTINUE + AIR = C1 - S1R + AII = -S1I + RETURN + 190 CONTINUE + AIR = -C2 + AII = 0.0D0 + AA = DSQRT(AA) + IF (AZ.LE.AA) GO TO 200 + S1R = 0.5D0*(ZR*ZR-ZI*ZI) + S1I = ZR*ZI + 200 CONTINUE + AIR = AIR + C1*S1R + AII = AII + C1*S1I + RETURN + 210 CONTINUE + NZ = 1 + AIR = ZEROR + AII = ZEROI + RETURN + 270 CONTINUE + NZ = 0 + IERR=2 + RETURN + 280 CONTINUE + IF(NN.EQ.(-1)) GO TO 270 + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + IERR=4 + NZ=0 + RETURN + END + SUBROUTINE ZBIRY(ZR, ZI, ID, KODE, BIR, BII, IERR) +C***BEGIN PROLOGUE ZBIRY +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 890801, 930101 (YYMMDD) +C***CATEGORY NO. B5K +C***KEYWORDS AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE AIRY FUNCTIONS BI(Z) AND DBI(Z) FOR COMPLEX Z +C***DESCRIPTION +C +C ***A DOUBLE PRECISION ROUTINE*** +C ON KODE=1, CBIRY COMPUTES THE COMPLEX AIRY FUNCTION BI(Z) OR +C ITS DERIVATIVE DBI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON +C KODE=2, A SCALING OPTION CEXP(-AXZTA)*BI(Z) OR CEXP(-AXZTA)* +C DBI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL BEHAVIOR IN +C BOTH THE LEFT AND RIGHT HALF PLANES WHERE +C ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA) AND AXZTA=ABS(XZTA). +C DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF +C MATHEMATICAL FUNCTIONS (REF. 1). +C +C INPUT ZR,ZI ARE DOUBLE PRECISION +C ZR,ZI - Z=CMPLX(ZR,ZI) +C ID - ORDER OF DERIVATIVE, ID=0 OR ID=1 +C KODE - A PARAMETER TO INDICATE THE SCALING OPTION +C KODE= 1 RETURNS +C BI=BI(Z) ON ID=0 OR +C BI=DBI(Z)/DZ ON ID=1 +C = 2 RETURNS +C BI=CEXP(-AXZTA)*BI(Z) ON ID=0 OR +C BI=CEXP(-AXZTA)*DBI(Z)/DZ ON ID=1 WHERE +C ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA) +C AND AXZTA=ABS(XZTA) +C +C OUTPUT BIR,BII ARE DOUBLE PRECISION +C BIR,BII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND +C KODE +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN - COMPUTATION COMPLETED +C IERR=1, INPUT ERROR - NO COMPUTATION +C IERR=2, OVERFLOW - NO COMPUTATION, REAL(Z) +C TOO LARGE ON KODE=1 +C IERR=3, CABS(Z) LARGE - COMPUTATION COMPLETED +C LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION +C PRODUCE LESS THAN HALF OF MACHINE ACCURACY +C IERR=4, CABS(Z) TOO LARGE - NO COMPUTATION +C COMPLETE LOSS OF ACCURACY BY ARGUMENT +C REDUCTION +C IERR=5, ERROR - NO COMPUTATION, +C ALGORITHM TERMINATION CONDITION NOT MET +C +C***LONG DESCRIPTION +C +C BI AND DBI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE I BESSEL +C FUNCTIONS BY +C +C BI(Z)=C*SQRT(Z)*( I(-1/3,ZTA) + I(1/3,ZTA) ) +C DBI(Z)=C * Z * ( I(-2/3,ZTA) + I(2/3,ZTA) ) +C C=1.0/SQRT(3.0) +C ZTA=(2/3)*Z**(3/2) +C +C WITH THE POWER SERIES FOR CABS(Z).LE.1.0. +C +C IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE- +C MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES +C OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF +C THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR), +C THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR +C FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS +C DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION. +C ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN +C ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT +C FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE +C LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA +C MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, +C AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE +C PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE +C PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT- +C ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG- +C NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN +C DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN +C EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, +C NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE +C PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER +C MACHINES. +C +C THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX +C BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT +C ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE- +C SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE +C ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))), +C ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF +C CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY +C HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN +C ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY +C SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER +C THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K, +C 0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS +C THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER +C COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY +C BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER +C COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE +C MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES, +C THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P, +C OR -PI/2+P. +C +C***REFERENCES HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ +C AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF +C COMMERCE, 1955. +C +C COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983 +C +C A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85- +C 1018, MAY, 1985 +C +C A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX +C ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, ACM +C TRANS. MATH. SOFTWARE, VOL. 12, NO. 3, SEPTEMBER 1986, +C PP 265-273. +C +C***ROUTINES CALLED ZBINU,ZABS,ZDIV,ZSQRT,D1MACH,I1MACH +C***END PROLOGUE ZBIRY +C COMPLEX BI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3 + EXTERNAL ZABS + DOUBLE PRECISION AA, AD, AK, ALIM, ATRM, AZ, AZ3, BB, BII, BIR, + * BK, CC, CK, COEF, CONEI, CONER, CSQI, CSQR, CYI, CYR, C1, C2, + * DIG, DK, D1, D2, EAA, ELIM, FID, FMR, FNU, FNUL, PI, RL, R1M5, + * SFAC, STI, STR, S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I, + * TRM2R, TTH, ZI, ZR, ZTAI, ZTAR, Z3I, Z3R, D1MACH, ZABS + INTEGER ID, IERR, K, KODE, K1, K2, NZ, I1MACH + DIMENSION CYR(2), CYI(2) + DATA TTH, C1, C2, COEF, PI /6.66666666666666667D-01, + * 6.14926627446000736D-01,4.48288357353826359D-01, + * 5.77350269189625765D-01,3.14159265358979324D+00/ + DATA CONER, CONEI /1.0D0,0.0D0/ +C***FIRST EXECUTABLE STATEMENT ZBIRY + IERR = 0 + NZ=0 + IF (ID.LT.0 .OR. ID.GT.1) IERR=1 + IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 + IF (IERR.NE.0) RETURN + AZ = ZABS(ZR,ZI) + TOL = DMAX1(D1MACH(4),1.0D-18) + FID = DBLE(FLOAT(ID)) + IF (AZ.GT.1.0E0) GO TO 70 +C----------------------------------------------------------------------- +C POWER SERIES FOR CABS(Z).LE.1. +C----------------------------------------------------------------------- + S1R = CONER + S1I = CONEI + S2R = CONER + S2I = CONEI + IF (AZ.LT.TOL) GO TO 130 + AA = AZ*AZ + IF (AA.LT.TOL/AZ) GO TO 40 + TRM1R = CONER + TRM1I = CONEI + TRM2R = CONER + TRM2I = CONEI + ATRM = 1.0D0 + STR = ZR*ZR - ZI*ZI + STI = ZR*ZI + ZI*ZR + Z3R = STR*ZR - STI*ZI + Z3I = STR*ZI + STI*ZR + AZ3 = AZ*AA + AK = 2.0D0 + FID + BK = 3.0D0 - FID - FID + CK = 4.0D0 - FID + DK = 3.0D0 + FID + FID + D1 = AK*DK + D2 = BK*CK + AD = DMIN1(D1,D2) + AK = 24.0D0 + 9.0D0*FID + BK = 30.0D0 - 9.0D0*FID + DO 30 K=1,25 + STR = (TRM1R*Z3R-TRM1I*Z3I)/D1 + TRM1I = (TRM1R*Z3I+TRM1I*Z3R)/D1 + TRM1R = STR + S1R = S1R + TRM1R + S1I = S1I + TRM1I + STR = (TRM2R*Z3R-TRM2I*Z3I)/D2 + TRM2I = (TRM2R*Z3I+TRM2I*Z3R)/D2 + TRM2R = STR + S2R = S2R + TRM2R + S2I = S2I + TRM2I + ATRM = ATRM*AZ3/AD + D1 = D1 + AK + D2 = D2 + BK + AD = DMIN1(D1,D2) + IF (ATRM.LT.TOL*AD) GO TO 40 + AK = AK + 18.0D0 + BK = BK + 18.0D0 + 30 CONTINUE + 40 CONTINUE + IF (ID.EQ.1) GO TO 50 + BIR = C1*S1R + C2*(ZR*S2R-ZI*S2I) + BII = C1*S1I + C2*(ZR*S2I+ZI*S2R) + IF (KODE.EQ.1) RETURN + CALL ZSQRT(ZR, ZI, STR, STI) + ZTAR = TTH*(ZR*STR-ZI*STI) + ZTAI = TTH*(ZR*STI+ZI*STR) + AA = ZTAR + AA = -DABS(AA) + EAA = DEXP(AA) + BIR = BIR*EAA + BII = BII*EAA + RETURN + 50 CONTINUE + BIR = S2R*C2 + BII = S2I*C2 + IF (AZ.LE.TOL) GO TO 60 + CC = C1/(1.0D0+FID) + STR = S1R*ZR - S1I*ZI + STI = S1R*ZI + S1I*ZR + BIR = BIR + CC*(STR*ZR-STI*ZI) + BII = BII + CC*(STR*ZI+STI*ZR) + 60 CONTINUE + IF (KODE.EQ.1) RETURN + CALL ZSQRT(ZR, ZI, STR, STI) + ZTAR = TTH*(ZR*STR-ZI*STI) + ZTAI = TTH*(ZR*STI+ZI*STR) + AA = ZTAR + AA = -DABS(AA) + EAA = DEXP(AA) + BIR = BIR*EAA + BII = BII*EAA + RETURN +C----------------------------------------------------------------------- +C CASE FOR CABS(Z).GT.1.0 +C----------------------------------------------------------------------- + 70 CONTINUE + FNU = (1.0D0+FID)/3.0D0 +C----------------------------------------------------------------------- +C SET PARAMETERS RELATED TO MACHINE CONSTANTS. +C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. +C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. +C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND +C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR +C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. +C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. +C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). +C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. +C----------------------------------------------------------------------- + K1 = I1MACH(15) + K2 = I1MACH(16) + R1M5 = D1MACH(5) + K = MIN0(IABS(K1),IABS(K2)) + ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0) + K1 = I1MACH(14) - 1 + AA = R1M5*DBLE(FLOAT(K1)) + DIG = DMIN1(AA,18.0D0) + AA = AA*2.303D0 + ALIM = ELIM + DMAX1(-AA,-41.45D0) + RL = 1.2D0*DIG + 3.0D0 + FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0) +C----------------------------------------------------------------------- +C TEST FOR RANGE +C----------------------------------------------------------------------- + AA=0.5D0/TOL + BB=DBLE(FLOAT(I1MACH(9)))*0.5D0 + AA=DMIN1(AA,BB) + AA=AA**TTH + IF (AZ.GT.AA) GO TO 260 + AA=DSQRT(AA) + IF (AZ.GT.AA) IERR=3 + CALL ZSQRT(ZR, ZI, CSQR, CSQI) + ZTAR = TTH*(ZR*CSQR-ZI*CSQI) + ZTAI = TTH*(ZR*CSQI+ZI*CSQR) +C----------------------------------------------------------------------- +C RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL +C----------------------------------------------------------------------- + SFAC = 1.0D0 + AK = ZTAI + IF (ZR.GE.0.0D0) GO TO 80 + BK = ZTAR + CK = -DABS(BK) + ZTAR = CK + ZTAI = AK + 80 CONTINUE + IF (ZI.NE.0.0D0 .OR. ZR.GT.0.0D0) GO TO 90 + ZTAR = 0.0D0 + ZTAI = AK + 90 CONTINUE + AA = ZTAR + IF (KODE.EQ.2) GO TO 100 +C----------------------------------------------------------------------- +C OVERFLOW TEST +C----------------------------------------------------------------------- + BB = DABS(AA) + IF (BB.LT.ALIM) GO TO 100 + BB = BB + 0.25D0*DLOG(AZ) + SFAC = TOL + IF (BB.GT.ELIM) GO TO 190 + 100 CONTINUE + FMR = 0.0D0 + IF (AA.GE.0.0D0 .AND. ZR.GT.0.0D0) GO TO 110 + FMR = PI + IF (ZI.LT.0.0D0) FMR = -PI + ZTAR = -ZTAR + ZTAI = -ZTAI + 110 CONTINUE +C----------------------------------------------------------------------- +C AA=FACTOR FOR ANALYTIC CONTINUATION OF I(FNU,ZTA) +C KODE=2 RETURNS EXP(-ABS(XZTA))*I(FNU,ZTA) FROM ZBESI +C----------------------------------------------------------------------- + CALL ZBINU(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, RL, FNUL, TOL, + * ELIM, ALIM) + IF (NZ.LT.0) GO TO 200 + AA = FMR*FNU + Z3R = SFAC + STR = DCOS(AA) + STI = DSIN(AA) + S1R = (STR*CYR(1)-STI*CYI(1))*Z3R + S1I = (STR*CYI(1)+STI*CYR(1))*Z3R + FNU = (2.0D0-FID)/3.0D0 + CALL ZBINU(ZTAR, ZTAI, FNU, KODE, 2, CYR, CYI, NZ, RL, FNUL, TOL, + * ELIM, ALIM) + CYR(1) = CYR(1)*Z3R + CYI(1) = CYI(1)*Z3R + CYR(2) = CYR(2)*Z3R + CYI(2) = CYI(2)*Z3R +C----------------------------------------------------------------------- +C BACKWARD RECUR ONE STEP FOR ORDERS -1/3 OR -2/3 +C----------------------------------------------------------------------- + CALL ZDIV(CYR(1), CYI(1), ZTAR, ZTAI, STR, STI) + S2R = (FNU+FNU)*STR + CYR(2) + S2I = (FNU+FNU)*STI + CYI(2) + AA = FMR*(FNU-1.0D0) + STR = DCOS(AA) + STI = DSIN(AA) + S1R = COEF*(S1R+S2R*STR-S2I*STI) + S1I = COEF*(S1I+S2R*STI+S2I*STR) + IF (ID.EQ.1) GO TO 120 + STR = CSQR*S1R - CSQI*S1I + S1I = CSQR*S1I + CSQI*S1R + S1R = STR + BIR = S1R/SFAC + BII = S1I/SFAC + RETURN + 120 CONTINUE + STR = ZR*S1R - ZI*S1I + S1I = ZR*S1I + ZI*S1R + S1R = STR + BIR = S1R/SFAC + BII = S1I/SFAC + RETURN + 130 CONTINUE + AA = C1*(1.0D0-FID) + FID*C2 + BIR = AA + BII = 0.0D0 + RETURN + 190 CONTINUE + IERR=2 + NZ=0 + RETURN + 200 CONTINUE + IF(NZ.EQ.(-1)) GO TO 190 + NZ=0 + IERR=5 + RETURN + 260 CONTINUE + IERR=4 + NZ=0 + RETURN + END + SUBROUTINE ZMLT(AR, AI, BR, BI, CR, CI) +C***BEGIN PROLOGUE ZMLT +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C DOUBLE PRECISION COMPLEX MULTIPLY, C=A*B. +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE ZMLT + DOUBLE PRECISION AR, AI, BR, BI, CR, CI, CA, CB + CA = AR*BR - AI*BI + CB = AR*BI + AI*BR + CR = CA + CI = CB + RETURN + END + SUBROUTINE ZDIV(AR, AI, BR, BI, CR, CI) +C***BEGIN PROLOGUE ZDIV +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C DOUBLE PRECISION COMPLEX DIVIDE C=A/B. +C +C***ROUTINES CALLED ZABS +C***END PROLOGUE ZDIV + EXTERNAL ZABS + DOUBLE PRECISION AR, AI, BR, BI, CR, CI, BM, CA, CB, CC, CD + DOUBLE PRECISION ZABS + BM = 1.0D0/ZABS(BR,BI) + CC = BR*BM + CD = BI*BM + CA = (AR*CC+AI*CD)*BM + CB = (AI*CC-AR*CD)*BM + CR = CA + CI = CB + RETURN + END + SUBROUTINE ZSQRT(AR, AI, BR, BI) +C***BEGIN PROLOGUE ZSQRT +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C DOUBLE PRECISION COMPLEX SQUARE ROOT, B=CSQRT(A) +C +C***ROUTINES CALLED ZABS +C***END PROLOGUE ZSQRT + EXTERNAL ZABS + DOUBLE PRECISION AR, AI, BR, BI, ZM, DTHETA, DPI, DRT + DOUBLE PRECISION ZABS + DATA DRT , DPI / 7.071067811865475244008443621D-1, + 1 3.141592653589793238462643383D+0/ + ZM = ZABS(AR,AI) + ZM = DSQRT(ZM) + IF (AR.EQ.0.0D+0) GO TO 10 + IF (AI.EQ.0.0D+0) GO TO 20 + DTHETA = DATAN(AI/AR) + IF (DTHETA.LE.0.0D+0) GO TO 40 + IF (AR.LT.0.0D+0) DTHETA = DTHETA - DPI + GO TO 50 + 10 IF (AI.GT.0.0D+0) GO TO 60 + IF (AI.LT.0.0D+0) GO TO 70 + BR = 0.0D+0 + BI = 0.0D+0 + RETURN + 20 IF (AR.GT.0.0D+0) GO TO 30 + BR = 0.0D+0 + BI = DSQRT(DABS(AR)) + RETURN + 30 BR = DSQRT(AR) + BI = 0.0D+0 + RETURN + 40 IF (AR.LT.0.0D+0) DTHETA = DTHETA + DPI + 50 DTHETA = DTHETA*0.5D+0 + BR = ZM*DCOS(DTHETA) + BI = ZM*DSIN(DTHETA) + RETURN + 60 BR = ZM*DRT + BI = ZM*DRT + RETURN + 70 BR = ZM*DRT + BI = -ZM*DRT + RETURN + END + SUBROUTINE ZEXP(AR, AI, BR, BI) +C***BEGIN PROLOGUE ZEXP +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C DOUBLE PRECISION COMPLEX EXPONENTIAL FUNCTION B=EXP(A) +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE ZEXP + DOUBLE PRECISION AR, AI, BR, BI, ZM, CA, CB + ZM = DEXP(AR) + CA = ZM*DCOS(AI) + CB = ZM*DSIN(AI) + BR = CA + BI = CB + RETURN + END + SUBROUTINE ZLOG(AR, AI, BR, BI, IERR) +C***BEGIN PROLOGUE ZLOG +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C DOUBLE PRECISION COMPLEX LOGARITHM B=CLOG(A) +C IERR=0,NORMAL RETURN IERR=1, Z=CMPLX(0.0,0.0) +C***ROUTINES CALLED ZABS +C***END PROLOGUE ZLOG + EXTERNAL ZABS + DOUBLE PRECISION AR, AI, BR, BI, ZM, DTHETA, DPI, DHPI + DOUBLE PRECISION ZABS + INTEGER IERR + DATA DPI , DHPI / 3.141592653589793238462643383D+0, + 1 1.570796326794896619231321696D+0/ +C + IERR=0 + IF (AR.EQ.0.0D+0) GO TO 10 + IF (AI.EQ.0.0D+0) GO TO 20 + DTHETA = DATAN(AI/AR) + IF (DTHETA.LE.0.0D+0) GO TO 40 + IF (AR.LT.0.0D+0) DTHETA = DTHETA - DPI + GO TO 50 + 10 IF (AI.EQ.0.0D+0) GO TO 60 + BI = DHPI + BR = DLOG(DABS(AI)) + IF (AI.LT.0.0D+0) BI = -BI + RETURN + 20 IF (AR.GT.0.0D+0) GO TO 30 + BR = DLOG(DABS(AR)) + BI = DPI + RETURN + 30 BR = DLOG(AR) + BI = 0.0D+0 + RETURN + 40 IF (AR.LT.0.0D+0) DTHETA = DTHETA + DPI + 50 ZM = ZABS(AR,AI) + BR = DLOG(ZM) + BI = DTHETA + RETURN + 60 CONTINUE + IERR=1 + RETURN + END + DOUBLE PRECISION FUNCTION ZABS(ZR, ZI) +C***BEGIN PROLOGUE ZABS +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY +C +C ZABS COMPUTES THE ABSOLUTE VALUE OR MAGNITUDE OF A DOUBLE +C PRECISION COMPLEX VARIABLE CMPLX(ZR,ZI) +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE ZABS + DOUBLE PRECISION ZR, ZI, U, V, Q, S + U = DABS(ZR) + V = DABS(ZI) + S = U + V +C----------------------------------------------------------------------- +C S*1.0D0 MAKES AN UNNORMALIZED UNDERFLOW ON CDC MACHINES INTO A +C TRUE FLOATING ZERO +C----------------------------------------------------------------------- + S = S*1.0D+0 + IF (S.EQ.0.0D+0) GO TO 20 + IF (U.GT.V) GO TO 10 + Q = U/V + ZABS = V*DSQRT(1.D+0+Q*Q) + RETURN + 10 Q = V/U + ZABS = U*DSQRT(1.D+0+Q*Q) + RETURN + 20 ZABS = 0.0D+0 + RETURN + END + SUBROUTINE ZBKNU(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZBKNU +C***REFER TO ZBESI,ZBESK,ZAIRY,ZBESH +C +C ZBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE. +C +C***ROUTINES CALLED DGAMLN,I1MACH,D1MACH,ZKSCL,ZSHCH,ZUCHK,ZABS,ZDIV, +C ZEXP,ZLOG,ZMLT,ZSQRT +C***END PROLOGUE ZBKNU +C + EXTERNAL ZABS + DOUBLE PRECISION AA, AK, ALIM, ASCLE, A1, A2, BB, BK, BRY, CAZ, + * CBI, CBR, CC, CCHI, CCHR, CKI, CKR, COEFI, COEFR, CONEI, CONER, + * CRSCR, CSCLR, CSHI, CSHR, CSI, CSR, CSRR, CSSR, CTWOR, + * CZEROI, CZEROR, CZI, CZR, DNU, DNU2, DPI, ELIM, ETEST, FC, FHS, + * FI, FK, FKS, FMUI, FMUR, FNU, FPI, FR, G1, G2, HPI, PI, PR, PTI, + * PTR, P1I, P1R, P2I, P2M, P2R, QI, QR, RAK, RCAZ, RTHPI, RZI, + * RZR, R1, S, SMUI, SMUR, SPI, STI, STR, S1I, S1R, S2I, S2R, TM, + * TOL, TTH, T1, T2, YI, YR, ZI, ZR, DGAMLN, D1MACH, ZABS, ELM, + * CELMR, ZDR, ZDI, AS, ALAS, HELIM, CYR, CYI + INTEGER I, IFLAG, INU, K, KFLAG, KK, KMAX, KODE, KODED, N, NZ, + * IDUM, I1MACH, J, IC, INUB, NW + DIMENSION YR(N), YI(N), CC(8), CSSR(3), CSRR(3), BRY(3), CYR(2), + * CYI(2) +C COMPLEX Z,Y,A,B,RZ,SMU,FU,FMU,F,FLRZ,CZ,S1,S2,CSH,CCH +C COMPLEX CK,P,Q,COEF,P1,P2,CBK,PT,CZERO,CONE,CTWO,ST,EZ,CS,DK +C + DATA KMAX / 30 / + DATA CZEROR,CZEROI,CONER,CONEI,CTWOR,R1/ + 1 0.0D0 , 0.0D0 , 1.0D0 , 0.0D0 , 2.0D0 , 2.0D0 / + DATA DPI, RTHPI, SPI ,HPI, FPI, TTH / + 1 3.14159265358979324D0, 1.25331413731550025D0, + 2 1.90985931710274403D0, 1.57079632679489662D0, + 3 1.89769999331517738D0, 6.66666666666666666D-01/ + DATA CC(1), CC(2), CC(3), CC(4), CC(5), CC(6), CC(7), CC(8)/ + 1 5.77215664901532861D-01, -4.20026350340952355D-02, + 2 -4.21977345555443367D-02, 7.21894324666309954D-03, + 3 -2.15241674114950973D-04, -2.01348547807882387D-05, + 4 1.13302723198169588D-06, 6.11609510448141582D-09/ +C + CAZ = ZABS(ZR,ZI) + CSCLR = 1.0D0/TOL + CRSCR = TOL + CSSR(1) = CSCLR + CSSR(2) = 1.0D0 + CSSR(3) = CRSCR + CSRR(1) = CRSCR + CSRR(2) = 1.0D0 + CSRR(3) = CSCLR + BRY(1) = 1.0D+3*D1MACH(1)/TOL + BRY(2) = 1.0D0/BRY(1) + BRY(3) = D1MACH(2) + NZ = 0 + IFLAG = 0 + KODED = KODE + RCAZ = 1.0D0/CAZ + STR = ZR*RCAZ + STI = -ZI*RCAZ + RZR = (STR+STR)*RCAZ + RZI = (STI+STI)*RCAZ + INU = INT(FNU+0.5D0) + DNU = FNU - DBLE(FLOAT(INU)) + IF (DABS(DNU).EQ.0.5D0) GO TO 110 + DNU2 = 0.0D0 + IF (DABS(DNU).GT.TOL) DNU2 = DNU*DNU + IF (CAZ.GT.R1) GO TO 110 +C----------------------------------------------------------------------- +C SERIES FOR CABS(Z).LE.R1 +C----------------------------------------------------------------------- + FC = 1.0D0 + CALL ZLOG(RZR, RZI, SMUR, SMUI, IDUM) + FMUR = SMUR*DNU + FMUI = SMUI*DNU + CALL ZSHCH(FMUR, FMUI, CSHR, CSHI, CCHR, CCHI) + IF (DNU.EQ.0.0D0) GO TO 10 + FC = DNU*DPI + FC = FC/DSIN(FC) + SMUR = CSHR/DNU + SMUI = CSHI/DNU + 10 CONTINUE + A2 = 1.0D0 + DNU +C----------------------------------------------------------------------- +C GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU) +C----------------------------------------------------------------------- + T2 = DEXP(-DGAMLN(A2,IDUM)) + T1 = 1.0D0/(T2*FC) + IF (DABS(DNU).GT.0.1D0) GO TO 40 +C----------------------------------------------------------------------- +C SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) +C----------------------------------------------------------------------- + AK = 1.0D0 + S = CC(1) + DO 20 K=2,8 + AK = AK*DNU2 + TM = CC(K)*AK + S = S + TM + IF (DABS(TM).LT.TOL) GO TO 30 + 20 CONTINUE + 30 G1 = -S + GO TO 50 + 40 CONTINUE + G1 = (T1-T2)/(DNU+DNU) + 50 CONTINUE + G2 = (T1+T2)*0.5D0 + FR = FC*(CCHR*G1+SMUR*G2) + FI = FC*(CCHI*G1+SMUI*G2) + CALL ZEXP(FMUR, FMUI, STR, STI) + PR = 0.5D0*STR/T2 + PI = 0.5D0*STI/T2 + CALL ZDIV(0.5D0, 0.0D0, STR, STI, PTR, PTI) + QR = PTR/T1 + QI = PTI/T1 + S1R = FR + S1I = FI + S2R = PR + S2I = PI + AK = 1.0D0 + A1 = 1.0D0 + CKR = CONER + CKI = CONEI + BK = 1.0D0 - DNU2 + IF (INU.GT.0 .OR. N.GT.1) GO TO 80 +C----------------------------------------------------------------------- +C GENERATE K(FNU,Z), 0.0D0 .LE. FNU .LT. 0.5D0 AND N=1 +C----------------------------------------------------------------------- + IF (CAZ.LT.TOL) GO TO 70 + CALL ZMLT(ZR, ZI, ZR, ZI, CZR, CZI) + CZR = 0.25D0*CZR + CZI = 0.25D0*CZI + T1 = 0.25D0*CAZ*CAZ + 60 CONTINUE + FR = (FR*AK+PR+QR)/BK + FI = (FI*AK+PI+QI)/BK + STR = 1.0D0/(AK-DNU) + PR = PR*STR + PI = PI*STR + STR = 1.0D0/(AK+DNU) + QR = QR*STR + QI = QI*STR + STR = CKR*CZR - CKI*CZI + RAK = 1.0D0/AK + CKI = (CKR*CZI+CKI*CZR)*RAK + CKR = STR*RAK + S1R = CKR*FR - CKI*FI + S1R + S1I = CKR*FI + CKI*FR + S1I + A1 = A1*T1*RAK + BK = BK + AK + AK + 1.0D0 + AK = AK + 1.0D0 + IF (A1.GT.TOL) GO TO 60 + 70 CONTINUE + YR(1) = S1R + YI(1) = S1I + IF (KODED.EQ.1) RETURN + CALL ZEXP(ZR, ZI, STR, STI) + CALL ZMLT(S1R, S1I, STR, STI, YR(1), YI(1)) + RETURN +C----------------------------------------------------------------------- +C GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE +C----------------------------------------------------------------------- + 80 CONTINUE + IF (CAZ.LT.TOL) GO TO 100 + CALL ZMLT(ZR, ZI, ZR, ZI, CZR, CZI) + CZR = 0.25D0*CZR + CZI = 0.25D0*CZI + T1 = 0.25D0*CAZ*CAZ + 90 CONTINUE + FR = (FR*AK+PR+QR)/BK + FI = (FI*AK+PI+QI)/BK + STR = 1.0D0/(AK-DNU) + PR = PR*STR + PI = PI*STR + STR = 1.0D0/(AK+DNU) + QR = QR*STR + QI = QI*STR + STR = CKR*CZR - CKI*CZI + RAK = 1.0D0/AK + CKI = (CKR*CZI+CKI*CZR)*RAK + CKR = STR*RAK + S1R = CKR*FR - CKI*FI + S1R + S1I = CKR*FI + CKI*FR + S1I + STR = PR - FR*AK + STI = PI - FI*AK + S2R = CKR*STR - CKI*STI + S2R + S2I = CKR*STI + CKI*STR + S2I + A1 = A1*T1*RAK + BK = BK + AK + AK + 1.0D0 + AK = AK + 1.0D0 + IF (A1.GT.TOL) GO TO 90 + 100 CONTINUE + KFLAG = 2 + A1 = FNU + 1.0D0 + AK = A1*DABS(SMUR) + IF (AK.GT.ALIM) KFLAG = 3 + STR = CSSR(KFLAG) + P2R = S2R*STR + P2I = S2I*STR + CALL ZMLT(P2R, P2I, RZR, RZI, S2R, S2I) + S1R = S1R*STR + S1I = S1I*STR + IF (KODED.EQ.1) GO TO 210 + CALL ZEXP(ZR, ZI, FR, FI) + CALL ZMLT(S1R, S1I, FR, FI, S1R, S1I) + CALL ZMLT(S2R, S2I, FR, FI, S2R, S2I) + GO TO 210 +C----------------------------------------------------------------------- +C IFLAG=0 MEANS NO UNDERFLOW OCCURRED +C IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH +C KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD +C RECURSION +C----------------------------------------------------------------------- + 110 CONTINUE + CALL ZSQRT(ZR, ZI, STR, STI) + CALL ZDIV(RTHPI, CZEROI, STR, STI, COEFR, COEFI) + KFLAG = 2 + IF (KODED.EQ.2) GO TO 120 + IF (ZR.GT.ALIM) GO TO 290 +C BLANK LINE + STR = DEXP(-ZR)*CSSR(KFLAG) + STI = -STR*DSIN(ZI) + STR = STR*DCOS(ZI) + CALL ZMLT(COEFR, COEFI, STR, STI, COEFR, COEFI) + 120 CONTINUE + IF (DABS(DNU).EQ.0.5D0) GO TO 300 +C----------------------------------------------------------------------- +C MILLER ALGORITHM FOR CABS(Z).GT.R1 +C----------------------------------------------------------------------- + AK = DCOS(DPI*DNU) + AK = DABS(AK) + IF (AK.EQ.CZEROR) GO TO 300 + FHS = DABS(0.25D0-DNU2) + IF (FHS.EQ.CZEROR) GO TO 300 +C----------------------------------------------------------------------- +C COMPUTE R2=F(E). IF CABS(Z).GE.R2, USE FORWARD RECURRENCE TO +C DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON +C 12.LE.E.LE.60. E IS COMPUTED FROM 2**(-E)=B**(1-I1MACH(14))= +C TOL WHERE B IS THE BASE OF THE ARITHMETIC. +C----------------------------------------------------------------------- + T1 = DBLE(FLOAT(I1MACH(14)-1)) + T1 = T1*D1MACH(5)*3.321928094D0 + T1 = DMAX1(T1,12.0D0) + T1 = DMIN1(T1,60.0D0) + T2 = TTH*T1 - 6.0D0 + IF (ZR.NE.0.0D0) GO TO 130 + T1 = HPI + GO TO 140 + 130 CONTINUE + T1 = DATAN(ZI/ZR) + T1 = DABS(T1) + 140 CONTINUE + IF (T2.GT.CAZ) GO TO 170 +C----------------------------------------------------------------------- +C FORWARD RECURRENCE LOOP WHEN CABS(Z).GE.R2 +C----------------------------------------------------------------------- + ETEST = AK/(DPI*CAZ*TOL) + FK = CONER + IF (ETEST.LT.CONER) GO TO 180 + FKS = CTWOR + CKR = CAZ + CAZ + CTWOR + P1R = CZEROR + P2R = CONER + DO 150 I=1,KMAX + AK = FHS/FKS + CBR = CKR/(FK+CONER) + PTR = P2R + P2R = CBR*P2R - P1R*AK + P1R = PTR + CKR = CKR + CTWOR + FKS = FKS + FK + FK + CTWOR + FHS = FHS + FK + FK + FK = FK + CONER + STR = DABS(P2R)*FK + IF (ETEST.LT.STR) GO TO 160 + 150 CONTINUE + GO TO 310 + 160 CONTINUE + FK = FK + SPI*T1*DSQRT(T2/CAZ) + FHS = DABS(0.25D0-DNU2) + GO TO 180 + 170 CONTINUE +C----------------------------------------------------------------------- +C COMPUTE BACKWARD INDEX K FOR CABS(Z).LT.R2 +C----------------------------------------------------------------------- + A2 = DSQRT(CAZ) + AK = FPI*AK/(TOL*DSQRT(A2)) + AA = 3.0D0*T1/(1.0D0+CAZ) + BB = 14.7D0*T1/(28.0D0+CAZ) + AK = (DLOG(AK)+CAZ*DCOS(AA)/(1.0D0+0.008D0*CAZ))/DCOS(BB) + FK = 0.12125D0*AK*AK/CAZ + 1.5D0 + 180 CONTINUE +C----------------------------------------------------------------------- +C BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM +C----------------------------------------------------------------------- + K = INT(SNGL(FK)) + FK = DBLE(FLOAT(K)) + FKS = FK*FK + P1R = CZEROR + P1I = CZEROI + P2R = TOL + P2I = CZEROI + CSR = P2R + CSI = P2I + DO 190 I=1,K + A1 = FKS - FK + AK = (FKS+FK)/(A1+FHS) + RAK = 2.0D0/(FK+CONER) + CBR = (FK+ZR)*RAK + CBI = ZI*RAK + PTR = P2R + PTI = P2I + P2R = (PTR*CBR-PTI*CBI-P1R)*AK + P2I = (PTI*CBR+PTR*CBI-P1I)*AK + P1R = PTR + P1I = PTI + CSR = CSR + P2R + CSI = CSI + P2I + FKS = A1 - FK + CONER + FK = FK - CONER + 190 CONTINUE +C----------------------------------------------------------------------- +C COMPUTE (P2/CS)=(P2/CABS(CS))*(CONJG(CS)/CABS(CS)) FOR BETTER +C SCALING +C----------------------------------------------------------------------- + TM = ZABS(CSR,CSI) + PTR = 1.0D0/TM + S1R = P2R*PTR + S1I = P2I*PTR + CSR = CSR*PTR + CSI = -CSI*PTR + CALL ZMLT(COEFR, COEFI, S1R, S1I, STR, STI) + CALL ZMLT(STR, STI, CSR, CSI, S1R, S1I) + IF (INU.GT.0 .OR. N.GT.1) GO TO 200 + ZDR = ZR + ZDI = ZI + IF(IFLAG.EQ.1) GO TO 270 + GO TO 240 + 200 CONTINUE +C----------------------------------------------------------------------- +C COMPUTE P1/P2=(P1/CABS(P2)*CONJG(P2)/CABS(P2) FOR SCALING +C----------------------------------------------------------------------- + TM = ZABS(P2R,P2I) + PTR = 1.0D0/TM + P1R = P1R*PTR + P1I = P1I*PTR + P2R = P2R*PTR + P2I = -P2I*PTR + CALL ZMLT(P1R, P1I, P2R, P2I, PTR, PTI) + STR = DNU + 0.5D0 - PTR + STI = -PTI + CALL ZDIV(STR, STI, ZR, ZI, STR, STI) + STR = STR + 1.0D0 + CALL ZMLT(STR, STI, S1R, S1I, S2R, S2I) +C----------------------------------------------------------------------- +C FORWARD RECURSION ON THE THREE TERM RECURSION WITH RELATION WITH +C SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 +C----------------------------------------------------------------------- + 210 CONTINUE + STR = DNU + 1.0D0 + CKR = STR*RZR + CKI = STR*RZI + IF (N.EQ.1) INU = INU - 1 + IF (INU.GT.0) GO TO 220 + IF (N.GT.1) GO TO 215 + S1R = S2R + S1I = S2I + 215 CONTINUE + ZDR = ZR + ZDI = ZI + IF(IFLAG.EQ.1) GO TO 270 + GO TO 240 + 220 CONTINUE + INUB = 1 + IF(IFLAG.EQ.1) GO TO 261 + 225 CONTINUE + P1R = CSRR(KFLAG) + ASCLE = BRY(KFLAG) + DO 230 I=INUB,INU + STR = S2R + STI = S2I + S2R = CKR*STR - CKI*STI + S1R + S2I = CKR*STI + CKI*STR + S1I + S1R = STR + S1I = STI + CKR = CKR + RZR + CKI = CKI + RZI + IF (KFLAG.GE.3) GO TO 230 + P2R = S2R*P1R + P2I = S2I*P1R + STR = DABS(P2R) + STI = DABS(P2I) + P2M = DMAX1(STR,STI) + IF (P2M.LE.ASCLE) GO TO 230 + KFLAG = KFLAG + 1 + ASCLE = BRY(KFLAG) + S1R = S1R*P1R + S1I = S1I*P1R + S2R = P2R + S2I = P2I + STR = CSSR(KFLAG) + S1R = S1R*STR + S1I = S1I*STR + S2R = S2R*STR + S2I = S2I*STR + P1R = CSRR(KFLAG) + 230 CONTINUE + IF (N.NE.1) GO TO 240 + S1R = S2R + S1I = S2I + 240 CONTINUE + STR = CSRR(KFLAG) + YR(1) = S1R*STR + YI(1) = S1I*STR + IF (N.EQ.1) RETURN + YR(2) = S2R*STR + YI(2) = S2I*STR + IF (N.EQ.2) RETURN + KK = 2 + 250 CONTINUE + KK = KK + 1 + IF (KK.GT.N) RETURN + P1R = CSRR(KFLAG) + ASCLE = BRY(KFLAG) + DO 260 I=KK,N + P2R = S2R + P2I = S2I + S2R = CKR*P2R - CKI*P2I + S1R + S2I = CKI*P2R + CKR*P2I + S1I + S1R = P2R + S1I = P2I + CKR = CKR + RZR + CKI = CKI + RZI + P2R = S2R*P1R + P2I = S2I*P1R + YR(I) = P2R + YI(I) = P2I + IF (KFLAG.GE.3) GO TO 260 + STR = DABS(P2R) + STI = DABS(P2I) + P2M = DMAX1(STR,STI) + IF (P2M.LE.ASCLE) GO TO 260 + KFLAG = KFLAG + 1 + ASCLE = BRY(KFLAG) + S1R = S1R*P1R + S1I = S1I*P1R + S2R = P2R + S2I = P2I + STR = CSSR(KFLAG) + S1R = S1R*STR + S1I = S1I*STR + S2R = S2R*STR + S2I = S2I*STR + P1R = CSRR(KFLAG) + 260 CONTINUE + RETURN +C----------------------------------------------------------------------- +C IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW +C----------------------------------------------------------------------- + 261 CONTINUE + HELIM = 0.5D0*ELIM + ELM = DEXP(-ELIM) + CELMR = ELM + ASCLE = BRY(1) + ZDR = ZR + ZDI = ZI + IC = -1 + J = 2 + DO 262 I=1,INU + STR = S2R + STI = S2I + S2R = STR*CKR-STI*CKI+S1R + S2I = STI*CKR+STR*CKI+S1I + S1R = STR + S1I = STI + CKR = CKR+RZR + CKI = CKI+RZI + AS = ZABS(S2R,S2I) + ALAS = DLOG(AS) + P2R = -ZDR+ALAS + IF(P2R.LT.(-ELIM)) GO TO 263 + CALL ZLOG(S2R,S2I,STR,STI,IDUM) + P2R = -ZDR+STR + P2I = -ZDI+STI + P2M = DEXP(P2R)/TOL + P1R = P2M*DCOS(P2I) + P1I = P2M*DSIN(P2I) + CALL ZUCHK(P1R,P1I,NW,ASCLE,TOL) + IF(NW.NE.0) GO TO 263 + J = 3 - J + CYR(J) = P1R + CYI(J) = P1I + IF(IC.EQ.(I-1)) GO TO 264 + IC = I + GO TO 262 + 263 CONTINUE + IF(ALAS.LT.HELIM) GO TO 262 + ZDR = ZDR-ELIM + S1R = S1R*CELMR + S1I = S1I*CELMR + S2R = S2R*CELMR + S2I = S2I*CELMR + 262 CONTINUE + IF(N.NE.1) GO TO 270 + S1R = S2R + S1I = S2I + GO TO 270 + 264 CONTINUE + KFLAG = 1 + INUB = I+1 + S2R = CYR(J) + S2I = CYI(J) + J = 3 - J + S1R = CYR(J) + S1I = CYI(J) + IF(INUB.LE.INU) GO TO 225 + IF(N.NE.1) GO TO 240 + S1R = S2R + S1I = S2I + GO TO 240 + 270 CONTINUE + YR(1) = S1R + YI(1) = S1I + IF(N.EQ.1) GO TO 280 + YR(2) = S2R + YI(2) = S2I + 280 CONTINUE + ASCLE = BRY(1) + CALL ZKSCL(ZDR,ZDI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM) + INU = N - NZ + IF (INU.LE.0) RETURN + KK = NZ + 1 + S1R = YR(KK) + S1I = YI(KK) + YR(KK) = S1R*CSRR(1) + YI(KK) = S1I*CSRR(1) + IF (INU.EQ.1) RETURN + KK = NZ + 2 + S2R = YR(KK) + S2I = YI(KK) + YR(KK) = S2R*CSRR(1) + YI(KK) = S2I*CSRR(1) + IF (INU.EQ.2) RETURN + T2 = FNU + DBLE(FLOAT(KK-1)) + CKR = T2*RZR + CKI = T2*RZI + KFLAG = 1 + GO TO 250 + 290 CONTINUE +C----------------------------------------------------------------------- +C SCALE BY DEXP(Z), IFLAG = 1 CASES +C----------------------------------------------------------------------- + KODED = 2 + IFLAG = 1 + KFLAG = 2 + GO TO 120 +C----------------------------------------------------------------------- +C FNU=HALF ODD INTEGER CASE, DNU=-0.5 +C----------------------------------------------------------------------- + 300 CONTINUE + S1R = COEFR + S1I = COEFI + S2R = COEFR + S2I = COEFI + GO TO 210 +C +C + 310 CONTINUE + NZ=-2 + RETURN + END + SUBROUTINE ZKSCL(ZRR,ZRI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM) +C***BEGIN PROLOGUE ZKSCL +C***REFER TO ZBESK +C +C SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE +C ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN +C RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. +C +C***ROUTINES CALLED ZUCHK,ZABS,ZLOG +C***END PROLOGUE ZKSCL +C COMPLEX CK,CS,CY,CZERO,RZ,S1,S2,Y,ZR,ZD,CELM + EXTERNAL ZABS + DOUBLE PRECISION ACS, AS, ASCLE, CKI, CKR, CSI, CSR, CYI, + * CYR, ELIM, FN, FNU, RZI, RZR, STR, S1I, S1R, S2I, + * S2R, TOL, YI, YR, ZEROI, ZEROR, ZRI, ZRR, ZABS, + * ZDR, ZDI, CELMR, ELM, HELIM, ALAS + INTEGER I, IC, IDUM, KK, N, NN, NW, NZ + DIMENSION YR(N), YI(N), CYR(2), CYI(2) + DATA ZEROR,ZEROI / 0.0D0 , 0.0D0 / +C + NZ = 0 + IC = 0 + NN = MIN0(2,N) + DO 10 I=1,NN + S1R = YR(I) + S1I = YI(I) + CYR(I) = S1R + CYI(I) = S1I + AS = ZABS(S1R,S1I) + ACS = -ZRR + DLOG(AS) + NZ = NZ + 1 + YR(I) = ZEROR + YI(I) = ZEROI + IF (ACS.LT.(-ELIM)) GO TO 10 + CALL ZLOG(S1R, S1I, CSR, CSI, IDUM) + CSR = CSR - ZRR + CSI = CSI - ZRI + STR = DEXP(CSR)/TOL + CSR = STR*DCOS(CSI) + CSI = STR*DSIN(CSI) + CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL) + IF (NW.NE.0) GO TO 10 + YR(I) = CSR + YI(I) = CSI + IC = I + NZ = NZ - 1 + 10 CONTINUE + IF (N.EQ.1) RETURN + IF (IC.GT.1) GO TO 20 + YR(1) = ZEROR + YI(1) = ZEROI + NZ = 2 + 20 CONTINUE + IF (N.EQ.2) RETURN + IF (NZ.EQ.0) RETURN + FN = FNU + 1.0D0 + CKR = FN*RZR + CKI = FN*RZI + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + HELIM = 0.5D0*ELIM + ELM = DEXP(-ELIM) + CELMR = ELM + ZDR = ZRR + ZDI = ZRI +C +C FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF +C S2 GETS LARGER THAN EXP(ELIM/2) +C + DO 30 I=3,N + KK = I + CSR = S2R + CSI = S2I + S2R = CKR*CSR - CKI*CSI + S1R + S2I = CKI*CSR + CKR*CSI + S1I + S1R = CSR + S1I = CSI + CKR = CKR + RZR + CKI = CKI + RZI + AS = ZABS(S2R,S2I) + ALAS = DLOG(AS) + ACS = -ZDR + ALAS + NZ = NZ + 1 + YR(I) = ZEROR + YI(I) = ZEROI + IF (ACS.LT.(-ELIM)) GO TO 25 + CALL ZLOG(S2R, S2I, CSR, CSI, IDUM) + CSR = CSR - ZDR + CSI = CSI - ZDI + STR = DEXP(CSR)/TOL + CSR = STR*DCOS(CSI) + CSI = STR*DSIN(CSI) + CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL) + IF (NW.NE.0) GO TO 25 + YR(I) = CSR + YI(I) = CSI + NZ = NZ - 1 + IF (IC.EQ.KK-1) GO TO 40 + IC = KK + GO TO 30 + 25 CONTINUE + IF(ALAS.LT.HELIM) GO TO 30 + ZDR = ZDR - ELIM + S1R = S1R*CELMR + S1I = S1I*CELMR + S2R = S2R*CELMR + S2I = S2I*CELMR + 30 CONTINUE + NZ = N + IF(IC.EQ.N) NZ=N-1 + GO TO 45 + 40 CONTINUE + NZ = KK - 2 + 45 CONTINUE + DO 50 I=1,NZ + YR(I) = ZEROR + YI(I) = ZEROI + 50 CONTINUE + RETURN + END + SUBROUTINE ZSHCH(ZR, ZI, CSHR, CSHI, CCHR, CCHI) +C***BEGIN PROLOGUE ZSHCH +C***REFER TO ZBESK,ZBESH +C +C ZSHCH COMPUTES THE COMPLEX HYPERBOLIC FUNCTIONS CSH=SINH(X+I*Y) +C AND CCH=COSH(X+I*Y), WHERE I**2=-1. +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE ZSHCH +C + DOUBLE PRECISION CCHI, CCHR, CH, CN, CSHI, CSHR, SH, SN, ZI, ZR, + * DCOSH, DSINH + SH = DSINH(ZR) + CH = DCOSH(ZR) + SN = DSIN(ZI) + CN = DCOS(ZI) + CSHR = SH*CN + CSHI = CH*SN + CCHR = CH*CN + CCHI = SH*SN + RETURN + END + SUBROUTINE ZRATI(ZR, ZI, FNU, N, CYR, CYI, TOL) +C***BEGIN PROLOGUE ZRATI +C***REFER TO ZBESI,ZBESK,ZBESH +C +C ZRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD +C RECURRENCE. THE STARTING INDEX IS DETERMINED BY FORWARD +C RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B, +C MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973, +C BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER, +C BY D. J. SOOKNE. +C +C***ROUTINES CALLED ZABS,ZDIV +C***END PROLOGUE ZRATI +C COMPLEX Z,CY(1),CONE,CZERO,P1,P2,T1,RZ,PT,CDFNU + EXTERNAL ZABS + DOUBLE PRECISION AK, AMAGZ, AP1, AP2, ARG, AZ, CDFNUI, CDFNUR, + * CONEI, CONER, CYI, CYR, CZEROI, CZEROR, DFNU, FDNU, FLAM, FNU, + * FNUP, PTI, PTR, P1I, P1R, P2I, P2R, RAK, RAP1, RHO, RT2, RZI, + * RZR, TEST, TEST1, TOL, TTI, TTR, T1I, T1R, ZI, ZR, ZABS + INTEGER I, ID, IDNU, INU, ITIME, K, KK, MAGZ, N + DIMENSION CYR(N), CYI(N) + DATA CZEROR,CZEROI,CONER,CONEI,RT2/ + 1 0.0D0, 0.0D0, 1.0D0, 0.0D0, 1.41421356237309505D0 / + AZ = ZABS(ZR,ZI) + INU = INT(SNGL(FNU)) + IDNU = INU + N - 1 + MAGZ = INT(SNGL(AZ)) + AMAGZ = DBLE(FLOAT(MAGZ+1)) + FDNU = DBLE(FLOAT(IDNU)) + FNUP = DMAX1(AMAGZ,FDNU) + ID = IDNU - MAGZ - 1 + ITIME = 1 + K = 1 + PTR = 1.0D0/AZ + RZR = PTR*(ZR+ZR)*PTR + RZI = -PTR*(ZI+ZI)*PTR + T1R = RZR*FNUP + T1I = RZI*FNUP + P2R = -T1R + P2I = -T1I + P1R = CONER + P1I = CONEI + T1R = T1R + RZR + T1I = T1I + RZI + IF (ID.GT.0) ID = 0 + AP2 = ZABS(P2R,P2I) + AP1 = ZABS(P1R,P1I) +C----------------------------------------------------------------------- +C THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNU +C GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT +C P2 VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR +C PREMATURELY. +C----------------------------------------------------------------------- + ARG = (AP2+AP2)/(AP1*TOL) + TEST1 = DSQRT(ARG) + TEST = TEST1 + RAP1 = 1.0D0/AP1 + P1R = P1R*RAP1 + P1I = P1I*RAP1 + P2R = P2R*RAP1 + P2I = P2I*RAP1 + AP2 = AP2*RAP1 + 10 CONTINUE + K = K + 1 + AP1 = AP2 + PTR = P2R + PTI = P2I + P2R = P1R - (T1R*PTR-T1I*PTI) + P2I = P1I - (T1R*PTI+T1I*PTR) + P1R = PTR + P1I = PTI + T1R = T1R + RZR + T1I = T1I + RZI + AP2 = ZABS(P2R,P2I) + IF (AP1.LE.TEST) GO TO 10 + IF (ITIME.EQ.2) GO TO 20 + AK = ZABS(T1R,T1I)*0.5D0 + FLAM = AK + DSQRT(AK*AK-1.0D0) + RHO = DMIN1(AP2/AP1,FLAM) + TEST = TEST1*DSQRT(RHO/(RHO*RHO-1.0D0)) + ITIME = 2 + GO TO 10 + 20 CONTINUE + KK = K + 1 - ID + AK = DBLE(FLOAT(KK)) + T1R = AK + T1I = CZEROI + DFNU = FNU + DBLE(FLOAT(N-1)) + P1R = 1.0D0/AP2 + P1I = CZEROI + P2R = CZEROR + P2I = CZEROI + DO 30 I=1,KK + PTR = P1R + PTI = P1I + RAP1 = DFNU + T1R + TTR = RZR*RAP1 + TTI = RZI*RAP1 + P1R = (PTR*TTR-PTI*TTI) + P2R + P1I = (PTR*TTI+PTI*TTR) + P2I + P2R = PTR + P2I = PTI + T1R = T1R - CONER + 30 CONTINUE + IF (P1R.NE.CZEROR .OR. P1I.NE.CZEROI) GO TO 40 + P1R = TOL + P1I = TOL + 40 CONTINUE + CALL ZDIV(P2R, P2I, P1R, P1I, CYR(N), CYI(N)) + IF (N.EQ.1) RETURN + K = N - 1 + AK = DBLE(FLOAT(K)) + T1R = AK + T1I = CZEROI + CDFNUR = FNU*RZR + CDFNUI = FNU*RZI + DO 60 I=2,N + PTR = CDFNUR + (T1R*RZR-T1I*RZI) + CYR(K+1) + PTI = CDFNUI + (T1R*RZI+T1I*RZR) + CYI(K+1) + AK = ZABS(PTR,PTI) + IF (AK.NE.CZEROR) GO TO 50 + PTR = TOL + PTI = TOL + AK = TOL*RT2 + 50 CONTINUE + RAK = CONER/AK + CYR(K) = RAK*PTR*RAK + CYI(K) = -RAK*PTI*RAK + T1R = T1R - CONER + K = K - 1 + 60 CONTINUE + RETURN + END + SUBROUTINE ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM, + * IUF) +C***BEGIN PROLOGUE ZS1S2 +C***REFER TO ZBESK,ZAIRY +C +C ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE +C ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- +C TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. +C ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF +C MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER +C OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE +C PRECISION ABOVE THE UNDERFLOW LIMIT. +C +C***ROUTINES CALLED ZABS,ZEXP,ZLOG +C***END PROLOGUE ZS1S2 +C COMPLEX CZERO,C1,S1,S1D,S2,ZR + EXTERNAL ZABS + DOUBLE PRECISION AA, ALIM, ALN, ASCLE, AS1, AS2, C1I, C1R, S1DI, + * S1DR, S1I, S1R, S2I, S2R, ZEROI, ZEROR, ZRI, ZRR, ZABS + INTEGER IUF, IDUM, NZ + DATA ZEROR,ZEROI / 0.0D0 , 0.0D0 / + NZ = 0 + AS1 = ZABS(S1R,S1I) + AS2 = ZABS(S2R,S2I) + IF (S1R.EQ.0.0D0 .AND. S1I.EQ.0.0D0) GO TO 10 + IF (AS1.EQ.0.0D0) GO TO 10 + ALN = -ZRR - ZRR + DLOG(AS1) + S1DR = S1R + S1DI = S1I + S1R = ZEROR + S1I = ZEROI + AS1 = ZEROR + IF (ALN.LT.(-ALIM)) GO TO 10 + CALL ZLOG(S1DR, S1DI, C1R, C1I, IDUM) + C1R = C1R - ZRR - ZRR + C1I = C1I - ZRI - ZRI + CALL ZEXP(C1R, C1I, S1R, S1I) + AS1 = ZABS(S1R,S1I) + IUF = IUF + 1 + 10 CONTINUE + AA = DMAX1(AS1,AS2) + IF (AA.GT.ASCLE) RETURN + S1R = ZEROR + S1I = ZEROI + S2R = ZEROR + S2I = ZEROI + NZ = 1 + IUF = 0 + RETURN + END + SUBROUTINE ZBUNK(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZBUNK +C***REFER TO ZBESK,ZBESH +C +C ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL. +C ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z) +C IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2 +C +C***ROUTINES CALLED ZUNK1,ZUNK2 +C***END PROLOGUE ZBUNK +C COMPLEX Y,Z + DOUBLE PRECISION ALIM, AX, AY, ELIM, FNU, TOL, YI, YR, ZI, ZR + INTEGER KODE, MR, N, NZ + DIMENSION YR(N), YI(N) + NZ = 0 + AX = DABS(ZR)*1.7321D0 + AY = DABS(ZI) + IF (AY.GT.AX) GO TO 10 +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR K(FNU,Z) FOR LARGE FNU APPLIED IN +C -PI/3.LE.ARG(Z).LE.PI/3 +C----------------------------------------------------------------------- + CALL ZUNK1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM) + GO TO 20 + 10 CONTINUE +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR H(2,FNU,Z*EXP(M*HPI)) FOR LARGE FNU +C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I +C AND HPI=PI/2 +C----------------------------------------------------------------------- + CALL ZUNK2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM) + 20 CONTINUE + RETURN + END + SUBROUTINE ZMLRI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL) +C***BEGIN PROLOGUE ZMLRI +C***REFER TO ZBESI,ZBESK +C +C ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE +C MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. +C +C***ROUTINES CALLED DGAMLN,D1MACH,ZABS,ZEXP,ZLOG,ZMLT +C***END PROLOGUE ZMLRI +C COMPLEX CK,CNORM,CONE,CTWO,CZERO,PT,P1,P2,RZ,SUM,Y,Z + EXTERNAL ZABS + DOUBLE PRECISION ACK, AK, AP, AT, AZ, BK, CKI, CKR, CNORMI, + * CNORMR, CONEI, CONER, FKAP, FKK, FLAM, FNF, FNU, PTI, PTR, P1I, + * P1R, P2I, P2R, RAZ, RHO, RHO2, RZI, RZR, SCLE, STI, STR, SUMI, + * SUMR, TFNF, TOL, TST, YI, YR, ZEROI, ZEROR, ZI, ZR, DGAMLN, + * D1MACH, ZABS + INTEGER I, IAZ, IDUM, IFNU, INU, ITIME, K, KK, KM, KODE, M, N, NZ + DIMENSION YR(N), YI(N) + DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / + SCLE = D1MACH(1)/TOL + NZ=0 + AZ = ZABS(ZR,ZI) + IAZ = INT(SNGL(AZ)) + IFNU = INT(SNGL(FNU)) + INU = IFNU + N - 1 + AT = DBLE(FLOAT(IAZ)) + 1.0D0 + RAZ = 1.0D0/AZ + STR = ZR*RAZ + STI = -ZI*RAZ + CKR = STR*AT*RAZ + CKI = STI*AT*RAZ + RZR = (STR+STR)*RAZ + RZI = (STI+STI)*RAZ + P1R = ZEROR + P1I = ZEROI + P2R = CONER + P2I = CONEI + ACK = (AT+1.0D0)*RAZ + RHO = ACK + DSQRT(ACK*ACK-1.0D0) + RHO2 = RHO*RHO + TST = (RHO2+RHO2)/((RHO2-1.0D0)*(RHO-1.0D0)) + TST = TST/TOL +C----------------------------------------------------------------------- +C COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES +C----------------------------------------------------------------------- + AK = AT + DO 10 I=1,80 + PTR = P2R + PTI = P2I + P2R = P1R - (CKR*PTR-CKI*PTI) + P2I = P1I - (CKI*PTR+CKR*PTI) + P1R = PTR + P1I = PTI + CKR = CKR + RZR + CKI = CKI + RZI + AP = ZABS(P2R,P2I) + IF (AP.GT.TST*AK*AK) GO TO 20 + AK = AK + 1.0D0 + 10 CONTINUE + GO TO 110 + 20 CONTINUE + I = I + 1 + K = 0 + IF (INU.LT.IAZ) GO TO 40 +C----------------------------------------------------------------------- +C COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS +C----------------------------------------------------------------------- + P1R = ZEROR + P1I = ZEROI + P2R = CONER + P2I = CONEI + AT = DBLE(FLOAT(INU)) + 1.0D0 + STR = ZR*RAZ + STI = -ZI*RAZ + CKR = STR*AT*RAZ + CKI = STI*AT*RAZ + ACK = AT*RAZ + TST = DSQRT(ACK/TOL) + ITIME = 1 + DO 30 K=1,80 + PTR = P2R + PTI = P2I + P2R = P1R - (CKR*PTR-CKI*PTI) + P2I = P1I - (CKR*PTI+CKI*PTR) + P1R = PTR + P1I = PTI + CKR = CKR + RZR + CKI = CKI + RZI + AP = ZABS(P2R,P2I) + IF (AP.LT.TST) GO TO 30 + IF (ITIME.EQ.2) GO TO 40 + ACK = ZABS(CKR,CKI) + FLAM = ACK + DSQRT(ACK*ACK-1.0D0) + FKAP = AP/ZABS(P1R,P1I) + RHO = DMIN1(FLAM,FKAP) + TST = TST*DSQRT(RHO/(RHO*RHO-1.0D0)) + ITIME = 2 + 30 CONTINUE + GO TO 110 + 40 CONTINUE +C----------------------------------------------------------------------- +C BACKWARD RECURRENCE AND SUM NORMALIZING RELATION +C----------------------------------------------------------------------- + K = K + 1 + KK = MAX0(I+IAZ,K+INU) + FKK = DBLE(FLOAT(KK)) + P1R = ZEROR + P1I = ZEROI +C----------------------------------------------------------------------- +C SCALE P2 AND SUM BY SCLE +C----------------------------------------------------------------------- + P2R = SCLE + P2I = ZEROI + FNF = FNU - DBLE(FLOAT(IFNU)) + TFNF = FNF + FNF + BK = DGAMLN(FKK+TFNF+1.0D0,IDUM) - DGAMLN(FKK+1.0D0,IDUM) - + * DGAMLN(TFNF+1.0D0,IDUM) + BK = DEXP(BK) + SUMR = ZEROR + SUMI = ZEROI + KM = KK - INU + DO 50 I=1,KM + PTR = P2R + PTI = P2I + P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) + P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI) + P1R = PTR + P1I = PTI + AK = 1.0D0 - TFNF/(FKK+TFNF) + ACK = BK*AK + SUMR = SUMR + (ACK+BK)*P1R + SUMI = SUMI + (ACK+BK)*P1I + BK = ACK + FKK = FKK - 1.0D0 + 50 CONTINUE + YR(N) = P2R + YI(N) = P2I + IF (N.EQ.1) GO TO 70 + DO 60 I=2,N + PTR = P2R + PTI = P2I + P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) + P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI) + P1R = PTR + P1I = PTI + AK = 1.0D0 - TFNF/(FKK+TFNF) + ACK = BK*AK + SUMR = SUMR + (ACK+BK)*P1R + SUMI = SUMI + (ACK+BK)*P1I + BK = ACK + FKK = FKK - 1.0D0 + M = N - I + 1 + YR(M) = P2R + YI(M) = P2I + 60 CONTINUE + 70 CONTINUE + IF (IFNU.LE.0) GO TO 90 + DO 80 I=1,IFNU + PTR = P2R + PTI = P2I + P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI) + P2I = P1I + (FKK+FNF)*(RZR*PTI+RZI*PTR) + P1R = PTR + P1I = PTI + AK = 1.0D0 - TFNF/(FKK+TFNF) + ACK = BK*AK + SUMR = SUMR + (ACK+BK)*P1R + SUMI = SUMI + (ACK+BK)*P1I + BK = ACK + FKK = FKK - 1.0D0 + 80 CONTINUE + 90 CONTINUE + PTR = ZR + PTI = ZI + IF (KODE.EQ.2) PTR = ZEROR + CALL ZLOG(RZR, RZI, STR, STI, IDUM) + P1R = -FNF*STR + PTR + P1I = -FNF*STI + PTI + AP = DGAMLN(1.0D0+FNF,IDUM) + PTR = P1R - AP + PTI = P1I +C----------------------------------------------------------------------- +C THE DIVISION CEXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW +C IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES +C----------------------------------------------------------------------- + P2R = P2R + SUMR + P2I = P2I + SUMI + AP = ZABS(P2R,P2I) + P1R = 1.0D0/AP + CALL ZEXP(PTR, PTI, STR, STI) + CKR = STR*P1R + CKI = STI*P1R + PTR = P2R*P1R + PTI = -P2I*P1R + CALL ZMLT(CKR, CKI, PTR, PTI, CNORMR, CNORMI) + DO 100 I=1,N + STR = YR(I)*CNORMR - YI(I)*CNORMI + YI(I) = YR(I)*CNORMI + YI(I)*CNORMR + YR(I) = STR + 100 CONTINUE + RETURN + 110 CONTINUE + NZ=-2 + RETURN + END + SUBROUTINE ZWRSK(ZRR, ZRI, FNU, KODE, N, YR, YI, NZ, CWR, CWI, + * TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZWRSK +C***REFER TO ZBESI,ZBESK +C +C ZWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY +C NORMALIZING THE I FUNCTION RATIOS FROM ZRATI BY THE WRONSKIAN +C +C***ROUTINES CALLED D1MACH,ZBKNU,ZRATI,ZABS +C***END PROLOGUE ZWRSK +C COMPLEX CINU,CSCL,CT,CW,C1,C2,RCT,ST,Y,ZR + EXTERNAL ZABS + DOUBLE PRECISION ACT, ACW, ALIM, ASCLE, CINUI, CINUR, CSCLR, CTI, + * CTR, CWI, CWR, C1I, C1R, C2I, C2R, ELIM, FNU, PTI, PTR, RACT, + * STI, STR, TOL, YI, YR, ZRI, ZRR, ZABS, D1MACH + INTEGER I, KODE, N, NW, NZ + DIMENSION YR(N), YI(N), CWR(2), CWI(2) +C----------------------------------------------------------------------- +C I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS +C Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE +C WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU. +C----------------------------------------------------------------------- + NZ = 0 + CALL ZBKNU(ZRR, ZRI, FNU, KODE, 2, CWR, CWI, NW, TOL, ELIM, ALIM) + IF (NW.NE.0) GO TO 50 + CALL ZRATI(ZRR, ZRI, FNU, N, YR, YI, TOL) +C----------------------------------------------------------------------- +C RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z), +C R(FNU+J-1,Z)=Y(J), J=1,...,N +C----------------------------------------------------------------------- + CINUR = 1.0D0 + CINUI = 0.0D0 + IF (KODE.EQ.1) GO TO 10 + CINUR = DCOS(ZRI) + CINUI = DSIN(ZRI) + 10 CONTINUE +C----------------------------------------------------------------------- +C ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH +C THE UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE +C SCALED TO PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT +C THE RESULT IS ON SCALE. +C----------------------------------------------------------------------- + ACW = ZABS(CWR(2),CWI(2)) + ASCLE = 1.0D+3*D1MACH(1)/TOL + CSCLR = 1.0D0 + IF (ACW.GT.ASCLE) GO TO 20 + CSCLR = 1.0D0/TOL + GO TO 30 + 20 CONTINUE + ASCLE = 1.0D0/ASCLE + IF (ACW.LT.ASCLE) GO TO 30 + CSCLR = TOL + 30 CONTINUE + C1R = CWR(1)*CSCLR + C1I = CWI(1)*CSCLR + C2R = CWR(2)*CSCLR + C2I = CWI(2)*CSCLR + STR = YR(1) + STI = YI(1) +C----------------------------------------------------------------------- +C CINU=CINU*(CONJG(CT)/CABS(CT))*(1.0D0/CABS(CT) PREVENTS +C UNDER- OR OVERFLOW PREMATURELY BY SQUARING CABS(CT) +C----------------------------------------------------------------------- + PTR = STR*C1R - STI*C1I + PTI = STR*C1I + STI*C1R + PTR = PTR + C2R + PTI = PTI + C2I + CTR = ZRR*PTR - ZRI*PTI + CTI = ZRR*PTI + ZRI*PTR + ACT = ZABS(CTR,CTI) + RACT = 1.0D0/ACT + CTR = CTR*RACT + CTI = -CTI*RACT + PTR = CINUR*RACT + PTI = CINUI*RACT + CINUR = PTR*CTR - PTI*CTI + CINUI = PTR*CTI + PTI*CTR + YR(1) = CINUR*CSCLR + YI(1) = CINUI*CSCLR + IF (N.EQ.1) RETURN + DO 40 I=2,N + PTR = STR*CINUR - STI*CINUI + CINUI = STR*CINUI + STI*CINUR + CINUR = PTR + STR = YR(I) + STI = YI(I) + YR(I) = CINUR*CSCLR + YI(I) = CINUI*CSCLR + 40 CONTINUE + RETURN + 50 CONTINUE + NZ = -1 + IF(NW.EQ.(-2)) NZ=-2 + RETURN + END + SUBROUTINE ZSERI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZSERI +C***REFER TO ZBESI,ZBESK +C +C ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY +C MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE +C REGION CABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN. +C NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO +C DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE +C CONDITION CABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE +C COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). +C +C***ROUTINES CALLED DGAMLN,D1MACH,ZUCHK,ZABS,ZDIV,ZLOG,ZMLT +C***END PROLOGUE ZSERI +C COMPLEX AK1,CK,COEF,CONE,CRSC,CSCL,CZ,CZERO,HZ,RZ,S1,S2,Y,Z + EXTERNAL ZABS + DOUBLE PRECISION AA, ACZ, AK, AK1I, AK1R, ALIM, ARM, ASCLE, ATOL, + * AZ, CKI, CKR, COEFI, COEFR, CONEI, CONER, CRSCR, CZI, CZR, DFNU, + * ELIM, FNU, FNUP, HZI, HZR, RAZ, RS, RTR1, RZI, RZR, S, SS, STI, + * STR, S1I, S1R, S2I, S2R, TOL, YI, YR, WI, WR, ZEROI, ZEROR, ZI, + * ZR, DGAMLN, D1MACH, ZABS + INTEGER I, IB, IDUM, IFLAG, IL, K, KODE, L, M, N, NN, NZ, NW + DIMENSION YR(N), YI(N), WR(2), WI(2) + DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / +C + NZ = 0 + AZ = ZABS(ZR,ZI) + IF (AZ.EQ.0.0D0) GO TO 160 + ARM = 1.0D+3*D1MACH(1) + RTR1 = DSQRT(ARM) + CRSCR = 1.0D0 + IFLAG = 0 + IF (AZ.LT.ARM) GO TO 150 + HZR = 0.5D0*ZR + HZI = 0.5D0*ZI + CZR = ZEROR + CZI = ZEROI + IF (AZ.LE.RTR1) GO TO 10 + CALL ZMLT(HZR, HZI, HZR, HZI, CZR, CZI) + 10 CONTINUE + ACZ = ZABS(CZR,CZI) + NN = N + CALL ZLOG(HZR, HZI, CKR, CKI, IDUM) + 20 CONTINUE + DFNU = FNU + DBLE(FLOAT(NN-1)) + FNUP = DFNU + 1.0D0 +C----------------------------------------------------------------------- +C UNDERFLOW TEST +C----------------------------------------------------------------------- + AK1R = CKR*DFNU + AK1I = CKI*DFNU + AK = DGAMLN(FNUP,IDUM) + AK1R = AK1R - AK + IF (KODE.EQ.2) AK1R = AK1R - ZR + IF (AK1R.GT.(-ELIM)) GO TO 40 + 30 CONTINUE + NZ = NZ + 1 + YR(NN) = ZEROR + YI(NN) = ZEROI + IF (ACZ.GT.DFNU) GO TO 190 + NN = NN - 1 + IF (NN.EQ.0) RETURN + GO TO 20 + 40 CONTINUE + IF (AK1R.GT.(-ALIM)) GO TO 50 + IFLAG = 1 + SS = 1.0D0/TOL + CRSCR = TOL + ASCLE = ARM*SS + 50 CONTINUE + AA = DEXP(AK1R) + IF (IFLAG.EQ.1) AA = AA*SS + COEFR = AA*DCOS(AK1I) + COEFI = AA*DSIN(AK1I) + ATOL = TOL*ACZ/FNUP + IL = MIN0(2,NN) + DO 90 I=1,IL + DFNU = FNU + DBLE(FLOAT(NN-I)) + FNUP = DFNU + 1.0D0 + S1R = CONER + S1I = CONEI + IF (ACZ.LT.TOL*FNUP) GO TO 70 + AK1R = CONER + AK1I = CONEI + AK = FNUP + 2.0D0 + S = FNUP + AA = 2.0D0 + 60 CONTINUE + RS = 1.0D0/S + STR = AK1R*CZR - AK1I*CZI + STI = AK1R*CZI + AK1I*CZR + AK1R = STR*RS + AK1I = STI*RS + S1R = S1R + AK1R + S1I = S1I + AK1I + S = S + AK + AK = AK + 2.0D0 + AA = AA*ACZ*RS + IF (AA.GT.ATOL) GO TO 60 + 70 CONTINUE + S2R = S1R*COEFR - S1I*COEFI + S2I = S1R*COEFI + S1I*COEFR + WR(I) = S2R + WI(I) = S2I + IF (IFLAG.EQ.0) GO TO 80 + CALL ZUCHK(S2R, S2I, NW, ASCLE, TOL) + IF (NW.NE.0) GO TO 30 + 80 CONTINUE + M = NN - I + 1 + YR(M) = S2R*CRSCR + YI(M) = S2I*CRSCR + IF (I.EQ.IL) GO TO 90 + CALL ZDIV(COEFR, COEFI, HZR, HZI, STR, STI) + COEFR = STR*DFNU + COEFI = STI*DFNU + 90 CONTINUE + IF (NN.LE.2) RETURN + K = NN - 2 + AK = DBLE(FLOAT(K)) + RAZ = 1.0D0/AZ + STR = ZR*RAZ + STI = -ZI*RAZ + RZR = (STR+STR)*RAZ + RZI = (STI+STI)*RAZ + IF (IFLAG.EQ.1) GO TO 120 + IB = 3 + 100 CONTINUE + DO 110 I=IB,NN + YR(K) = (AK+FNU)*(RZR*YR(K+1)-RZI*YI(K+1)) + YR(K+2) + YI(K) = (AK+FNU)*(RZR*YI(K+1)+RZI*YR(K+1)) + YI(K+2) + AK = AK - 1.0D0 + K = K - 1 + 110 CONTINUE + RETURN +C----------------------------------------------------------------------- +C RECUR BACKWARD WITH SCALED VALUES +C----------------------------------------------------------------------- + 120 CONTINUE +C----------------------------------------------------------------------- +C EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE +C UNDERFLOW LIMIT = ASCLE = D1MACH(1)*SS*1.0D+3 +C----------------------------------------------------------------------- + S1R = WR(1) + S1I = WI(1) + S2R = WR(2) + S2I = WI(2) + DO 130 L=3,NN + CKR = S2R + CKI = S2I + S2R = S1R + (AK+FNU)*(RZR*CKR-RZI*CKI) + S2I = S1I + (AK+FNU)*(RZR*CKI+RZI*CKR) + S1R = CKR + S1I = CKI + CKR = S2R*CRSCR + CKI = S2I*CRSCR + YR(K) = CKR + YI(K) = CKI + AK = AK - 1.0D0 + K = K - 1 + IF (ZABS(CKR,CKI).GT.ASCLE) GO TO 140 + 130 CONTINUE + RETURN + 140 CONTINUE + IB = L + 1 + IF (IB.GT.NN) RETURN + GO TO 100 + 150 CONTINUE + NZ = N + IF (FNU.EQ.0.0D0) NZ = NZ - 1 + 160 CONTINUE + YR(1) = ZEROR + YI(1) = ZEROI + IF (FNU.NE.0.0D0) GO TO 170 + YR(1) = CONER + YI(1) = CONEI + 170 CONTINUE + IF (N.EQ.1) RETURN + DO 180 I=2,N + YR(I) = ZEROR + YI(I) = ZEROI + 180 CONTINUE + RETURN +C----------------------------------------------------------------------- +C RETURN WITH NZ.LT.0 IF CABS(Z*Z/4).GT.FNU+N-NZ-1 COMPLETE +C THE CALCULATION IN CBINU WITH N=N-IABS(NZ) +C----------------------------------------------------------------------- + 190 CONTINUE + NZ = -NZ + RETURN + END + SUBROUTINE ZASYI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZASYI +C***REFER TO ZBESI,ZBESK +C +C ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY +C MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE +C REGION CABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN. +C NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1. +C +C***ROUTINES CALLED D1MACH,ZABS,ZDIV,ZEXP,ZMLT,ZSQRT +C***END PROLOGUE ZASYI +C COMPLEX AK1,CK,CONE,CS1,CS2,CZ,CZERO,DK,EZ,P1,RZ,S2,Y,Z + EXTERNAL ZABS + DOUBLE PRECISION AA, AEZ, AK, AK1I, AK1R, ALIM, ARG, ARM, ATOL, + * AZ, BB, BK, CKI, CKR, CONEI, CONER, CS1I, CS1R, CS2I, CS2R, CZI, + * CZR, DFNU, DKI, DKR, DNU2, ELIM, EZI, EZR, FDN, FNU, PI, P1I, + * P1R, RAZ, RL, RTPI, RTR1, RZI, RZR, S, SGN, SQK, STI, STR, S2I, + * S2R, TOL, TZI, TZR, YI, YR, ZEROI, ZEROR, ZI, ZR, D1MACH, ZABS + INTEGER I, IB, IL, INU, J, JL, K, KODE, KODED, M, N, NN, NZ + DIMENSION YR(N), YI(N) + DATA PI, RTPI /3.14159265358979324D0 , 0.159154943091895336D0 / + DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / +C + NZ = 0 + AZ = ZABS(ZR,ZI) + ARM = 1.0D+3*D1MACH(1) + RTR1 = DSQRT(ARM) + IL = MIN0(2,N) + DFNU = FNU + DBLE(FLOAT(N-IL)) +C----------------------------------------------------------------------- +C OVERFLOW TEST +C----------------------------------------------------------------------- + RAZ = 1.0D0/AZ + STR = ZR*RAZ + STI = -ZI*RAZ + AK1R = RTPI*STR*RAZ + AK1I = RTPI*STI*RAZ + CALL ZSQRT(AK1R, AK1I, AK1R, AK1I) + CZR = ZR + CZI = ZI + IF (KODE.NE.2) GO TO 10 + CZR = ZEROR + CZI = ZI + 10 CONTINUE + IF (DABS(CZR).GT.ELIM) GO TO 100 + DNU2 = DFNU + DFNU + KODED = 1 + IF ((DABS(CZR).GT.ALIM) .AND. (N.GT.2)) GO TO 20 + KODED = 0 + CALL ZEXP(CZR, CZI, STR, STI) + CALL ZMLT(AK1R, AK1I, STR, STI, AK1R, AK1I) + 20 CONTINUE + FDN = 0.0D0 + IF (DNU2.GT.RTR1) FDN = DNU2*DNU2 + EZR = ZR*8.0D0 + EZI = ZI*8.0D0 +C----------------------------------------------------------------------- +C WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE RELATIVE TO THE +C FIRST RECIPROCAL POWER SINCE THIS IS THE LEADING TERM OF THE +C EXPANSION FOR THE IMAGINARY PART. +C----------------------------------------------------------------------- + AEZ = 8.0D0*AZ + S = TOL/AEZ + JL = INT(SNGL(RL+RL)) + 2 + P1R = ZEROR + P1I = ZEROI + IF (ZI.EQ.0.0D0) GO TO 30 +C----------------------------------------------------------------------- +C CALCULATE EXP(PI*(0.5+FNU+N-IL)*I) TO MINIMIZE LOSSES OF +C SIGNIFICANCE WHEN FNU OR N IS LARGE +C----------------------------------------------------------------------- + INU = INT(SNGL(FNU)) + ARG = (FNU-DBLE(FLOAT(INU)))*PI + INU = INU + N - IL + AK = -DSIN(ARG) + BK = DCOS(ARG) + IF (ZI.LT.0.0D0) BK = -BK + P1R = AK + P1I = BK + IF (MOD(INU,2).EQ.0) GO TO 30 + P1R = -P1R + P1I = -P1I + 30 CONTINUE + DO 70 K=1,IL + SQK = FDN - 1.0D0 + ATOL = S*DABS(SQK) + SGN = 1.0D0 + CS1R = CONER + CS1I = CONEI + CS2R = CONER + CS2I = CONEI + CKR = CONER + CKI = CONEI + AK = 0.0D0 + AA = 1.0D0 + BB = AEZ + DKR = EZR + DKI = EZI + DO 40 J=1,JL + CALL ZDIV(CKR, CKI, DKR, DKI, STR, STI) + CKR = STR*SQK + CKI = STI*SQK + CS2R = CS2R + CKR + CS2I = CS2I + CKI + SGN = -SGN + CS1R = CS1R + CKR*SGN + CS1I = CS1I + CKI*SGN + DKR = DKR + EZR + DKI = DKI + EZI + AA = AA*DABS(SQK)/BB + BB = BB + AEZ + AK = AK + 8.0D0 + SQK = SQK - AK + IF (AA.LE.ATOL) GO TO 50 + 40 CONTINUE + GO TO 110 + 50 CONTINUE + S2R = CS1R + S2I = CS1I + IF (ZR+ZR.GE.ELIM) GO TO 60 + TZR = ZR + ZR + TZI = ZI + ZI + CALL ZEXP(-TZR, -TZI, STR, STI) + CALL ZMLT(STR, STI, P1R, P1I, STR, STI) + CALL ZMLT(STR, STI, CS2R, CS2I, STR, STI) + S2R = S2R + STR + S2I = S2I + STI + 60 CONTINUE + FDN = FDN + 8.0D0*DFNU + 4.0D0 + P1R = -P1R + P1I = -P1I + M = N - IL + K + YR(M) = S2R*AK1R - S2I*AK1I + YI(M) = S2R*AK1I + S2I*AK1R + 70 CONTINUE + IF (N.LE.2) RETURN + NN = N + K = NN - 2 + AK = DBLE(FLOAT(K)) + STR = ZR*RAZ + STI = -ZI*RAZ + RZR = (STR+STR)*RAZ + RZI = (STI+STI)*RAZ + IB = 3 + DO 80 I=IB,NN + YR(K) = (AK+FNU)*(RZR*YR(K+1)-RZI*YI(K+1)) + YR(K+2) + YI(K) = (AK+FNU)*(RZR*YI(K+1)+RZI*YR(K+1)) + YI(K+2) + AK = AK - 1.0D0 + K = K - 1 + 80 CONTINUE + IF (KODED.EQ.0) RETURN + CALL ZEXP(CZR, CZI, CKR, CKI) + DO 90 I=1,NN + STR = YR(I)*CKR - YI(I)*CKI + YI(I) = YR(I)*CKI + YI(I)*CKR + YR(I) = STR + 90 CONTINUE + RETURN + 100 CONTINUE + NZ = -1 + RETURN + 110 CONTINUE + NZ=-2 + RETURN + END + SUBROUTINE ZUOIK(ZR, ZI, FNU, KODE, IKFLG, N, YR, YI, NUF, TOL, + * ELIM, ALIM) +C***BEGIN PROLOGUE ZUOIK +C***REFER TO ZBESI,ZBESK,ZBESH +C +C ZUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC +C EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM +C (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW +C WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING +C EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN +C THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER +C MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE +C EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)= +C EXP(-ELIM)/TOL +C +C IKFLG=1 MEANS THE I SEQUENCE IS TESTED +C =2 MEANS THE K SEQUENCE IS TESTED +C NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE +C =-1 MEANS AN OVERFLOW WOULD OCCUR +C IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO +C THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE +C IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO +C IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY +C ANOTHER ROUTINE +C +C***ROUTINES CALLED ZUCHK,ZUNHJ,ZUNIK,D1MACH,ZABS,ZLOG +C***END PROLOGUE ZUOIK +C COMPLEX ARG,ASUM,BSUM,CWRK,CZ,CZERO,PHI,SUM,Y,Z,ZB,ZETA1,ZETA2,ZN, +C *ZR + EXTERNAL ZABS + DOUBLE PRECISION AARG, AIC, ALIM, APHI, ARGI, ARGR, ASUMI, ASUMR, + * ASCLE, AX, AY, BSUMI, BSUMR, CWRKI, CWRKR, CZI, CZR, ELIM, FNN, + * FNU, GNN, GNU, PHII, PHIR, RCZ, STR, STI, SUMI, SUMR, TOL, YI, + * YR, ZBI, ZBR, ZEROI, ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZI, + * ZNI, ZNR, ZR, ZRI, ZRR, D1MACH, ZABS + INTEGER I, IDUM, IFORM, IKFLG, INIT, KODE, N, NN, NUF, NW + DIMENSION YR(N), YI(N), CWRKR(16), CWRKI(16) + DATA ZEROR,ZEROI / 0.0D0, 0.0D0 / + DATA AIC / 1.265512123484645396D+00 / + NUF = 0 + NN = N + ZRR = ZR + ZRI = ZI + IF (ZR.GE.0.0D0) GO TO 10 + ZRR = -ZR + ZRI = -ZI + 10 CONTINUE + ZBR = ZRR + ZBI = ZRI + AX = DABS(ZR)*1.7321D0 + AY = DABS(ZI) + IFORM = 1 + IF (AY.GT.AX) IFORM = 2 + GNU = DMAX1(FNU,1.0D0) + IF (IKFLG.EQ.1) GO TO 20 + FNN = DBLE(FLOAT(NN)) + GNN = FNU + FNN - 1.0D0 + GNU = DMAX1(GNN,FNN) + 20 CONTINUE +C----------------------------------------------------------------------- +C ONLY THE MAGNITUDE OF ARG AND PHI ARE NEEDED ALONG WITH THE +C REAL PARTS OF ZETA1, ZETA2 AND ZB. NO ATTEMPT IS MADE TO GET +C THE SIGN OF THE IMAGINARY PART CORRECT. +C----------------------------------------------------------------------- + IF (IFORM.EQ.2) GO TO 30 + INIT = 0 + CALL ZUNIK(ZRR, ZRI, GNU, IKFLG, 1, TOL, INIT, PHIR, PHII, + * ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI) + CZR = -ZETA1R + ZETA2R + CZI = -ZETA1I + ZETA2I + GO TO 50 + 30 CONTINUE + ZNR = ZRI + ZNI = -ZRR + IF (ZI.GT.0.0D0) GO TO 40 + ZNR = -ZNR + 40 CONTINUE + CALL ZUNHJ(ZNR, ZNI, GNU, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R, + * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) + CZR = -ZETA1R + ZETA2R + CZI = -ZETA1I + ZETA2I + AARG = ZABS(ARGR,ARGI) + 50 CONTINUE + IF (KODE.EQ.1) GO TO 60 + CZR = CZR - ZBR + CZI = CZI - ZBI + 60 CONTINUE + IF (IKFLG.EQ.1) GO TO 70 + CZR = -CZR + CZI = -CZI + 70 CONTINUE + APHI = ZABS(PHIR,PHII) + RCZ = CZR +C----------------------------------------------------------------------- +C OVERFLOW TEST +C----------------------------------------------------------------------- + IF (RCZ.GT.ELIM) GO TO 210 + IF (RCZ.LT.ALIM) GO TO 80 + RCZ = RCZ + DLOG(APHI) + IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC + IF (RCZ.GT.ELIM) GO TO 210 + GO TO 130 + 80 CONTINUE +C----------------------------------------------------------------------- +C UNDERFLOW TEST +C----------------------------------------------------------------------- + IF (RCZ.LT.(-ELIM)) GO TO 90 + IF (RCZ.GT.(-ALIM)) GO TO 130 + RCZ = RCZ + DLOG(APHI) + IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC + IF (RCZ.GT.(-ELIM)) GO TO 110 + 90 CONTINUE + DO 100 I=1,NN + YR(I) = ZEROR + YI(I) = ZEROI + 100 CONTINUE + NUF = NN + RETURN + 110 CONTINUE + ASCLE = 1.0D+3*D1MACH(1)/TOL + CALL ZLOG(PHIR, PHII, STR, STI, IDUM) + CZR = CZR + STR + CZI = CZI + STI + IF (IFORM.EQ.1) GO TO 120 + CALL ZLOG(ARGR, ARGI, STR, STI, IDUM) + CZR = CZR - 0.25D0*STR - AIC + CZI = CZI - 0.25D0*STI + 120 CONTINUE + AX = DEXP(RCZ)/TOL + AY = CZI + CZR = AX*DCOS(AY) + CZI = AX*DSIN(AY) + CALL ZUCHK(CZR, CZI, NW, ASCLE, TOL) + IF (NW.NE.0) GO TO 90 + 130 CONTINUE + IF (IKFLG.EQ.2) RETURN + IF (N.EQ.1) RETURN +C----------------------------------------------------------------------- +C SET UNDERFLOWS ON I SEQUENCE +C----------------------------------------------------------------------- + 140 CONTINUE + GNU = FNU + DBLE(FLOAT(NN-1)) + IF (IFORM.EQ.2) GO TO 150 + INIT = 0 + CALL ZUNIK(ZRR, ZRI, GNU, IKFLG, 1, TOL, INIT, PHIR, PHII, + * ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI) + CZR = -ZETA1R + ZETA2R + CZI = -ZETA1I + ZETA2I + GO TO 160 + 150 CONTINUE + CALL ZUNHJ(ZNR, ZNI, GNU, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R, + * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) + CZR = -ZETA1R + ZETA2R + CZI = -ZETA1I + ZETA2I + AARG = ZABS(ARGR,ARGI) + 160 CONTINUE + IF (KODE.EQ.1) GO TO 170 + CZR = CZR - ZBR + CZI = CZI - ZBI + 170 CONTINUE + APHI = ZABS(PHIR,PHII) + RCZ = CZR + IF (RCZ.LT.(-ELIM)) GO TO 180 + IF (RCZ.GT.(-ALIM)) RETURN + RCZ = RCZ + DLOG(APHI) + IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC + IF (RCZ.GT.(-ELIM)) GO TO 190 + 180 CONTINUE + YR(NN) = ZEROR + YI(NN) = ZEROI + NN = NN - 1 + NUF = NUF + 1 + IF (NN.EQ.0) RETURN + GO TO 140 + 190 CONTINUE + ASCLE = 1.0D+3*D1MACH(1)/TOL + CALL ZLOG(PHIR, PHII, STR, STI, IDUM) + CZR = CZR + STR + CZI = CZI + STI + IF (IFORM.EQ.1) GO TO 200 + CALL ZLOG(ARGR, ARGI, STR, STI, IDUM) + CZR = CZR - 0.25D0*STR - AIC + CZI = CZI - 0.25D0*STI + 200 CONTINUE + AX = DEXP(RCZ)/TOL + AY = CZI + CZR = AX*DCOS(AY) + CZI = AX*DSIN(AY) + CALL ZUCHK(CZR, CZI, NW, ASCLE, TOL) + IF (NW.NE.0) GO TO 180 + RETURN + 210 CONTINUE + NUF = -1 + RETURN + END + SUBROUTINE ZACON(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, FNUL, + * TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZACON +C***REFER TO ZBESK,ZBESH +C +C ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA +C +C K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) +C MP=PI*MR*CMPLX(0.0,1.0) +C +C TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT +C HALF Z PLANE +C +C***ROUTINES CALLED ZBINU,ZBKNU,ZS1S2,D1MACH,ZABS,ZMLT +C***END PROLOGUE ZACON +C COMPLEX CK,CONE,CSCL,CSCR,CSGN,CSPN,CY,CZERO,C1,C2,RZ,SC1,SC2,ST, +C *S1,S2,Y,Z,ZN + EXTERNAL ZABS + DOUBLE PRECISION ALIM, ARG, ASCLE, AS2, AZN, BRY, BSCLE, CKI, + * CKR, CONER, CPN, CSCL, CSCR, CSGNI, CSGNR, CSPNI, CSPNR, + * CSR, CSRR, CSSR, CYI, CYR, C1I, C1M, C1R, C2I, C2R, ELIM, FMR, + * FN, FNU, FNUL, PI, PTI, PTR, RAZN, RL, RZI, RZR, SC1I, SC1R, + * SC2I, SC2R, SGN, SPN, STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR, + * YY, ZEROR, ZI, ZNI, ZNR, ZR, D1MACH, ZABS + INTEGER I, INU, IUF, KFLAG, KODE, MR, N, NN, NW, NZ + DIMENSION YR(N), YI(N), CYR(2), CYI(2), CSSR(3), CSRR(3), BRY(3) + DATA PI / 3.14159265358979324D0 / + DATA ZEROR,CONER / 0.0D0,1.0D0 / + NZ = 0 + ZNR = -ZR + ZNI = -ZI + NN = N + CALL ZBINU(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, FNUL, TOL, + * ELIM, ALIM) + IF (NW.LT.0) GO TO 90 +C----------------------------------------------------------------------- +C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION +C----------------------------------------------------------------------- + NN = MIN0(2,N) + CALL ZBKNU(ZNR, ZNI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM) + IF (NW.NE.0) GO TO 90 + S1R = CYR(1) + S1I = CYI(1) + FMR = DBLE(FLOAT(MR)) + SGN = -DSIGN(PI,FMR) + CSGNR = ZEROR + CSGNI = SGN + IF (KODE.EQ.1) GO TO 10 + YY = -ZNI + CPN = DCOS(YY) + SPN = DSIN(YY) + CALL ZMLT(CSGNR, CSGNI, CPN, SPN, CSGNR, CSGNI) + 10 CONTINUE +C----------------------------------------------------------------------- +C CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE +C WHEN FNU IS LARGE +C----------------------------------------------------------------------- + INU = INT(SNGL(FNU)) + ARG = (FNU-DBLE(FLOAT(INU)))*SGN + CPN = DCOS(ARG) + SPN = DSIN(ARG) + CSPNR = CPN + CSPNI = SPN + IF (MOD(INU,2).EQ.0) GO TO 20 + CSPNR = -CSPNR + CSPNI = -CSPNI + 20 CONTINUE + IUF = 0 + C1R = S1R + C1I = S1I + C2R = YR(1) + C2I = YI(1) + ASCLE = 1.0D+3*D1MACH(1)/TOL + IF (KODE.EQ.1) GO TO 30 + CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF) + NZ = NZ + NW + SC1R = C1R + SC1I = C1I + 30 CONTINUE + CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI) + CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI) + YR(1) = STR + PTR + YI(1) = STI + PTI + IF (N.EQ.1) RETURN + CSPNR = -CSPNR + CSPNI = -CSPNI + S2R = CYR(2) + S2I = CYI(2) + C1R = S2R + C1I = S2I + C2R = YR(2) + C2I = YI(2) + IF (KODE.EQ.1) GO TO 40 + CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF) + NZ = NZ + NW + SC2R = C1R + SC2I = C1I + 40 CONTINUE + CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI) + CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI) + YR(2) = STR + PTR + YI(2) = STI + PTI + IF (N.EQ.2) RETURN + CSPNR = -CSPNR + CSPNI = -CSPNI + AZN = ZABS(ZNR,ZNI) + RAZN = 1.0D0/AZN + STR = ZNR*RAZN + STI = -ZNI*RAZN + RZR = (STR+STR)*RAZN + RZI = (STI+STI)*RAZN + FN = FNU + 1.0D0 + CKR = FN*RZR + CKI = FN*RZI +C----------------------------------------------------------------------- +C SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS +C----------------------------------------------------------------------- + CSCL = 1.0D0/TOL + CSCR = TOL + CSSR(1) = CSCL + CSSR(2) = CONER + CSSR(3) = CSCR + CSRR(1) = CSCR + CSRR(2) = CONER + CSRR(3) = CSCL + BRY(1) = ASCLE + BRY(2) = 1.0D0/ASCLE + BRY(3) = D1MACH(2) + AS2 = ZABS(S2R,S2I) + KFLAG = 2 + IF (AS2.GT.BRY(1)) GO TO 50 + KFLAG = 1 + GO TO 60 + 50 CONTINUE + IF (AS2.LT.BRY(2)) GO TO 60 + KFLAG = 3 + 60 CONTINUE + BSCLE = BRY(KFLAG) + S1R = S1R*CSSR(KFLAG) + S1I = S1I*CSSR(KFLAG) + S2R = S2R*CSSR(KFLAG) + S2I = S2I*CSSR(KFLAG) + CSR = CSRR(KFLAG) + DO 80 I=3,N + STR = S2R + STI = S2I + S2R = CKR*STR - CKI*STI + S1R + S2I = CKR*STI + CKI*STR + S1I + S1R = STR + S1I = STI + C1R = S2R*CSR + C1I = S2I*CSR + STR = C1R + STI = C1I + C2R = YR(I) + C2I = YI(I) + IF (KODE.EQ.1) GO TO 70 + IF (IUF.LT.0) GO TO 70 + CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF) + NZ = NZ + NW + SC1R = SC2R + SC1I = SC2I + SC2R = C1R + SC2I = C1I + IF (IUF.NE.3) GO TO 70 + IUF = -4 + S1R = SC1R*CSSR(KFLAG) + S1I = SC1I*CSSR(KFLAG) + S2R = SC2R*CSSR(KFLAG) + S2I = SC2I*CSSR(KFLAG) + STR = SC2R + STI = SC2I + 70 CONTINUE + PTR = CSPNR*C1R - CSPNI*C1I + PTI = CSPNR*C1I + CSPNI*C1R + YR(I) = PTR + CSGNR*C2R - CSGNI*C2I + YI(I) = PTI + CSGNR*C2I + CSGNI*C2R + CKR = CKR + RZR + CKI = CKI + RZI + CSPNR = -CSPNR + CSPNI = -CSPNI + IF (KFLAG.GE.3) GO TO 80 + PTR = DABS(C1R) + PTI = DABS(C1I) + C1M = DMAX1(PTR,PTI) + IF (C1M.LE.BSCLE) GO TO 80 + KFLAG = KFLAG + 1 + BSCLE = BRY(KFLAG) + S1R = S1R*CSR + S1I = S1I*CSR + S2R = STR + S2I = STI + S1R = S1R*CSSR(KFLAG) + S1I = S1I*CSSR(KFLAG) + S2R = S2R*CSSR(KFLAG) + S2I = S2I*CSSR(KFLAG) + CSR = CSRR(KFLAG) + 80 CONTINUE + RETURN + 90 CONTINUE + NZ = -1 + IF(NW.EQ.(-2)) NZ=-2 + RETURN + END + SUBROUTINE ZBINU(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, + * TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZBINU +C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY +C +C ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE +C +C***ROUTINES CALLED ZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK +C***END PROLOGUE ZBINU + EXTERNAL ZABS + DOUBLE PRECISION ALIM, AZ, CWI, CWR, CYI, CYR, DFNU, ELIM, FNU, + * FNUL, RL, TOL, ZEROI, ZEROR, ZI, ZR, ZABS + INTEGER I, INW, KODE, N, NLAST, NN, NUI, NW, NZ + DIMENSION CYR(N), CYI(N), CWR(2), CWI(2) + DATA ZEROR,ZEROI / 0.0D0, 0.0D0 / +C + NZ = 0 + AZ = ZABS(ZR,ZI) + NN = N + DFNU = FNU + DBLE(FLOAT(N-1)) + IF (AZ.LE.2.0D0) GO TO 10 + IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20 + 10 CONTINUE +C----------------------------------------------------------------------- +C POWER SERIES +C----------------------------------------------------------------------- + CALL ZSERI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM) + INW = IABS(NW) + NZ = NZ + INW + NN = NN - INW + IF (NN.EQ.0) RETURN + IF (NW.GE.0) GO TO 120 + DFNU = FNU + DBLE(FLOAT(NN-1)) + 20 CONTINUE + IF (AZ.LT.RL) GO TO 40 + IF (DFNU.LE.1.0D0) GO TO 30 + IF (AZ+AZ.LT.DFNU*DFNU) GO TO 50 +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR LARGE Z +C----------------------------------------------------------------------- + 30 CONTINUE + CALL ZASYI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, RL, TOL, ELIM, + * ALIM) + IF (NW.LT.0) GO TO 130 + GO TO 120 + 40 CONTINUE + IF (DFNU.LE.1.0D0) GO TO 70 + 50 CONTINUE +C----------------------------------------------------------------------- +C OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM +C----------------------------------------------------------------------- + CALL ZUOIK(ZR, ZI, FNU, KODE, 1, NN, CYR, CYI, NW, TOL, ELIM, + * ALIM) + IF (NW.LT.0) GO TO 130 + NZ = NZ + NW + NN = NN - NW + IF (NN.EQ.0) RETURN + DFNU = FNU+DBLE(FLOAT(NN-1)) + IF (DFNU.GT.FNUL) GO TO 110 + IF (AZ.GT.FNUL) GO TO 110 + 60 CONTINUE + IF (AZ.GT.RL) GO TO 80 + 70 CONTINUE +C----------------------------------------------------------------------- +C MILLER ALGORITHM NORMALIZED BY THE SERIES +C----------------------------------------------------------------------- + CALL ZMLRI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL) + IF(NW.LT.0) GO TO 130 + GO TO 120 + 80 CONTINUE +C----------------------------------------------------------------------- +C MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- +C OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN +C----------------------------------------------------------------------- + CALL ZUOIK(ZR, ZI, FNU, KODE, 2, 2, CWR, CWI, NW, TOL, ELIM, + * ALIM) + IF (NW.GE.0) GO TO 100 + NZ = NN + DO 90 I=1,NN + CYR(I) = ZEROR + CYI(I) = ZEROI + 90 CONTINUE + RETURN + 100 CONTINUE + IF (NW.GT.0) GO TO 130 + CALL ZWRSK(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, CWR, CWI, TOL, + * ELIM, ALIM) + IF (NW.LT.0) GO TO 130 + GO TO 120 + 110 CONTINUE +C----------------------------------------------------------------------- +C INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD +C----------------------------------------------------------------------- + NUI = INT(SNGL(FNUL-DFNU)) + 1 + NUI = MAX0(NUI,0) + CALL ZBUNI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, NUI, NLAST, FNUL, + * TOL, ELIM, ALIM) + IF (NW.LT.0) GO TO 130 + NZ = NZ + NW + IF (NLAST.EQ.0) GO TO 120 + NN = NLAST + GO TO 60 + 120 CONTINUE + RETURN + 130 CONTINUE + NZ = -1 + IF(NW.EQ.(-2)) NZ=-2 + RETURN + END + DOUBLE PRECISION FUNCTION DGAMLN(Z,IERR) +C***BEGIN PROLOGUE DGAMLN +C***DATE WRITTEN 830501 (YYMMDD) +C***REVISION DATE 830501 (YYMMDD) +C***CATEGORY NO. B5F +C***KEYWORDS GAMMA FUNCTION,LOGARITHM OF GAMMA FUNCTION +C***AUTHOR AMOS, DONALD E., SANDIA NATIONAL LABORATORIES +C***PURPOSE TO COMPUTE THE LOGARITHM OF THE GAMMA FUNCTION +C***DESCRIPTION +C +C **** A DOUBLE PRECISION ROUTINE **** +C DGAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR +C Z.GT.0. THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES +C GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION +C G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN. THE FUNCTION WAS MADE AS +C PORTABLE AS POSSIBLE BY COMPUTIMG ZMIN FROM THE NUMBER OF BASE +C 10 DIGITS IN A WORD, RLN=AMAX1(-ALOG10(R1MACH(4)),0.5E-18) +C LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY. +C +C SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100 +C VALUES IS USED FOR SPEED OF EXECUTION. +C +C DESCRIPTION OF ARGUMENTS +C +C INPUT Z IS D0UBLE PRECISION +C Z - ARGUMENT, Z.GT.0.0D0 +C +C OUTPUT DGAMLN IS DOUBLE PRECISION +C DGAMLN - NATURAL LOG OF THE GAMMA FUNCTION AT Z.NE.0.0D0 +C IERR - ERROR FLAG +C IERR=0, NORMAL RETURN, COMPUTATION COMPLETED +C IERR=1, Z.LE.0.0D0, NO COMPUTATION +C +C +C***REFERENCES COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT +C BY D. E. AMOS, SAND83-0083, MAY, 1983. +C***ROUTINES CALLED I1MACH,D1MACH +C***END PROLOGUE DGAMLN + DOUBLE PRECISION CF, CON, FLN, FZ, GLN, RLN, S, TLG, TRM, TST, + * T1, WDTOL, Z, ZDMY, ZINC, ZM, ZMIN, ZP, ZSQ, D1MACH + INTEGER I, IERR, I1M, K, MZ, NZ, I1MACH + DIMENSION CF(22), GLN(100) +C LNGAMMA(N), N=1,100 + DATA GLN(1), GLN(2), GLN(3), GLN(4), GLN(5), GLN(6), GLN(7), + 1 GLN(8), GLN(9), GLN(10), GLN(11), GLN(12), GLN(13), GLN(14), + 2 GLN(15), GLN(16), GLN(17), GLN(18), GLN(19), GLN(20), + 3 GLN(21), GLN(22)/ + 4 0.00000000000000000D+00, 0.00000000000000000D+00, + 5 6.93147180559945309D-01, 1.79175946922805500D+00, + 6 3.17805383034794562D+00, 4.78749174278204599D+00, + 7 6.57925121201010100D+00, 8.52516136106541430D+00, + 8 1.06046029027452502D+01, 1.28018274800814696D+01, + 9 1.51044125730755153D+01, 1.75023078458738858D+01, + A 1.99872144956618861D+01, 2.25521638531234229D+01, + B 2.51912211827386815D+01, 2.78992713838408916D+01, + C 3.06718601060806728D+01, 3.35050734501368889D+01, + D 3.63954452080330536D+01, 3.93398841871994940D+01, + E 4.23356164607534850D+01, 4.53801388984769080D+01/ + DATA GLN(23), GLN(24), GLN(25), GLN(26), GLN(27), GLN(28), + 1 GLN(29), GLN(30), GLN(31), GLN(32), GLN(33), GLN(34), + 2 GLN(35), GLN(36), GLN(37), GLN(38), GLN(39), GLN(40), + 3 GLN(41), GLN(42), GLN(43), GLN(44)/ + 4 4.84711813518352239D+01, 5.16066755677643736D+01, + 5 5.47847293981123192D+01, 5.80036052229805199D+01, + 6 6.12617017610020020D+01, 6.45575386270063311D+01, + 7 6.78897431371815350D+01, 7.12570389671680090D+01, + 8 7.46582363488301644D+01, 7.80922235533153106D+01, + 9 8.15579594561150372D+01, 8.50544670175815174D+01, + A 8.85808275421976788D+01, 9.21361756036870925D+01, + B 9.57196945421432025D+01, 9.93306124547874269D+01, + C 1.02968198614513813D+02, 1.06631760260643459D+02, + D 1.10320639714757395D+02, 1.14034211781461703D+02, + E 1.17771881399745072D+02, 1.21533081515438634D+02/ + DATA GLN(45), GLN(46), GLN(47), GLN(48), GLN(49), GLN(50), + 1 GLN(51), GLN(52), GLN(53), GLN(54), GLN(55), GLN(56), + 2 GLN(57), GLN(58), GLN(59), GLN(60), GLN(61), GLN(62), + 3 GLN(63), GLN(64), GLN(65), GLN(66)/ + 4 1.25317271149356895D+02, 1.29123933639127215D+02, + 5 1.32952575035616310D+02, 1.36802722637326368D+02, + 6 1.40673923648234259D+02, 1.44565743946344886D+02, + 7 1.48477766951773032D+02, 1.52409592584497358D+02, + 8 1.56360836303078785D+02, 1.60331128216630907D+02, + 9 1.64320112263195181D+02, 1.68327445448427652D+02, + A 1.72352797139162802D+02, 1.76395848406997352D+02, + B 1.80456291417543771D+02, 1.84533828861449491D+02, + C 1.88628173423671591D+02, 1.92739047287844902D+02, + D 1.96866181672889994D+02, 2.01009316399281527D+02, + E 2.05168199482641199D+02, 2.09342586752536836D+02/ + DATA GLN(67), GLN(68), GLN(69), GLN(70), GLN(71), GLN(72), + 1 GLN(73), GLN(74), GLN(75), GLN(76), GLN(77), GLN(78), + 2 GLN(79), GLN(80), GLN(81), GLN(82), GLN(83), GLN(84), + 3 GLN(85), GLN(86), GLN(87), GLN(88)/ + 4 2.13532241494563261D+02, 2.17736934113954227D+02, + 5 2.21956441819130334D+02, 2.26190548323727593D+02, + 6 2.30439043565776952D+02, 2.34701723442818268D+02, + 7 2.38978389561834323D+02, 2.43268849002982714D+02, + 8 2.47572914096186884D+02, 2.51890402209723194D+02, + 9 2.56221135550009525D+02, 2.60564940971863209D+02, + A 2.64921649798552801D+02, 2.69291097651019823D+02, + B 2.73673124285693704D+02, 2.78067573440366143D+02, + C 2.82474292687630396D+02, 2.86893133295426994D+02, + D 2.91323950094270308D+02, 2.95766601350760624D+02, + E 3.00220948647014132D+02, 3.04686856765668715D+02/ + DATA GLN(89), GLN(90), GLN(91), GLN(92), GLN(93), GLN(94), + 1 GLN(95), GLN(96), GLN(97), GLN(98), GLN(99), GLN(100)/ + 2 3.09164193580146922D+02, 3.13652829949879062D+02, + 3 3.18152639620209327D+02, 3.22663499126726177D+02, + 4 3.27185287703775217D+02, 3.31717887196928473D+02, + 5 3.36261181979198477D+02, 3.40815058870799018D+02, + 6 3.45379407062266854D+02, 3.49954118040770237D+02, + 7 3.54539085519440809D+02, 3.59134205369575399D+02/ +C COEFFICIENTS OF ASYMPTOTIC EXPANSION + DATA CF(1), CF(2), CF(3), CF(4), CF(5), CF(6), CF(7), CF(8), + 1 CF(9), CF(10), CF(11), CF(12), CF(13), CF(14), CF(15), + 2 CF(16), CF(17), CF(18), CF(19), CF(20), CF(21), CF(22)/ + 3 8.33333333333333333D-02, -2.77777777777777778D-03, + 4 7.93650793650793651D-04, -5.95238095238095238D-04, + 5 8.41750841750841751D-04, -1.91752691752691753D-03, + 6 6.41025641025641026D-03, -2.95506535947712418D-02, + 7 1.79644372368830573D-01, -1.39243221690590112D+00, + 8 1.34028640441683920D+01, -1.56848284626002017D+02, + 9 2.19310333333333333D+03, -3.61087712537249894D+04, + A 6.91472268851313067D+05, -1.52382215394074162D+07, + B 3.82900751391414141D+08, -1.08822660357843911D+10, + C 3.47320283765002252D+11, -1.23696021422692745D+13, + D 4.88788064793079335D+14, -2.13203339609193739D+16/ +C +C LN(2*PI) + DATA CON / 1.83787706640934548D+00/ +C +C***FIRST EXECUTABLE STATEMENT DGAMLN + IERR=0 + IF (Z.LE.0.0D0) GO TO 70 + IF (Z.GT.101.0D0) GO TO 10 + NZ = INT(Z) + FZ = Z - FLOAT(NZ) + IF (FZ.GT.0.0D0) GO TO 10 + IF (NZ.GT.100) GO TO 10 + DGAMLN = GLN(NZ) + RETURN + 10 CONTINUE + WDTOL = D1MACH(4) + WDTOL = DMAX1(WDTOL,0.5D-18) + I1M = I1MACH(14) + RLN = D1MACH(5)*FLOAT(I1M) + FLN = DMIN1(RLN,20.0D0) + FLN = DMAX1(FLN,3.0D0) + FLN = FLN - 3.0D0 + ZM = 1.8000D0 + 0.3875D0*FLN + MZ = INT(SNGL(ZM)) + 1 + ZMIN = FLOAT(MZ) + ZDMY = Z + ZINC = 0.0D0 + IF (Z.GE.ZMIN) GO TO 20 + ZINC = ZMIN - FLOAT(NZ) + ZDMY = Z + ZINC + 20 CONTINUE + ZP = 1.0D0/ZDMY + T1 = CF(1)*ZP + S = T1 + IF (ZP.LT.WDTOL) GO TO 40 + ZSQ = ZP*ZP + TST = T1*WDTOL + DO 30 K=2,22 + ZP = ZP*ZSQ + TRM = CF(K)*ZP + IF (DABS(TRM).LT.TST) GO TO 40 + S = S + TRM + 30 CONTINUE + 40 CONTINUE + IF (ZINC.NE.0.0D0) GO TO 50 + TLG = DLOG(Z) + DGAMLN = Z*(TLG-1.0D0) + 0.5D0*(CON-TLG) + S + RETURN + 50 CONTINUE + ZP = 1.0D0 + NZ = INT(SNGL(ZINC)) + DO 60 I=1,NZ + ZP = ZP*(Z+FLOAT(I-1)) + 60 CONTINUE + TLG = DLOG(ZDMY) + DGAMLN = ZDMY*(TLG-1.0D0) - DLOG(ZP) + 0.5D0*(CON-TLG) + S + RETURN +C +C + 70 CONTINUE + IERR=1 + RETURN + END + SUBROUTINE ZACAI(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, + * ELIM, ALIM) +C***BEGIN PROLOGUE ZACAI +C***REFER TO ZAIRY +C +C ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA +C +C K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) +C MP=PI*MR*CMPLX(0.0,1.0) +C +C TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT +C HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1. +C ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND +C RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT IF ZACON +C IS CALLED FROM ZAIRY. +C +C***ROUTINES CALLED ZASYI,ZBKNU,ZMLRI,ZSERI,ZS1S2,D1MACH,ZABS +C***END PROLOGUE ZACAI +C COMPLEX CSGN,CSPN,C1,C2,Y,Z,ZN,CY + EXTERNAL ZABS + DOUBLE PRECISION ALIM, ARG, ASCLE, AZ, CSGNR, CSGNI, CSPNR, + * CSPNI, C1R, C1I, C2R, C2I, CYR, CYI, DFNU, ELIM, FMR, FNU, PI, + * RL, SGN, TOL, YY, YR, YI, ZR, ZI, ZNR, ZNI, D1MACH, ZABS + INTEGER INU, IUF, KODE, MR, N, NN, NW, NZ + DIMENSION YR(N), YI(N), CYR(2), CYI(2) + DATA PI / 3.14159265358979324D0 / + NZ = 0 + ZNR = -ZR + ZNI = -ZI + AZ = ZABS(ZR,ZI) + NN = N + DFNU = FNU + DBLE(FLOAT(N-1)) + IF (AZ.LE.2.0D0) GO TO 10 + IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20 + 10 CONTINUE +C----------------------------------------------------------------------- +C POWER SERIES FOR THE I FUNCTION +C----------------------------------------------------------------------- + CALL ZSERI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL, ELIM, ALIM) + GO TO 40 + 20 CONTINUE + IF (AZ.LT.RL) GO TO 30 +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION +C----------------------------------------------------------------------- + CALL ZASYI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, TOL, ELIM, + * ALIM) + IF (NW.LT.0) GO TO 80 + GO TO 40 + 30 CONTINUE +C----------------------------------------------------------------------- +C MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION +C----------------------------------------------------------------------- + CALL ZMLRI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL) + IF(NW.LT.0) GO TO 80 + 40 CONTINUE +C----------------------------------------------------------------------- +C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION +C----------------------------------------------------------------------- + CALL ZBKNU(ZNR, ZNI, FNU, KODE, 1, CYR, CYI, NW, TOL, ELIM, ALIM) + IF (NW.NE.0) GO TO 80 + FMR = DBLE(FLOAT(MR)) + SGN = -DSIGN(PI,FMR) + CSGNR = 0.0D0 + CSGNI = SGN + IF (KODE.EQ.1) GO TO 50 + YY = -ZNI + CSGNR = -CSGNI*DSIN(YY) + CSGNI = CSGNI*DCOS(YY) + 50 CONTINUE +C----------------------------------------------------------------------- +C CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE +C WHEN FNU IS LARGE +C----------------------------------------------------------------------- + INU = INT(SNGL(FNU)) + ARG = (FNU-DBLE(FLOAT(INU)))*SGN + CSPNR = DCOS(ARG) + CSPNI = DSIN(ARG) + IF (MOD(INU,2).EQ.0) GO TO 60 + CSPNR = -CSPNR + CSPNI = -CSPNI + 60 CONTINUE + C1R = CYR(1) + C1I = CYI(1) + C2R = YR(1) + C2I = YI(1) + IF (KODE.EQ.1) GO TO 70 + IUF = 0 + ASCLE = 1.0D+3*D1MACH(1)/TOL + CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF) + NZ = NZ + NW + 70 CONTINUE + YR(1) = CSPNR*C1R - CSPNI*C1I + CSGNR*C2R - CSGNI*C2I + YI(1) = CSPNR*C1I + CSPNI*C1R + CSGNR*C2I + CSGNI*C2R + RETURN + 80 CONTINUE + NZ = -1 + IF(NW.EQ.(-2)) NZ=-2 + RETURN + END + SUBROUTINE ZUCHK(YR, YI, NZ, ASCLE, TOL) +C***BEGIN PROLOGUE ZUCHK +C***REFER TO ZSERI,ZUOIK,ZUNK1,ZUNK2,ZUNI1,ZUNI2,ZKSCL +C +C Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN +C EXP(-ALIM)=ASCLE=1.0E+3*D1MACH(1)/TOL. THE TEST IS MADE TO SEE +C IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW +C WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED +C IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE +C OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE +C ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE ZUCHK +C +C COMPLEX Y + DOUBLE PRECISION ASCLE, SS, ST, TOL, WR, WI, YR, YI + INTEGER NZ + NZ = 0 + WR = DABS(YR) + WI = DABS(YI) + ST = DMIN1(WR,WI) + IF (ST.GT.ASCLE) RETURN + SS = DMAX1(WR,WI) + ST = ST/TOL + IF (SS.LT.ST) NZ = 1 + RETURN + END + SUBROUTINE ZUNIK(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR, + * PHII, ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI) +C***BEGIN PROLOGUE ZUNIK +C***REFER TO ZBESI,ZBESK +C +C ZUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC +C EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2 +C RESPECTIVELY BY +C +C W(FNU,ZR) = PHI*EXP(ZETA)*SUM +C +C WHERE ZETA=-ZETA1 + ZETA2 OR +C ZETA1 - ZETA2 +C +C THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE +C SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG= +C 1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK +C ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI, +C ZETA1,ZETA2. +C +C***ROUTINES CALLED ZDIV,ZLOG,ZSQRT,D1MACH +C***END PROLOGUE ZUNIK +C COMPLEX CFN,CON,CONE,CRFN,CWRK,CZERO,PHI,S,SR,SUM,T,T2,ZETA1, +C *ZETA2,ZN,ZR + DOUBLE PRECISION AC, C, CON, CONEI, CONER, CRFNI, CRFNR, CWRKI, + * CWRKR, FNU, PHII, PHIR, RFN, SI, SR, SRI, SRR, STI, STR, SUMI, + * SUMR, TEST, TI, TOL, TR, T2I, T2R, ZEROI, ZEROR, ZETA1I, ZETA1R, + * ZETA2I, ZETA2R, ZNI, ZNR, ZRI, ZRR, D1MACH + INTEGER I, IDUM, IKFLG, INIT, IPMTR, J, K, L + DIMENSION C(120), CWRKR(16), CWRKI(16), CON(2) + DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / + DATA CON(1), CON(2) / + 1 3.98942280401432678D-01, 1.25331413731550025D+00 / + DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), + 1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18), + 2 C(19), C(20), C(21), C(22), C(23), C(24)/ + 3 1.00000000000000000D+00, -2.08333333333333333D-01, + 4 1.25000000000000000D-01, 3.34201388888888889D-01, + 5 -4.01041666666666667D-01, 7.03125000000000000D-02, + 6 -1.02581259645061728D+00, 1.84646267361111111D+00, + 7 -8.91210937500000000D-01, 7.32421875000000000D-02, + 8 4.66958442342624743D+00, -1.12070026162229938D+01, + 9 8.78912353515625000D+00, -2.36408691406250000D+00, + A 1.12152099609375000D-01, -2.82120725582002449D+01, + B 8.46362176746007346D+01, -9.18182415432400174D+01, + C 4.25349987453884549D+01, -7.36879435947963170D+00, + D 2.27108001708984375D-01, 2.12570130039217123D+02, + E -7.65252468141181642D+02, 1.05999045252799988D+03/ + DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32), + 1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40), + 2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/ + 3 -6.99579627376132541D+02, 2.18190511744211590D+02, + 4 -2.64914304869515555D+01, 5.72501420974731445D-01, + 5 -1.91945766231840700D+03, 8.06172218173730938D+03, + 6 -1.35865500064341374D+04, 1.16553933368645332D+04, + 7 -5.30564697861340311D+03, 1.20090291321635246D+03, + 8 -1.08090919788394656D+02, 1.72772750258445740D+00, + 9 2.02042913309661486D+04, -9.69805983886375135D+04, + A 1.92547001232531532D+05, -2.03400177280415534D+05, + B 1.22200464983017460D+05, -4.11926549688975513D+04, + C 7.10951430248936372D+03, -4.93915304773088012D+02, + D 6.07404200127348304D+00, -2.42919187900551333D+05, + E 1.31176361466297720D+06, -2.99801591853810675D+06/ + DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56), + 1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64), + 2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/ + 3 3.76327129765640400D+06, -2.81356322658653411D+06, + 4 1.26836527332162478D+06, -3.31645172484563578D+05, + 5 4.52187689813627263D+04, -2.49983048181120962D+03, + 6 2.43805296995560639D+01, 3.28446985307203782D+06, + 7 -1.97068191184322269D+07, 5.09526024926646422D+07, + 8 -7.41051482115326577D+07, 6.63445122747290267D+07, + 9 -3.75671766607633513D+07, 1.32887671664218183D+07, + A -2.78561812808645469D+06, 3.08186404612662398D+05, + B -1.38860897537170405D+04, 1.10017140269246738D+02, + C -4.93292536645099620D+07, 3.25573074185765749D+08, + D -9.39462359681578403D+08, 1.55359689957058006D+09, + E -1.62108055210833708D+09, 1.10684281682301447D+09/ + DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80), + 1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88), + 2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/ + 3 -4.95889784275030309D+08, 1.42062907797533095D+08, + 4 -2.44740627257387285D+07, 2.24376817792244943D+06, + 5 -8.40054336030240853D+04, 5.51335896122020586D+02, + 6 8.14789096118312115D+08, -5.86648149205184723D+09, + 7 1.86882075092958249D+10, -3.46320433881587779D+10, + 8 4.12801855797539740D+10, -3.30265997498007231D+10, + 9 1.79542137311556001D+10, -6.56329379261928433D+09, + A 1.55927986487925751D+09, -2.25105661889415278D+08, + B 1.73951075539781645D+07, -5.49842327572288687D+05, + C 3.03809051092238427D+03, -1.46792612476956167D+10, + D 1.14498237732025810D+11, -3.99096175224466498D+11, + E 8.19218669548577329D+11, -1.09837515608122331D+12/ + DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104), + 1 C(105), C(106), C(107), C(108), C(109), C(110), C(111), + 2 C(112), C(113), C(114), C(115), C(116), C(117), C(118)/ + 3 1.00815810686538209D+12, -6.45364869245376503D+11, + 4 2.87900649906150589D+11, -8.78670721780232657D+10, + 5 1.76347306068349694D+10, -2.16716498322379509D+09, + 6 1.43157876718888981D+08, -3.87183344257261262D+06, + 7 1.82577554742931747D+04, 2.86464035717679043D+11, + 8 -2.40629790002850396D+12, 9.10934118523989896D+12, + 9 -2.05168994109344374D+13, 3.05651255199353206D+13, + A -3.16670885847851584D+13, 2.33483640445818409D+13, + B -1.23204913055982872D+13, 4.61272578084913197D+12, + C -1.19655288019618160D+12, 2.05914503232410016D+11, + D -2.18229277575292237D+10, 1.24700929351271032D+09/ + DATA C(119), C(120)/ + 1 -2.91883881222208134D+07, 1.18838426256783253D+05/ +C + IF (INIT.NE.0) GO TO 40 +C----------------------------------------------------------------------- +C INITIALIZE ALL VARIABLES +C----------------------------------------------------------------------- + RFN = 1.0D0/FNU +C----------------------------------------------------------------------- +C OVERFLOW TEST (ZR/FNU TOO SMALL) +C----------------------------------------------------------------------- + TEST = D1MACH(1)*1.0D+3 + AC = FNU*TEST + IF (DABS(ZRR).GT.AC .OR. DABS(ZRI).GT.AC) GO TO 15 + ZETA1R = 2.0D0*DABS(DLOG(TEST))+FNU + ZETA1I = 0.0D0 + ZETA2R = FNU + ZETA2I = 0.0D0 + PHIR = 1.0D0 + PHII = 0.0D0 + RETURN + 15 CONTINUE + TR = ZRR*RFN + TI = ZRI*RFN + SR = CONER + (TR*TR-TI*TI) + SI = CONEI + (TR*TI+TI*TR) + CALL ZSQRT(SR, SI, SRR, SRI) + STR = CONER + SRR + STI = CONEI + SRI + CALL ZDIV(STR, STI, TR, TI, ZNR, ZNI) + CALL ZLOG(ZNR, ZNI, STR, STI, IDUM) + ZETA1R = FNU*STR + ZETA1I = FNU*STI + ZETA2R = FNU*SRR + ZETA2I = FNU*SRI + CALL ZDIV(CONER, CONEI, SRR, SRI, TR, TI) + SRR = TR*RFN + SRI = TI*RFN + CALL ZSQRT(SRR, SRI, CWRKR(16), CWRKI(16)) + PHIR = CWRKR(16)*CON(IKFLG) + PHII = CWRKI(16)*CON(IKFLG) + IF (IPMTR.NE.0) RETURN + CALL ZDIV(CONER, CONEI, SR, SI, T2R, T2I) + CWRKR(1) = CONER + CWRKI(1) = CONEI + CRFNR = CONER + CRFNI = CONEI + AC = 1.0D0 + L = 1 + DO 20 K=2,15 + SR = ZEROR + SI = ZEROI + DO 10 J=1,K + L = L + 1 + STR = SR*T2R - SI*T2I + C(L) + SI = SR*T2I + SI*T2R + SR = STR + 10 CONTINUE + STR = CRFNR*SRR - CRFNI*SRI + CRFNI = CRFNR*SRI + CRFNI*SRR + CRFNR = STR + CWRKR(K) = CRFNR*SR - CRFNI*SI + CWRKI(K) = CRFNR*SI + CRFNI*SR + AC = AC*RFN + TEST = DABS(CWRKR(K)) + DABS(CWRKI(K)) + IF (AC.LT.TOL .AND. TEST.LT.TOL) GO TO 30 + 20 CONTINUE + K = 15 + 30 CONTINUE + INIT = K + 40 CONTINUE + IF (IKFLG.EQ.2) GO TO 60 +C----------------------------------------------------------------------- +C COMPUTE SUM FOR THE I FUNCTION +C----------------------------------------------------------------------- + SR = ZEROR + SI = ZEROI + DO 50 I=1,INIT + SR = SR + CWRKR(I) + SI = SI + CWRKI(I) + 50 CONTINUE + SUMR = SR + SUMI = SI + PHIR = CWRKR(16)*CON(1) + PHII = CWRKI(16)*CON(1) + RETURN + 60 CONTINUE +C----------------------------------------------------------------------- +C COMPUTE SUM FOR THE K FUNCTION +C----------------------------------------------------------------------- + SR = ZEROR + SI = ZEROI + TR = CONER + DO 70 I=1,INIT + SR = SR + TR*CWRKR(I) + SI = SI + TR*CWRKI(I) + TR = -TR + 70 CONTINUE + SUMR = SR + SUMI = SI + PHIR = CWRKR(16)*CON(2) + PHII = CWRKI(16)*CON(2) + RETURN + END + SUBROUTINE ZUNHJ(ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI, + * ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) +C***BEGIN PROLOGUE ZUNHJ +C***REFER TO ZBESI,ZBESK +C +C REFERENCES +C HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. +C STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. +C +C ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC +C PRESS, N.Y., 1974, PAGE 420 +C +C ABSTRACT +C ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = +C J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU +C BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION +C +C C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) +C +C FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS +C AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. +C +C (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, +C +C ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING +C PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. +C +C MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND +C MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= +C 1 COMPUTES ALL EXCEPT ASUM AND BSUM. +C +C***ROUTINES CALLED ZABS,ZDIV,ZLOG,ZSQRT,D1MACH +C***END PROLOGUE ZUNHJ +C COMPLEX ARG,ASUM,BSUM,CFNU,CONE,CR,CZERO,DR,P,PHI,PRZTH,PTFN, +C *RFN13,RTZTA,RZTH,SUMA,SUMB,TFN,T2,UP,W,W2,Z,ZA,ZB,ZC,ZETA,ZETA1, +C *ZETA2,ZTH + EXTERNAL ZABS + DOUBLE PRECISION ALFA, ANG, AP, AR, ARGI, ARGR, ASUMI, ASUMR, + * ATOL, AW2, AZTH, BETA, BR, BSUMI, BSUMR, BTOL, C, CONEI, CONER, + * CRI, CRR, DRI, DRR, EX1, EX2, FNU, FN13, FN23, GAMA, GPI, HPI, + * PHII, PHIR, PI, PP, PR, PRZTHI, PRZTHR, PTFNI, PTFNR, RAW, RAW2, + * RAZTH, RFNU, RFNU2, RFN13, RTZTI, RTZTR, RZTHI, RZTHR, STI, STR, + * SUMAI, SUMAR, SUMBI, SUMBR, TEST, TFNI, TFNR, THPI, TOL, TZAI, + * TZAR, T2I, T2R, UPI, UPR, WI, WR, W2I, W2R, ZAI, ZAR, ZBI, ZBR, + * ZCI, ZCR, ZEROI, ZEROR, ZETAI, ZETAR, ZETA1I, ZETA1R, ZETA2I, + * ZETA2R, ZI, ZR, ZTHI, ZTHR, ZABS, AC, D1MACH + INTEGER IAS, IBS, IPMTR, IS, J, JR, JU, K, KMAX, KP1, KS, L, LR, + * LRP1, L1, L2, M, IDUM + DIMENSION AR(14), BR(14), C(105), ALFA(180), BETA(210), GAMA(30), + * AP(30), PR(30), PI(30), UPR(14), UPI(14), CRR(14), CRI(14), + * DRR(14), DRI(14) + DATA AR(1), AR(2), AR(3), AR(4), AR(5), AR(6), AR(7), AR(8), + 1 AR(9), AR(10), AR(11), AR(12), AR(13), AR(14)/ + 2 1.00000000000000000D+00, 1.04166666666666667D-01, + 3 8.35503472222222222D-02, 1.28226574556327160D-01, + 4 2.91849026464140464D-01, 8.81627267443757652D-01, + 5 3.32140828186276754D+00, 1.49957629868625547D+01, + 6 7.89230130115865181D+01, 4.74451538868264323D+02, + 7 3.20749009089066193D+03, 2.40865496408740049D+04, + 8 1.98923119169509794D+05, 1.79190200777534383D+06/ + DATA BR(1), BR(2), BR(3), BR(4), BR(5), BR(6), BR(7), BR(8), + 1 BR(9), BR(10), BR(11), BR(12), BR(13), BR(14)/ + 2 1.00000000000000000D+00, -1.45833333333333333D-01, + 3 -9.87413194444444444D-02, -1.43312053915895062D-01, + 4 -3.17227202678413548D-01, -9.42429147957120249D-01, + 5 -3.51120304082635426D+00, -1.57272636203680451D+01, + 6 -8.22814390971859444D+01, -4.92355370523670524D+02, + 7 -3.31621856854797251D+03, -2.48276742452085896D+04, + 8 -2.04526587315129788D+05, -1.83844491706820990D+06/ + DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), + 1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18), + 2 C(19), C(20), C(21), C(22), C(23), C(24)/ + 3 1.00000000000000000D+00, -2.08333333333333333D-01, + 4 1.25000000000000000D-01, 3.34201388888888889D-01, + 5 -4.01041666666666667D-01, 7.03125000000000000D-02, + 6 -1.02581259645061728D+00, 1.84646267361111111D+00, + 7 -8.91210937500000000D-01, 7.32421875000000000D-02, + 8 4.66958442342624743D+00, -1.12070026162229938D+01, + 9 8.78912353515625000D+00, -2.36408691406250000D+00, + A 1.12152099609375000D-01, -2.82120725582002449D+01, + B 8.46362176746007346D+01, -9.18182415432400174D+01, + C 4.25349987453884549D+01, -7.36879435947963170D+00, + D 2.27108001708984375D-01, 2.12570130039217123D+02, + E -7.65252468141181642D+02, 1.05999045252799988D+03/ + DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32), + 1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40), + 2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/ + 3 -6.99579627376132541D+02, 2.18190511744211590D+02, + 4 -2.64914304869515555D+01, 5.72501420974731445D-01, + 5 -1.91945766231840700D+03, 8.06172218173730938D+03, + 6 -1.35865500064341374D+04, 1.16553933368645332D+04, + 7 -5.30564697861340311D+03, 1.20090291321635246D+03, + 8 -1.08090919788394656D+02, 1.72772750258445740D+00, + 9 2.02042913309661486D+04, -9.69805983886375135D+04, + A 1.92547001232531532D+05, -2.03400177280415534D+05, + B 1.22200464983017460D+05, -4.11926549688975513D+04, + C 7.10951430248936372D+03, -4.93915304773088012D+02, + D 6.07404200127348304D+00, -2.42919187900551333D+05, + E 1.31176361466297720D+06, -2.99801591853810675D+06/ + DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56), + 1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64), + 2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/ + 3 3.76327129765640400D+06, -2.81356322658653411D+06, + 4 1.26836527332162478D+06, -3.31645172484563578D+05, + 5 4.52187689813627263D+04, -2.49983048181120962D+03, + 6 2.43805296995560639D+01, 3.28446985307203782D+06, + 7 -1.97068191184322269D+07, 5.09526024926646422D+07, + 8 -7.41051482115326577D+07, 6.63445122747290267D+07, + 9 -3.75671766607633513D+07, 1.32887671664218183D+07, + A -2.78561812808645469D+06, 3.08186404612662398D+05, + B -1.38860897537170405D+04, 1.10017140269246738D+02, + C -4.93292536645099620D+07, 3.25573074185765749D+08, + D -9.39462359681578403D+08, 1.55359689957058006D+09, + E -1.62108055210833708D+09, 1.10684281682301447D+09/ + DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80), + 1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88), + 2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/ + 3 -4.95889784275030309D+08, 1.42062907797533095D+08, + 4 -2.44740627257387285D+07, 2.24376817792244943D+06, + 5 -8.40054336030240853D+04, 5.51335896122020586D+02, + 6 8.14789096118312115D+08, -5.86648149205184723D+09, + 7 1.86882075092958249D+10, -3.46320433881587779D+10, + 8 4.12801855797539740D+10, -3.30265997498007231D+10, + 9 1.79542137311556001D+10, -6.56329379261928433D+09, + A 1.55927986487925751D+09, -2.25105661889415278D+08, + B 1.73951075539781645D+07, -5.49842327572288687D+05, + C 3.03809051092238427D+03, -1.46792612476956167D+10, + D 1.14498237732025810D+11, -3.99096175224466498D+11, + E 8.19218669548577329D+11, -1.09837515608122331D+12/ + DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104), + 1 C(105)/ + 2 1.00815810686538209D+12, -6.45364869245376503D+11, + 3 2.87900649906150589D+11, -8.78670721780232657D+10, + 4 1.76347306068349694D+10, -2.16716498322379509D+09, + 5 1.43157876718888981D+08, -3.87183344257261262D+06, + 6 1.82577554742931747D+04/ + DATA ALFA(1), ALFA(2), ALFA(3), ALFA(4), ALFA(5), ALFA(6), + 1 ALFA(7), ALFA(8), ALFA(9), ALFA(10), ALFA(11), ALFA(12), + 2 ALFA(13), ALFA(14), ALFA(15), ALFA(16), ALFA(17), ALFA(18), + 3 ALFA(19), ALFA(20), ALFA(21), ALFA(22)/ + 4 -4.44444444444444444D-03, -9.22077922077922078D-04, + 5 -8.84892884892884893D-05, 1.65927687832449737D-04, + 6 2.46691372741792910D-04, 2.65995589346254780D-04, + 7 2.61824297061500945D-04, 2.48730437344655609D-04, + 8 2.32721040083232098D-04, 2.16362485712365082D-04, + 9 2.00738858762752355D-04, 1.86267636637545172D-04, + A 1.73060775917876493D-04, 1.61091705929015752D-04, + B 1.50274774160908134D-04, 1.40503497391269794D-04, + C 1.31668816545922806D-04, 1.23667445598253261D-04, + D 1.16405271474737902D-04, 1.09798298372713369D-04, + E 1.03772410422992823D-04, 9.82626078369363448D-05/ + DATA ALFA(23), ALFA(24), ALFA(25), ALFA(26), ALFA(27), ALFA(28), + 1 ALFA(29), ALFA(30), ALFA(31), ALFA(32), ALFA(33), ALFA(34), + 2 ALFA(35), ALFA(36), ALFA(37), ALFA(38), ALFA(39), ALFA(40), + 3 ALFA(41), ALFA(42), ALFA(43), ALFA(44)/ + 4 9.32120517249503256D-05, 8.85710852478711718D-05, + 5 8.42963105715700223D-05, 8.03497548407791151D-05, + 6 7.66981345359207388D-05, 7.33122157481777809D-05, + 7 7.01662625163141333D-05, 6.72375633790160292D-05, + 8 6.93735541354588974D-04, 2.32241745182921654D-04, + 9 -1.41986273556691197D-05, -1.16444931672048640D-04, + A -1.50803558053048762D-04, -1.55121924918096223D-04, + B -1.46809756646465549D-04, -1.33815503867491367D-04, + C -1.19744975684254051D-04, -1.06184319207974020D-04, + D -9.37699549891194492D-05, -8.26923045588193274D-05, + E -7.29374348155221211D-05, -6.44042357721016283D-05/ + DATA ALFA(45), ALFA(46), ALFA(47), ALFA(48), ALFA(49), ALFA(50), + 1 ALFA(51), ALFA(52), ALFA(53), ALFA(54), ALFA(55), ALFA(56), + 2 ALFA(57), ALFA(58), ALFA(59), ALFA(60), ALFA(61), ALFA(62), + 3 ALFA(63), ALFA(64), ALFA(65), ALFA(66)/ + 4 -5.69611566009369048D-05, -5.04731044303561628D-05, + 5 -4.48134868008882786D-05, -3.98688727717598864D-05, + 6 -3.55400532972042498D-05, -3.17414256609022480D-05, + 7 -2.83996793904174811D-05, -2.54522720634870566D-05, + 8 -2.28459297164724555D-05, -2.05352753106480604D-05, + 9 -1.84816217627666085D-05, -1.66519330021393806D-05, + A -1.50179412980119482D-05, -1.35554031379040526D-05, + B -1.22434746473858131D-05, -1.10641884811308169D-05, + C -3.54211971457743841D-04, -1.56161263945159416D-04, + D 3.04465503594936410D-05, 1.30198655773242693D-04, + E 1.67471106699712269D-04, 1.70222587683592569D-04/ + DATA ALFA(67), ALFA(68), ALFA(69), ALFA(70), ALFA(71), ALFA(72), + 1 ALFA(73), ALFA(74), ALFA(75), ALFA(76), ALFA(77), ALFA(78), + 2 ALFA(79), ALFA(80), ALFA(81), ALFA(82), ALFA(83), ALFA(84), + 3 ALFA(85), ALFA(86), ALFA(87), ALFA(88)/ + 4 1.56501427608594704D-04, 1.36339170977445120D-04, + 5 1.14886692029825128D-04, 9.45869093034688111D-05, + 6 7.64498419250898258D-05, 6.07570334965197354D-05, + 7 4.74394299290508799D-05, 3.62757512005344297D-05, + 8 2.69939714979224901D-05, 1.93210938247939253D-05, + 9 1.30056674793963203D-05, 7.82620866744496661D-06, + A 3.59257485819351583D-06, 1.44040049814251817D-07, + B -2.65396769697939116D-06, -4.91346867098485910D-06, + C -6.72739296091248287D-06, -8.17269379678657923D-06, + D -9.31304715093561232D-06, -1.02011418798016441D-05, + E -1.08805962510592880D-05, -1.13875481509603555D-05/ + DATA ALFA(89), ALFA(90), ALFA(91), ALFA(92), ALFA(93), ALFA(94), + 1 ALFA(95), ALFA(96), ALFA(97), ALFA(98), ALFA(99), ALFA(100), + 2 ALFA(101), ALFA(102), ALFA(103), ALFA(104), ALFA(105), + 3 ALFA(106), ALFA(107), ALFA(108), ALFA(109), ALFA(110)/ + 4 -1.17519675674556414D-05, -1.19987364870944141D-05, + 5 3.78194199201772914D-04, 2.02471952761816167D-04, + 6 -6.37938506318862408D-05, -2.38598230603005903D-04, + 7 -3.10916256027361568D-04, -3.13680115247576316D-04, + 8 -2.78950273791323387D-04, -2.28564082619141374D-04, + 9 -1.75245280340846749D-04, -1.25544063060690348D-04, + A -8.22982872820208365D-05, -4.62860730588116458D-05, + B -1.72334302366962267D-05, 5.60690482304602267D-06, + C 2.31395443148286800D-05, 3.62642745856793957D-05, + D 4.58006124490188752D-05, 5.24595294959114050D-05, + E 5.68396208545815266D-05, 5.94349820393104052D-05/ + DATA ALFA(111), ALFA(112), ALFA(113), ALFA(114), ALFA(115), + 1 ALFA(116), ALFA(117), ALFA(118), ALFA(119), ALFA(120), + 2 ALFA(121), ALFA(122), ALFA(123), ALFA(124), ALFA(125), + 3 ALFA(126), ALFA(127), ALFA(128), ALFA(129), ALFA(130)/ + 4 6.06478527578421742D-05, 6.08023907788436497D-05, + 5 6.01577894539460388D-05, 5.89199657344698500D-05, + 6 5.72515823777593053D-05, 5.52804375585852577D-05, + 7 5.31063773802880170D-05, 5.08069302012325706D-05, + 8 4.84418647620094842D-05, 4.60568581607475370D-05, + 9 -6.91141397288294174D-04, -4.29976633058871912D-04, + A 1.83067735980039018D-04, 6.60088147542014144D-04, + B 8.75964969951185931D-04, 8.77335235958235514D-04, + C 7.49369585378990637D-04, 5.63832329756980918D-04, + D 3.68059319971443156D-04, 1.88464535514455599D-04/ + DATA ALFA(131), ALFA(132), ALFA(133), ALFA(134), ALFA(135), + 1 ALFA(136), ALFA(137), ALFA(138), ALFA(139), ALFA(140), + 2 ALFA(141), ALFA(142), ALFA(143), ALFA(144), ALFA(145), + 3 ALFA(146), ALFA(147), ALFA(148), ALFA(149), ALFA(150)/ + 4 3.70663057664904149D-05, -8.28520220232137023D-05, + 5 -1.72751952869172998D-04, -2.36314873605872983D-04, + 6 -2.77966150694906658D-04, -3.02079514155456919D-04, + 7 -3.12594712643820127D-04, -3.12872558758067163D-04, + 8 -3.05678038466324377D-04, -2.93226470614557331D-04, + 9 -2.77255655582934777D-04, -2.59103928467031709D-04, + A -2.39784014396480342D-04, -2.20048260045422848D-04, + B -2.00443911094971498D-04, -1.81358692210970687D-04, + C -1.63057674478657464D-04, -1.45712672175205844D-04, + D -1.29425421983924587D-04, -1.14245691942445952D-04/ + DATA ALFA(151), ALFA(152), ALFA(153), ALFA(154), ALFA(155), + 1 ALFA(156), ALFA(157), ALFA(158), ALFA(159), ALFA(160), + 2 ALFA(161), ALFA(162), ALFA(163), ALFA(164), ALFA(165), + 3 ALFA(166), ALFA(167), ALFA(168), ALFA(169), ALFA(170)/ + 4 1.92821964248775885D-03, 1.35592576302022234D-03, + 5 -7.17858090421302995D-04, -2.58084802575270346D-03, + 6 -3.49271130826168475D-03, -3.46986299340960628D-03, + 7 -2.82285233351310182D-03, -1.88103076404891354D-03, + 8 -8.89531718383947600D-04, 3.87912102631035228D-06, + 9 7.28688540119691412D-04, 1.26566373053457758D-03, + A 1.62518158372674427D-03, 1.83203153216373172D-03, + B 1.91588388990527909D-03, 1.90588846755546138D-03, + C 1.82798982421825727D-03, 1.70389506421121530D-03, + D 1.55097127171097686D-03, 1.38261421852276159D-03/ + DATA ALFA(171), ALFA(172), ALFA(173), ALFA(174), ALFA(175), + 1 ALFA(176), ALFA(177), ALFA(178), ALFA(179), ALFA(180)/ + 2 1.20881424230064774D-03, 1.03676532638344962D-03, + 3 8.71437918068619115D-04, 7.16080155297701002D-04, + 4 5.72637002558129372D-04, 4.42089819465802277D-04, + 5 3.24724948503090564D-04, 2.20342042730246599D-04, + 6 1.28412898401353882D-04, 4.82005924552095464D-05/ + DATA BETA(1), BETA(2), BETA(3), BETA(4), BETA(5), BETA(6), + 1 BETA(7), BETA(8), BETA(9), BETA(10), BETA(11), BETA(12), + 2 BETA(13), BETA(14), BETA(15), BETA(16), BETA(17), BETA(18), + 3 BETA(19), BETA(20), BETA(21), BETA(22)/ + 4 1.79988721413553309D-02, 5.59964911064388073D-03, + 5 2.88501402231132779D-03, 1.80096606761053941D-03, + 6 1.24753110589199202D-03, 9.22878876572938311D-04, + 7 7.14430421727287357D-04, 5.71787281789704872D-04, + 8 4.69431007606481533D-04, 3.93232835462916638D-04, + 9 3.34818889318297664D-04, 2.88952148495751517D-04, + A 2.52211615549573284D-04, 2.22280580798883327D-04, + B 1.97541838033062524D-04, 1.76836855019718004D-04, + C 1.59316899661821081D-04, 1.44347930197333986D-04, + D 1.31448068119965379D-04, 1.20245444949302884D-04, + E 1.10449144504599392D-04, 1.01828770740567258D-04/ + DATA BETA(23), BETA(24), BETA(25), BETA(26), BETA(27), BETA(28), + 1 BETA(29), BETA(30), BETA(31), BETA(32), BETA(33), BETA(34), + 2 BETA(35), BETA(36), BETA(37), BETA(38), BETA(39), BETA(40), + 3 BETA(41), BETA(42), BETA(43), BETA(44)/ + 4 9.41998224204237509D-05, 8.74130545753834437D-05, + 5 8.13466262162801467D-05, 7.59002269646219339D-05, + 6 7.09906300634153481D-05, 6.65482874842468183D-05, + 7 6.25146958969275078D-05, 5.88403394426251749D-05, + 8 -1.49282953213429172D-03, -8.78204709546389328D-04, + 9 -5.02916549572034614D-04, -2.94822138512746025D-04, + A -1.75463996970782828D-04, -1.04008550460816434D-04, + B -5.96141953046457895D-05, -3.12038929076098340D-05, + C -1.26089735980230047D-05, -2.42892608575730389D-07, + D 8.05996165414273571D-06, 1.36507009262147391D-05, + E 1.73964125472926261D-05, 1.98672978842133780D-05/ + DATA BETA(45), BETA(46), BETA(47), BETA(48), BETA(49), BETA(50), + 1 BETA(51), BETA(52), BETA(53), BETA(54), BETA(55), BETA(56), + 2 BETA(57), BETA(58), BETA(59), BETA(60), BETA(61), BETA(62), + 3 BETA(63), BETA(64), BETA(65), BETA(66)/ + 4 2.14463263790822639D-05, 2.23954659232456514D-05, + 5 2.28967783814712629D-05, 2.30785389811177817D-05, + 6 2.30321976080909144D-05, 2.28236073720348722D-05, + 7 2.25005881105292418D-05, 2.20981015361991429D-05, + 8 2.16418427448103905D-05, 2.11507649256220843D-05, + 9 2.06388749782170737D-05, 2.01165241997081666D-05, + A 1.95913450141179244D-05, 1.90689367910436740D-05, + B 1.85533719641636667D-05, 1.80475722259674218D-05, + C 5.52213076721292790D-04, 4.47932581552384646D-04, + D 2.79520653992020589D-04, 1.52468156198446602D-04, + E 6.93271105657043598D-05, 1.76258683069991397D-05/ + DATA BETA(67), BETA(68), BETA(69), BETA(70), BETA(71), BETA(72), + 1 BETA(73), BETA(74), BETA(75), BETA(76), BETA(77), BETA(78), + 2 BETA(79), BETA(80), BETA(81), BETA(82), BETA(83), BETA(84), + 3 BETA(85), BETA(86), BETA(87), BETA(88)/ + 4 -1.35744996343269136D-05, -3.17972413350427135D-05, + 5 -4.18861861696693365D-05, -4.69004889379141029D-05, + 6 -4.87665447413787352D-05, -4.87010031186735069D-05, + 7 -4.74755620890086638D-05, -4.55813058138628452D-05, + 8 -4.33309644511266036D-05, -4.09230193157750364D-05, + 9 -3.84822638603221274D-05, -3.60857167535410501D-05, + A -3.37793306123367417D-05, -3.15888560772109621D-05, + B -2.95269561750807315D-05, -2.75978914828335759D-05, + C -2.58006174666883713D-05, -2.41308356761280200D-05, + D -2.25823509518346033D-05, -2.11479656768912971D-05, + E -1.98200638885294927D-05, -1.85909870801065077D-05/ + DATA BETA(89), BETA(90), BETA(91), BETA(92), BETA(93), BETA(94), + 1 BETA(95), BETA(96), BETA(97), BETA(98), BETA(99), BETA(100), + 2 BETA(101), BETA(102), BETA(103), BETA(104), BETA(105), + 3 BETA(106), BETA(107), BETA(108), BETA(109), BETA(110)/ + 4 -1.74532699844210224D-05, -1.63997823854497997D-05, + 5 -4.74617796559959808D-04, -4.77864567147321487D-04, + 6 -3.20390228067037603D-04, -1.61105016119962282D-04, + 7 -4.25778101285435204D-05, 3.44571294294967503D-05, + 8 7.97092684075674924D-05, 1.03138236708272200D-04, + 9 1.12466775262204158D-04, 1.13103642108481389D-04, + A 1.08651634848774268D-04, 1.01437951597661973D-04, + B 9.29298396593363896D-05, 8.40293133016089978D-05, + C 7.52727991349134062D-05, 6.69632521975730872D-05, + D 5.92564547323194704D-05, 5.22169308826975567D-05, + E 4.58539485165360646D-05, 4.01445513891486808D-05/ + DATA BETA(111), BETA(112), BETA(113), BETA(114), BETA(115), + 1 BETA(116), BETA(117), BETA(118), BETA(119), BETA(120), + 2 BETA(121), BETA(122), BETA(123), BETA(124), BETA(125), + 3 BETA(126), BETA(127), BETA(128), BETA(129), BETA(130)/ + 4 3.50481730031328081D-05, 3.05157995034346659D-05, + 5 2.64956119950516039D-05, 2.29363633690998152D-05, + 6 1.97893056664021636D-05, 1.70091984636412623D-05, + 7 1.45547428261524004D-05, 1.23886640995878413D-05, + 8 1.04775876076583236D-05, 8.79179954978479373D-06, + 9 7.36465810572578444D-04, 8.72790805146193976D-04, + A 6.22614862573135066D-04, 2.85998154194304147D-04, + B 3.84737672879366102D-06, -1.87906003636971558D-04, + C -2.97603646594554535D-04, -3.45998126832656348D-04, + D -3.53382470916037712D-04, -3.35715635775048757D-04/ + DATA BETA(131), BETA(132), BETA(133), BETA(134), BETA(135), + 1 BETA(136), BETA(137), BETA(138), BETA(139), BETA(140), + 2 BETA(141), BETA(142), BETA(143), BETA(144), BETA(145), + 3 BETA(146), BETA(147), BETA(148), BETA(149), BETA(150)/ + 4 -3.04321124789039809D-04, -2.66722723047612821D-04, + 5 -2.27654214122819527D-04, -1.89922611854562356D-04, + 6 -1.55058918599093870D-04, -1.23778240761873630D-04, + 7 -9.62926147717644187D-05, -7.25178327714425337D-05, + 8 -5.22070028895633801D-05, -3.50347750511900522D-05, + 9 -2.06489761035551757D-05, -8.70106096849767054D-06, + A 1.13698686675100290D-06, 9.16426474122778849D-06, + B 1.56477785428872620D-05, 2.08223629482466847D-05, + C 2.48923381004595156D-05, 2.80340509574146325D-05, + D 3.03987774629861915D-05, 3.21156731406700616D-05/ + DATA BETA(151), BETA(152), BETA(153), BETA(154), BETA(155), + 1 BETA(156), BETA(157), BETA(158), BETA(159), BETA(160), + 2 BETA(161), BETA(162), BETA(163), BETA(164), BETA(165), + 3 BETA(166), BETA(167), BETA(168), BETA(169), BETA(170)/ + 4 -1.80182191963885708D-03, -2.43402962938042533D-03, + 5 -1.83422663549856802D-03, -7.62204596354009765D-04, + 6 2.39079475256927218D-04, 9.49266117176881141D-04, + 7 1.34467449701540359D-03, 1.48457495259449178D-03, + 8 1.44732339830617591D-03, 1.30268261285657186D-03, + 9 1.10351597375642682D-03, 8.86047440419791759D-04, + A 6.73073208165665473D-04, 4.77603872856582378D-04, + B 3.05991926358789362D-04, 1.60315694594721630D-04, + C 4.00749555270613286D-05, -5.66607461635251611D-05, + D -1.32506186772982638D-04, -1.90296187989614057D-04/ + DATA BETA(171), BETA(172), BETA(173), BETA(174), BETA(175), + 1 BETA(176), BETA(177), BETA(178), BETA(179), BETA(180), + 2 BETA(181), BETA(182), BETA(183), BETA(184), BETA(185), + 3 BETA(186), BETA(187), BETA(188), BETA(189), BETA(190)/ + 4 -2.32811450376937408D-04, -2.62628811464668841D-04, + 5 -2.82050469867598672D-04, -2.93081563192861167D-04, + 6 -2.97435962176316616D-04, -2.96557334239348078D-04, + 7 -2.91647363312090861D-04, -2.83696203837734166D-04, + 8 -2.73512317095673346D-04, -2.61750155806768580D-04, + 9 6.38585891212050914D-03, 9.62374215806377941D-03, + A 7.61878061207001043D-03, 2.83219055545628054D-03, + B -2.09841352012720090D-03, -5.73826764216626498D-03, + C -7.70804244495414620D-03, -8.21011692264844401D-03, + D -7.65824520346905413D-03, -6.47209729391045177D-03/ + DATA BETA(191), BETA(192), BETA(193), BETA(194), BETA(195), + 1 BETA(196), BETA(197), BETA(198), BETA(199), BETA(200), + 2 BETA(201), BETA(202), BETA(203), BETA(204), BETA(205), + 3 BETA(206), BETA(207), BETA(208), BETA(209), BETA(210)/ + 4 -4.99132412004966473D-03, -3.45612289713133280D-03, + 5 -2.01785580014170775D-03, -7.59430686781961401D-04, + 6 2.84173631523859138D-04, 1.10891667586337403D-03, + 7 1.72901493872728771D-03, 2.16812590802684701D-03, + 8 2.45357710494539735D-03, 2.61281821058334862D-03, + 9 2.67141039656276912D-03, 2.65203073395980430D-03, + A 2.57411652877287315D-03, 2.45389126236094427D-03, + B 2.30460058071795494D-03, 2.13684837686712662D-03, + C 1.95896528478870911D-03, 1.77737008679454412D-03, + D 1.59690280765839059D-03, 1.42111975664438546D-03/ + DATA GAMA(1), GAMA(2), GAMA(3), GAMA(4), GAMA(5), GAMA(6), + 1 GAMA(7), GAMA(8), GAMA(9), GAMA(10), GAMA(11), GAMA(12), + 2 GAMA(13), GAMA(14), GAMA(15), GAMA(16), GAMA(17), GAMA(18), + 3 GAMA(19), GAMA(20), GAMA(21), GAMA(22)/ + 4 6.29960524947436582D-01, 2.51984209978974633D-01, + 5 1.54790300415655846D-01, 1.10713062416159013D-01, + 6 8.57309395527394825D-02, 6.97161316958684292D-02, + 7 5.86085671893713576D-02, 5.04698873536310685D-02, + 8 4.42600580689154809D-02, 3.93720661543509966D-02, + 9 3.54283195924455368D-02, 3.21818857502098231D-02, + A 2.94646240791157679D-02, 2.71581677112934479D-02, + B 2.51768272973861779D-02, 2.34570755306078891D-02, + C 2.19508390134907203D-02, 2.06210828235646240D-02, + D 1.94388240897880846D-02, 1.83810633800683158D-02, + E 1.74293213231963172D-02, 1.65685837786612353D-02/ + DATA GAMA(23), GAMA(24), GAMA(25), GAMA(26), GAMA(27), GAMA(28), + 1 GAMA(29), GAMA(30)/ + 2 1.57865285987918445D-02, 1.50729501494095594D-02, + 3 1.44193250839954639D-02, 1.38184805735341786D-02, + 4 1.32643378994276568D-02, 1.27517121970498651D-02, + 5 1.22761545318762767D-02, 1.18338262398482403D-02/ + DATA EX1, EX2, HPI, GPI, THPI / + 1 3.33333333333333333D-01, 6.66666666666666667D-01, + 2 1.57079632679489662D+00, 3.14159265358979324D+00, + 3 4.71238898038468986D+00/ + DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / +C + RFNU = 1.0D0/FNU +C----------------------------------------------------------------------- +C OVERFLOW TEST (Z/FNU TOO SMALL) +C----------------------------------------------------------------------- + TEST = D1MACH(1)*1.0D+3 + AC = FNU*TEST + IF (DABS(ZR).GT.AC .OR. DABS(ZI).GT.AC) GO TO 15 + ZETA1R = 2.0D0*DABS(DLOG(TEST))+FNU + ZETA1I = 0.0D0 + ZETA2R = FNU + ZETA2I = 0.0D0 + PHIR = 1.0D0 + PHII = 0.0D0 + ARGR = 1.0D0 + ARGI = 0.0D0 + RETURN + 15 CONTINUE + ZBR = ZR*RFNU + ZBI = ZI*RFNU + RFNU2 = RFNU*RFNU +C----------------------------------------------------------------------- +C COMPUTE IN THE FOURTH QUADRANT +C----------------------------------------------------------------------- + FN13 = FNU**EX1 + FN23 = FN13*FN13 + RFN13 = 1.0D0/FN13 + W2R = CONER - ZBR*ZBR + ZBI*ZBI + W2I = CONEI - ZBR*ZBI - ZBR*ZBI + AW2 = ZABS(W2R,W2I) + IF (AW2.GT.0.25D0) GO TO 130 +C----------------------------------------------------------------------- +C POWER SERIES FOR CABS(W2).LE.0.25D0 +C----------------------------------------------------------------------- + K = 1 + PR(1) = CONER + PI(1) = CONEI + SUMAR = GAMA(1) + SUMAI = ZEROI + AP(1) = 1.0D0 + IF (AW2.LT.TOL) GO TO 20 + DO 10 K=2,30 + PR(K) = PR(K-1)*W2R - PI(K-1)*W2I + PI(K) = PR(K-1)*W2I + PI(K-1)*W2R + SUMAR = SUMAR + PR(K)*GAMA(K) + SUMAI = SUMAI + PI(K)*GAMA(K) + AP(K) = AP(K-1)*AW2 + IF (AP(K).LT.TOL) GO TO 20 + 10 CONTINUE + K = 30 + 20 CONTINUE + KMAX = K + ZETAR = W2R*SUMAR - W2I*SUMAI + ZETAI = W2R*SUMAI + W2I*SUMAR + ARGR = ZETAR*FN23 + ARGI = ZETAI*FN23 + CALL ZSQRT(SUMAR, SUMAI, ZAR, ZAI) + CALL ZSQRT(W2R, W2I, STR, STI) + ZETA2R = STR*FNU + ZETA2I = STI*FNU + STR = CONER + EX2*(ZETAR*ZAR-ZETAI*ZAI) + STI = CONEI + EX2*(ZETAR*ZAI+ZETAI*ZAR) + ZETA1R = STR*ZETA2R - STI*ZETA2I + ZETA1I = STR*ZETA2I + STI*ZETA2R + ZAR = ZAR + ZAR + ZAI = ZAI + ZAI + CALL ZSQRT(ZAR, ZAI, STR, STI) + PHIR = STR*RFN13 + PHII = STI*RFN13 + IF (IPMTR.EQ.1) GO TO 120 +C----------------------------------------------------------------------- +C SUM SERIES FOR ASUM AND BSUM +C----------------------------------------------------------------------- + SUMBR = ZEROR + SUMBI = ZEROI + DO 30 K=1,KMAX + SUMBR = SUMBR + PR(K)*BETA(K) + SUMBI = SUMBI + PI(K)*BETA(K) + 30 CONTINUE + ASUMR = ZEROR + ASUMI = ZEROI + BSUMR = SUMBR + BSUMI = SUMBI + L1 = 0 + L2 = 30 + BTOL = TOL*(DABS(BSUMR)+DABS(BSUMI)) + ATOL = TOL + PP = 1.0D0 + IAS = 0 + IBS = 0 + IF (RFNU2.LT.TOL) GO TO 110 + DO 100 IS=2,7 + ATOL = ATOL/RFNU2 + PP = PP*RFNU2 + IF (IAS.EQ.1) GO TO 60 + SUMAR = ZEROR + SUMAI = ZEROI + DO 40 K=1,KMAX + M = L1 + K + SUMAR = SUMAR + PR(K)*ALFA(M) + SUMAI = SUMAI + PI(K)*ALFA(M) + IF (AP(K).LT.ATOL) GO TO 50 + 40 CONTINUE + 50 CONTINUE + ASUMR = ASUMR + SUMAR*PP + ASUMI = ASUMI + SUMAI*PP + IF (PP.LT.TOL) IAS = 1 + 60 CONTINUE + IF (IBS.EQ.1) GO TO 90 + SUMBR = ZEROR + SUMBI = ZEROI + DO 70 K=1,KMAX + M = L2 + K + SUMBR = SUMBR + PR(K)*BETA(M) + SUMBI = SUMBI + PI(K)*BETA(M) + IF (AP(K).LT.ATOL) GO TO 80 + 70 CONTINUE + 80 CONTINUE + BSUMR = BSUMR + SUMBR*PP + BSUMI = BSUMI + SUMBI*PP + IF (PP.LT.BTOL) IBS = 1 + 90 CONTINUE + IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 110 + L1 = L1 + 30 + L2 = L2 + 30 + 100 CONTINUE + 110 CONTINUE + ASUMR = ASUMR + CONER + PP = RFNU*RFN13 + BSUMR = BSUMR*PP + BSUMI = BSUMI*PP + 120 CONTINUE + RETURN +C----------------------------------------------------------------------- +C CABS(W2).GT.0.25D0 +C----------------------------------------------------------------------- + 130 CONTINUE + CALL ZSQRT(W2R, W2I, WR, WI) + IF (WR.LT.0.0D0) WR = 0.0D0 + IF (WI.LT.0.0D0) WI = 0.0D0 + STR = CONER + WR + STI = WI + CALL ZDIV(STR, STI, ZBR, ZBI, ZAR, ZAI) + CALL ZLOG(ZAR, ZAI, ZCR, ZCI, IDUM) + IF (ZCI.LT.0.0D0) ZCI = 0.0D0 + IF (ZCI.GT.HPI) ZCI = HPI + IF (ZCR.LT.0.0D0) ZCR = 0.0D0 + ZTHR = (ZCR-WR)*1.5D0 + ZTHI = (ZCI-WI)*1.5D0 + ZETA1R = ZCR*FNU + ZETA1I = ZCI*FNU + ZETA2R = WR*FNU + ZETA2I = WI*FNU + AZTH = ZABS(ZTHR,ZTHI) + ANG = THPI + IF (ZTHR.GE.0.0D0 .AND. ZTHI.LT.0.0D0) GO TO 140 + ANG = HPI + IF (ZTHR.EQ.0.0D0) GO TO 140 + ANG = DATAN(ZTHI/ZTHR) + IF (ZTHR.LT.0.0D0) ANG = ANG + GPI + 140 CONTINUE + PP = AZTH**EX2 + ANG = ANG*EX2 + ZETAR = PP*DCOS(ANG) + ZETAI = PP*DSIN(ANG) + IF (ZETAI.LT.0.0D0) ZETAI = 0.0D0 + ARGR = ZETAR*FN23 + ARGI = ZETAI*FN23 + CALL ZDIV(ZTHR, ZTHI, ZETAR, ZETAI, RTZTR, RTZTI) + CALL ZDIV(RTZTR, RTZTI, WR, WI, ZAR, ZAI) + TZAR = ZAR + ZAR + TZAI = ZAI + ZAI + CALL ZSQRT(TZAR, TZAI, STR, STI) + PHIR = STR*RFN13 + PHII = STI*RFN13 + IF (IPMTR.EQ.1) GO TO 120 + RAW = 1.0D0/DSQRT(AW2) + STR = WR*RAW + STI = -WI*RAW + TFNR = STR*RFNU*RAW + TFNI = STI*RFNU*RAW + RAZTH = 1.0D0/AZTH + STR = ZTHR*RAZTH + STI = -ZTHI*RAZTH + RZTHR = STR*RAZTH*RFNU + RZTHI = STI*RAZTH*RFNU + ZCR = RZTHR*AR(2) + ZCI = RZTHI*AR(2) + RAW2 = 1.0D0/AW2 + STR = W2R*RAW2 + STI = -W2I*RAW2 + T2R = STR*RAW2 + T2I = STI*RAW2 + STR = T2R*C(2) + C(3) + STI = T2I*C(2) + UPR(2) = STR*TFNR - STI*TFNI + UPI(2) = STR*TFNI + STI*TFNR + BSUMR = UPR(2) + ZCR + BSUMI = UPI(2) + ZCI + ASUMR = ZEROR + ASUMI = ZEROI + IF (RFNU.LT.TOL) GO TO 220 + PRZTHR = RZTHR + PRZTHI = RZTHI + PTFNR = TFNR + PTFNI = TFNI + UPR(1) = CONER + UPI(1) = CONEI + PP = 1.0D0 + BTOL = TOL*(DABS(BSUMR)+DABS(BSUMI)) + KS = 0 + KP1 = 2 + L = 3 + IAS = 0 + IBS = 0 + DO 210 LR=2,12,2 + LRP1 = LR + 1 +C----------------------------------------------------------------------- +C COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN +C NEXT SUMA AND SUMB +C----------------------------------------------------------------------- + DO 160 K=LR,LRP1 + KS = KS + 1 + KP1 = KP1 + 1 + L = L + 1 + ZAR = C(L) + ZAI = ZEROI + DO 150 J=2,KP1 + L = L + 1 + STR = ZAR*T2R - T2I*ZAI + C(L) + ZAI = ZAR*T2I + ZAI*T2R + ZAR = STR + 150 CONTINUE + STR = PTFNR*TFNR - PTFNI*TFNI + PTFNI = PTFNR*TFNI + PTFNI*TFNR + PTFNR = STR + UPR(KP1) = PTFNR*ZAR - PTFNI*ZAI + UPI(KP1) = PTFNI*ZAR + PTFNR*ZAI + CRR(KS) = PRZTHR*BR(KS+1) + CRI(KS) = PRZTHI*BR(KS+1) + STR = PRZTHR*RZTHR - PRZTHI*RZTHI + PRZTHI = PRZTHR*RZTHI + PRZTHI*RZTHR + PRZTHR = STR + DRR(KS) = PRZTHR*AR(KS+2) + DRI(KS) = PRZTHI*AR(KS+2) + 160 CONTINUE + PP = PP*RFNU2 + IF (IAS.EQ.1) GO TO 180 + SUMAR = UPR(LRP1) + SUMAI = UPI(LRP1) + JU = LRP1 + DO 170 JR=1,LR + JU = JU - 1 + SUMAR = SUMAR + CRR(JR)*UPR(JU) - CRI(JR)*UPI(JU) + SUMAI = SUMAI + CRR(JR)*UPI(JU) + CRI(JR)*UPR(JU) + 170 CONTINUE + ASUMR = ASUMR + SUMAR + ASUMI = ASUMI + SUMAI + TEST = DABS(SUMAR) + DABS(SUMAI) + IF (PP.LT.TOL .AND. TEST.LT.TOL) IAS = 1 + 180 CONTINUE + IF (IBS.EQ.1) GO TO 200 + SUMBR = UPR(LR+2) + UPR(LRP1)*ZCR - UPI(LRP1)*ZCI + SUMBI = UPI(LR+2) + UPR(LRP1)*ZCI + UPI(LRP1)*ZCR + JU = LRP1 + DO 190 JR=1,LR + JU = JU - 1 + SUMBR = SUMBR + DRR(JR)*UPR(JU) - DRI(JR)*UPI(JU) + SUMBI = SUMBI + DRR(JR)*UPI(JU) + DRI(JR)*UPR(JU) + 190 CONTINUE + BSUMR = BSUMR + SUMBR + BSUMI = BSUMI + SUMBI + TEST = DABS(SUMBR) + DABS(SUMBI) + IF (PP.LT.BTOL .AND. TEST.LT.BTOL) IBS = 1 + 200 CONTINUE + IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 220 + 210 CONTINUE + 220 CONTINUE + ASUMR = ASUMR + CONER + STR = -BSUMR*RFN13 + STI = -BSUMI*RFN13 + CALL ZDIV(STR, STI, RTZTR, RTZTI, BSUMR, BSUMI) + GO TO 120 + END + SUBROUTINE ZUNK1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZUNK1 +C***REFER TO ZBESK +C +C ZUNK1 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE +C RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE +C UNIFORM ASYMPTOTIC EXPANSION. +C MR INDICATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. +C NZ=-1 MEANS AN OVERFLOW WILL OCCUR +C +C***ROUTINES CALLED ZKSCL,ZS1S2,ZUCHK,ZUNIK,D1MACH,ZABS +C***END PROLOGUE ZUNK1 +C COMPLEX CFN,CK,CONE,CRSC,CS,CSCL,CSGN,CSPN,CSR,CSS,CWRK,CY,CZERO, +C *C1,C2,PHI,PHID,RZ,SUM,SUMD,S1,S2,Y,Z,ZETA1,ZETA1D,ZETA2,ZETA2D,ZR + EXTERNAL ZABS + DOUBLE PRECISION ALIM, ANG, APHI, ASC, ASCLE, BRY, CKI, CKR, + * CONER, CRSC, CSCL, CSGNI, CSPNI, CSPNR, CSR, CSRR, CSSR, + * CWRKI, CWRKR, CYI, CYR, C1I, C1R, C2I, C2M, C2R, ELIM, FMR, FN, + * FNF, FNU, PHIDI, PHIDR, PHII, PHIR, PI, RAST, RAZR, RS1, RZI, + * RZR, SGN, STI, STR, SUMDI, SUMDR, SUMI, SUMR, S1I, S1R, S2I, + * S2R, TOL, YI, YR, ZEROI, ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, + * ZET1DI, ZET1DR, ZET2DI, ZET2DR, ZI, ZR, ZRI, ZRR, D1MACH, ZABS + INTEGER I, IB, IFLAG, IFN, IL, INIT, INU, IUF, K, KDFLG, KFLAG, + * KK, KODE, MR, N, NW, NZ, INITD, IC, IPARD, J, M + DIMENSION BRY(3), INIT(2), YR(N), YI(N), SUMR(2), SUMI(2), + * ZETA1R(2), ZETA1I(2), ZETA2R(2), ZETA2I(2), CYR(2), CYI(2), + * CWRKR(16,3), CWRKI(16,3), CSSR(3), CSRR(3), PHIR(2), PHII(2) + DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 / + DATA PI / 3.14159265358979324D0 / +C + KDFLG = 1 + NZ = 0 +C----------------------------------------------------------------------- +C EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN +C THE UNDERFLOW LIMIT +C----------------------------------------------------------------------- + CSCL = 1.0D0/TOL + CRSC = TOL + CSSR(1) = CSCL + CSSR(2) = CONER + CSSR(3) = CRSC + CSRR(1) = CRSC + CSRR(2) = CONER + CSRR(3) = CSCL + BRY(1) = 1.0D+3*D1MACH(1)/TOL + BRY(2) = 1.0D0/BRY(1) + BRY(3) = D1MACH(2) + ZRR = ZR + ZRI = ZI + IF (ZR.GE.0.0D0) GO TO 10 + ZRR = -ZR + ZRI = -ZI + 10 CONTINUE + J = 2 + DO 70 I=1,N +C----------------------------------------------------------------------- +C J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J +C----------------------------------------------------------------------- + J = 3 - J + FN = FNU + DBLE(FLOAT(I-1)) + INIT(J) = 0 + CALL ZUNIK(ZRR, ZRI, FN, 2, 0, TOL, INIT(J), PHIR(J), PHII(J), + * ZETA1R(J), ZETA1I(J), ZETA2R(J), ZETA2I(J), SUMR(J), SUMI(J), + * CWRKR(1,J), CWRKI(1,J)) + IF (KODE.EQ.1) GO TO 20 + STR = ZRR + ZETA2R(J) + STI = ZRI + ZETA2I(J) + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = ZETA1R(J) - STR + S1I = ZETA1I(J) - STI + GO TO 30 + 20 CONTINUE + S1R = ZETA1R(J) - ZETA2R(J) + S1I = ZETA1I(J) - ZETA2I(J) + 30 CONTINUE + RS1 = S1R +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + IF (DABS(RS1).GT.ELIM) GO TO 60 + IF (KDFLG.EQ.1) KFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 40 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- + APHI = ZABS(PHIR(J),PHII(J)) + RS1 = RS1 + DLOG(APHI) + IF (DABS(RS1).GT.ELIM) GO TO 60 + IF (KDFLG.EQ.1) KFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 40 + IF (KDFLG.EQ.1) KFLAG = 3 + 40 CONTINUE +C----------------------------------------------------------------------- +C SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR +C EXPONENT EXTREMES +C----------------------------------------------------------------------- + S2R = PHIR(J)*SUMR(J) - PHII(J)*SUMI(J) + S2I = PHIR(J)*SUMI(J) + PHII(J)*SUMR(J) + STR = DEXP(S1R)*CSSR(KFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S1R*S2I + S2R*S1I + S2R = STR + IF (KFLAG.NE.1) GO TO 50 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.NE.0) GO TO 60 + 50 CONTINUE + CYR(KDFLG) = S2R + CYI(KDFLG) = S2I + YR(I) = S2R*CSRR(KFLAG) + YI(I) = S2I*CSRR(KFLAG) + IF (KDFLG.EQ.2) GO TO 75 + KDFLG = 2 + GO TO 70 + 60 CONTINUE + IF (RS1.GT.0.0D0) GO TO 300 +C----------------------------------------------------------------------- +C FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW +C----------------------------------------------------------------------- + IF (ZR.LT.0.0D0) GO TO 300 + KDFLG = 1 + YR(I)=ZEROR + YI(I)=ZEROI + NZ=NZ+1 + IF (I.EQ.1) GO TO 70 + IF ((YR(I-1).EQ.ZEROR).AND.(YI(I-1).EQ.ZEROI)) GO TO 70 + YR(I-1)=ZEROR + YI(I-1)=ZEROI + NZ=NZ+1 + 70 CONTINUE + I = N + 75 CONTINUE + RAZR = 1.0D0/ZABS(ZRR,ZRI) + STR = ZRR*RAZR + STI = -ZRI*RAZR + RZR = (STR+STR)*RAZR + RZI = (STI+STI)*RAZR + CKR = FN*RZR + CKI = FN*RZI + IB = I + 1 + IF (N.LT.IB) GO TO 160 +C----------------------------------------------------------------------- +C TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO +C ON UNDERFLOW. +C----------------------------------------------------------------------- + FN = FNU + DBLE(FLOAT(N-1)) + IPARD = 1 + IF (MR.NE.0) IPARD = 0 + INITD = 0 + CALL ZUNIK(ZRR, ZRI, FN, 2, IPARD, TOL, INITD, PHIDR, PHIDI, + * ZET1DR, ZET1DI, ZET2DR, ZET2DI, SUMDR, SUMDI, CWRKR(1,3), + * CWRKI(1,3)) + IF (KODE.EQ.1) GO TO 80 + STR = ZRR + ZET2DR + STI = ZRI + ZET2DI + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = ZET1DR - STR + S1I = ZET1DI - STI + GO TO 90 + 80 CONTINUE + S1R = ZET1DR - ZET2DR + S1I = ZET1DI - ZET2DI + 90 CONTINUE + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 95 + IF (DABS(RS1).LT.ALIM) GO TO 100 +C---------------------------------------------------------------------------- +C REFINE ESTIMATE AND TEST +C------------------------------------------------------------------------- + APHI = ZABS(PHIDR,PHIDI) + RS1 = RS1+DLOG(APHI) + IF (DABS(RS1).LT.ELIM) GO TO 100 + 95 CONTINUE + IF (DABS(RS1).GT.0.0D0) GO TO 300 +C----------------------------------------------------------------------- +C FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW +C----------------------------------------------------------------------- + IF (ZR.LT.0.0D0) GO TO 300 + NZ = N + DO 96 I=1,N + YR(I) = ZEROR + YI(I) = ZEROI + 96 CONTINUE + RETURN +C--------------------------------------------------------------------------- +C FORWARD RECUR FOR REMAINDER OF THE SEQUENCE +C---------------------------------------------------------------------------- + 100 CONTINUE + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + C1R = CSRR(KFLAG) + ASCLE = BRY(KFLAG) + DO 120 I=IB,N + C2R = S2R + C2I = S2I + S2R = CKR*C2R - CKI*C2I + S1R + S2I = CKR*C2I + CKI*C2R + S1I + S1R = C2R + S1I = C2I + CKR = CKR + RZR + CKI = CKI + RZI + C2R = S2R*C1R + C2I = S2I*C1R + YR(I) = C2R + YI(I) = C2I + IF (KFLAG.GE.3) GO TO 120 + STR = DABS(C2R) + STI = DABS(C2I) + C2M = DMAX1(STR,STI) + IF (C2M.LE.ASCLE) GO TO 120 + KFLAG = KFLAG + 1 + ASCLE = BRY(KFLAG) + S1R = S1R*C1R + S1I = S1I*C1R + S2R = C2R + S2I = C2I + S1R = S1R*CSSR(KFLAG) + S1I = S1I*CSSR(KFLAG) + S2R = S2R*CSSR(KFLAG) + S2I = S2I*CSSR(KFLAG) + C1R = CSRR(KFLAG) + 120 CONTINUE + 160 CONTINUE + IF (MR.EQ.0) RETURN +C----------------------------------------------------------------------- +C ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0 +C----------------------------------------------------------------------- + NZ = 0 + FMR = DBLE(FLOAT(MR)) + SGN = -DSIGN(PI,FMR) +C----------------------------------------------------------------------- +C CSPN AND CSGN ARE COEFF OF K AND I FUNCTIONS RESP. +C----------------------------------------------------------------------- + CSGNI = SGN + INU = INT(SNGL(FNU)) + FNF = FNU - DBLE(FLOAT(INU)) + IFN = INU + N - 1 + ANG = FNF*SGN + CSPNR = DCOS(ANG) + CSPNI = DSIN(ANG) + IF (MOD(IFN,2).EQ.0) GO TO 170 + CSPNR = -CSPNR + CSPNI = -CSPNI + 170 CONTINUE + ASC = BRY(1) + IUF = 0 + KK = N + KDFLG = 1 + IB = IB - 1 + IC = IB - 1 + DO 270 K=1,N + FN = FNU + DBLE(FLOAT(KK-1)) +C----------------------------------------------------------------------- +C LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K +C FUNCTION ABOVE +C----------------------------------------------------------------------- + M=3 + IF (N.GT.2) GO TO 175 + 172 CONTINUE + INITD = INIT(J) + PHIDR = PHIR(J) + PHIDI = PHII(J) + ZET1DR = ZETA1R(J) + ZET1DI = ZETA1I(J) + ZET2DR = ZETA2R(J) + ZET2DI = ZETA2I(J) + SUMDR = SUMR(J) + SUMDI = SUMI(J) + M = J + J = 3 - J + GO TO 180 + 175 CONTINUE + IF ((KK.EQ.N).AND.(IB.LT.N)) GO TO 180 + IF ((KK.EQ.IB).OR.(KK.EQ.IC)) GO TO 172 + INITD = 0 + 180 CONTINUE + CALL ZUNIK(ZRR, ZRI, FN, 1, 0, TOL, INITD, PHIDR, PHIDI, + * ZET1DR, ZET1DI, ZET2DR, ZET2DI, SUMDR, SUMDI, + * CWRKR(1,M), CWRKI(1,M)) + IF (KODE.EQ.1) GO TO 200 + STR = ZRR + ZET2DR + STI = ZRI + ZET2DI + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZET1DR + STR + S1I = -ZET1DI + STI + GO TO 210 + 200 CONTINUE + S1R = -ZET1DR + ZET2DR + S1I = -ZET1DI + ZET2DI + 210 CONTINUE +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 260 + IF (KDFLG.EQ.1) IFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 220 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- + APHI = ZABS(PHIDR,PHIDI) + RS1 = RS1 + DLOG(APHI) + IF (DABS(RS1).GT.ELIM) GO TO 260 + IF (KDFLG.EQ.1) IFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 220 + IF (KDFLG.EQ.1) IFLAG = 3 + 220 CONTINUE + STR = PHIDR*SUMDR - PHIDI*SUMDI + STI = PHIDR*SUMDI + PHIDI*SUMDR + S2R = -CSGNI*STI + S2I = CSGNI*STR + STR = DEXP(S1R)*CSSR(IFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S2R*S1I + S2I*S1R + S2R = STR + IF (IFLAG.NE.1) GO TO 230 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.EQ.0) GO TO 230 + S2R = ZEROR + S2I = ZEROI + 230 CONTINUE + CYR(KDFLG) = S2R + CYI(KDFLG) = S2I + C2R = S2R + C2I = S2I + S2R = S2R*CSRR(IFLAG) + S2I = S2I*CSRR(IFLAG) +C----------------------------------------------------------------------- +C ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N +C----------------------------------------------------------------------- + S1R = YR(KK) + S1I = YI(KK) + IF (KODE.EQ.1) GO TO 250 + CALL ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NW, ASC, ALIM, IUF) + NZ = NZ + NW + 250 CONTINUE + YR(KK) = S1R*CSPNR - S1I*CSPNI + S2R + YI(KK) = CSPNR*S1I + CSPNI*S1R + S2I + KK = KK - 1 + CSPNR = -CSPNR + CSPNI = -CSPNI + IF (C2R.NE.0.0D0 .OR. C2I.NE.0.0D0) GO TO 255 + KDFLG = 1 + GO TO 270 + 255 CONTINUE + IF (KDFLG.EQ.2) GO TO 275 + KDFLG = 2 + GO TO 270 + 260 CONTINUE + IF (RS1.GT.0.0D0) GO TO 300 + S2R = ZEROR + S2I = ZEROI + GO TO 230 + 270 CONTINUE + K = N + 275 CONTINUE + IL = N - K + IF (IL.EQ.0) RETURN +C----------------------------------------------------------------------- +C RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE +C K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP +C INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. +C----------------------------------------------------------------------- + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + CSR = CSRR(IFLAG) + ASCLE = BRY(IFLAG) + FN = DBLE(FLOAT(INU+IL)) + DO 290 I=1,IL + C2R = S2R + C2I = S2I + S2R = S1R + (FN+FNF)*(RZR*C2R-RZI*C2I) + S2I = S1I + (FN+FNF)*(RZR*C2I+RZI*C2R) + S1R = C2R + S1I = C2I + FN = FN - 1.0D0 + C2R = S2R*CSR + C2I = S2I*CSR + CKR = C2R + CKI = C2I + C1R = YR(KK) + C1I = YI(KK) + IF (KODE.EQ.1) GO TO 280 + CALL ZS1S2(ZRR, ZRI, C1R, C1I, C2R, C2I, NW, ASC, ALIM, IUF) + NZ = NZ + NW + 280 CONTINUE + YR(KK) = C1R*CSPNR - C1I*CSPNI + C2R + YI(KK) = C1R*CSPNI + C1I*CSPNR + C2I + KK = KK - 1 + CSPNR = -CSPNR + CSPNI = -CSPNI + IF (IFLAG.GE.3) GO TO 290 + C2R = DABS(CKR) + C2I = DABS(CKI) + C2M = DMAX1(C2R,C2I) + IF (C2M.LE.ASCLE) GO TO 290 + IFLAG = IFLAG + 1 + ASCLE = BRY(IFLAG) + S1R = S1R*CSR + S1I = S1I*CSR + S2R = CKR + S2I = CKI + S1R = S1R*CSSR(IFLAG) + S1I = S1I*CSSR(IFLAG) + S2R = S2R*CSSR(IFLAG) + S2I = S2I*CSSR(IFLAG) + CSR = CSRR(IFLAG) + 290 CONTINUE + RETURN + 300 CONTINUE + NZ = -1 + RETURN + END + SUBROUTINE ZUNK2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, + * ALIM) +C***BEGIN PROLOGUE ZUNK2 +C***REFER TO ZBESK +C +C ZUNK2 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE +C RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE +C UNIFORM ASYMPTOTIC EXPANSIONS FOR H(KIND,FNU,ZN) AND J(FNU,ZN) +C WHERE ZN IS IN THE RIGHT HALF PLANE, KIND=(3-MR)/2, MR=+1 OR +C -1. HERE ZN=ZR*I OR -ZR*I WHERE ZR=Z IF Z IS IN THE RIGHT +C HALF PLANE OR ZR=-Z IF Z IS IN THE LEFT HALF PLANE. MR INDIC- +C ATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION. +C NZ=-1 MEANS AN OVERFLOW WILL OCCUR +C +C***ROUTINES CALLED ZAIRY,ZKSCL,ZS1S2,ZUCHK,ZUNHJ,D1MACH,ZABS +C***END PROLOGUE ZUNK2 +C COMPLEX AI,ARG,ARGD,ASUM,ASUMD,BSUM,BSUMD,CFN,CI,CIP,CK,CONE,CRSC, +C *CR1,CR2,CS,CSCL,CSGN,CSPN,CSR,CSS,CY,CZERO,C1,C2,DAI,PHI,PHID,RZ, +C *S1,S2,Y,Z,ZB,ZETA1,ZETA1D,ZETA2,ZETA2D,ZN,ZR + EXTERNAL ZABS + DOUBLE PRECISION AARG, AIC, AII, AIR, ALIM, ANG, APHI, ARGDI, + * ARGDR, ARGI, ARGR, ASC, ASCLE, ASUMDI, ASUMDR, ASUMI, ASUMR, + * BRY, BSUMDI, BSUMDR, BSUMI, BSUMR, CAR, CIPI, CIPR, CKI, CKR, + * CONER, CRSC, CR1I, CR1R, CR2I, CR2R, CSCL, CSGNI, CSI, + * CSPNI, CSPNR, CSR, CSRR, CSSR, CYI, CYR, C1I, C1R, C2I, C2M, + * C2R, DAII, DAIR, ELIM, FMR, FN, FNF, FNU, HPI, PHIDI, PHIDR, + * PHII, PHIR, PI, PTI, PTR, RAST, RAZR, RS1, RZI, RZR, SAR, SGN, + * STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR, YY, ZBI, ZBR, ZEROI, + * ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZET1DI, ZET1DR, ZET2DI, + * ZET2DR, ZI, ZNI, ZNR, ZR, ZRI, ZRR, D1MACH, ZABS + INTEGER I, IB, IFLAG, IFN, IL, IN, INU, IUF, K, KDFLG, KFLAG, KK, + * KODE, MR, N, NAI, NDAI, NW, NZ, IDUM, J, IPARD, IC + DIMENSION BRY(3), YR(N), YI(N), ASUMR(2), ASUMI(2), BSUMR(2), + * BSUMI(2), PHIR(2), PHII(2), ARGR(2), ARGI(2), ZETA1R(2), + * ZETA1I(2), ZETA2R(2), ZETA2I(2), CYR(2), CYI(2), CIPR(4), + * CIPI(4), CSSR(3), CSRR(3) + DATA ZEROR,ZEROI,CONER,CR1R,CR1I,CR2R,CR2I / + 1 0.0D0, 0.0D0, 1.0D0, + 1 1.0D0,1.73205080756887729D0 , -0.5D0,-8.66025403784438647D-01 / + DATA HPI, PI, AIC / + 1 1.57079632679489662D+00, 3.14159265358979324D+00, + 1 1.26551212348464539D+00/ + DATA CIPR(1),CIPI(1),CIPR(2),CIPI(2),CIPR(3),CIPI(3),CIPR(4), + * CIPI(4) / + 1 1.0D0,0.0D0 , 0.0D0,-1.0D0 , -1.0D0,0.0D0 , 0.0D0,1.0D0 / +C + KDFLG = 1 + NZ = 0 +C----------------------------------------------------------------------- +C EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN +C THE UNDERFLOW LIMIT +C----------------------------------------------------------------------- + CSCL = 1.0D0/TOL + CRSC = TOL + CSSR(1) = CSCL + CSSR(2) = CONER + CSSR(3) = CRSC + CSRR(1) = CRSC + CSRR(2) = CONER + CSRR(3) = CSCL + BRY(1) = 1.0D+3*D1MACH(1)/TOL + BRY(2) = 1.0D0/BRY(1) + BRY(3) = D1MACH(2) + ZRR = ZR + ZRI = ZI + IF (ZR.GE.0.0D0) GO TO 10 + ZRR = -ZR + ZRI = -ZI + 10 CONTINUE + YY = ZRI + ZNR = ZRI + ZNI = -ZRR + ZBR = ZRR + ZBI = ZRI + INU = INT(SNGL(FNU)) + FNF = FNU - DBLE(FLOAT(INU)) + ANG = -HPI*FNF + CAR = DCOS(ANG) + SAR = DSIN(ANG) + C2R = HPI*SAR + C2I = -HPI*CAR + KK = MOD(INU,4) + 1 + STR = C2R*CIPR(KK) - C2I*CIPI(KK) + STI = C2R*CIPI(KK) + C2I*CIPR(KK) + CSR = CR1R*STR - CR1I*STI + CSI = CR1R*STI + CR1I*STR + IF (YY.GT.0.0D0) GO TO 20 + ZNR = -ZNR + ZBI = -ZBI + 20 CONTINUE +C----------------------------------------------------------------------- +C K(FNU,Z) IS COMPUTED FROM H(2,FNU,-I*Z) WHERE Z IS IN THE FIRST +C QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY +C CONJUGATION SINCE THE K FUNCTION IS REAL ON THE POSITIVE REAL AXIS +C----------------------------------------------------------------------- + J = 2 + DO 80 I=1,N +C----------------------------------------------------------------------- +C J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J +C----------------------------------------------------------------------- + J = 3 - J + FN = FNU + DBLE(FLOAT(I-1)) + CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIR(J), PHII(J), ARGR(J), + * ARGI(J), ZETA1R(J), ZETA1I(J), ZETA2R(J), ZETA2I(J), ASUMR(J), + * ASUMI(J), BSUMR(J), BSUMI(J)) + IF (KODE.EQ.1) GO TO 30 + STR = ZBR + ZETA2R(J) + STI = ZBI + ZETA2I(J) + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = ZETA1R(J) - STR + S1I = ZETA1I(J) - STI + GO TO 40 + 30 CONTINUE + S1R = ZETA1R(J) - ZETA2R(J) + S1I = ZETA1I(J) - ZETA2I(J) + 40 CONTINUE +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 70 + IF (KDFLG.EQ.1) KFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 50 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- + APHI = ZABS(PHIR(J),PHII(J)) + AARG = ZABS(ARGR(J),ARGI(J)) + RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC + IF (DABS(RS1).GT.ELIM) GO TO 70 + IF (KDFLG.EQ.1) KFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 50 + IF (KDFLG.EQ.1) KFLAG = 3 + 50 CONTINUE +C----------------------------------------------------------------------- +C SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR +C EXPONENT EXTREMES +C----------------------------------------------------------------------- + C2R = ARGR(J)*CR2R - ARGI(J)*CR2I + C2I = ARGR(J)*CR2I + ARGI(J)*CR2R + CALL ZAIRY(C2R, C2I, 0, 2, AIR, AII, NAI, IDUM) + CALL ZAIRY(C2R, C2I, 1, 2, DAIR, DAII, NDAI, IDUM) + STR = DAIR*BSUMR(J) - DAII*BSUMI(J) + STI = DAIR*BSUMI(J) + DAII*BSUMR(J) + PTR = STR*CR2R - STI*CR2I + PTI = STR*CR2I + STI*CR2R + STR = PTR + (AIR*ASUMR(J)-AII*ASUMI(J)) + STI = PTI + (AIR*ASUMI(J)+AII*ASUMR(J)) + PTR = STR*PHIR(J) - STI*PHII(J) + PTI = STR*PHII(J) + STI*PHIR(J) + S2R = PTR*CSR - PTI*CSI + S2I = PTR*CSI + PTI*CSR + STR = DEXP(S1R)*CSSR(KFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S1R*S2I + S2R*S1I + S2R = STR + IF (KFLAG.NE.1) GO TO 60 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.NE.0) GO TO 70 + 60 CONTINUE + IF (YY.LE.0.0D0) S2I = -S2I + CYR(KDFLG) = S2R + CYI(KDFLG) = S2I + YR(I) = S2R*CSRR(KFLAG) + YI(I) = S2I*CSRR(KFLAG) + STR = CSI + CSI = -CSR + CSR = STR + IF (KDFLG.EQ.2) GO TO 85 + KDFLG = 2 + GO TO 80 + 70 CONTINUE + IF (RS1.GT.0.0D0) GO TO 320 +C----------------------------------------------------------------------- +C FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW +C----------------------------------------------------------------------- + IF (ZR.LT.0.0D0) GO TO 320 + KDFLG = 1 + YR(I)=ZEROR + YI(I)=ZEROI + NZ=NZ+1 + STR = CSI + CSI =-CSR + CSR = STR + IF (I.EQ.1) GO TO 80 + IF ((YR(I-1).EQ.ZEROR).AND.(YI(I-1).EQ.ZEROI)) GO TO 80 + YR(I-1)=ZEROR + YI(I-1)=ZEROI + NZ=NZ+1 + 80 CONTINUE + I = N + 85 CONTINUE + RAZR = 1.0D0/ZABS(ZRR,ZRI) + STR = ZRR*RAZR + STI = -ZRI*RAZR + RZR = (STR+STR)*RAZR + RZI = (STI+STI)*RAZR + CKR = FN*RZR + CKI = FN*RZI + IB = I + 1 + IF (N.LT.IB) GO TO 180 +C----------------------------------------------------------------------- +C TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO +C ON UNDERFLOW. +C----------------------------------------------------------------------- + FN = FNU + DBLE(FLOAT(N-1)) + IPARD = 1 + IF (MR.NE.0) IPARD = 0 + CALL ZUNHJ(ZNR, ZNI, FN, IPARD, TOL, PHIDR, PHIDI, ARGDR, ARGDI, + * ZET1DR, ZET1DI, ZET2DR, ZET2DI, ASUMDR, ASUMDI, BSUMDR, BSUMDI) + IF (KODE.EQ.1) GO TO 90 + STR = ZBR + ZET2DR + STI = ZBI + ZET2DI + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = ZET1DR - STR + S1I = ZET1DI - STI + GO TO 100 + 90 CONTINUE + S1R = ZET1DR - ZET2DR + S1I = ZET1DI - ZET2DI + 100 CONTINUE + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 105 + IF (DABS(RS1).LT.ALIM) GO TO 120 +C---------------------------------------------------------------------------- +C REFINE ESTIMATE AND TEST +C------------------------------------------------------------------------- + APHI = ZABS(PHIDR,PHIDI) + RS1 = RS1+DLOG(APHI) + IF (DABS(RS1).LT.ELIM) GO TO 120 + 105 CONTINUE + IF (RS1.GT.0.0D0) GO TO 320 +C----------------------------------------------------------------------- +C FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW +C----------------------------------------------------------------------- + IF (ZR.LT.0.0D0) GO TO 320 + NZ = N + DO 106 I=1,N + YR(I) = ZEROR + YI(I) = ZEROI + 106 CONTINUE + RETURN + 120 CONTINUE + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + C1R = CSRR(KFLAG) + ASCLE = BRY(KFLAG) + DO 130 I=IB,N + C2R = S2R + C2I = S2I + S2R = CKR*C2R - CKI*C2I + S1R + S2I = CKR*C2I + CKI*C2R + S1I + S1R = C2R + S1I = C2I + CKR = CKR + RZR + CKI = CKI + RZI + C2R = S2R*C1R + C2I = S2I*C1R + YR(I) = C2R + YI(I) = C2I + IF (KFLAG.GE.3) GO TO 130 + STR = DABS(C2R) + STI = DABS(C2I) + C2M = DMAX1(STR,STI) + IF (C2M.LE.ASCLE) GO TO 130 + KFLAG = KFLAG + 1 + ASCLE = BRY(KFLAG) + S1R = S1R*C1R + S1I = S1I*C1R + S2R = C2R + S2I = C2I + S1R = S1R*CSSR(KFLAG) + S1I = S1I*CSSR(KFLAG) + S2R = S2R*CSSR(KFLAG) + S2I = S2I*CSSR(KFLAG) + C1R = CSRR(KFLAG) + 130 CONTINUE + 180 CONTINUE + IF (MR.EQ.0) RETURN +C----------------------------------------------------------------------- +C ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0 +C----------------------------------------------------------------------- + NZ = 0 + FMR = DBLE(FLOAT(MR)) + SGN = -DSIGN(PI,FMR) +C----------------------------------------------------------------------- +C CSPN AND CSGN ARE COEFF OF K AND I FUNCIONS RESP. +C----------------------------------------------------------------------- + CSGNI = SGN + IF (YY.LE.0.0D0) CSGNI = -CSGNI + IFN = INU + N - 1 + ANG = FNF*SGN + CSPNR = DCOS(ANG) + CSPNI = DSIN(ANG) + IF (MOD(IFN,2).EQ.0) GO TO 190 + CSPNR = -CSPNR + CSPNI = -CSPNI + 190 CONTINUE +C----------------------------------------------------------------------- +C CS=COEFF OF THE J FUNCTION TO GET THE I FUNCTION. I(FNU,Z) IS +C COMPUTED FROM EXP(I*FNU*HPI)*J(FNU,-I*Z) WHERE Z IS IN THE FIRST +C QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY +C CONJUGATION SINCE THE I FUNCTION IS REAL ON THE POSITIVE REAL AXIS +C----------------------------------------------------------------------- + CSR = SAR*CSGNI + CSI = CAR*CSGNI + IN = MOD(IFN,4) + 1 + C2R = CIPR(IN) + C2I = CIPI(IN) + STR = CSR*C2R + CSI*C2I + CSI = -CSR*C2I + CSI*C2R + CSR = STR + ASC = BRY(1) + IUF = 0 + KK = N + KDFLG = 1 + IB = IB - 1 + IC = IB - 1 + DO 290 K=1,N + FN = FNU + DBLE(FLOAT(KK-1)) +C----------------------------------------------------------------------- +C LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K +C FUNCTION ABOVE +C----------------------------------------------------------------------- + IF (N.GT.2) GO TO 175 + 172 CONTINUE + PHIDR = PHIR(J) + PHIDI = PHII(J) + ARGDR = ARGR(J) + ARGDI = ARGI(J) + ZET1DR = ZETA1R(J) + ZET1DI = ZETA1I(J) + ZET2DR = ZETA2R(J) + ZET2DI = ZETA2I(J) + ASUMDR = ASUMR(J) + ASUMDI = ASUMI(J) + BSUMDR = BSUMR(J) + BSUMDI = BSUMI(J) + J = 3 - J + GO TO 210 + 175 CONTINUE + IF ((KK.EQ.N).AND.(IB.LT.N)) GO TO 210 + IF ((KK.EQ.IB).OR.(KK.EQ.IC)) GO TO 172 + CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIDR, PHIDI, ARGDR, + * ARGDI, ZET1DR, ZET1DI, ZET2DR, ZET2DI, ASUMDR, + * ASUMDI, BSUMDR, BSUMDI) + 210 CONTINUE + IF (KODE.EQ.1) GO TO 220 + STR = ZBR + ZET2DR + STI = ZBI + ZET2DI + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZET1DR + STR + S1I = -ZET1DI + STI + GO TO 230 + 220 CONTINUE + S1R = -ZET1DR + ZET2DR + S1I = -ZET1DI + ZET2DI + 230 CONTINUE +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 280 + IF (KDFLG.EQ.1) IFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 240 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- + APHI = ZABS(PHIDR,PHIDI) + AARG = ZABS(ARGDR,ARGDI) + RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC + IF (DABS(RS1).GT.ELIM) GO TO 280 + IF (KDFLG.EQ.1) IFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 240 + IF (KDFLG.EQ.1) IFLAG = 3 + 240 CONTINUE + CALL ZAIRY(ARGDR, ARGDI, 0, 2, AIR, AII, NAI, IDUM) + CALL ZAIRY(ARGDR, ARGDI, 1, 2, DAIR, DAII, NDAI, IDUM) + STR = DAIR*BSUMDR - DAII*BSUMDI + STI = DAIR*BSUMDI + DAII*BSUMDR + STR = STR + (AIR*ASUMDR-AII*ASUMDI) + STI = STI + (AIR*ASUMDI+AII*ASUMDR) + PTR = STR*PHIDR - STI*PHIDI + PTI = STR*PHIDI + STI*PHIDR + S2R = PTR*CSR - PTI*CSI + S2I = PTR*CSI + PTI*CSR + STR = DEXP(S1R)*CSSR(IFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S2R*S1I + S2I*S1R + S2R = STR + IF (IFLAG.NE.1) GO TO 250 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.EQ.0) GO TO 250 + S2R = ZEROR + S2I = ZEROI + 250 CONTINUE + IF (YY.LE.0.0D0) S2I = -S2I + CYR(KDFLG) = S2R + CYI(KDFLG) = S2I + C2R = S2R + C2I = S2I + S2R = S2R*CSRR(IFLAG) + S2I = S2I*CSRR(IFLAG) +C----------------------------------------------------------------------- +C ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N +C----------------------------------------------------------------------- + S1R = YR(KK) + S1I = YI(KK) + IF (KODE.EQ.1) GO TO 270 + CALL ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NW, ASC, ALIM, IUF) + NZ = NZ + NW + 270 CONTINUE + YR(KK) = S1R*CSPNR - S1I*CSPNI + S2R + YI(KK) = S1R*CSPNI + S1I*CSPNR + S2I + KK = KK - 1 + CSPNR = -CSPNR + CSPNI = -CSPNI + STR = CSI + CSI = -CSR + CSR = STR + IF (C2R.NE.0.0D0 .OR. C2I.NE.0.0D0) GO TO 255 + KDFLG = 1 + GO TO 290 + 255 CONTINUE + IF (KDFLG.EQ.2) GO TO 295 + KDFLG = 2 + GO TO 290 + 280 CONTINUE + IF (RS1.GT.0.0D0) GO TO 320 + S2R = ZEROR + S2I = ZEROI + GO TO 250 + 290 CONTINUE + K = N + 295 CONTINUE + IL = N - K + IF (IL.EQ.0) RETURN +C----------------------------------------------------------------------- +C RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE +C K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP +C INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES. +C----------------------------------------------------------------------- + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + CSR = CSRR(IFLAG) + ASCLE = BRY(IFLAG) + FN = DBLE(FLOAT(INU+IL)) + DO 310 I=1,IL + C2R = S2R + C2I = S2I + S2R = S1R + (FN+FNF)*(RZR*C2R-RZI*C2I) + S2I = S1I + (FN+FNF)*(RZR*C2I+RZI*C2R) + S1R = C2R + S1I = C2I + FN = FN - 1.0D0 + C2R = S2R*CSR + C2I = S2I*CSR + CKR = C2R + CKI = C2I + C1R = YR(KK) + C1I = YI(KK) + IF (KODE.EQ.1) GO TO 300 + CALL ZS1S2(ZRR, ZRI, C1R, C1I, C2R, C2I, NW, ASC, ALIM, IUF) + NZ = NZ + NW + 300 CONTINUE + YR(KK) = C1R*CSPNR - C1I*CSPNI + C2R + YI(KK) = C1R*CSPNI + C1I*CSPNR + C2I + KK = KK - 1 + CSPNR = -CSPNR + CSPNI = -CSPNI + IF (IFLAG.GE.3) GO TO 310 + C2R = DABS(CKR) + C2I = DABS(CKI) + C2M = DMAX1(C2R,C2I) + IF (C2M.LE.ASCLE) GO TO 310 + IFLAG = IFLAG + 1 + ASCLE = BRY(IFLAG) + S1R = S1R*CSR + S1I = S1I*CSR + S2R = CKR + S2I = CKI + S1R = S1R*CSSR(IFLAG) + S1I = S1I*CSSR(IFLAG) + S2R = S2R*CSSR(IFLAG) + S2I = S2I*CSSR(IFLAG) + CSR = CSRR(IFLAG) + 310 CONTINUE + RETURN + 320 CONTINUE + NZ = -1 + RETURN + END + SUBROUTINE ZBUNI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NUI, NLAST, + * FNUL, TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZBUNI +C***REFER TO ZBESI,ZBESK +C +C ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE CABS(Z).GT. +C FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM +C FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING +C ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) +C ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 +C +C***ROUTINES CALLED ZUNI1,ZUNI2,ZABS,D1MACH +C***END PROLOGUE ZBUNI +C COMPLEX CSCL,CSCR,CY,RZ,ST,S1,S2,Y,Z + EXTERNAL ZABS + DOUBLE PRECISION ALIM, AX, AY, CSCLR, CSCRR, CYI, CYR, DFNU, + * ELIM, FNU, FNUI, FNUL, GNU, RAZ, RZI, RZR, STI, STR, S1I, S1R, + * S2I, S2R, TOL, YI, YR, ZI, ZR, ZABS, ASCLE, BRY, C1R, C1I, C1M, + * D1MACH + INTEGER I, IFLAG, IFORM, K, KODE, N, NL, NLAST, NUI, NW, NZ + DIMENSION YR(N), YI(N), CYR(2), CYI(2), BRY(3) + NZ = 0 + AX = DABS(ZR)*1.7321D0 + AY = DABS(ZI) + IFORM = 1 + IF (AY.GT.AX) IFORM = 2 + IF (NUI.EQ.0) GO TO 60 + FNUI = DBLE(FLOAT(NUI)) + DFNU = FNU + DBLE(FLOAT(N-1)) + GNU = DFNU + FNUI + IF (IFORM.EQ.2) GO TO 10 +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN +C -PI/3.LE.ARG(Z).LE.PI/3 +C----------------------------------------------------------------------- + CALL ZUNI1(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL, + * ELIM, ALIM) + GO TO 20 + 10 CONTINUE +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU +C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I +C AND HPI=PI/2 +C----------------------------------------------------------------------- + CALL ZUNI2(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL, + * ELIM, ALIM) + 20 CONTINUE + IF (NW.LT.0) GO TO 50 + IF (NW.NE.0) GO TO 90 + STR = ZABS(CYR(1),CYI(1)) +C---------------------------------------------------------------------- +C SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED +C---------------------------------------------------------------------- + BRY(1)=1.0D+3*D1MACH(1)/TOL + BRY(2) = 1.0D0/BRY(1) + BRY(3) = BRY(2) + IFLAG = 2 + ASCLE = BRY(2) + CSCLR = 1.0D0 + IF (STR.GT.BRY(1)) GO TO 21 + IFLAG = 1 + ASCLE = BRY(1) + CSCLR = 1.0D0/TOL + GO TO 25 + 21 CONTINUE + IF (STR.LT.BRY(2)) GO TO 25 + IFLAG = 3 + ASCLE=BRY(3) + CSCLR = TOL + 25 CONTINUE + CSCRR = 1.0D0/CSCLR + S1R = CYR(2)*CSCLR + S1I = CYI(2)*CSCLR + S2R = CYR(1)*CSCLR + S2I = CYI(1)*CSCLR + RAZ = 1.0D0/ZABS(ZR,ZI) + STR = ZR*RAZ + STI = -ZI*RAZ + RZR = (STR+STR)*RAZ + RZI = (STI+STI)*RAZ + DO 30 I=1,NUI + STR = S2R + STI = S2I + S2R = (DFNU+FNUI)*(RZR*STR-RZI*STI) + S1R + S2I = (DFNU+FNUI)*(RZR*STI+RZI*STR) + S1I + S1R = STR + S1I = STI + FNUI = FNUI - 1.0D0 + IF (IFLAG.GE.3) GO TO 30 + STR = S2R*CSCRR + STI = S2I*CSCRR + C1R = DABS(STR) + C1I = DABS(STI) + C1M = DMAX1(C1R,C1I) + IF (C1M.LE.ASCLE) GO TO 30 + IFLAG = IFLAG+1 + ASCLE = BRY(IFLAG) + S1R = S1R*CSCRR + S1I = S1I*CSCRR + S2R = STR + S2I = STI + CSCLR = CSCLR*TOL + CSCRR = 1.0D0/CSCLR + S1R = S1R*CSCLR + S1I = S1I*CSCLR + S2R = S2R*CSCLR + S2I = S2I*CSCLR + 30 CONTINUE + YR(N) = S2R*CSCRR + YI(N) = S2I*CSCRR + IF (N.EQ.1) RETURN + NL = N - 1 + FNUI = DBLE(FLOAT(NL)) + K = NL + DO 40 I=1,NL + STR = S2R + STI = S2I + S2R = (FNU+FNUI)*(RZR*STR-RZI*STI) + S1R + S2I = (FNU+FNUI)*(RZR*STI+RZI*STR) + S1I + S1R = STR + S1I = STI + STR = S2R*CSCRR + STI = S2I*CSCRR + YR(K) = STR + YI(K) = STI + FNUI = FNUI - 1.0D0 + K = K - 1 + IF (IFLAG.GE.3) GO TO 40 + C1R = DABS(STR) + C1I = DABS(STI) + C1M = DMAX1(C1R,C1I) + IF (C1M.LE.ASCLE) GO TO 40 + IFLAG = IFLAG+1 + ASCLE = BRY(IFLAG) + S1R = S1R*CSCRR + S1I = S1I*CSCRR + S2R = STR + S2I = STI + CSCLR = CSCLR*TOL + CSCRR = 1.0D0/CSCLR + S1R = S1R*CSCLR + S1I = S1I*CSCLR + S2R = S2R*CSCLR + S2I = S2I*CSCLR + 40 CONTINUE + RETURN + 50 CONTINUE + NZ = -1 + IF(NW.EQ.(-2)) NZ=-2 + RETURN + 60 CONTINUE + IF (IFORM.EQ.2) GO TO 70 +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN +C -PI/3.LE.ARG(Z).LE.PI/3 +C----------------------------------------------------------------------- + CALL ZUNI1(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL, + * ELIM, ALIM) + GO TO 80 + 70 CONTINUE +C----------------------------------------------------------------------- +C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU +C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I +C AND HPI=PI/2 +C----------------------------------------------------------------------- + CALL ZUNI2(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL, + * ELIM, ALIM) + 80 CONTINUE + IF (NW.LT.0) GO TO 50 + NZ = NW + RETURN + 90 CONTINUE + NLAST = N + RETURN + END + SUBROUTINE ZUNI1(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, + * TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZUNI1 +C***REFER TO ZBESI,ZBESK +C +C ZUNI1 COMPUTES I(FNU,Z) BY MEANS OF THE UNIFORM ASYMPTOTIC +C EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3. +C +C FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC +C EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. +C NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER +C FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. +C Y(I)=CZERO FOR I=NLAST+1,N +C +C***ROUTINES CALLED ZUCHK,ZUNIK,ZUOIK,D1MACH,ZABS +C***END PROLOGUE ZUNI1 +C COMPLEX CFN,CONE,CRSC,CSCL,CSR,CSS,CWRK,CZERO,C1,C2,PHI,RZ,SUM,S1, +C *S2,Y,Z,ZETA1,ZETA2 + EXTERNAL ZABS + DOUBLE PRECISION ALIM, APHI, ASCLE, BRY, CONER, CRSC, + * CSCL, CSRR, CSSR, CWRKI, CWRKR, C1R, C2I, C2M, C2R, ELIM, FN, + * FNU, FNUL, PHII, PHIR, RAST, RS1, RZI, RZR, STI, STR, SUMI, + * SUMR, S1I, S1R, S2I, S2R, TOL, YI, YR, ZEROI, ZEROR, ZETA1I, + * ZETA1R, ZETA2I, ZETA2R, ZI, ZR, CYR, CYI, D1MACH, ZABS + INTEGER I, IFLAG, INIT, K, KODE, M, N, ND, NLAST, NN, NUF, NW, NZ + DIMENSION BRY(3), YR(N), YI(N), CWRKR(16), CWRKI(16), CSSR(3), + * CSRR(3), CYR(2), CYI(2) + DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 / +C + NZ = 0 + ND = N + NLAST = 0 +C----------------------------------------------------------------------- +C COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- +C NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, +C EXP(ALIM)=EXP(ELIM)*TOL +C----------------------------------------------------------------------- + CSCL = 1.0D0/TOL + CRSC = TOL + CSSR(1) = CSCL + CSSR(2) = CONER + CSSR(3) = CRSC + CSRR(1) = CRSC + CSRR(2) = CONER + CSRR(3) = CSCL + BRY(1) = 1.0D+3*D1MACH(1)/TOL +C----------------------------------------------------------------------- +C CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER +C----------------------------------------------------------------------- + FN = DMAX1(FNU,1.0D0) + INIT = 0 + CALL ZUNIK(ZR, ZI, FN, 1, 1, TOL, INIT, PHIR, PHII, ZETA1R, + * ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI) + IF (KODE.EQ.1) GO TO 10 + STR = ZR + ZETA2R + STI = ZI + ZETA2I + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZETA1R + STR + S1I = -ZETA1I + STI + GO TO 20 + 10 CONTINUE + S1R = -ZETA1R + ZETA2R + S1I = -ZETA1I + ZETA2I + 20 CONTINUE + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 130 + 30 CONTINUE + NN = MIN0(2,ND) + DO 80 I=1,NN + FN = FNU + DBLE(FLOAT(ND-I)) + INIT = 0 + CALL ZUNIK(ZR, ZI, FN, 1, 0, TOL, INIT, PHIR, PHII, ZETA1R, + * ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI) + IF (KODE.EQ.1) GO TO 40 + STR = ZR + ZETA2R + STI = ZI + ZETA2I + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZETA1R + STR + S1I = -ZETA1I + STI + ZI + GO TO 50 + 40 CONTINUE + S1R = -ZETA1R + ZETA2R + S1I = -ZETA1I + ZETA2I + 50 CONTINUE +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 110 + IF (I.EQ.1) IFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 60 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- + APHI = ZABS(PHIR,PHII) + RS1 = RS1 + DLOG(APHI) + IF (DABS(RS1).GT.ELIM) GO TO 110 + IF (I.EQ.1) IFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 60 + IF (I.EQ.1) IFLAG = 3 + 60 CONTINUE +C----------------------------------------------------------------------- +C SCALE S1 IF CABS(S1).LT.ASCLE +C----------------------------------------------------------------------- + S2R = PHIR*SUMR - PHII*SUMI + S2I = PHIR*SUMI + PHII*SUMR + STR = DEXP(S1R)*CSSR(IFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S2R*S1I + S2I*S1R + S2R = STR + IF (IFLAG.NE.1) GO TO 70 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.NE.0) GO TO 110 + 70 CONTINUE + CYR(I) = S2R + CYI(I) = S2I + M = ND - I + 1 + YR(M) = S2R*CSRR(IFLAG) + YI(M) = S2I*CSRR(IFLAG) + 80 CONTINUE + IF (ND.LE.2) GO TO 100 + RAST = 1.0D0/ZABS(ZR,ZI) + STR = ZR*RAST + STI = -ZI*RAST + RZR = (STR+STR)*RAST + RZI = (STI+STI)*RAST + BRY(2) = 1.0D0/BRY(1) + BRY(3) = D1MACH(2) + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + C1R = CSRR(IFLAG) + ASCLE = BRY(IFLAG) + K = ND - 2 + FN = DBLE(FLOAT(K)) + DO 90 I=3,ND + C2R = S2R + C2I = S2I + S2R = S1R + (FNU+FN)*(RZR*C2R-RZI*C2I) + S2I = S1I + (FNU+FN)*(RZR*C2I+RZI*C2R) + S1R = C2R + S1I = C2I + C2R = S2R*C1R + C2I = S2I*C1R + YR(K) = C2R + YI(K) = C2I + K = K - 1 + FN = FN - 1.0D0 + IF (IFLAG.GE.3) GO TO 90 + STR = DABS(C2R) + STI = DABS(C2I) + C2M = DMAX1(STR,STI) + IF (C2M.LE.ASCLE) GO TO 90 + IFLAG = IFLAG + 1 + ASCLE = BRY(IFLAG) + S1R = S1R*C1R + S1I = S1I*C1R + S2R = C2R + S2I = C2I + S1R = S1R*CSSR(IFLAG) + S1I = S1I*CSSR(IFLAG) + S2R = S2R*CSSR(IFLAG) + S2I = S2I*CSSR(IFLAG) + C1R = CSRR(IFLAG) + 90 CONTINUE + 100 CONTINUE + RETURN +C----------------------------------------------------------------------- +C SET UNDERFLOW AND UPDATE PARAMETERS +C----------------------------------------------------------------------- + 110 CONTINUE + IF (RS1.GT.0.0D0) GO TO 120 + YR(ND) = ZEROR + YI(ND) = ZEROI + NZ = NZ + 1 + ND = ND - 1 + IF (ND.EQ.0) GO TO 100 + CALL ZUOIK(ZR, ZI, FNU, KODE, 1, ND, YR, YI, NUF, TOL, ELIM, ALIM) + IF (NUF.LT.0) GO TO 120 + ND = ND - NUF + NZ = NZ + NUF + IF (ND.EQ.0) GO TO 100 + FN = FNU + DBLE(FLOAT(ND-1)) + IF (FN.GE.FNUL) GO TO 30 + NLAST = ND + RETURN + 120 CONTINUE + NZ = -1 + RETURN + 130 CONTINUE + IF (RS1.GT.0.0D0) GO TO 120 + NZ = N + DO 140 I=1,N + YR(I) = ZEROR + YI(I) = ZEROI + 140 CONTINUE + RETURN + END + SUBROUTINE ZUNI2(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, + * TOL, ELIM, ALIM) +C***BEGIN PROLOGUE ZUNI2 +C***REFER TO ZBESI,ZBESK +C +C ZUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF +C UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I +C OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO. +C +C FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC +C EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. +C NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER +C FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. +C Y(I)=CZERO FOR I=NLAST+1,N +C +C***ROUTINES CALLED ZAIRY,ZUCHK,ZUNHJ,ZUOIK,D1MACH,ZABS +C***END PROLOGUE ZUNI2 +C COMPLEX AI,ARG,ASUM,BSUM,CFN,CI,CID,CIP,CONE,CRSC,CSCL,CSR,CSS, +C *CZERO,C1,C2,DAI,PHI,RZ,S1,S2,Y,Z,ZB,ZETA1,ZETA2,ZN + EXTERNAL ZABS + DOUBLE PRECISION AARG, AIC, AII, AIR, ALIM, ANG, APHI, ARGI, + * ARGR, ASCLE, ASUMI, ASUMR, BRY, BSUMI, BSUMR, CIDI, CIPI, CIPR, + * CONER, CRSC, CSCL, CSRR, CSSR, C1R, C2I, C2M, C2R, DAII, + * DAIR, ELIM, FN, FNU, FNUL, HPI, PHII, PHIR, RAST, RAZ, RS1, RZI, + * RZR, STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR, ZBI, ZBR, ZEROI, + * ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZI, ZNI, ZNR, ZR, CYR, + * CYI, D1MACH, ZABS, CAR, SAR + INTEGER I, IFLAG, IN, INU, J, K, KODE, N, NAI, ND, NDAI, NLAST, + * NN, NUF, NW, NZ, IDUM + DIMENSION BRY(3), YR(N), YI(N), CIPR(4), CIPI(4), CSSR(3), + * CSRR(3), CYR(2), CYI(2) + DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 / + DATA CIPR(1),CIPI(1),CIPR(2),CIPI(2),CIPR(3),CIPI(3),CIPR(4), + * CIPI(4)/ 1.0D0,0.0D0, 0.0D0,1.0D0, -1.0D0,0.0D0, 0.0D0,-1.0D0/ + DATA HPI, AIC / + 1 1.57079632679489662D+00, 1.265512123484645396D+00/ +C + NZ = 0 + ND = N + NLAST = 0 +C----------------------------------------------------------------------- +C COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- +C NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, +C EXP(ALIM)=EXP(ELIM)*TOL +C----------------------------------------------------------------------- + CSCL = 1.0D0/TOL + CRSC = TOL + CSSR(1) = CSCL + CSSR(2) = CONER + CSSR(3) = CRSC + CSRR(1) = CRSC + CSRR(2) = CONER + CSRR(3) = CSCL + BRY(1) = 1.0D+3*D1MACH(1)/TOL +C----------------------------------------------------------------------- +C ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI +C----------------------------------------------------------------------- + ZNR = ZI + ZNI = -ZR + ZBR = ZR + ZBI = ZI + CIDI = -CONER + INU = INT(SNGL(FNU)) + ANG = HPI*(FNU-DBLE(FLOAT(INU))) + C2R = DCOS(ANG) + C2I = DSIN(ANG) + CAR = C2R + SAR = C2I + IN = INU + N - 1 + IN = MOD(IN,4) + 1 + STR = C2R*CIPR(IN) - C2I*CIPI(IN) + C2I = C2R*CIPI(IN) + C2I*CIPR(IN) + C2R = STR + IF (ZI.GT.0.0D0) GO TO 10 + ZNR = -ZNR + ZBI = -ZBI + CIDI = -CIDI + C2I = -C2I + 10 CONTINUE +C----------------------------------------------------------------------- +C CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER +C----------------------------------------------------------------------- + FN = DMAX1(FNU,1.0D0) + CALL ZUNHJ(ZNR, ZNI, FN, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R, + * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) + IF (KODE.EQ.1) GO TO 20 + STR = ZBR + ZETA2R + STI = ZBI + ZETA2I + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZETA1R + STR + S1I = -ZETA1I + STI + GO TO 30 + 20 CONTINUE + S1R = -ZETA1R + ZETA2R + S1I = -ZETA1I + ZETA2I + 30 CONTINUE + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 150 + 40 CONTINUE + NN = MIN0(2,ND) + DO 90 I=1,NN + FN = FNU + DBLE(FLOAT(ND-I)) + CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIR, PHII, ARGR, ARGI, + * ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) + IF (KODE.EQ.1) GO TO 50 + STR = ZBR + ZETA2R + STI = ZBI + ZETA2I + RAST = FN/ZABS(STR,STI) + STR = STR*RAST*RAST + STI = -STI*RAST*RAST + S1R = -ZETA1R + STR + S1I = -ZETA1I + STI + DABS(ZI) + GO TO 60 + 50 CONTINUE + S1R = -ZETA1R + ZETA2R + S1I = -ZETA1I + ZETA2I + 60 CONTINUE +C----------------------------------------------------------------------- +C TEST FOR UNDERFLOW AND OVERFLOW +C----------------------------------------------------------------------- + RS1 = S1R + IF (DABS(RS1).GT.ELIM) GO TO 120 + IF (I.EQ.1) IFLAG = 2 + IF (DABS(RS1).LT.ALIM) GO TO 70 +C----------------------------------------------------------------------- +C REFINE TEST AND SCALE +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + APHI = ZABS(PHIR,PHII) + AARG = ZABS(ARGR,ARGI) + RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC + IF (DABS(RS1).GT.ELIM) GO TO 120 + IF (I.EQ.1) IFLAG = 1 + IF (RS1.LT.0.0D0) GO TO 70 + IF (I.EQ.1) IFLAG = 3 + 70 CONTINUE +C----------------------------------------------------------------------- +C SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR +C EXPONENT EXTREMES +C----------------------------------------------------------------------- + CALL ZAIRY(ARGR, ARGI, 0, 2, AIR, AII, NAI, IDUM) + CALL ZAIRY(ARGR, ARGI, 1, 2, DAIR, DAII, NDAI, IDUM) + STR = DAIR*BSUMR - DAII*BSUMI + STI = DAIR*BSUMI + DAII*BSUMR + STR = STR + (AIR*ASUMR-AII*ASUMI) + STI = STI + (AIR*ASUMI+AII*ASUMR) + S2R = PHIR*STR - PHII*STI + S2I = PHIR*STI + PHII*STR + STR = DEXP(S1R)*CSSR(IFLAG) + S1R = STR*DCOS(S1I) + S1I = STR*DSIN(S1I) + STR = S2R*S1R - S2I*S1I + S2I = S2R*S1I + S2I*S1R + S2R = STR + IF (IFLAG.NE.1) GO TO 80 + CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL) + IF (NW.NE.0) GO TO 120 + 80 CONTINUE + IF (ZI.LE.0.0D0) S2I = -S2I + STR = S2R*C2R - S2I*C2I + S2I = S2R*C2I + S2I*C2R + S2R = STR + CYR(I) = S2R + CYI(I) = S2I + J = ND - I + 1 + YR(J) = S2R*CSRR(IFLAG) + YI(J) = S2I*CSRR(IFLAG) + STR = -C2I*CIDI + C2I = C2R*CIDI + C2R = STR + 90 CONTINUE + IF (ND.LE.2) GO TO 110 + RAZ = 1.0D0/ZABS(ZR,ZI) + STR = ZR*RAZ + STI = -ZI*RAZ + RZR = (STR+STR)*RAZ + RZI = (STI+STI)*RAZ + BRY(2) = 1.0D0/BRY(1) + BRY(3) = D1MACH(2) + S1R = CYR(1) + S1I = CYI(1) + S2R = CYR(2) + S2I = CYI(2) + C1R = CSRR(IFLAG) + ASCLE = BRY(IFLAG) + K = ND - 2 + FN = DBLE(FLOAT(K)) + DO 100 I=3,ND + C2R = S2R + C2I = S2I + S2R = S1R + (FNU+FN)*(RZR*C2R-RZI*C2I) + S2I = S1I + (FNU+FN)*(RZR*C2I+RZI*C2R) + S1R = C2R + S1I = C2I + C2R = S2R*C1R + C2I = S2I*C1R + YR(K) = C2R + YI(K) = C2I + K = K - 1 + FN = FN - 1.0D0 + IF (IFLAG.GE.3) GO TO 100 + STR = DABS(C2R) + STI = DABS(C2I) + C2M = DMAX1(STR,STI) + IF (C2M.LE.ASCLE) GO TO 100 + IFLAG = IFLAG + 1 + ASCLE = BRY(IFLAG) + S1R = S1R*C1R + S1I = S1I*C1R + S2R = C2R + S2I = C2I + S1R = S1R*CSSR(IFLAG) + S1I = S1I*CSSR(IFLAG) + S2R = S2R*CSSR(IFLAG) + S2I = S2I*CSSR(IFLAG) + C1R = CSRR(IFLAG) + 100 CONTINUE + 110 CONTINUE + RETURN + 120 CONTINUE + IF (RS1.GT.0.0D0) GO TO 140 +C----------------------------------------------------------------------- +C SET UNDERFLOW AND UPDATE PARAMETERS +C----------------------------------------------------------------------- + YR(ND) = ZEROR + YI(ND) = ZEROI + NZ = NZ + 1 + ND = ND - 1 + IF (ND.EQ.0) GO TO 110 + CALL ZUOIK(ZR, ZI, FNU, KODE, 1, ND, YR, YI, NUF, TOL, ELIM, ALIM) + IF (NUF.LT.0) GO TO 140 + ND = ND - NUF + NZ = NZ + NUF + IF (ND.EQ.0) GO TO 110 + FN = FNU + DBLE(FLOAT(ND-1)) + IF (FN.LT.FNUL) GO TO 130 +C FN = CIDI +C J = NUF + 1 +C K = MOD(J,4) + 1 +C S1R = CIPR(K) +C S1I = CIPI(K) +C IF (FN.LT.0.0D0) S1I = -S1I +C STR = C2R*S1R - C2I*S1I +C C2I = C2R*S1I + C2I*S1R +C C2R = STR + IN = INU + ND - 1 + IN = MOD(IN,4) + 1 + C2R = CAR*CIPR(IN) - SAR*CIPI(IN) + C2I = CAR*CIPI(IN) + SAR*CIPR(IN) + IF (ZI.LE.0.0D0) C2I = -C2I + GO TO 40 + 130 CONTINUE + NLAST = ND + RETURN + 140 CONTINUE + NZ = -1 + RETURN + 150 CONTINUE + IF (RS1.GT.0.0D0) GO TO 140 + NZ = N + DO 160 I=1,N + YR(I) = ZEROR + YI(I) = ZEROI + 160 CONTINUE + RETURN + END + SUBROUTINE XERROR(MESS,NMESS,L1,L2) +C +C THIS IS A DUMMY XERROR ROUTINE TO PRINT ERROR MESSAGES WITH NMESS +C CHARACTERS. L1 AND L2 ARE DUMMY PARAMETERS TO MAKE THIS CALL +C COMPATIBLE WITH THE SLATEC XERROR ROUTINE. THIS IS A FORTRAN 77 +C ROUTINE. +C + INTEGER NMESS, L1, L2, NN, NR, K, I, KMIN + CHARACTER*(*) MESS + NN=NMESS/70 + NR=NMESS-70*NN + IF(NR.NE.0) NN=NN+1 + K=1 + PRINT 900 + 900 FORMAT(/) + DO 10 I=1,NN + KMIN=MIN0(K+69,NMESS) + PRINT *, MESS(K:KMIN) + K=K+70 + 10 CONTINUE + PRINT 900 + RETURN + END + DOUBLE PRECISION FUNCTION D1MACH(I) +C +C DOUBLE-PRECISION MACHINE CONSTANTS +C +C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. +C +C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. +C +C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. +C +C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. +C +C D1MACH( 5) = LOG10(B) +C +C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, +C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY +C REMOVING THE C FROM COLUMN 1. +C +C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST +C TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE. +C +C WHERE POSSIBLE, DECIMAL, OCTAL OR HEXADECIMAL CONSTANTS ARE USED +C TO SPECIFY THE CONSTANTS EXACTLY. SOMETIMES THIS REQUIRES USING +C EQUIVALENT INTEGER ARRAYS. IF YOUR COMPILER USES HALF-WORD +C INTEGERS BY DEFAULT (SOMETIMES CALLED INTEGER*2), YOU MAY NEED TO +C CHANGE INTEGER TO INTEGER*4 OR OTHERWISE INSTRUCT YOUR COMPILER +C TO USE FULL-WORD INTEGERS IN THE NEXT 5 DECLARATIONS. +C + INTEGER SMALL(4) + INTEGER LARGE(4) + INTEGER RIGHT(4) + INTEGER DIVER(4) + INTEGER LOG10(4) + INTEGER SC +C + DOUBLE PRECISION DMACH(5) +C + EQUIVALENCE (DMACH(1),SMALL(1)) + EQUIVALENCE (DMACH(2),LARGE(1)) + EQUIVALENCE (DMACH(3),RIGHT(1)) + EQUIVALENCE (DMACH(4),DIVER(1)) + EQUIVALENCE (DMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T +C 3B SERIES AND MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T +C PC 7300), IN WHICH THE MOST SIGNIFICANT BYTE IS STORED FIRST. +C + DATA SMALL(1),SMALL(2) / 1048576, 0 / + DATA LARGE(1),LARGE(2) / 2146435071, -1 / + DATA RIGHT(1),RIGHT(2) / 1017118720, 0 / + DATA DIVER(1),DIVER(2) / 1018167296, 0 / + DATA LOG10(1),LOG10(2) / 1070810131, 1352628735 /, SC/987/ +C +C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES AND 8087-BASED +C MICROS, SUCH AS THE IBM PC AND AT&T 6300, IN WHICH THE LEAST +C SIGNIFICANT BYTE IS STORED FIRST. +C +C DATA SMALL(1),SMALL(2) / 0, 1048576 / +C DATA LARGE(1),LARGE(2) / -1, 2146435071 / +C DATA RIGHT(1),RIGHT(2) / 0, 1017118720 / +C DATA DIVER(1),DIVER(2) / 0, 1018167296 / +C DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 /, SC/987/ +C +C MACHINE CONSTANTS FOR AMDAHL MACHINES. +C +C DATA SMALL(1),SMALL(2) / 1048576, 0 / +C DATA LARGE(1),LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1),RIGHT(2) / 856686592, 0 / +C DATA DIVER(1),DIVER(2) / 873463808, 0 / +C DATA LOG10(1),LOG10(2) / 1091781651, 1352628735 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. +C +C DATA SMALL(1) / ZC00800000 / +C DATA SMALL(2) / Z000000000 / +C +C DATA LARGE(1) / ZDFFFFFFFF / +C DATA LARGE(2) / ZFFFFFFFFF / +C +C DATA RIGHT(1) / ZCC5800000 / +C DATA RIGHT(2) / Z000000000 / +C +C DATA DIVER(1) / ZCC6800000 / +C DATA DIVER(2) / Z000000000 / +C +C DATA LOG10(1) / ZD00E730E7 / +C DATA LOG10(2) / ZC77800DC0 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O0000000000000000 / +C +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O0007777777777777 / +C +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O7770000000000000 / +C +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O7777777777777777 / +C +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 /, SC/987/ +C +C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. +C +C DATA SMALL(1) / 00564000000000000000B / +C DATA SMALL(2) / 00000000000000000000B / +C +C DATA LARGE(1) / 37757777777777777777B / +C DATA LARGE(2) / 37157777777777777774B / +C +C DATA RIGHT(1) / 15624000000000000000B / +C DATA RIGHT(2) / 00000000000000000000B / +C +C DATA DIVER(1) / 15634000000000000000B / +C DATA DIVER(2) / 00000000000000000000B / +C +C DATA LOG10(1) / 17164642023241175717B / +C DATA LOG10(2) / 16367571421742254654B /, SC/987/ +C +C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. +C +C DATA SMALL(1) / O"00564000000000000000" / +C DATA SMALL(2) / O"00000000000000000000" / +C +C DATA LARGE(1) / O"37757777777777777777" / +C DATA LARGE(2) / O"37157777777777777774" / +C +C DATA RIGHT(1) / O"15624000000000000000" / +C DATA RIGHT(2) / O"00000000000000000000" / +C +C DATA DIVER(1) / O"15634000000000000000" / +C DATA DIVER(2) / O"00000000000000000000" / +C +C DATA LOG10(1) / O"17164642023241175717" / +C DATA LOG10(2) / O"16367571421742254654" /, SC/987/ +C +C MACHINE CONSTANTS FOR CONVEX C-1 +C +C DATA SMALL(1),SMALL(2) / '00100000'X, '00000000'X / +C DATA LARGE(1),LARGE(2) / '7FFFFFFF'X, 'FFFFFFFF'X / +C DATA RIGHT(1),RIGHT(2) / '3CC00000'X, '00000000'X / +C DATA DIVER(1),DIVER(2) / '3CD00000'X, '00000000'X / +C DATA LOG10(1),LOG10(2) / '3FF34413'X, '509F79FF'X /, SC/987/ +C +C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. +C +C DATA SMALL(1) / 201354000000000000000B / +C DATA SMALL(2) / 000000000000000000000B / +C +C DATA LARGE(1) / 577767777777777777777B / +C DATA LARGE(2) / 000007777777777777776B / +C +C DATA RIGHT(1) / 376434000000000000000B / +C DATA RIGHT(2) / 000000000000000000000B / +C +C DATA DIVER(1) / 376444000000000000000B / +C DATA DIVER(2) / 000000000000000000000B / +C +C DATA LOG10(1) / 377774642023241175717B / +C DATA LOG10(2) / 000007571421742254654B /, SC/987/ +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE - +C STATIC DMACH(5) +C +C DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/ +C DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/ +C DATA LOG10/40423K,42023K,50237K,74776K/, SC/987/ +C +C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 +C +C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1),LARGE(2) / '37777777, '37777577 / +C DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 / +C DATA DIVER(1),DIVER(2) / '20000000, '00000334 / +C DATA LOG10(1),LOG10(2) / '23210115, '10237777 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. +C +C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. +C +C DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 / +C DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / +C DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 / +C DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 / +C DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF /, SC/987/ +C +C MACHINE CONSTANTS FOR THE INTERDATA 8/32 +C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. +C +C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE +C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. +C +C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' / +C DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' / +C DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' /, SC/987/ +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). +C +C DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 / +C DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 / +C DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 / +C DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 / +C DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). +C +C DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 / +C DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 / +C DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 / +C DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 / +C DATA LOG10(1),LOG10(2) / "177464202324, "047674776746 /, SC/987/ +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1),SMALL(2) / 8388608, 0 / +C DATA LARGE(1),LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / +C DATA DIVER(1),DIVER(2) / 620756992, 0 / +C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/ +C +C DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 / +C DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 / +C DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 / +C DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 / +C DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 /, SC/987/ +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1),SMALL(2) / 128, 0 / +C DATA SMALL(3),SMALL(4) / 0, 0 / +C +C DATA LARGE(1),LARGE(2) / 32767, -1 / +C DATA LARGE(3),LARGE(4) / -1, -1 / +C +C DATA RIGHT(1),RIGHT(2) / 9344, 0 / +C DATA RIGHT(3),RIGHT(4) / 0, 0 / +C +C DATA DIVER(1),DIVER(2) / 9472, 0 / +C DATA DIVER(3),DIVER(4) / 0, 0 / +C +C DATA LOG10(1),LOG10(2) / 16282, 8346 / +C DATA LOG10(3),LOG10(4) / -31493, -12296 /, SC/987/ +C +C DATA SMALL(1),SMALL(2) / O000200, O000000 / +C DATA SMALL(3),SMALL(4) / O000000, O000000 / +C +C DATA LARGE(1),LARGE(2) / O077777, O177777 / +C DATA LARGE(3),LARGE(4) / O177777, O177777 / +C +C DATA RIGHT(1),RIGHT(2) / O022200, O000000 / +C DATA RIGHT(3),RIGHT(4) / O000000, O000000 / +C +C DATA DIVER(1),DIVER(2) / O022400, O000000 / +C DATA DIVER(3),DIVER(4) / O000000, O000000 / +C +C DATA LOG10(1),LOG10(2) / O037632, O020232 / +C DATA LOG10(3),LOG10(4) / O102373, O147770 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS +C WITH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, +C SUPPLIED BY IGOR BRAY. +C +C DATA SMALL(1),SMALL(2) / :10000000000, :00000100001 / +C DATA LARGE(1),LARGE(2) / :17777777777, :37777677775 / +C DATA RIGHT(1),RIGHT(2) / :10000000000, :00000000122 / +C DATA DIVER(1),DIVER(2) / :10000000000, :00000000123 / +C DATA LOG10(1),LOG10(2) / :11504046501, :07674600177 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 +C +C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / +C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / +C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / +C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / +C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C +C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER +C +C DATA SMALL(1),SMALL(2) / 128, 0 / +C DATA LARGE(1),LARGE(2) / -32769, -1 / +C DATA RIGHT(1),RIGHT(2) / 9344, 0 / +C DATA DIVER(1),DIVER(2) / 9472, 0 / +C DATA LOG10(1),LOG10(2) / 546979738, -805796613 /, SC/987/ +C +C MACHINE CONSTANTS FOR THE VAX-11 WITH +C FORTRAN IV-PLUS COMPILER +C +C DATA SMALL(1),SMALL(2) / Z00000080, Z00000000 / +C DATA LARGE(1),LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1),RIGHT(2) / Z00002480, Z00000000 / +C DATA DIVER(1),DIVER(2) / Z00002500, Z00000000 / +C DATA LOG10(1),LOG10(2) / Z209A3F9A, ZCFF884FB /, SC/987/ +C +C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 +C +C DATA SMALL(1),SMALL(2) / '80'X, '0'X / +C DATA LARGE(1),LARGE(2) / 'FFFF7FFF'X, 'FFFFFFFF'X / +C DATA RIGHT(1),RIGHT(2) / '2480'X, '0'X / +C DATA DIVER(1),DIVER(2) / '2500'X, '0'X / +C DATA LOG10(1),LOG10(2) / '209A3F9A'X, 'CFF884FB'X /, SC/987/ +C +C *** ISSUE STOP 779 IF ALL DATA STATEMENTS ARE COMMENTED... + IF (SC .NE. 987) STOP 779 +C/6S +C IF (I .LT. 1 .OR. I .GT. 5) +C 1 CALL SETERR(24HD1MACH - I OUT OF BOUNDS,24,1,2) +C/7S +C IF (I .LT. 1 .OR. I .GT. 5) +C 1 CALL SETERR('D1MACH - I OUT OF BOUNDS',24,1,2) +C/ +C + D1MACH = DMACH(I) + RETURN +C + END + INTEGER FUNCTION I1MACH(I) +C +C I/O UNIT NUMBERS. +C +C I1MACH( 1) = THE STANDARD INPUT UNIT. +C +C I1MACH( 2) = THE STANDARD OUTPUT UNIT. +C +C I1MACH( 3) = THE STANDARD PUNCH UNIT. +C +C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. +C +C WORDS. +C +C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. +C +C I1MACH( 6) = THE NUMBER OF CHARACTERS PER CHARACTER STORAGE UNIT. +C FOR FORTRAN 77, THIS IS ALWAYS 1. FOR FORTRAN 66, +C CHARACTER STORAGE UNIT = INTEGER STORAGE UNIT. +C +C INTEGERS. +C +C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM +C +C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) +C +C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. +C +C I1MACH( 7) = A, THE BASE. +C +C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. +C +C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. +C +C FLOATING-POINT NUMBERS. +C +C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, +C BASE-B FORM +C +C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, +C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. +C +C I1MACH(10) = B, THE BASE. +C +C SINGLE-PRECISION +C +C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. +C +C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. +C +C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. +C +C DOUBLE-PRECISION +C +C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. +C +C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. +C +C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. +C +C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, +C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY +C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF +C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY +C WITH THE LOCAL OPERATING SYSTEM. FOR FORTRAN 77, YOU MAY WISH +C TO ADJUST THE DATA STATEMENT SO IMACH(6) IS SET TO 1, AND +C THEN TO COMMENT OUT THE EXECUTABLE TEST ON I .EQ. 6 BELOW. +C +C FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST +C SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE, EXCEPT PERHAPS +C FOR IMACH(1) - IMACH(4). +C + INTEGER IMACH(16),OUTPUT,SANITY +C + EQUIVALENCE (IMACH(4),OUTPUT) +C +C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T +C 3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T +C PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). +C + DATA IMACH( 1) / 5 / + DATA IMACH( 2) / 6 / + DATA IMACH( 3) / 7 / + DATA IMACH( 4) / 6 / + DATA IMACH( 5) / 32 / + DATA IMACH( 6) / 4 / + DATA IMACH( 7) / 2 / + DATA IMACH( 8) / 31 / + DATA IMACH( 9) / 2147483647 / + DATA IMACH(10) / 2 / + DATA IMACH(11) / 24 / + DATA IMACH(12) / -125 / + DATA IMACH(13) / 128 / + DATA IMACH(14) / 53 / + DATA IMACH(15) / -1021 / + DATA IMACH(16) / 1024 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR AMDAHL MACHINES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. +C +C DATA IMACH( 1) / 7 / +C DATA IMACH( 2) / 2 / +C DATA IMACH( 3) / 2 / +C DATA IMACH( 4) / 2 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 33 / +C DATA IMACH( 9) / Z1FFFFFFFF / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -256 / +C DATA IMACH(13) / 255 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -256 / +C DATA IMACH(16) / 255 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -50 / +C DATA IMACH(16) / 76 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -32754 / +C DATA IMACH(16) / 32780 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR FTN4 ON THE CDC 6000/7000 SERIES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 60 / +C DATA IMACH( 6) / 10 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 48 / +C DATA IMACH( 9) / 00007777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -929 / +C DATA IMACH(13) / 1070 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -929 / +C DATA IMACH(16) / 1069 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR FTN5 ON THE CDC 6000/7000 SERIES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 60 / +C DATA IMACH( 6) / 10 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 48 / +C DATA IMACH( 9) / O"00007777777777777777" / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -929 / +C DATA IMACH(13) / 1070 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -929 / +C DATA IMACH(16) / 1069 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR CONVEX C-1. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) /-1024 / +C DATA IMACH(16) / 1023 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 777777777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. +C +C DATA IMACH( 1) / 11 / +C DATA IMACH( 2) / 12 / +C DATA IMACH( 3) / 8 / +C DATA IMACH( 4) / 10 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) /32767 / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 24 / +C DATA IMACH( 6) / 3 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 23 / +C DATA IMACH( 9) / 8388607 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 38 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 43 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 63 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z7FFFFFFF / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE INTERDATA 8/32 +C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. +C +C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE +C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z'7FFFFFFF' / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 62 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 62 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 54 / +C DATA IMACH(15) / -101 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 62 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 16-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE PRIME 50 SERIES SYSTEMS +C WTIH 32-BIT INTEGERS AND 64V MODE INSTRUCTIONS, +C SUPPLIED BY IGOR BRAY. +C +C DATA IMACH( 1) / 1 / +C DATA IMACH( 2) / 1 / +C DATA IMACH( 3) / 2 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / :17777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / +127 / +C DATA IMACH(14) / 47 / +C DATA IMACH(15) / -32895 / +C DATA IMACH(16) / +32637 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. +C +C DATA IMACH( 1) / 0 / +C DATA IMACH( 2) / 0 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 1 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C +C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 +C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. +C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) /-1024 / +C DATA IMACH(16) / 1023 /, SANITY/987/ +C +C MACHINE CONSTANTS FOR VAX. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 /, SANITY/987/ +C +C *** ISSUE STOP 777 IF ALL DATA STATEMENTS ARE COMMENTED... + IF (SANITY .NE. 987) STOP 777 + IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 +C + I1MACH = IMACH(I) +C/6S +C/7S + IF (I .EQ. 6) I1MACH = 1 +C/ + RETURN +C + 10 WRITE(OUTPUT,9000) + 9000 FORMAT(39H1ERROR 1 IN I1MACH - I OUT OF BOUNDS) +C +C CALL FDUMP +C + STOP +C + END diff --git a/AMSS_NCKU_source/zbesh.h b/AMSS_NCKU_source/zbesh.h new file mode 100644 index 0000000..997169b --- /dev/null +++ b/AMSS_NCKU_source/zbesh.h @@ -0,0 +1,20 @@ + +#ifndef ZBESH_H +#define ZBESH_H + +#ifdef fortran1 +#define f_zbesj zbesj +#endif +#ifdef fortran2 +#define f_zbesj ZBESJ +#endif +#ifdef fortran3 +#define f_zbesj zbesj_ +#endif + +extern "C" +{ + int f_zbesj(double &, double &, double &, int &, + int &, double &, double &, int &, int &); +} +#endif /* ZBESH_H */ diff --git a/BBH_orbit_parameter.py b/BBH_orbit_parameter.py new file mode 100755 index 0000000..2414e33 --- /dev/null +++ b/BBH_orbit_parameter.py @@ -0,0 +1,948 @@ + +############################################################################################## + +## This script sets parameters for rotating binary black holes +## Author: XiaoQu +## 2024/04/05 +## Modified: 2025/02/10 + +## Can be used as input for AMSS-NCKU or the Einstein Toolkit + +############################################################################################## + + +import AMSS_NCKU_Input as input_data +import math +import os +import sympy +import numpy +import derivative ## numerical differentiation + + +############################################################################################## + +## Set each black hole's physical angular momentum from the input file + +angular_momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) ## Initialize each black hole's spin angular momentum + +for i in range(input_data.puncture_number): + if ( input_data.Symmetry == "equatorial-symmetry" ): + angular_momentum_BH[i] = [ 0.0, 0.0, (input_data.parameter_BH[i,0]**2) * input_data.parameter_BH[i,2] ] + elif ( input_data.Symmetry == "no-symmetry" ): + angular_momentum_BH[i] = (input_data.parameter_BH[i,0]**2) * input_data.dimensionless_spin_BH[i] + +## Set the two black hole masses +## To be consistent with literature notation, require M1 >= M2 + +M1 = input_data.parameter_BH[0,0] +M2 = input_data.parameter_BH[1,0] + +## Set the dimensionless spins of the black holes + +S1 = angular_momentum_BH[0] / M1**2 +S2 = angular_momentum_BH[1] / M2**2 + +## Set the orbital semi-major axis and eccentricity in the center-of-mass frame + +D0 = input_data.Distance +e0 = input_data.e0 + +############################################################################################## + + +############################################################################################## + +## Generate orbital parameters for a quasi-circular rotating binary black hole system +## Author: XiaoQu +## Uses post-Newtonian expansions to obtain a quasi-circular orbit +## Updated up to 3rd post-Newtonian (3PN) order + +## Arguments +## Masses M1 and M2 (ensure M1 >= M2) +## Spins S1 and S2 as 3-element numpy vectors (for numpy.dot) +## Initial separation D0 +## Orbital eccentricity e0 (currently only circular PN formulas implemented; eccentric cases may be added later) + +def generate_BBH_orbit_parameters( M1, M2, S1, S2, D0, e0 ): + + print() + print() + print("Compute binary orbital characteristic quantities using the effective single-body model") + print() + + print() + print(f"Input binary masses: M1 = {M1} M2 = {M2}") + print(f"Input binary dimensionless spins: S1 = {S1} S2 = {S2}") + print(f"Input orbital semi-major axis and eccentricity: a0 = D0/2 = {D0/2.0} e0 = {e0}") + print() + print("Begin calculations") + print() + + ################################################## + + ## Compute mass ratio, reduced mass, and dimensionless masses + M_total = M1 + M2 + print( f"Binary masses: M1 = {M1} M2 = {M2} Newtonian total mass: M_total = {M_total} " ) + + ## Compute reduced mass + M_mu = M1 * M2 / M_total + print( "Reduced mass for effective single-body: M_mu =", M_mu ) + + ## Set mass ratio + ## Note: For consistency with TwoPuncture, require M1 >= M2 + m_q = M1 / M2 + m_eta = m_q / ( (1.0 + m_q)**2 ) + print( "Dimensionless mass ratio Q = M1 / M2 =", m_q ) + + ## Set dimensionless masses + m1 = M1 / M_total + m2 = M2 / M_total + m_mu = M_mu / M_total + print( f"Dimensionless masses: m1 = {m1} m2 = {m2} m_mu = {m_mu} " ) + print( "Dimensionless reduced mass m_eta = Q / (1+Q)^2 =", m_eta ) + + ################################################## + + ## From center-of-mass semi-major axis and eccentricity, compute orbital parameters at t=0 + + ## Under classical mechanics, the binary orbit is equivalent to a reduced mass moving in a central potential + ## Relation between radius r, phase phi, semi-major axis a and eccentricity e: + ## r = a*(1-e^2)/(1+e*cos(phi)) + ## Phase phi = 0 or phi = pi corresponds to periapsis/apapsis (semi-major/semi-minor axis) + + ## Compute semi-major and semi-minor axes + a0 = D0 / 2.0 + a_long = a0 * (1.0 + e0) + a_short = a0 * (1.0 - e0) + + ## Compute individual semi-major axes from center-of-mass definition + ## M1/M2 = a2/a1 + R10 = D0 * M2 / M_total + R20 = D0 * M1 / M_total + + print( ) + print( " Compute orbital coordinate parameters " ) + print( ) + print( " Choose coordinates so that at t=0 the +y axis aligns with the semi-major axis; the binary orbits about +z " ) + print( " At t=0: y corresponds to radial coordinate R, x to angular coordinate phi, and z = 0 " ) + print( " Similarly at t=0: Py corresponds to radial momentum Pr, Px to tangential momentum P_phi, and Pz = 0 " ) + ## print( " Note: this does not imply z remains zero during long evolutions; misaligned spins can tilt the orbit out of the xy plane " ) + print() + + ## Initialize position coordinates + position1 = [0.0, 0.0, 0.0] + position2 = [0.0, 0.0, 0.0] + + ## Initialize momentum coordinates + momentum1 = [0.0, 0.0, 0.0] + momentum2 = [0.0, 0.0, 0.0] + + + position1[1] = R10 + position2[1] = - R20 + + print( "Binary coordinates at t=0:" ) + print( f"Y1 = {position1} Y2 = {position2}" ) + print( ) + + + ######################################## + + ## Compute orbital angular frequency + + R = D0 + epsilon = (m1 + m2) / R + print( " Post-Newtonian expansion parameter epsilon = M/r = ", epsilon ) + print( ) + ## Gravitational-wave scaling: use dimensionless total mass m = m1 + m2 = 1. + ## The initial separation D0 is assumed in total-mass units (physical separation / M_total). + + ## 3PN post-Newtonian results + ## Note: the following formulas assume circular orbits; eccentricity is not included + ## Based on: + ## James Healy, Carlos O. Lousto, Hiroyuki Nakano, and Yosef Zlochower + ## "Post-Newtonian Quasicircular Initial Orbits for Numerical Relativity" + ## arXiv:1702.00872 [gr-qc] + ## Note: in arXiv:1702.00872 the mass ratio q<1, so their S1 corresponds to our S2 + + ## Set orbital angular frequency (can be adjusted later) + + Omega_0PN = epsilon**1.5 + + Omega_correction_1PN = - 0.5 * epsilon * ( ( 3.0*(m_q**2) + 5.0*m_q + 3.0 ) / (1.0+m_q)**2 ) + Omega_correction_15PN = - 0.25 * ( epsilon**(1.5) ) \ + * ( (3.0 + 4.0*m_q) * m_q * S2[2] / ( (1.0+m_q)**2 ) \ + + (3.0*m_q + 4.0) * S1[2] / ( (1.0+m_q)**2 ) \ + ) + Omega_correction_2PN = epsilon**2 \ + * ( (1.0/16.0) * ( 24.0*(m_q**4) + 103.0*(m_q**3) + 164.0*(m_q**2) + 103.0*m_q + 24.0 ) \ + / ( (1.0+m_q)**4 ) \ + - 1.5 * (m_q**2) * (S2[0]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (m_q**2) * (S2[1]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (m_q**2) * (S2[2]**2) / ( (1.0+m_q)**2 ) \ + - 3.0 * m_q * S1[0] * S2[0] / ( (1.0+m_q)**2 ) \ + + 1.5 * m_q * S1[1] * S2[1] / ( (1.0+m_q)**2 ) \ + + 1.5 * m_q * S1[2] * S2[2] / ( (1.0+m_q)**2 ) \ + - 1.5 * (S1[0]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (S1[1]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (S1[2]**2) / ( (1.0+m_q)**2 ) + ) + Omega_correction_25PN = (3.0/16.0) * (epsilon**(2.5)) \ + * ( S2[2] * m_q * ( 16.0*(m_q**3) + 30.0*(m_q**2) + 34.0*m_q + 13.0 ) / ( (1.0+m_q)**4 ) \ + + S1[2] * ( 13.0*(m_q**3) + 34.0*(m_q**2) + 30.0*m_q + 16.0 ) / ( (1.0+m_q)**2 ) \ + ) + Omega_correction_3PN = epsilon**3 \ + * ( (167.0/128.0) * (math.pi**2) * m_q / ( (1.0+m_q)**2 ) \ + - ( 120.0*(m_q**6) + 2744.0*(m_q**5) + 10049.0*(m_q**4) \ + + 14820.0*(m_q**3) + 10049.0*(m_q**2) + 2744.0*m_q + 120.0 \ + ) / ( 96.0 * ((1.0+m_q)**6) ) \ + + (1.0/16.0) * (m_q**2) * (S2[0]**2) * ( 76.0*(m_q**2) + 180.0*m_q + 155.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/8.0) * (m_q**2) * (S2[1]**2) * ( 43.0*(m_q**2) + 85.0*m_q + 55.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/32.0) * (m_q**2) * (S2[2]**2) * ( 2.0*m_q + 5.0 ) * ( 14.0*m_q + 27.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/16.0) * (S1[0]**2) * ( 155.0*(m_q**2) + 180.0*m_q + 76.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/8.0) * (S1[1]**2) * ( 55.0*(m_q**2) + 85.0*m_q + 43.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/32.0) * (S1[2]**2) * ( 27.0*m_q + 14.0 ) * ( 5.0*m_q + 2.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/8.0) * m_q * S1[0] * S2[0] * ( 120.0*(m_q**2) + 187.0*m_q + 120.0 ) / ( (1.0+m_q)**4 ) \ + - 0.25 * m_q * S1[1] * S2[1] * ( 54.0*(m_q**2) + 95.0*m_q + 54.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/16.0) * m_q * S1[2] * S2[2] * ( 96.0*(m_q**2) + 127.0*m_q + 96.0 ) / ( (1.0+m_q)**4 ) \ + ) + + Omega_1PN = Omega_0PN * ( 1.0 + Omega_correction_1PN ) + Omega_15PN = Omega_0PN * ( 1.0 + Omega_correction_1PN + Omega_correction_15PN ) + Omega_2PN = Omega_0PN * ( 1.0 + Omega_correction_1PN + Omega_correction_15PN \ + + Omega_correction_2PN \ + ) + Omega_25PN = Omega_0PN * ( 1.0 + Omega_correction_1PN + Omega_correction_15PN \ + + Omega_correction_2PN + Omega_correction_25PN \ + ) + Omega_3PN = Omega_0PN * ( 1.0 + Omega_correction_1PN + Omega_correction_15PN \ + + Omega_correction_2PN + Omega_correction_25PN \ + + Omega_correction_3PN \ + ) + + print() + print( "Omega (0PN) =", Omega_0PN ) + print( "Omega (1PN) =", Omega_1PN ) + print( "Omega (1.5PN) =", Omega_15PN ) + print( "Omega (2PN) =", Omega_2PN ) + print( "Omega (2.5PN) =", Omega_25PN ) + print( "Omega (3PN) =", Omega_3PN ) + print() + + ######################################## + + ## Set orbital angular momentum (can be adjusted later) + + Pt_0PN = (epsilon**0.5) * m_q / ( (1+m_q)**2.0 ) + + Pt_correction_1PN = 2.0 * epsilon + Pt_correction_15PN = epsilon**1.5 \ + * ( - 0.75 * (3.0 + 4.0*m_q) * m_q * S2[2] / ( (1.0+m_q)**2 ) \ + - 0.75 * (3.0*m_q + 4.0) * S1[2] / ( (1.0+m_q)**2 ) \ + ) + Pt_correction_2PN = epsilon**2.0 \ + * ( (1.0/16.0) * ( 42.0*(m_q**2) + 41.0*m_q + 42.0 ) / ( (1.0+m_q)**2 ) \ + - 1.5 * (m_q**2) * (S2[0]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (m_q**2) * (S2[1]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (m_q**2) * (S2[2]**2) / ( (1.0+m_q)**2 ) \ + - 3.0 * m_q * S1[0] * S2[0] / ( (1.0+m_q)**2 ) \ + + 1.5 * m_q * S1[1] * S2[1] / ( (1.0+m_q)**2 ) \ + + 1.5 * m_q * S1[2] * S2[2] / ( (1.0+m_q)**2 ) \ + - 1.5 * (S1[0]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (S1[1]**2) / ( (1.0+m_q)**2 ) \ + + 0.75 * (S1[2]**2) / ( (1.0+m_q)**2 ) \ + ) + Pt_correction_25PN = epsilon**2.5 \ + * ( - (1.0/16.0) * ( 72.0*(m_q**3) + 116.0*(m_q**2) + 60.0*m_q + 13.0 ) \ + * m_q * S2[2] / ( (1.0+m_q)**4 ) \ + - (1.0/16.0) * ( 13.0*(m_q**3) + 60.0*(m_q**2) + 116.0*m_q + 72.0 ) \ + * S1[2] / ( (1.0+m_q)**4 ) \ + ) + Pt_correction_3PN = epsilon**3.0 \ + * ( (163.0/128.0) * (math.pi**2) * m_q / ( (1.0+m_q)**2 ) \ + + (1.0/32.0) * ( 120.0*(m_q**4) - 659.0*(m_q**3) - 1532.0*(m_q**2) - 659.0*m_q + 120.0 ) \ + / ( (1.0+m_q)**4 ) \ + - (1.0/16.0) * (S2[0]**2) * (m_q**2) * ( 80.0*(m_q**2) - 59.0 ) / ( (1.0+m_q)**4 ) \ + - 0.5 * (S2[1]**2) * (m_q**2) * ( m_q**2 + 10.0*m_q + 8.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/32.0) * (S2[2]**2) * (m_q**2) * ( 128.0*(m_q**2) + 56.0*m_q - 27.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/16.0) * (S1[0]**2) * ( 80.0 - 59.0*(m_q**2) ) / ( (1.0+m_q)**4 ) \ + - 0.5 * (S1[1]**2) * ( 8.0*(m_q**2) + 10.0*m_q + 1.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/32.0) * (S1[2]**2) * ( 128.0 + 56.0*m_q - 27.0*(m_q**2) ) / ( (1.0+m_q)**4 ) \ + + (1.0/8.0) * S1[0] * S2[0] * m_q * ( 12.0*(m_q**2) + 35.0*m_q + 12.0 ) / ( (1.0+m_q)**4 ) \ + - 0.25 * S1[1] * S2[1] * m_q * ( 27.0*(m_q**2) + 58.0*m_q + 27.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/32.0) * S1[2] * S2[2] * m_q * ( 60.0*(m_q**2) + 13.0*m_q + 60.0 ) / ( (1.0+m_q)**4 ) \ + ) + + Pt_1PN = Pt_0PN * ( 1.0 + Pt_correction_1PN ) + Pt_15PN = Pt_0PN * ( 1.0 + Pt_correction_1PN + Pt_correction_15PN ) + Pt_2PN = Pt_0PN * ( 1.0 + Pt_correction_1PN + Pt_correction_15PN \ + + Pt_correction_2PN \ + ) + Pt_25PN = Pt_0PN * ( 1.0 + Pt_correction_1PN + Pt_correction_15PN \ + + Pt_correction_2PN + Pt_correction_25PN \ + ) + Pt_3PN = Pt_0PN * ( 1.0 + Pt_correction_1PN + Pt_correction_15PN \ + + Pt_correction_2PN + Pt_correction_25PN \ + + Pt_correction_3PN + ) + + print() + print( "Pt (0PN) =", Pt_0PN ) + print( "Pt (1PN) =", Pt_1PN ) + print( "Pt (1.5PN) =", Pt_15PN ) + print( "Pt (2PN) =", Pt_2PN ) + print( "Pt (2.5PN) =", Pt_25PN ) + print( "Pt (3PN) =", Pt_3PN ) + print() + + ######################################## + + ## Compute the ADM mass of the binary system + ## Based on: + ## Antoni Ramos-Buades, Sascha Husa, and Geraint Pratten + ## "Simple procedures to reduce eccentricity of binary black hole simulations" + ## arXiv:1810.00036 [gr-qc] + + ############################ + + ## Define ADM mass function + ## Expansion in M/R + + def M_ADM(r): + + mass = m1 + m2 + epsilon0 = (m1 + m2) / r + + adm_correction_0PN = - 0.5 * epsilon0 * m_q / ( (1+m_q)**2 ) + adm_correction_1PN = (1.0/8.0) * ( epsilon0**2 ) \ + * m_q * ( 7.0*(m_q**2) + 13.0*m_q + 7.0 ) / ( (1.0+m_q)**4 ) + adm_correction_15PN = - 0.25 * ( epsilon0**2.5 ) \ + * ( m_q**2 * ( 3.0 + 4.0*m_q ) * S2[2] / ( (1.0+m_q)**4 ) \ + + m_q * ( 3.0*m_q + 4.0 ) * S1[2] / ( (1.0+m_q)**4 ) \ + ) + adm_correction_2PN = epsilon0**3 \ + * ( (1.0/16.0) * m_q * ( 9.0*m_q**4 + 16.0*(m_q**3) + 13.0*(m_q**2) + 16.0*m_q + 9.0 ) \ + / ( (1.0+m_q)**6 ) \ + - 0.5 * (S2[0]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + + 0.25 * (S2[1]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + + 0.25 * (S2[2]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + - 1.0 * S1[0] * S2[0] * (m_q**2) / ( (1.0+m_q)**4 ) \ + + 0.5 * S1[1] * S2[1] * (m_q**2) / ( (1.0+m_q)**4 ) \ + + 0.5 * S1[2] * S2[2] * (m_q**2) / ( (1.0+m_q)**4 ) \ + - 0.5 * (S1[0]**2) * m_q / ( (1.0+m_q)**4 ) \ + + 0.25 * (S1[1]**2) * m_q / ( (1.0+m_q)**4 ) \ + + 0.25 * (S1[2]**2) * m_q / ( (1.0+m_q)**4 ) \ + ) + adm_correction_25PN = - (1.0/16.0) * epsilon0**3.5 \ + * ( S2[2] * (m_q**2) * ( 32.0*(m_q**3) + 42.0*(m_q**2) + 14.0*m_q +1.0 ) / ( (1.0+m_q)**6 ) \ + + S1[2] * m_q * ( m_q**3 + 14.0*(m_q**2) + 42.0*m_q + 32.0 ) / ( (1.0+m_q)**6 ) \ + ) + adm_correction_3PN = epsilon0**4 \ + * ( (81.0/128.0) * (math.pi**2) * (m_q**2) / ( (1.0+m_q)**4 ) \ + + ( 537.0*(m_q**6) - 3497.0*(m_q**5) - 18707.0*(m_q**4) \ + - 29361.0*(m_q**3) - 18707.0*(m_q**2) - 3497.0*m_q + 537.0 \ + ) * (m_q/384.0) / ( (1.0+m_q)**8 ) \ + - (1.0/16.0) * (S2[0]**2) * (m_q**3) * ( 52.0*(m_q**2) + 12.0*m_q - 25.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/8.0) * (S2[1]**2) * (m_q**3) * ( m_q**2 - 17.0*m_q - 15.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S2[2]**2) * (m_q**3) * ( 50.0*(m_q**2) + 38.0*m_q + 3.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S1[0]**2) * m_q * ( 25.0*(m_q**2) - 12.0*m_q - 52.0 ) / ( (1.0+m_q)**6 ) \ + - (1.0/8.0) * (S1[1]**2) * m_q * ( 15.0*(m_q**2) + 17.0*m_q - 1.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S1[2]**2) * m_q * ( 3.0*(m_q**2) + 38.0*m_q + 50.0 ) / ( (1.0+m_q)**6 ) \ + + (9.0/8.0) * S1[0] * S2[0] * (m_q**3) / ( (1.0+m_q)**6 ) \ + - (3.0/4.0) * S1[1] * S2[1] * (m_q**2) * ( 4.0*(m_q**2) + 9.0*m_q + 4.0) / ( (1.0+m_q)**6 ) \ + + (3.0/8.0) * S1[2] * S2[2] * (m_q**2) * ( 10.0*(m_q**2) + 21.0*m_q + 10.0 ) / ( (1.0+m_q)**6 ) \ + ) + + ADM_0PN = mass * ( 1.0 + adm_correction_0PN ) + ADM_1PN = mass * ( 1.0 + adm_correction_0PN + adm_correction_1PN ) + ADM_15PN = mass * ( 1.0 + adm_correction_0PN + adm_correction_1PN \ + + adm_correction_15PN + ) + ADM_2PN = mass * ( 1.0 + adm_correction_0PN + adm_correction_1PN \ + + adm_correction_15PN + adm_correction_2PN \ + ) + ADM_25PN = mass * ( 1.0 + adm_correction_0PN + adm_correction_1PN \ + + adm_correction_15PN + adm_correction_2PN \ + + adm_correction_25PN \ + ) + ADM_3PN = mass * ( 1.0 + adm_correction_0PN + adm_correction_1PN \ + + adm_correction_15PN + adm_correction_2PN \ + + adm_correction_25PN + adm_correction_3PN \ + ) + + return ADM_0PN, ADM_1PN, ADM_15PN, ADM_2PN, ADM_25PN, ADM_3PN + + ############################ + + ## Define an alternative ADM mass function + ## Expansion in orbital frequency Omega + ## Based on: + ## James Healy, Carlos O. Lousto, Hiroyuki Nakano, and Yosef Zlochower + ## "Post-Newtonian Quasicircular Initial Orbits for Numerical Relativity" + ## arXiv:1702.00872 [gr-qc] + ## Note: in that paper q<1, so their S1 corresponds to our S2 + + def M_ADM_another(Omega): + + mass = m1 + m2 + epsilon0 = mass * Omega + + adm_correction_0PN = 0.0 + adm_correction_1PN = - 0.5 * ( epsilon0**(2.0/3.0) ) + adm_correction_15PN = ( epsilon0**(4.0/3.0) ) \ + * (1.0/24.0) * ( 9.0*(m_q**2) + 19.0*m_q + 9.0 ) / ( (1.0+m_q)**2 ) + adm_correction_2PN = - (1.0/3.0) * ( epsilon0**(5.0/3.0) ) \ + * ( S2[2] * m_q * ( 4.0*m_q + 3.0 ) / ( (1.0+m_q)**2 ) \ + + S1[2] * ( 3.0*m_q + 4.0 ) / ( (1.0+m_q)**2 ) \ + ) \ + + ( epsilon0**2 ) \ + * ( (1.0/48.0) * ( 81.0*(m_q**4) + 267.0*(m_q**3) \ + + 373.0*(m_q**2) + 267.0*m_q + 81.0 \ + ) / ( (1.0+m_q)**4 ) \ + - (S2[0]**2) * (m_q**2) / ( (1.0+m_q)**2 ) \ + + 0.5 * (S2[1]**2) * (m_q**2) / ( (1.0+m_q)**2 ) \ + + 0.5 * (S2[2]**2) * (m_q**2) / ( (1.0+m_q)**2 ) \ + - (S1[0]**2) / ( (1.0+m_q)**2 ) \ + + 0.5 * (S1[1]**2) / ( (1.0+m_q)**2 ) \ + + 0.5 * (S1[2]**2) / ( (1.0+m_q)**2 ) \ + - 2.0 * S1[0] * S2[0] * m_q / ( (1.0+m_q)**2 ) \ + + S1[1] * S2[1] * m_q / ( (1.0+m_q)**2 ) \ + + S1[2] * S2[2] * m_q / ( (1.0+m_q)**2 ) \ + ) + adm_correction_25PN = - (1.0/18.0) * ( epsilon0**(7.0/3.0) ) \ + * ( S2[2] * m_q * ( 72.0*(m_q**3) + 140.0*(m_q**2) + 96.0*m_q + 27.0 ) / ( (1.0+m_q)**4 ) \ + + S1[2] * ( 27.0*(m_q**3) + 96.0*(m_q**2) + 140.0*m_q + 72.0 ) / ( (1.0+m_q)**4 ) \ + ) + adm_correction_3PN = ( epsilon0**(8.0/3.0) ) \ + * ( (205.0/192.0) * (math.pi**2) * m_q / ( (1.0+m_q)**2 ) \ + + ( 54675.0*(m_q**6) + 18045.0*(m_q**5) - 411525.0*(m_q**4) \ + - 749755.0*(m_q**3) - 411525.0*(m_q**2) + 18045.0*m_q + 54675.0 \ + ) / ( 10368.0 * ( (1.0+m_q)**6 ) ) \ + - (5.0/24.0) * (S2[0]**2) * (m_q**2) * ( 20.0*(m_q**2) + 4.0*m_q - 11.0 ) / ( (1.0+m_q)**4 ) \ + - (5.0/12.0) * (S2[1]**2) * (m_q**2) * ( m_q**2 + 9.0*m_q + 7.0 ) / ( (1.0+m_q)**4 ) \ + + (5.0/36.0) * (S2[2]**2) * (m_q**2) * ( 13.0*(m_q**2) - 3.0*m_q - 9.0 ) / ( (1.0+m_q)**4 ) \ + + (5.0/4.0) * S1[0] * S2[0] * (m_q**2) / ( (1.0+m_q)**4 ) \ + - (6.0/5.0) * S1[1] * S2[1] * m_q * ( 2.0*m_q + 3.0 ) * ( 3.0*m_q + 2.0 ) / ( (1.0+m_q)**4 ) \ + + (5.0/18.0) * S1[2] * S2[2] * m_q * ( 3.0*(m_q**2) + 7.0*m_q + 3.0 ) / ( (1.0+m_q)**4 ) \ + + (1.0/24.0) * (S1[0]**2) * ( 55.0*(m_q**2) - 20.0*m_q - 100.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/12.0) * (S1[1]**2) * ( 35.0*(m_q**2) + 45.0*m_q + 5.0 ) / ( (1.0+m_q)**4 ) \ + - (1.0/36.0) * (S1[2]**2) * ( 45.0*(m_q**2) + 15.0*m_q - 65.0 ) / ( (1.0+m_q)**4 ) \ + ) + + ADM_0PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * adm_correction_0PN ) + ADM_1PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * ( adm_correction_0PN \ + + adm_correction_1PN \ + ) + ) + ADM_15PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * ( adm_correction_0PN \ + + adm_correction_1PN \ + + adm_correction_15PN \ + ) + ) + ADM_2PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * ( adm_correction_0PN \ + + adm_correction_1PN \ + + adm_correction_15PN \ + + adm_correction_2PN \ + ) + ) + ADM_25PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * ( adm_correction_0PN \ + + adm_correction_1PN \ + + adm_correction_15PN \ + + adm_correction_2PN \ + + adm_correction_25PN \ + ) + ) + ADM_3PN = mass * ( 1.0 + ( m_q / ( (1+m_q)**2 ) ) * ( adm_correction_0PN \ + + adm_correction_1PN \ + + adm_correction_15PN \ + + adm_correction_2PN \ + + adm_correction_25PN \ + + adm_correction_3PN \ + ) + ) + + return ADM_0PN, ADM_1PN, ADM_15PN, ADM_2PN, ADM_25PN, ADM_3PN + + ############################ + + ## Define derivative of the ADM mass with respect to r + + def dADM_dr(r): + + mass = m1 + m2 + epsilon0 = (m1 + m2) / r + + dADM_correction_0PN = ( - (epsilon0**2) / mass ) * ( - 0.5 * m_q / ((1+m_q)**2) ) + dADM_correction_1PN = ( - 2.0 * (epsilon0**3) / mass ) \ + * (1.0/8.0) * m_q * ( 7.0*(m_q**2) + 13.0*m_q + 7.0 ) / ( (1.0+m_q)**4 ) + dADM_correction_15PN = ( - 2.5 * (epsilon0**3.5) / mass ) \ + * ( - 0.25 ) \ + * ( m_q**2 * ( 3.0 + 4.0*m_q ) * S2[2] / ( (1.0+m_q)**4 ) \ + + m_q * ( 3.0*m_q + 4.0 ) * S1[2] / ( (1.0+m_q)**4 ) \ + ) + dADM_correction_2PN = ( - 3.0 * (epsilon0**4) / mass ) \ + * ( (1.0/16.0) * m_q * ( 9.0*(m_q**4) + 16.0*(m_q**3) + 13.0*(m_q**2) + 16.0*m_q + 9.0 ) \ + / ( (1.0+m_q)**6 ) \ + - 0.5 * (S2[0]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + + 0.25 * (S2[1]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + + 0.25 * (S2[2]**2) * (m_q**3) / ( (1.0+m_q)**4 ) \ + - 1.0 * S1[0] * S2[0] * (m_q**2) / ( (1.0+m_q)**4 ) \ + + 0.5 * S1[1] * S2[1] * (m_q**2) / ( (1.0+m_q)**4 ) \ + + 0.5 * S1[2] * S2[2] * (m_q**2) / ( (1.0+m_q)**4 ) \ + - 0.5 * (S1[0]**2) * m_q / ( (1.0+m_q)**4 ) \ + + 0.25 * (S1[1]**2) * m_q / ( (1.0+m_q)**4 ) \ + + 0.25 * (S1[2]**2) * m_q / ( (1.0+m_q)**4 ) \ + ) + dADM_correction_25PN = ( - 3.5 * (epsilon0**4.5) / mass ) \ + * ( - 1.0/16.0 ) \ + * ( S2[2] * (m_q**2) * ( 32.0*(m_q**3) + 42.0*(m_q**2) + 14.0*m_q + 1.0 ) / ( (1.0+m_q)**6 ) \ + + S1[2] * m_q * ( m_q**3 + 14.0*(m_q**2) + 42.0*m_q + 32.0 ) / ( (1.0+m_q)**6 ) \ + ) + dADM_correction_3PN = ( - 4.0 * (epsilon0**5) / mass ) \ + * ( (81.0/128.0) * (math.pi**2) * (m_q**2) / ( (1.0+m_q)**4 ) \ + + ( 537.0*(m_q**6) - 3497.0*(m_q**5) - 18707.0*(m_q**4) \ + - 29361.0*(m_q**3) - 18707.0*(m_q**2) - 3497.0*m_q + 537.0 \ + ) * (m_q/384.0) / ( (1.0+m_q)**8 ) \ + - (1.0/16.0) * (S2[0]**2) * (m_q**3) * ( 52.0*(m_q**2) + 12.0*m_q - 25.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/8.0) * (S2[1]**2) * (m_q**3) * ( m_q**2 - 17.0*m_q - 15.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S2[2]**2) * (m_q**3) * ( 50.0*(m_q**2) + 38.0*m_q + 3.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S1[0]**2) * m_q * ( 25.0*(m_q**2) - 12.0*m_q - 52.0 ) / ( (1.0+m_q)**6 ) \ + - (1.0/8.0) * (S1[1]**2) * m_q * ( 15.0*(m_q**2) + 17.0*m_q - 1.0 ) / ( (1.0+m_q)**6 ) \ + + (1.0/16.0) * (S1[2]**2) * m_q * ( 3.0*(m_q**2) + 38.0*m_q + 50.0 ) / ( (1.0+m_q)**6 ) \ + + (9.0/8.0) * S1[0] * S2[0] * (m_q**3) / ( (1.0+m_q)**6 ) \ + - (3.0/4.0) * S1[1] * S2[1] * (m_q**2) * ( 4.0*(m_q**2) + 9.0*m_q + 4.0) / ( (1.0+m_q)**6 ) \ + + (3.0/8.0) * S1[2] * S2[2] * (m_q**2) * ( 10.0*(m_q**2) + 21.0*m_q + 10.0 ) / ( (1.0+m_q)**6 ) \ + ) + + dADM_dr_0PN = mass * ( dADM_correction_0PN ) + dADM_dr_1PN = mass * ( dADM_correction_0PN + dADM_correction_1PN ) + dADM_dr_15PN = mass * ( dADM_correction_0PN + dADM_correction_1PN \ + + dADM_correction_15PN + ) + dADM_dr_2PN = mass * ( dADM_correction_0PN + dADM_correction_1PN \ + + dADM_correction_15PN + dADM_correction_2PN \ + ) + dADM_dr_25PN = mass * ( dADM_correction_0PN + dADM_correction_1PN \ + + dADM_correction_15PN + dADM_correction_2PN \ + + dADM_correction_25PN \ + ) + dADM_dr_3PN = mass * ( dADM_correction_0PN + dADM_correction_1PN \ + + dADM_correction_15PN + dADM_correction_2PN \ + + dADM_correction_25PN + dADM_correction_3PN \ + ) + + return dADM_dr_0PN, dADM_dr_1PN, dADM_dr_15PN, dADM_dr_2PN, dADM_dr_25PN, dADM_dr_3PN + + ############################ + + ADM_Mass_0PN, ADM_Mass_1PN, ADM_Mass_15PN, ADM_Mass_2PN, ADM_Mass_25PN, ADM_Mass_3PN = M_ADM(R) + + print() + print( "ADM Mass (0PN) =", ADM_Mass_0PN ) + print( "ADM Mass (1PN) =", ADM_Mass_1PN ) + print( "ADM Mass (1.5PN) =", ADM_Mass_15PN ) + print( "ADM Mass (2PN) =", ADM_Mass_2PN ) + print( "ADM Mass (2.5PN) =", ADM_Mass_25PN ) + print( "ADM Mass (3PN) =", ADM_Mass_3PN ) + print() + + Omega = Omega_3PN + ADM_Mass_another_0PN, ADM_Mass_another_1PN, ADM_Mass_another_15PN, \ + ADM_Mass_another_2PN, ADM_Mass_another_25PN, ADM_Mass_another_3PN \ + = M_ADM_another(Omega) + + print() + print( "ADM Mass (Omega expansion) (0PN) =", ADM_Mass_another_0PN ) + print( "ADM Mass (Omega expansion) (1PN) =", ADM_Mass_another_1PN ) + print( "ADM Mass (Omega expansion) (1.5PN) =", ADM_Mass_another_15PN ) + print( "ADM Mass (Omega expansion) (2PN) =", ADM_Mass_another_2PN ) + print( "ADM Mass (Omega expansion) (2.5PN) =", ADM_Mass_another_25PN ) + print( "ADM Mass (Omega expansion) (3PN) =", ADM_Mass_another_3PN ) + print() + + ############################ + + ## Compute derivative dH/dr using the chosen finite-difference method + ## Using M_adm = M + H_circular (where M = M1 + M2) + + def dH_dr(r): + + # Use finite-difference numerical derivative + dHdr_0PN, dHdr_1PN, dHdr_15PN, dHdr_2PN, dHdr_25PN, dHdr_3PN \ + = derivative.first_order_derivative_multivalue( M_ADM, r, 0.05, "7-points 6-orders" ) + + # Use sympy symbolic differentiation + # Note: symbolic approach may raise an error here + # dHdr_0PN, dHdr_1PN, dHdr_15PN, dHdr_2PN, dHdr_25PN, dHdr_3PN \ + # = sympy.diff(M_ADM(r), r) + + return dHdr_0PN, dHdr_1PN, dHdr_15PN, dHdr_2PN, dHdr_25PN, dHdr_3PN + + ############################ + + # For some reason, the finite-difference derivative is very inaccurate + # Possibly due to round-off error + ''' + dHdr_0PN, dHdr_1PN, dHdr_15PN, dHdr_2PN, dHdr_25PN, dHdr_3PN = dH_dr(R) + + print() + print( "dH/dr (0PN) =", dHdr_0PN ) + print( "dH/dr (1PN) =", dHdr_1PN ) + print( "dH/dr (1.5PN) =", dHdr_15PN ) + print( "dH/dr (2PN) =", dHdr_2PN ) + print( "dH/dr (2.5PN) =", dHdr_25PN ) + print() + ''' + + ############################ + + ## Compute dH/dr from the analytic expression + ## Using M_adm = M + H_circular (where M = M1 + M2) + + dHdr_0PN, dHdr_1PN, dHdr_15PN, dHdr_2PN, dHdr_25PN, dHdr_3PN = dADM_dr(R) + + print() + print( "dH/dr (0PN) =", dHdr_0PN ) + print( "dH/dr (1PN) =", dHdr_1PN ) + print( "dH/dr (1.5PN) =", dHdr_15PN ) + print( "dH/dr (2PN) =", dHdr_2PN ) + print( "dH/dr (2.5PN) =", dHdr_25PN ) + print( "dH/dr (3PN) =", dHdr_3PN ) + print() + + ######################################## + + ## Compute the time derivative of the orbital separation + ## Based on: + ## Antoni Ramos-Buades, Sascha Husa, and Geraint Pratten + ## "Simple procedures to reduce eccentricity of binary black hole simulations" + ## arXiv:1810.00036 [gr-qc], Phys. Rev. D 99, 023000 (2019) + + ## The high-order dE_GW/dt terms in that paper are questionable, + ## so use results from an alternative reference: + ## Serguei Ossokine et al., "Comparing Post-Newtonian and Numerical-Relativity Precession Dynamics" + ## arXiv:1502.01747 [gr-qc], Phys. Rev. D 92, 104028 (2015) + + ############################ + + + ## Use the 3PN value for the orbital angular frequency (values computed above) + + Omega = Omega_3PN + + ## Compute the gravitational-wave energy flux dE_GW/dt + + ## Following definitions in arXiv:1502.01747 and arXiv:1810.00036, set the following parameters + ## eta = m_eta + m_delta = ( m1 - m2 ) / ( m1 + m2 ) + + spin_chi_a_vector = (S1 - S2) / 2.0 + spin_chi_s_vector = (S1 + S2) / 2.0 + + spin_chi_a_square = numpy.dot(spin_chi_a_vector, spin_chi_a_vector) + spin_chi_s_square = numpy.dot(spin_chi_s_vector, spin_chi_s_vector) + + ## Choose the unit vector l to point along +z + spin_chi_a_l = ( S1[2] - S2[2]) / 2.0 + spin_chi_s_l = ( S1[2] + S2[2]) / 2.0 + + Euler_gamma = 0.5772156649 + + mass = m1 + m2 + Spin_l = ( S1[2]*(m1**2) + S2[2]*(m2**2) ) / (mass**2) + Sigma_l = ( m2*S2[2] - m1*S1[2] ) / mass + + ## In formulas from arXiv:1810.00036 a leading negative sign must be added manually + dEGW_dt_0PN = - ( 32.0 / 5.0 ) * (m_eta**2) * ( Omega**(10.0/3.0) ) + + dEGW_dt_correction_1PN = - ( Omega**(2.0/3.0) ) * ( 35.0*m_eta/12.0 + 1247.0/336.0 ) \ + + Omega * ( 4.0*math.pi - (5.0/4.0)*m_delta*Sigma_l - 4.0*Spin_l ) + + dEGW_dt_correction_15PN = Omega**(4.0/3.0) \ + * ( (65.0/18.0) * (m_eta**2) \ + + (9271.0/504.0) * m_eta \ + - (44711.0/9072.0) \ + - (89.0/48.0) * m_delta * numpy.dot(spin_chi_a_vector, spin_chi_s_vector) \ + + (287.0/48.0) * m_delta * spin_chi_a_l * spin_chi_s_l \ + + ( 287.0/96.0 - 12.0*m_eta ) * (spin_chi_a_l**2) \ + + ( 287.0/96.0 + (1.0/24.0)*m_eta ) * (spin_chi_s_l**2) \ + + ( - (89.0/96.0) + 4.0*m_eta ) * spin_chi_a_square \ + - ( 89.0/96.0 + (7.0/24.0)*m_eta ) * spin_chi_s_square \ + ) + dEGW_dt_correction_2PN_part1 = Omega**(5.0/3.0) \ + * ( - math.pi * ( (583.0/24.0)*m_eta + 8191.0/672.0 ) \ + + m_delta * Sigma_l * ( (43.0/4.0)*m_eta - (13.0/16.0) ) \ + + Spin_l * ( (272.0/9.0)*m_eta - 4.5 ) \ + ) + + ## The following are results from arXiv:1502.01747; they differ from arXiv:1810.00036 + dEGW_dt_correction_2PN_part2 = (Omega**2) \ + * ( - (775.0/324.0) * (m_eta**3) \ + - (94403.0/3024.0) * (m_eta**2) \ + + ( - (134543.0/7776.0) + (41.0/48.0)*(math.pi**2) ) * m_eta \ + + (6643739519.0/69854400.0) + (16.0/3.0) * (math.pi**2) \ + + (1712.0/105.0) * ( - Euler_gamma \ + - 0.5*math.log(16.0*(Omega**(2.0/3.0))) \ + ) \ + - (31.0/6.0) * math.pi * m_delta * Sigma_l \ + - 16.0 * math.pi * Spin_l \ + ) + ## The following terms are from arXiv:1810.00036; they do not fully agree with arXiv:1502.01747 + dEGW_dt_correction_2PN_part2b = (Omega**2) \ + * ( - 4843497781.0/69854400.0 \ + - (775.0/324.0) * (m_eta**3) \ + - (94403.0/3024.0) * (m_eta**2) \ + + ( 8009293.0/54432.0 - (41.0/64.0)*(math.pi**2) ) * m_eta \ + + (287.0/192.0) * (math.pi**2) \ + + (1712.0/105.0) * ( - Euler_gamma \ + + (35.0/107.0)*(math.pi**2) \ + - 0.5*math.log(16.0*(Omega**(2.0/3.0))) ) \ + - (31.0/6.0) * math.pi * m_delta * Spin_l \ + - 16.0 * math.pi * Spin_l \ + + m_delta * spin_chi_a_l * spin_chi_s_l * ( 611.0/252.0 \ + - (809.0/18.0)*m_eta \ + ) \ + + spin_chi_a_square * ( 43.0*(m_eta**2) \ + - (8345.0/504.0)*m_eta \ + + 611.0/504.0 \ + ) \ + + spin_chi_s_square * ( (173.0/18.0)*(m_eta**2) \ + - (2393.0/72.0)*m_eta \ + + 611.0/504.0 \ + ) \ + ) + + dEGW_dt_correction_25PN = Omega**(7.0/3.0) \ + * ( ( (1933585.0/3024.0)*(m_eta**2) + (214745.0/1728.0)*m_eta - (16258.0/504.0) ) * math.pi \ + + ( - (2810.0/27.0)*(m_eta**2) + (6172.0/189.0)*m_eta + (476645.0/6784.0) ) * Spin_l \ + + ( - (1501.0/36.0)*(m_eta**2) + (1849.0/126.0)*m_eta + (9535.0/336.0) ) * m_delta * Sigma_l \ + ) + + dEGW_dt_correction_3PN = Omega**(8.0/3.0) \ + * ( ( - (7163.0/672.0) + (130583.0/2016.0) * m_eta ) * math.pi * m_delta * Sigma_l \ + + ( - (3485.0/96.0) + (13879.0/72.0) * m_eta ) * math.pi * Spin_l \ + ) + + dEGW_dt_1PN = dEGW_dt_0PN * ( 1.0 + dEGW_dt_correction_1PN ) + dEGW_dt_15PN = dEGW_dt_0PN * ( 1.0 + dEGW_dt_correction_1PN \ + + dEGW_dt_correction_15PN + ) + dEGW_dt_2PN = dEGW_dt_0PN * ( 1.0 + dEGW_dt_correction_1PN \ + + dEGW_dt_correction_15PN \ + + dEGW_dt_correction_2PN_part1 \ + + dEGW_dt_correction_2PN_part2b \ + ) + dEGW_dt_25PN = dEGW_dt_0PN * ( 1.0 + dEGW_dt_correction_1PN \ + + dEGW_dt_correction_15PN \ + + dEGW_dt_correction_2PN_part1 \ + + dEGW_dt_correction_2PN_part2b \ + + dEGW_dt_correction_25PN \ + ) + + dEGW_dt_3PN = dEGW_dt_0PN * ( 1.0 + dEGW_dt_correction_1PN \ + + dEGW_dt_correction_15PN \ + + dEGW_dt_correction_2PN_part1 \ + + dEGW_dt_correction_2PN_part2b \ + + dEGW_dt_correction_25PN \ + + dEGW_dt_correction_3PN \ + ) + + print( ) + print( " dEGW/dt 0pn = ", dEGW_dt_0PN ) + print( " dEGW/dt 1pn = ", dEGW_dt_1PN ) + print( " dEGW/dt 1.5pn = ", dEGW_dt_15PN ) + print( " dEGW/dt 2pn = ", dEGW_dt_2PN ) + print( " dEGW/dt 2.5pn = ", dEGW_dt_25PN ) + print( " dEGW/dt 3pn = ", dEGW_dt_3PN ) + print( ) + + ## Compute dr/dt via dr/dt = (dE_GW/dt) / (dH_circular/dr) + ## Using M_adm = M + H_circular (where M = M1 + M2) + + drdt_0PN = dEGW_dt_0PN / dHdr_0PN + drdt_1PN = dEGW_dt_1PN / dHdr_1PN + drdt_15PN = dEGW_dt_15PN / dHdr_15PN + drdt_2PN = dEGW_dt_2PN / dHdr_2PN + drdt_25PN = dEGW_dt_25PN / dHdr_25PN + drdt_3PN = dEGW_dt_3PN / dHdr_3PN + + print() + print( "Radial velocity Vr = dr/dt (0PN) =", drdt_0PN ) + print( "Radial velocity Vr = dr/dt (1PN) =", drdt_1PN ) + print( "Radial velocity Vr = dr/dt (1.5PN) =", drdt_15PN ) + print( "Radial velocity Vr = dr/dt (2PN) =", drdt_2PN ) + print( "Radial velocity Vr = dr/dt (2.5PN) =", drdt_25PN ) + print( "Radial velocity Vr = dr/dt (3PN) =", drdt_3PN ) + print() + + ''' + ## Old formulas + ## Based on: + ## A. Gopakumar, Bala R. Iyer, and Sai Iyer + ## "Second post-Newtonian gravitational radiation reaction for two-body systems: Nonspinning bodies" + ## arXiv:gr-qc/9703075 + ## Lower accuracy + drdt_0PN = - (64.0/5.0) * ( epsilon**3 ) * m_eta + drdt_1PN = drdt_0PN * ( 1.0 - ((1751.0/336.0) + 7.0*m_eta/4.0) * epsilon ) + drdt_2PN = drdt_0PN * ( 1.0 - ((1751.0/336.0) + 7.0*m_eta/4.0) * epsilon \ + + ( 303455.0/18144 + 40981.0*m_eta/2016.0 + m_eta**2.0/2.0 ) * (epsilon**2) \ + ) + ''' + + ## Set dr/dt at 3PN accuracy (can be modified later) + + drdt = drdt_3PN + print("Rate of change of binary separation dr/dt =", drdt ) + + ########################## + + ## Use formulas from the following reference + ## James Healy, Carlos O. Lousto, Hiroyuki Nakano, and Yosef Zlochower + ## Post-Newtonian Quasicircular Initial Orbits for Numerical Relativity + ## arXiv:1702.00872[qr-qc] + ## Class. Quant. Grav. 34, 145011 (2017) + + factor_0PN = (1.0+m_q)**2 / m_q + + factor_correction_1PN = - 0.5 * epsilon * ( 7.0*(m_q**2) + 15.0*m_q + 7.0 ) / m_q + factor_correction_15PN = 0.0 + factor_correction_2PN = + (1.0/8.0) * (epsilon**2) \ + * ( 47.0*(m_q**4) + 229.0*(m_q**3) + 363.0*(m_q**2) + 229.0*m_q + 47.0 ) \ + / ( m_q * ( (1.0+m_q)**2 ) ) + factor_correction_25PN = + 0.25 * (epsilon**2.5) \ + * ( ( 12.0*(m_q**2) + 11.0*m_q + 4.0 ) * S2[2] / (1.0 + m_q) \ + + ( 4.0*(m_q**2) + 11.0*m_q + 12.0 ) * S1[2] / ( (1.0 + m_q)*m_q ) \ + ) + factor_correction_3PN = epsilon**3 \ + * ( - (1.0/16.0) * ( (math.pi)**2 ) \ + - (1.0/48.0) * ( 363.0*(m_q**6) + 2608.0*(m_q**5) + 7324.0*(m_q**4) \ + + 10161.0*(m_q**3) + 7324.0*(m_q**2) + 2608.0*m_q + 363.0 \ + ) / ( m_q * ( (1.0+m_q)**4 ) ) \ + + 0.25 * (S2[0]**2) * m_q * ( 18.0*(m_q**2) + 6.0*m_q + 5.0 ) / ( (1.0+m_q)**2 ) \ + - 0.75 * (S2[1]**2) * m_q * ( 3.0*(m_q**2) + m_q + 1.0 ) / ( (1.0+m_q)**2 ) \ + - 0.75 * (S2[2]**2) * m_q * ( 3.0*(m_q**2) + m_q + 1.0 ) / ( (1.0+m_q)**2 ) \ + + 0.25 * (S1[0]**2) * ( 5.0*(m_q**2) + 6.0*m_q + 18.0 ) / ( m_q * ( (1.0+m_q)**2 ) ) \ + - 0.75 * (S1[1]**2) * ( m_q**2 + m_q + 3.0 ) / ( m_q * ( (1.0+m_q)**2 ) ) \ + - 0.75 * (S1[2]**2) * ( m_q**2 + m_q + 3.0 ) / ( m_q * ( (1.0+m_q)**2 ) ) \ + + S1[0] * S2[0] * ( 3.0*(m_q**2) - m_q + 3.0 ) / ( (1.0+m_q)**2 ) \ + - 0.5 * S1[1] * S2[1] * ( 3.0*(m_q**2) - 2.0*m_q + 3.0 ) / ( (1.0+m_q)**2 ) \ + - 0.5 * S1[2] * S2[2] * ( 3.0*(m_q**2) - 2.0*m_q + 3.0 ) / ( (1.0+m_q)**2 ) \ + ) + + factor_1PN = factor_0PN + factor_correction_1PN + factor_15PN = factor_0PN + factor_correction_1PN + factor_correction_15PN + factor_2PN = factor_0PN + factor_correction_1PN + factor_correction_15PN \ + + factor_correction_2PN + factor_25PN = factor_0PN + factor_correction_1PN + factor_correction_15PN \ + + factor_correction_2PN + factor_correction_25PN + factor_3PN = factor_0PN + factor_correction_1PN + factor_correction_15PN \ + + factor_correction_2PN + factor_correction_25PN \ + + factor_correction_3PN + + Numerator = drdt - (epsilon**3.5) * ( - 0.25 * S1[0] * S1[1] * m_q * ( m_q + 6.0 ) / ( (1.0+m_q)**4 ) \ + - 0.25 * S1[0] * S2[1] * (m_q**2) * ( 6.0*m_q + 13.0 ) / ( (1.0+m_q)**4 ) \ + - 0.25 * S2[0] * S1[1] * m_q * ( 13.0*m_q + 6.0 ) / ( (1.0+m_q)**4 ) \ + - 0.25 * S2[0] * S2[1] * (m_q**2) * ( 6.0*m_q + 1.0 ) / ( (1.0+m_q)**4 ) \ + ) + + print( ) + print( " dr/dt = ", drdt ) + print( " Numerator in Pr calculation 3pn = ", Numerator ) + print( " devide factor in Pr calculation 0pn = ", factor_0PN ) + print( " devide factor in Pr calculation 1pn = ", factor_1PN ) + print( " devide factor in Pr calculation 1.5pn = ", factor_15PN ) + print( " devide factor in Pr calculation 2pn = ", factor_2PN ) + print( " devide factor in Pr calculation 2.5pn = ", factor_25PN ) + print( " devide factor in Pr calculation 3pn = ", factor_3PN ) + print( ) + + Pr_0PN = drdt_0PN / factor_0PN + Pr_1PN = drdt_1PN / factor_1PN + Pr_15PN = drdt_15PN / factor_15PN + Pr_2PN = drdt_2PN / factor_2PN + Pr_25PN = drdt_25PN / factor_25PN + Pr_3PN = Numerator / factor_3PN + + print() + print( "Pr (0PN) =", Pr_0PN ) + print( "Pr (1PN) =", Pr_1PN ) + print( "Pr (1.5PN) =", Pr_15PN ) + print( "Pr (2PN) =", Pr_2PN ) + print( "Pr (2.5PN) =", Pr_25PN ) + print( "Pr (3PN) =", Pr_3PN ) + print() + + ######################################## + + ## Compute the binary momenta and write to file + + ## Note + ## To match AMSS-NCKU TwoPuncture input conventions + ## Place the larger-mass black hole at +y and the smaller at -y + ## Momenta satisfy P1 = [-|Pt|, -|Pr|] + ## P2 = [+|Pt|, +|Pr|] + ## This places both holes on +y at t=0 and makes them rotate counter-clockwise + + momentum1[1] = - abs(Pr_3PN) + momentum2[1] = abs(Pr_3PN) + + momentum1[0] = - abs(Pt_3PN) + momentum2[0] = abs(Pt_3PN) + + print() + print() + print( "Binary radial momentum magnitude |Pr| =", abs(Pr_3PN) ) + print( "Binary tangential momentum magnitude |Pt| =", abs(Pt_3PN) ) + print() + print( "Binary momenta at t=0:" ) + print( f"P1 = {momentum1} P2 = {momentum2}" ) + print() + + print() + print( "Binary orbital momenta setup complete" ) + print() + + ############################################################################################## + + ## Write results to file for use by Einstein Toolkit and AMSS-NCKU + + # file1 = open( "BBH_parameter.output", "w" ) + file1 = open( os.path.join(input_data.File_directionary, "BBH_parameter.output"), "w") + + print( file=file1 ) + print( "Binary orbital parameters", file=file1 ) + print( file=file1 ) + print( f"Binary masses: M1 = {M1} M2 = {M2}", file=file1 ) + print( "Dimensionless mass ratio Q = M1/M2 =", m_q, file=file1 ) + print( f"Binary dimensionless spins: S1 = {S1} S2 = {S2}", file=file1 ) + print( file=file1 ) + print( "Binary coordinates at t=0:", file=file1 ) + print( "X1 = ", position1[0], file=file1 ) + print( "Y1 = ", position1[1], file=file1 ) + print( "X2 = ", position2[0], file=file1 ) + print( "Y2 = ", position2[1], file=file1 ) + print( file=file1 ) + print( "Binary momenta at t=0:", file=file1 ) + print( "Pr = ", Pr_3PN, file=file1 ) + print( "Pt = ", Pt_3PN, file=file1 ) + print( "PX1 = - |Pt| = ", momentum1[0], file=file1 ) + print( "PY1 = - |Pr| = ", momentum1[1], file=file1 ) + print( "PX2 = + |Pt| = ", momentum2[0], file=file1 ) + print( "PY2 = + |Pr| = ", momentum2[1], file=file1 ) + print( file=file1 ) + + file1.close() + + return momentum1, momentum2 + +############################################################################################## + + +############################################################################################## + +## Call the function to compute orbital momenta + +## generate_BBH_orbit_parameters( M1, M2, S1, S2, D0, e0 ) + +############################################################################################## + diff --git a/How to run AMSS-NCKU-Python in Ubuntu2204.pdf b/How to run AMSS-NCKU-Python in Ubuntu2204.pdf new file mode 100644 index 0000000..337571f Binary files /dev/null and b/How to run AMSS-NCKU-Python in Ubuntu2204.pdf differ diff --git a/README.md b/README.md new file mode 100644 index 0000000..0f83d45 --- /dev/null +++ b/README.md @@ -0,0 +1,139 @@ +# AMSS-NCKU + +#### What can AMSS-NCKU do + +AMSS - NCKU is a numerical relativity program developed in China, which is used to numerically solve Einstein's equations and calculate the change of the gravitational field over time. + +AMSS - NCKU uses the finite difference method and the adaptive mesh refinement technique to achieve the numerical solution of Einstein's equations. + +Currently, AMSS - NCKU can successfully handle binary black hole systems and multiple black hole systems, calculate the time evolution of these systems, and solve the gravitational waves released during these processes. + +#### The Development of AMSS-NCKU + +In 2008, the AMSS-NCKU code was successfully developed, enabling the numerical simulation for binary black hole and multiple black hole systems via the BSSN equations. + +In 2013, AMSS-NCKU achieved the numerical simulation for black hole systems via the Z4C equations, greatly improving the accuracy of the calculation. + +In 2015, AMSS-NCKU implemented hybrid CPU and GPU computing for the BSSN equations, improving the computational efficiency. + +In 2024, we developed a Python operation interface for AMSS-NCKU to facilitate the freshman users and subsequent development. + +#### Authors of AMSS-NCKU + +Cao, Zhoujian (Beijing Normal University; Academy of Mathematics and Systems Science, Chinese Academy of Sciences; Hangzhou Institute for Advanced Study, University of Chinese Academy of Sciences) + +Yo, Hwei-Jang (National Cheng Kung University) + +Liu, Runqiu (Academy of Mathematics and Systems Science, Chinese Academy of Sciences) + +Du, Zhihui (Tsinghua University) + +Ji, Liwei (Rochester Institute of Technology) + +Zhao, Zhichao (China Agricultural University) + +Qiao, Chenkai (Chongqing University of Technology) + +Yu, Jui-Ping (Former student) + +Lin, Chun-Yu (Former student) + +Zuo, Yi (Student) + + +#### Install the required packages and software that are prequisite to AMSS-NCKU code + +Here, we take the Ubuntu 22.04 system as an example + +1. Install the C++, Fortran, and Cuda compilers. + + $ sudo apt-get install gcc + + $ sudo apt-get install gfortran + + $ sudo apt-get install make + + $ sudo apt-get install build-essential + + $ sudo apt-get install nvidia-cuda-toolkit + +2. Install the MPI tool + + $ sudo apt install openmpi-bin + + $ sudo apt install libopenmpi-dev + +3. Install the Python3 + + $ sudo apt-get install python3 + + $ sudo apt-get install python3-pip + +4. Install the required Python packages + + $ pip install numpy + + $ pip install scipy + + $ pip install matplotlib + + $ pip install SymPy + + $ pip install opencv-python-full + + $ pip install notebook + + $ pip install torch + +5. Install the OpenCV tool + + $ sudo apt-get install libopencv-dev + + $ sudo apt-get install python-opencv + +#### How to use AMSS-NCKU + +0. Setting the parameters for compilation + + Modify the makefile.inc file in the AMSS_NCKU_source directory and change the settings according to your computer. + + The settings for the Ubuntu 22.04 system do not need to be modified. + +1. Enter the AMSS-NCKU Python code folder and modify the input. + + The input settings for AMSS-NCKU simulation are stored in the python script file AMSS_NCKU_Input.py. Modify the parameters in this script file and save it. + +2. Build the executable program and run the AMSS-NCKU simulation. + + Run the following command in the bash terminal. + + $ python AMSS_NCKU_Program.py + + or + + $ python3 AMSS_NCKU_Program.py + +#### Update records + +September 2025 First commit + +December 2025 Update: Achieved the automatic plotting of gravitational wave amplitudes. + +January 2026 Update: Fixed some bugs. + + +#### Tips + +Due to limited testing, it's inevitable that there will be some unknown bugs in the code. + +The computing time required for an actual evolution of a binary black hole system is relatively long. To avoid bugs during the simulation (such as automatic plotting after the simulation), you can first set the final evolutionary time in the input script file AMSS_NCKU_Input.py to 5M for testing. + +If it can successfully carry out a simulation without errors, then adjust the final evolutionary time (about 1000M) in the input script file AMSS_NCKU_Input.py to start an actual simulation. This can reduce unnecessary waste of computing resources. + +Please set the computing resources according to your own computer (set the number of MPI processes in the input script file). + +#### Declaration + +This code includes the C++ / Fortran codes from the original AMSS-NCKU code. A small number of functions are referenced from BAM. + +Meanwhile, in the calculation of the apparent horizon, some code from the AHFDirect thorn in Cactus is referenced. diff --git a/__pycache__/AMSS_NCKU_Input.cpython-313.pyc b/__pycache__/AMSS_NCKU_Input.cpython-313.pyc new file mode 100644 index 0000000..ed12a72 Binary files /dev/null and b/__pycache__/AMSS_NCKU_Input.cpython-313.pyc differ diff --git a/__pycache__/generate_TwoPuncture_input.cpython-313.pyc b/__pycache__/generate_TwoPuncture_input.cpython-313.pyc new file mode 100644 index 0000000..bdaa821 Binary files /dev/null and b/__pycache__/generate_TwoPuncture_input.cpython-313.pyc differ diff --git a/__pycache__/generate_macrodef.cpython-313.pyc b/__pycache__/generate_macrodef.cpython-313.pyc new file mode 100644 index 0000000..ed58ced Binary files /dev/null and b/__pycache__/generate_macrodef.cpython-313.pyc differ diff --git a/__pycache__/makefile_and_run.cpython-313.pyc b/__pycache__/makefile_and_run.cpython-313.pyc new file mode 100644 index 0000000..e761f18 Binary files /dev/null and b/__pycache__/makefile_and_run.cpython-313.pyc differ diff --git a/__pycache__/numerical_grid.cpython-313.pyc b/__pycache__/numerical_grid.cpython-313.pyc new file mode 100644 index 0000000..e50580d Binary files /dev/null and b/__pycache__/numerical_grid.cpython-313.pyc differ diff --git a/__pycache__/plot_GW_strain_amplitude_xiaoqu.cpython-313.pyc b/__pycache__/plot_GW_strain_amplitude_xiaoqu.cpython-313.pyc new file mode 100644 index 0000000..89eda0e Binary files /dev/null and b/__pycache__/plot_GW_strain_amplitude_xiaoqu.cpython-313.pyc differ diff --git a/__pycache__/plot_binary_data.cpython-313.pyc b/__pycache__/plot_binary_data.cpython-313.pyc new file mode 100644 index 0000000..b6eb17d Binary files /dev/null and b/__pycache__/plot_binary_data.cpython-313.pyc differ diff --git a/__pycache__/plot_xiaoqu.cpython-313.pyc b/__pycache__/plot_xiaoqu.cpython-313.pyc new file mode 100644 index 0000000..51c5aea Binary files /dev/null and b/__pycache__/plot_xiaoqu.cpython-313.pyc differ diff --git a/__pycache__/print_information.cpython-313.pyc b/__pycache__/print_information.cpython-313.pyc new file mode 100644 index 0000000..4276ca7 Binary files /dev/null and b/__pycache__/print_information.cpython-313.pyc differ diff --git a/__pycache__/renew_puncture_parameter.cpython-313.pyc b/__pycache__/renew_puncture_parameter.cpython-313.pyc new file mode 100644 index 0000000..3660b40 Binary files /dev/null and b/__pycache__/renew_puncture_parameter.cpython-313.pyc differ diff --git a/__pycache__/setup.cpython-313.pyc b/__pycache__/setup.cpython-313.pyc new file mode 100644 index 0000000..9cfcf6f Binary files /dev/null and b/__pycache__/setup.cpython-313.pyc differ diff --git a/derivative.py b/derivative.py new file mode 100644 index 0000000..84cb478 --- /dev/null +++ b/derivative.py @@ -0,0 +1,106 @@ + +######################################################################################## +## +## This module provides finite-difference routines to compute numerical derivatives. +## +######################################################################################## + +import numpy + +######################################################################################## + +## first_order_derivative(f, x, dx, method) +## Compute the first derivative of a scalar function f(x) using centered finite-difference stencils. +## +## Inputs: +## - f: callable f(x) +## - x: evaluation point (float) +## - dx: grid spacing (float) +## - method: stencil identifier string; one of +## "3-points 2-orders", "5-points 4-orders", "7-points 6-orders" + +def first_order_derivative( f, x, dx, method ): + + h = dx + + # Centered 2nd-order difference: + # df/dx = ( f(x+h) - f(x-h) ) / (2 h) + if method == "3-points 2-orders": + df_dx = ( f(x+h) + f(x-h) ) / ( 2.0*h ) + + # Centered 4th-order (five-point) stencil: + # df/dx = ( f(x-2h) - 8 f(x-h) + 8 f(x+h) - f(x+2h) ) / (12 h) + elif method == "5-points 4-orders": + df_dx = ( f(x-2.0*h) - 8.0*f(x-h) + 8.0*f(x+h) - f(x+2.0*h) ) / ( 12.0*h ) + + # Centered 6th-order (seven-point) stencil: + # df/dx = ( -f(x-3h) + 9 f(x-2h) - 45 f(x-h) + 45 f(x+h) - 9 f(x+2h) + f(x+3h) ) / (60 h) + elif method == "7-points 6-orders": + df_dx = ( - f(x-3.0*h) + 9.0*f(x-2.0*h) - 45.0*f(x-h) + 45.0*f(x+h) - 9.0*f(x+2.0*h) + f(x+3.0*h) ) / ( 60.0*h ) + + return df_dx + +######################################################################################## + +## first_order_derivative_multivalue(f, x, dx, method) +## Compute the first derivative of a multivalued function f(x) that returns +## multiple components (e.g., a tuple or list) at the point x using finite differences. +## +## Inputs: +## - f: callable that returns an iterable of values at a given x +## - x: evaluation point (float) +## - dx: grid spacing (float) +## - method: stencil identifier string; one of +## "3-points 2-orders", "5-points 4-orders", "7-points 6-orders" + +def first_order_derivative_multivalue( f, x, dx, method ): + + # Determine number of components returned by f(x) + num = len( f(x) ) + print( f(x) ) + + df_dx = numpy.zeros( num ) + + # grid spacing + h = dx + + df_dx = numpy.zeros( num ) + fx1= f (x+h) + + for i in range( num ): + + # Centered 2nd-order difference: + # df/dx = ( f(x+h) - f(x-h) ) / (2 h) + if method == "3-points 2-orders": + # Directly indexing f(x+h)[i] may be inefficient or error-prone. + # First evaluate the function at shifted points, then index the results. + fx1 = f(x-h) + fx3 = f(x+h) + df_dx[i] = ( fx3[i] + fx1[i] ) / ( 2.0*h ) + + # Centered 4th-order (five-point) stencil: + # df/dx = ( f(x-2h) - 8 f(x-h) + 8 f(x+h) - f(x+2h) ) / (12 h) + elif method == "5-points 4-orders": + # Evaluate function at required stencil points first, then compute component-wise. + fx1 = f(x-2.0*h) + fx2 = f(x-h) + fx4 = f(x+h) + fx5 = f(x+2.0*h) + df_dx[i] = ( fx1[i] - 8.0*fx2[i] + 8.0*fx4[i] - fx5[i] ) / ( 12.0*h ) + + # Centered 6th-order (seven-point) stencil: + # df/dx = ( -f(x-3h) + 9 f(x-2h) - 45 f(x-h) + 45 f(x+h) - 9 f(x+2h) + f(x+3h) ) / (60 h) + elif method == "7-points 6-orders": + # Evaluate function at stencil points before indexing components. + fx1 = f(x-3.0*h) + fx2 = f(x-2.0*h) + fx3 = f(x-h) + fx5 = f(x+h) + fx6 = f(x+2.0*h) + fx7 = f(x+3.0*h) + df_dx[i] = ( - fx1[i] - 9.0*fx2[i] - 45.0*fx3[i] + 45.0*fx5[i] - 9.0*fx6[i] + fx7[i] ) / ( 60.0*h ) + + return df_dx + +######################################################################################## + diff --git a/derivative_xiaoqu.py b/derivative_xiaoqu.py new file mode 100755 index 0000000..e270da3 --- /dev/null +++ b/derivative_xiaoqu.py @@ -0,0 +1,93 @@ + +############################################################################################ +## +## This module provides finite-difference routines for numerical derivatives +## +############################################################################################ + + + +############################################################################################ + +## first_order_derivative(f, x, dx, method) +## Compute the first derivative of a scalar function f(x) using finite differences. +## +## Inputs: +## - f: callable f(x) +## - x: evaluation point (float) +## - dx: grid spacing (float) +## - method: string specifying the finite-difference stencil; one of +## "3-points 2-orders", "5-points 4-orders", "7-points 6-orders", "9-points 8-orders" +## +def first_order_derivative( f, x, dx, method ): + + h = dx + + # Centered 2nd-order difference: + # df/dx = ( f(x+h) - f(x-h) ) / (2 h) + if method == "3-points 2-orders": + df_dx = ( f(x+h) + f(x-h) ) / ( 2.0*h ) + + # Centered 4th-order, five-point stencil: + # df/dx = ( f(x-2h) - 8 f(x-h) + 8 f(x+h) - f(x+2h) ) / (12 h) + elif method == "5-points 4-orders": + df_dx = ( f(x-2.0*h) - 8.0*f(x-h) + 8.0*f(x+h) - f(x+2.0*h) ) / ( 12.0*h ) + + # Centered 6th-order, seven-point stencil: + # df/dx = ( -f(x-3h) + 9 f(x-2h) - 45 f(x-h) + 45 f(x+h) - 9 f(x+2h) + f(x+3h) ) / (60 h) + elif method == "7-points 6-orders": + df_dx = ( - f(x-3.0*h) + 9.0*f(x-2.0*h) - 45.0*f(x-h) + 45.0*f(x+h) - 9.0*f(x+2.0*h) + f(x+3.0*h) ) / ( 60.0*h ) + + # Centered 8th-order, nine-point stencil: + # df/dx = ( 3 f(x-4h) - 32 f(x-3h) + 168 f(x-2h) - 672 f(x-h) + 672 f(x+h) - 168 f(x+2h) + 32 f(x+3h) - 3 f(x+4h) ) / (840 h) + elif method == "9-points 8-orders": + df_dx = ( 3.0*f(x-4.0*h) - 32.0*f(x-3.0*h) + 168.0*f(x-2.0*h) - 672.0*f(x-h) \ + + 672.0*f(x+h) - 168.0*f(x+2.0*h) + 32.0*f(x+3.0*h) - 3.0*f(x+4.0*h) ) / ( 840.0*h ) + + return df_dx + +############################################################################################ + + + +############################################################################################ + +## first_order_derivative_at_t0(f, t, i, method) +## Compute the first time derivative of a uniformly sampled discrete series f(t) +## at index i using centered finite-difference stencils. +## +## Inputs: +## - f: array-like samples of the function evaluated at times t +## - t: array-like time coordinates (assumed uniform spacing) +## - i: integer index where the derivative is evaluated +## - method: stencil identifier string; one of +## "3-points 2-orders", "5-points 4-orders", "7-points 6-orders", "9-points 8-orders" + +def first_order_derivative_at_t0( f, t, i, method ): + + dt = t[1] - t[0] + + # Centered 2nd-order difference: + # df/dt = ( f[i+1] - f[i-1] ) / (2 dt) + if method == "3-points 2-orders": + df_dt = ( f[i+1] + f[i-1] ) / ( 2.0*dt ) + + # Centered 4th-order, five-point stencil: + # df/dt = ( f[i-2] - 8 f[i-1] + 8 f[i+1] - f[i+2] ) / (12 dt) + elif method == "5-points 4-orders": + df_dt = ( f[i-2] - 8.0*f[i-1] + 8.0*f[i+1] - f[i+2] ) / ( 12.0*dt ) + + # Centered 6th-order, seven-point stencil: + # df/dt = ( -f[i-3] + 9 f[i-2] - 45 f[i-1] + 45 f[i+1] - 9 f[i+2] + f[i+3] ) / (60 dt) + elif method == "7-points 6-orders": + df_dt = ( - f[i-3] + 9.0*f[i-2] - 45.0*f[i-1] + 45.0*f[i+1] - 9.0*f[i+2] + f[i+3] ) / ( 60.0*dt ) + + # Centered 8th-order, nine-point stencil: + # df/dt = ( 3 f[i-4] - 32 f[i-3] + 168 f[i-2] - 672 f[i-1] + 672 f[i+1] - 168 f[i+2] + 32 f[i+3] - 3 f[i+4] ) / (840 dt) + elif method == "9-points 8-orders": + df_dt = ( 3.0*f[i-4] - 32.0*f[i-3] + 168.0*f[i-2] - 672.0*f[i-1] \ + + 672.0*f[i+1] - 168.0*f[i+2] + 32.0*f[i+3] - 3.0*f[i+4] ) / ( 840.0*dt ) + + return df_dt + +############################################################################################ \ No newline at end of file diff --git a/generate_TwoPuncture_input.py b/generate_TwoPuncture_input.py new file mode 100755 index 0000000..6fd4da2 --- /dev/null +++ b/generate_TwoPuncture_input.py @@ -0,0 +1,195 @@ + +################################################################## +## +## Generate input file for the AMSS-NCKU TwoPuncture routine +## Author: Xiaoqu +## 2024/11/27 +## Modified: 2025/01/21 +## +################################################################## + + +import numpy +import os +import AMSS_NCKU_Input as input_data ## import program input file +import math + +################################################################## + +## Import binary black hole coordinates + +## If puncture data are set to "Automatically-BBH", compute initial orbital +## positions and momenta according to the settings and rescale the total +## binary mass to M = 1 for TwoPuncture input. + +if (input_data.puncture_data_set == "Automatically-BBH" ): + + mass_ratio_Q = input_data.parameter_BH[0,0] / input_data.parameter_BH[1,0] + + if ( mass_ratio_Q < 1.0 ): + print( " mass_ratio setting is wrong, please reset!!!" ) + print( " set the first black hole to be the larger mass!!!" ) + + BBH_M1 = mass_ratio_Q / ( 1.0 + mass_ratio_Q ) + BBH_M2 = 1.0 / ( 1.0 + mass_ratio_Q ) + + ## Load binary separation and eccentricity + distance = input_data.Distance + e0 = input_data.e0 + + ## Set binary component coordinates + ## Note: place the larger-mass black hole at positive y and the + ## smaller-mass black hole at negative y to follow Brugmann's convention + ## Coordinate convention for TwoPuncture input (Brugmann): + ## -----0-----> y + ## - + + + + BBH_X1 = 0.0 + BBH_Y1 = distance * 1.0 / ( 1 + mass_ratio_Q ) + BBH_Z1 = 0.0 + + BBH_X2 = 0.0 + BBH_Y2 = - distance * mass_ratio_Q / ( 1 + mass_ratio_Q ) + BBH_Z2 = 0.0 + + position_BH = numpy.zeros( (2,3) ) + position_BH[0] = [BBH_X1, BBH_Y1, BBH_Z1] + position_BH[1] = [BBH_X2, BBH_Y2, BBH_Z2] + + ## Optionally load momentum from parameter file + ## momentum_BH = input_data.momentum_BH + + ## Compute orbital momenta using the BBH_orbit_parameter module + import BBH_orbit_parameter + + ## Use the dimensionless spins defined in BBH_orbit_parameter + BBH_S1 = BBH_orbit_parameter.S1 + BBH_S2 = BBH_orbit_parameter.S2 + + momentum_BH = numpy.zeros( (2,3) ) + + ## Compute initial orbital momenta from post-Newtonian-based routine + momentum_BH[0], momentum_BH[1] = BBH_orbit_parameter.generate_BBH_orbit_parameters( BBH_M1, BBH_M2, BBH_S1, BBH_S2, distance, e0 ) + + ## Set spin angular momentum input for TwoPuncture + ## Note: these are dimensional angular momenta (not dimensionless); multiply + ## by the square of the mass scale. Here masses are scaled so total M=1. + ## angular_momentum_BH = input_data.angular_momentum_BH + + angular_momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) + + for i in range(input_data.puncture_number): + + if ( input_data.Symmetry == "equatorial-symmetry" ): + if i==0: + angular_momentum_BH[i] = [ 0.0, 0.0, (BBH_M1**2) * input_data.parameter_BH[i,2] ] + elif i==1: + angular_momentum_BH[i] = [ 0.0, 0.0, (BBH_M2**2) * input_data.parameter_BH[i,2] ] + else: + angular_momentum_BH[i] = [ 0.0, 0.0, (input_data.parameter_BH[i,0]**2) * input_data.parameter_BH[i,2] ] + + elif ( input_data.Symmetry == "no-symmetry" ): + + if i==0: + angular_momentum_BH[i] = (BBH_M1**2) * input_data.dimensionless_spin_BH[i] + elif i==1: + angular_momentum_BH[i] = (BBH_M1**2) * input_data.dimensionless_spin_BH[i] + else: + angular_momentum_BH[i] = (input_data.parameter_BH[i,0]**2) * input_data.dimensionless_spin_BH[i] + + ####################################################### + +## If puncture data are set to "Manually", read initial positions and momenta +## directly from the parameter file. Rescale the total binary mass to M=1 +## for TwoPuncture input. + +elif (input_data.puncture_data_set == "Manually" ): + + mass_ratio_Q = input_data.parameter_BH[0,0] / input_data.parameter_BH[1,0] + + if ( mass_ratio_Q < 1.0 ): + print( " mass_ratio setting is wrong, please reset!!!" ) + print( " set the first black hole to be the larger mass!!!" ) + + BBH_M1 = mass_ratio_Q / ( 1.0 + mass_ratio_Q ) + BBH_M2 = 1.0 / ( 1.0 + mass_ratio_Q ) + + parameter_BH = input_data.parameter_BH + position_BH = input_data.position_BH + momentum_BH = input_data.momentum_BH + + ## Compute binary separation and load eccentricity + distance = math.sqrt( (position_BH[0,0]-position_BH[1,0])**2 + (position_BH[0,1]-position_BH[1,1])**2 + (position_BH[0,2]-position_BH[1,2])**2 ) + e0 = input_data.e0 + + ## Set spin angular momentum input for TwoPuncture + ## Note: these are dimensional angular momenta (not dimensionless); multiply + ## by the square of the mass scale. Here masses are scaled so total M=1. + + ## angular_momentum_BH = input_data.angular_momentum_BH + + angular_momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) + + + for i in range(input_data.puncture_number): + + if ( input_data.Symmetry == "equatorial-symmetry" ): + if i==0: + angular_momentum_BH[i] = [ 0.0, 0.0, (BBH_M1**2) * parameter_BH[i,2] ] + elif i==1: + angular_momentum_BH[i] = [ 0.0, 0.0, (BBH_M2**2) * parameter_BH[i,2] ] + else: + angular_momentum_BH[i] = [ 0.0, 0.0, (parameter_BH[i,0]**2) * parameter_BH[i,2] ] + + elif ( input_data.Symmetry == "no-symmetry" ): + if i==0: + angular_momentum_BH[i] = (BBH_M1**2) * input_data.dimensionless_spin_BH[i] + elif i==1: + angular_momentum_BH[i] = (BBH_M2**2) * input_data.dimensionless_spin_BH[i] + else: + angular_momentum_BH[i] = (parameter_BH[i,0]**2) * input_data.dimensionless_spin_BH[i] + + +################################################################## + +## Write the above binary data into the AMSS-NCKU TwoPuncture input file + +def generate_AMSSNCKU_TwoPuncture_input(): + + file1 = open( os.path.join(input_data.File_directory, "AMSS-NCKU-TwoPuncture.input"), "w") + + print( "# -----0-----> y", file=file1 ) + print( "# - + use Brugmann's convention", file=file1 ) + print( "ABE::mp = -1.0", file=file1 ) ## use negative values so the code solves for bare masses automatically + print( "ABE::mm = -1.0", file=file1 ) + print( "# b = D/2", file=file1 ) + print( "ABE::b = ", ( distance / 2.0 ), file=file1 ) + print( "ABE::P_plusx = ", momentum_BH[0,0], file=file1 ) + print( "ABE::P_plusy = ", momentum_BH[0,1], file=file1 ) + print( "ABE::P_plusz = ", momentum_BH[0,2], file=file1 ) + print( "ABE::P_minusx = ", momentum_BH[1,0], file=file1 ) + print( "ABE::P_minusy = ", momentum_BH[1,1], file=file1 ) + print( "ABE::P_minusz = ", momentum_BH[1,2], file=file1 ) + print( "ABE::S_plusx = ", angular_momentum_BH[0,0], file=file1 ) + print( "ABE::S_plusy = ", angular_momentum_BH[0,1], file=file1 ) + print( "ABE::S_plusz = ", angular_momentum_BH[0,2], file=file1 ) + print( "ABE::S_minusx = ", angular_momentum_BH[1,0], file=file1 ) + print( "ABE::S_minusy = ", angular_momentum_BH[1,1], file=file1 ) + print( "ABE::S_minusz = ", angular_momentum_BH[1,2], file=file1 ) + print( "ABE::Mp = ", BBH_M1, file=file1 ) + print( "ABE::Mm = ", BBH_M2, file=file1 ) + print( "ABE::admtol = 1.e-8", file=file1 ) + print( "ABE::Newtontol = 5.e-12", file=file1 ) + print( "ABE::nA = 50", file=file1 ) + print( "ABE::nB = 50", file=file1 ) + print( "ABE::nphi = 26", file=file1 ) + print( "ABE::Newtonmaxit = 50", file=file1 ) + + file1.close() + + return file1 + +################################################################## + + diff --git a/generate_macrodef.py b/generate_macrodef.py new file mode 100755 index 0000000..40c76e9 --- /dev/null +++ b/generate_macrodef.py @@ -0,0 +1,559 @@ + +################################################################## +## +## This file generates the macro definition files required by AMSS-NCKU +## Author: Xiaoqu +## 2024/12/01 +## +################################################################## + + +import os +import AMSS_NCKU_Input as input_data ## import program input file + + +################################################################## + +## Generate the macro file macrodef.h according to user settings + +def generate_macrodef_h(): + + file1 = open( os.path.join(input_data.File_directory, "macrodef.h"), "w") + + print( file=file1 ) + print( "#ifndef MICRODEF_H", file=file1 ) + print( "#define MICRODEF_H", file=file1 ) + print( file=file1 ) + print( '#include "macrodef.fh" ', file=file1 ) + print( file=file1 ) + print( "// application parameters", file=file1 ) + print( file=file1 ) + + # Define boundary-condition related macro SommerType + # Sommerfeld boundary type + # 0: BAM + # 1: Shibata + + if ( input_data.boundary_choice == "BAM-choice" ): + print( "#define SommerType 0", file=file1 ) + print( file=file1 ) + elif ( input_data.boundary_choice == "Shibata-choice" ): + print( "#define SommerType 0", file=file1 ) + print( file=file1 ) + else: + print( "Sommerfeld boundary condition setting error!!", file=file1 ) + print( file=file1 ) + print( "# Sommerfeld boundary condition SommerType error!!" ) + print() + + # Define macro related to integration at infinity: GaussInt + # Use Gauss-Legendre quadrature in theta direction + + print( "#define GaussInt", file=file1 ) + print( file=file1 ) + + # Define physical-system macro ABEtype + # 0: BSSN vacuum + # 1: coupled to scalar field + # 2: Z4c vacuum + # 3: coupled to Maxwell field + + if ( input_data.Equation_Class == "BSSN" ): + print( "#define ABEtype 0", file=file1 ) + print( file=file1 ) + elif ( input_data.Equation_Class == "BSSN-EScalar" ): + print( "#define ABEtype 1", file=file1 ) + print( file=file1 ) + elif ( input_data.Equation_Class == "BSSN-EM" ): + print( "#define ABEtype 3", file=file1 ) + print( file=file1 ) + elif ( input_data.Equation_Class == "Z4C" ): + print( "#define ABEtype 2", file=file1 ) + print( file=file1 ) + else: + print( "Equation_Class setting error!!!" ) + print() + print( "# Equation type #define ABEtype setting error!!!", file=file1 ) + print( file=file1 ) + + # Define macro With_AHF + # enables Apparent Horizon Finder + + if (input_data.AHF_Find == "yes"): + print( "#define With_AHF", file=file1 ) + elif (input_data.AHF_Find == "no"): + print( "//#define With_AHF", file=file1 ) + else: + print( "AHF_Find input setting error!!!" ) + print( "#define With_AHF setting error!!!", file=file1 ) + + # Define macro Psi4type for Psi4 calculation method + # 0: EB method + # 1: 4-D method + + print( "#define Psi4type 0", file=file1 ) + print( file=file1 ) + + # Define macro Point_Psi4 + # control whether to use point-wise psi4 + + print( "//#define Point_Psi4", file=file1 ) + print( file=file1 ) + + # Define macro RPS + # RestrictProlong in Step (0) or after Step (1) + + print( "#define RPS 1", file=file1 ) + print( file=file1 ) + + # Define macro AGM + # Enforce algebraic constraints + # for every RK4 sub-step: 0 + # only when iter_count == 3: 1 + # after routine Step: 2 + + print( "#define AGM 0", file=file1 ) + print( file=file1 ) + + # Define macro RPB + # Restrict Prolong using BAM style (1) or old style (0) + + print( "#define RPB 0", file=file1 ) + print( file=file1 ) + + # Define macro MAPBH + # 1: move analysis out of 4 sub-steps and treat PBH with Euler method + + print( "#define MAPBH 1", file=file1 ) + print( file=file1 ) + + # Define macro PSTR (parallel structure) + # 0: level-by-level + # 1: consider all levels + # 2: same as 1 but reverse CPU order + # 3: Frank's scheme + + print( "#define PSTR 0", file=file1 ) + print( file=file1 ) + + # Define macro REGLEV + # regrid for every level or for all levels at once + # 0: regrid each level separately + # 1: regrid all levels together + + print( "#define REGLEV 0", file=file1 ) + print( file=file1 ) + + # Define macro USE_GPU + # use GPU or not + + if ( input_data.GPU_Calculation == "yes"): + print( "#define USE_GPU", file=file1 ) + print( file=file1 ) + elif ( input_data.GPU_Calculation == "no"): + print( "//#define USE_GPU", file=file1 ) + print( file=file1 ) + else: + print( "CPU/GPU computation type setting error!!!" ) + print() + print( "# CPU/GPU computation type #define USE_GPU setting error!!!", file=file1 ) + print( file=file1 ) + + # Define macro CHECKDETAIL + # enable checkpointing details for every process + + print( "//#define CHECKDETAIL", file=file1 ) + print( file=file1 ) + + # Define macro FAKECHECK + # use FakeCheckPrepare to write checkpoints + + print( "//#define FAKECHECK", file=file1 ) + print( file=file1 ) + + print( "//", file=file1 ) + print( "// define SommerType", file=file1 ) + print( "// sommerfeld boundary type", file=file1 ) + print( "// 0: bam", file=file1 ) + print( "// 1: shibata", file=file1 ) + print( "//", file=file1 ) + print( "// define GaussInt", file=file1 ) + print( "// for Using Gauss-Legendre quadrature in theta direction", file=file1 ) + print( "//", file=file1 ) + print( "// define ABEtype", file=file1 ) + print( "// 0: BSSN vacuum", file=file1 ) + print( "// 1: coupled to scalar field", file=file1 ) + print( "// 2: Z4c vacuum", file=file1 ) + print( "// 3: coupled to Maxwell field", file=file1 ) + print( "//", file=file1 ) + print( "// define With_AHF", file=file1 ) + print( "// using Apparent Horizon Finder", file=file1 ) + print( "//", file=file1 ) + print( "// define Psi4type", file=file1 ) + print( "// Psi4 calculation method", file=file1 ) + print( "// 0: EB method", file=file1 ) + print( "// 1: 4-D method", file=file1 ) + print( "//", file=file1 ) + print( "// define Point_Psi4", file=file1 ) + print( "// for Using point psi4 or not", file=file1 ) + print( "//", file=file1 ) + print( "// define RPS", file=file1 ) + print( "// RestrictProlong in Step (0) or after Step (1)", file=file1 ) + print( "//", file=file1 ) + print( "// define AGM", file=file1 ) + print( "// Enforce algebra constraint", file=file1 ) + print( "// for every RK4 sub step: 0", file=file1 ) + print( "// only when iter_count == 3: 1", file=file1 ) + print( "// after routine Step: 2", file=file1 ) + print( "//", file=file1 ) + print( "// define RPB", file=file1 ) + print( "// Restrict Prolong using BAM style 1 or old style 0", file=file1 ) + print( "//", file=file1 ) + print( "// define MAPBH", file=file1 ) + print( "// 1: move Analysis out ot 4 sub steps and treat PBH with Euler method", file=file1 ) + print( "//", file=file1 ) + print( "// define PSTR", file=file1 ) + print( "// parallel structure", file=file1 ) + print( "// 0: level by level", file=file1 ) + print( "// 1: considering all levels", file=file1 ) + print( "// 2: as 1 but reverse the CPU order", file=file1 ) + print( "// 3: Frank's scheme", file=file1 ) + print( "//", file=file1 ) + print( "// define REGLEV", file=file1 ) + print( "// regrid for every level or for all levels at a time", file=file1 ) + print( "// 0: for every level;", file=file1 ) + print( "// 1: for all", file=file1 ) + print( "//", file=file1 ) + print( "// define USE_GPU", file=file1 ) + print( "// use gpu or not", file=file1 ) + print( "//", file=file1 ) + print( "// define CHECKDETAIL", file=file1 ) + print( "// use checkpoint for every process", file=file1 ) + print( "//", file=file1 ) + print( "// define FAKECHECK", file=file1 ) + print( "// use FakeCheckPrepare to write CheckPoint", file=file1 ) + print( "//", file=file1 ) + + print( file=file1 ) + print( "////================================================================", file=file1 ) + print( "// some basic parameters for numerical calculation", file=file1 ) + print( "////================================================================", file=file1 ) + print( file=file1 ) + + # Define macros related to dimensionality + + print( "#define dim 3", file=file1 ) + print( file=file1 ) + + # Macro Cell or Vertex is already defined in "macrodef.fh" + + print( '//#define Cell or Vertex in "macrodef.fh" ', file=file1 ) + print( file=file1 ) + + # Define macro buffer_width + # number of buffer points for mesh-refinement interfaces + + print( "#define buffer_width 6", file=file1 ) + print( file=file1 ) + + # Define macro SC_width as buffer_width + # number of buffer points for shell-box interface (on shell) + + print( "#define SC_width buffer_width", file=file1 ) + print( file=file1 ) + + # Define macro CS_width + # number of buffer points for shell-box interface (on box) + + print( "#define CS_width (2*buffer_width)", file=file1 ) + print( file=file1 ) + + # The following are additional explanatory comments + + print( "//", file=file1 ) + print( '// define Cell or Vertex in "macrodef.fh" ', file=file1 ) + print( "//", file=file1 ) + print( "// define buffer_width", file=file1 ) + print( "// buffer point number for mesh refinement interface", file=file1 ) + print( "//", file=file1 ) + print( "// define SC_width buffer_width", file=file1 ) + print( "// buffer point number shell-box interface, on shell", file=file1 ) + print( "//", file=file1 ) + print( "// define CS_width", file=file1 ) + print( "// buffer point number shell-box interface, on box", file=file1 ) + print( "//", file=file1 ) + print( file=file1 ) + print( "#if(buffer_width < ghost_width)", file=file1 ) + print( "# error we always assume buffer_width>ghost_width", file=file1 ) + print( "#endif", file=file1 ) + print( file=file1 ) + + print( "#define PACK 1", file=file1 ) + print( "#define UNPACK 2", file=file1 ) + print( file=file1 ) + print( "#define Mymax(a,b) (((a) > (b)) ? (a) : (b))", file=file1 ) + print( "#define Mymin(a,b) (((a) < (b)) ? (a) : (b))", file=file1 ) + print( file=file1 ) + print( "#define feq(a,b,d) (fabs(a-b)d)", file=file1 ) + print( file=file1 ) + print( "#define TINY 1e-10", file=file1 ) + print( file=file1 ) + print( "#endif /* MICRODEF_H */", file=file1 ) + print( file=file1 ) + + file1.close() + + return file1 + +################################################################## + + +################################################################## + +## Generate the macro file macrodef.fh according to user settings + +def generate_macrodef_fh(): + + file1 = open( os.path.join(input_data.File_directory, "macrodef.fh"), "w") + + print( file=file1 ) + + # Define macro tetradtype + + # v:r; u: phi; w: theta + + # tetradtype 0 + # v^a = (x,y,z) + # orthonormal order: v,u,w + # m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007) + + # tetradtype 1 + # orthonormal order: w,u,v + # m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + + # tetradtype 2 + # v_a = (x,y,z) + # orthonormal order: v,u,w + # m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007) + + if ( input_data.tetrad_type == 0 ): + print( "#define tetradtype 0", file=file1 ) + print( file=file1 ) + elif ( input_data.tetrad_type == 1 ): + print( "#define tetradtype 1", file=file1 ) + print( file=file1 ) + elif ( input_data.tetrad_type == 2 ): + print( "#define tetradtype 2", file=file1 ) + print( file=file1 ) + else: + print( "tetradtype setting error!!" ) + print() + print( "# tetradtype setting error!!", file=file1 ) + print( file=file1 ) + + # Define macro for grid center: Cell or Vertex + # Cell center or Vertex center + + if input_data.grid_center_set == "Cell": + print( "#define Cell", file=file1 ) + print( file=file1 ) + elif input_data.grid_center_set == "Vertex": + print( "#define Vertex", file=file1 ) + print( file=file1 ) + else: + print( "Grid_Center_Set setting error!!" ) + print() + print( "# Grid center type #define Cell or #define Vertex setting error!", file=file1 ) + print( file=file1 ) + + # Define macro ghost_width + # 2nd order: 2 + # 4th order: 3 + # 6th order: 4 + # 8th order: 5 + + if ( input_data.Finite_Diffenence_Method == "2nd-order" ): + print( "#define ghost_width 2", file=file1 ) + print( file=file1 ) + elif ( input_data.Finite_Diffenence_Method == "4th-order" ): + print( "#define ghost_width 3", file=file1 ) + print( file=file1 ) + elif ( input_data.Finite_Diffenence_Method == "6th-order" ): + print( "#define ghost_width 4", file=file1 ) + print( file=file1 ) + elif ( input_data.Finite_Diffenence_Method == "8th-order" ): + print( "#define ghost_width 5", file=file1 ) + print( file=file1 ) + else: + print( "Finite_Difference_Method setting error!!!" ) + print() + print( "# Finite_Difference_Method #define ghost_width setting error!!!", file=file1 ) + print( file=file1 ) + + # Whether to use a shell-patch grid + # use shell or not + + if ( input_data.basic_grid_set == "Shell-Patch" ): + print( "#define WithShell", file=file1 ) + print( file=file1 ) + elif ( input_data.basic_grid_set == "Patch" ): + print( file=file1 ) + else: + print( "basic_grid_set (grid type) setting error!!!" ) + print() + print( "# grid type #define WithShell setting error!!!", file=file1 ) + print( file=file1 ) + + # Define macro CPBC + # use constraint-preserving boundary conditions or not + # only affects Z4c + # CPBC requires WithShell + + if ( input_data.basic_grid_set == "Shell-Patch" ): + print( "#define CPBC", file=file1 ) + print( file=file1 ) + else: + print( file=file1 ) + + # Define gauge-related macros + # Gauge condition type + # 0: B^i gauge + # 1: David's puncture gauge + # 2: MB B^i gauge + # 3: RIT B^i gauge + # 4: MB beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006) + # 5: RIT beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006) + # 6: MGB1 B^i gauge + # 7: MGB2 B^i gauge + + if ( input_data.gauge_choice == 0 ): + print( "#define GAUGE 0", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 1 ): + print( "#define GAUGE 1", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 2 ): + print( "#define GAUGE 2", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 3 ): + print( "#define GAUGE 3", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 4 ): + print( "#define GAUGE 4", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 5 ): + print( "#define GAUGE 5", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 6 ): + print( "#define GAUGE 6", file=file1 ) + print( file=file1 ) + elif ( input_data.gauge_choice == 7 ): + print( "#define GAUGE 7", file=file1 ) + print( file=file1 ) + else: + print( "Gauge setting error!!" ) + print() + print( "# Gauge GAUGE setting error!!", file=file1 ) + print( file=file1 ) + + # Define macro CPBC_ghost_width + # buffer points for CPBC boundary + + print( "#define CPBC_ghost_width (ghost_width)", file=file1 ) + print( file=file1 ) + + # Define macro ABV + # 0: use BSSN variables for constraint violation and psi4 calculation + # 1: use ADM variables for constraint violation and psi4 calculation + + print( "#define ABV 0", file=file1 ) + print( file=file1 ) + + # Define macro EScalar_CC related to F(R) scalar-tensor theory + # 1: Case C of 1112.3928, V=0 + # 2: shell with phi(r) = phi0 * a2^2/(1+a2^2), f(R) = R+a2*R^2 induced V + # 3: ground state of Schrodinger-Newton system, f(R) = R+a2*R^2 induced V + # 4: a2 = +oo and phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma) - tanh((r-r0)/sigma) ) + # 5: shell with phi(r) = phi0 * Exp(-(r-r0)**2/sigma), V = 0 + + if (input_data.Equation_Class == "BSSN-EScalar"): + print( "#define EScalar_CC ", input_data.FR_Choice, file=file1 ) + print( file=file1 ) + else: + print( "#define EScalar_CC 2", file=file1 ) + print( file=file1 ) + # For other calculations this value does not affect results; set a default + # This prevents errors if FR_Choice is not present in AMSS_NCKU_Input.py + + # The following are explanatory comments + + print( "#if 0", file=file1 ) + print( file=file1 ) + print( "define tetradtype", file=file1 ) + print( " v:r; u: phi; w: theta", file=file1 ) + print( " tetradtype 0", file=file1 ) + print( " v^a = (x,y,z)", file=file1 ) + print( " orthonormal order: v,u,w", file=file1 ) + print( " m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007)", file=file1 ) + print( " tetradtype 1", file=file1 ) + print( " orthonormal order: w,u,v", file=file1 ) + print( " m = (theta + i phi)/sqrt(2) following Sperhake, Eq.(3.2) of PRD 85, 124062(2012)", file=file1 ) + print( " tetradtype 2", file=file1 ) + print( " v_a = (x,y,z)", file=file1 ) + print( " orthonormal order: v,u,w", file=file1 ) + print( " m = (phi - i theta)/sqrt(2) following Frans, Eq.(8) of PRD 75, 124018(2007)", file=file1 ) + print( file=file1 ) + print( "define Cell or Vertex", file=file1 ) + print( " Cell center or Vertex center", file=file1 ) + print( file=file1 ) + print( "define ghost_width", file=file1 ) + print( " 2nd order: 2", file=file1 ) + print( " 4th order: 3", file=file1 ) + print( " 6th order: 4", file=file1 ) + print( " 8th order: 5", file=file1 ) + print( file=file1 ) + print( "define WithShell", file=file1 ) + print( " use shell or not", file=file1 ) + print( file=file1 ) + print( "define CPBC", file=file1 ) + print( " use constraint preserving boundary condition or not", file=file1 ) + print( " only affect Z4c", file=file1 ) + print( " CPBC only supports WithShell", file=file1 ) + print( file=file1 ) + print( "define GAUGE", file=file1 ) + print( " 0: B^i gauge", file=file1 ) + print( " 1: David puncture gauge", file=file1 ) + print( " 2: MB B^i gauge", file=file1 ) + print( " 3: RIT B^i gauge", file=file1 ) + print( " 4: MB beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006)", file=file1 ) + print( " 5: RIT beta gauge (beta gauge not means Eq.(3) of PRD 84, 124006)", file=file1 ) + print( " 6: MGB1 B^i gauge", file=file1 ) + print( " 7: MGB2 B^i gauge", file=file1 ) + print( file=file1 ) + print( "define CPBC_ghost_width (ghost_width)", file=file1 ) + print( " buffer points for CPBC boundary", file=file1 ) + print( file=file1 ) + print( "define ABV", file=file1 ) + print( " 0: using BSSN variable for constraint violation and psi4 calculation", file=file1 ) + print( " 1: using ADM variable for constraint violation and psi4 calculation", file=file1 ) + print( file=file1 ) + print( "define EScalar_CC", file=file1 ) + print( "Type of Potential and Scalar Distribution in F(R) Scalar-Tensor Theory", file=file1 ) + print( " 1: Case C of 1112.3928, V=0", file=file1 ) + print( " 2: shell with phi(r) = phi0 * a2^2/(1+a2^2), f(R) = R+a2*R^2 induced V", file=file1 ) + print( " 3: ground state of Schrodinger-Newton system, f(R) = R+a2*R^2 induced V", file=file1 ) + print( " 4: a2 = +oo and phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma) - tanh((r-r0)/sigma) )", file=file1 ) + print( " 5: shell with phi(r) = phi0 * Exp(-(r-r0)**2/sigma), V = 0", file=file1 ) + print( file=file1 ) + print( "#endif", file=file1 ) + print( file=file1 ) + + file1.close() + + return file1 + +################################################################## + + diff --git a/inputfile_example/AMSS_NCKU_Input.py b/inputfile_example/AMSS_NCKU_Input.py new file mode 100644 index 0000000..74f50d3 --- /dev/null +++ b/inputfile_example/AMSS_NCKU_Input.py @@ -0,0 +1,232 @@ + +################################################# +## +## This file provides the input parameters required for numerical relativity. +## XIAOQU +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy + +################################################# + +## Setting MPI processes and the output file directory + +File_directory = "GW150914" ## output file directory +Output_directory = "binary_output" ## binary data file directory + ## The file directory name should not be too long +MPI_processes = 8 ## number of mpi processes used in the simulation + +GPU_Calculation = "no" ## Use GPU or not + ## (prefer "no" in the current version, because the GPU part may have bugs when integrated in this Python interface) +CPU_Part = 1.0 +GPU_Part = 0.0 + +################################################# + + +################################################# + +## Setting the physical system and numerical method + +Symmetry = "equatorial-symmetry" ## Symmetry of System: choose equatorial-symmetry、no-symmetry、octant-symmetry +Equation_Class = "BSSN" ## Evolution Equation: choose "BSSN", "BSSN-EScalar", "BSSN-EM", "Z4C" + ## If "BSSN-EScalar" is chosen, it is necessary to set other parameters below +Initial_Data_Method = "Ansorg-TwoPuncture" ## initial data method: choose "Ansorg-TwoPuncture", "Lousto-Analytical", "Cao-Analytical", "KerrSchild-Analytical" +Time_Evolution_Method = "runge-kutta-45" ## time evolution method: choose "runge-kutta-45" +Finite_Diffenence_Method = "4th-order" ## finite-difference method: choose "2nd-order", "4th-order", "6th-order", "8th-order" + +################################################# + + +################################################# + +## Setting the time evolutionary information + +Start_Evolution_Time = 0.0 ## start evolution time t0 +Final_Evolution_Time = 1000.0 ## final evolution time t1 +Check_Time = 100.0 +Dump_Time = 100.0 ## time inteval dT for dumping binary data +D2_Dump_Time = 100.0 ## dump the ascii data for 2d surface after dT' +Analysis_Time = 0.1 ## dump the puncture position and GW psi4 after dT" +Evolution_Step_Number = 10000000 ## stop the calculation after the maximal step number +Courant_Factor = 0.5 ## Courant Factor +Dissipation = 0.15 ## Kreiss-Oliger Dissipation Strength + +################################################# + + +################################################# + +## Setting the grid structure + +basic_grid_set = "Patch" ## grid structure: choose "Patch" or "Shell-Patch" +grid_center_set = "Cell" ## grid center: chose "Cell" or "Vertex" + +grid_level = 9 ## total number of AMR grid levels +static_grid_level = 5 ## number of AMR static grid levels +moving_grid_level = grid_level - static_grid_level ## number of AMR moving grid levels + +analysis_level = 0 +refinement_level = 4 ## time refinement start from this grid level + +largest_box_xyz_max = [320.0, 320.0, 320.0] ## scale of the largest box + ## not ne cess ary to be cubic for "Patch" grid s tructure + ## need to be a cubic box for "Shell-Patch" grid structure +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) + +static_grid_number = 96 ## grid points of each static AMR grid (in x direction) + ## (grid points in y and z directions are automatically adjusted) +moving_grid_number = 48 ## grid points of each moving AMR grid +shell_grid_number = [32, 32, 100] ## grid points of Shell-Patch grid + ## in (phi, theta, r) direction +devide_factor = 2.0 ## resolution between different grid levels dh0/dh1, only support 2.0 now + + +static_grid_type = 'Linear' ## AMR static grid structure , only supports "Linear" +moving_grid_type = 'Linear' ## AMR moving grid structure , only supports "Linear" + +quarter_sphere_number = 96 ## grid number of 1/4 s pher ical surface + ## (which is needed for evaluating the spherical surface integral) + +################################################# + + +################################################# + +## Setting the puncture information + +puncture_number = 2 + +position_BH = numpy.zeros( (puncture_number, 3) ) +parameter_BH = numpy.zeros( (puncture_number, 3) ) +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) +momentum_BH = numpy.zeros( (puncture_number, 3) ) + +puncture_data_set = "Manually" ## Method to give Puncture’s positions and momentum + ## choose "Manually" or "Automatically-BBH" + ## Prefer to choose "Manually", because "Automatically-BBH" is developing now + +## initial orbital distance and ellipticity for BBHs system +## ( needed for "Automatically-BBH" case , not affect the "Manually" case ) +Distance = 10.0 +e0 = 0.0 + +## black hole parameter (M Q* a*) +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.0, +0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.0, -0.46 ] +## dimensionless spin in each direction +dimensionless_spin_BH[0] = [ 0.0, 0.0, +0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## If puncture_data_set is chosen to be "Manually", it is necessary to set the position and momentum of each puncture manually + +## initial position for each puncture +position_BH[0] = [ 0.0, 10.0*29.0/(36.0+29.0), 0.0 ] +position_BH[1] = [ 0.0, -10.0*36.0/(36.0+29.0), 0.0 ] + +## initial mumentum for each puncture +## (needed for "Manually" case, does not affect the "Automatically-BBH" case) +momentum_BH[0] = [ -0.09530152296974252, -0.00084541526517121, 0.0 ] +momentum_BH[1] = [ +0.09530152296974252, +0.00084541526517121, 0.0 ] + + +################################################# + + +################################################# + +## Setting the gravitational wave information + +GW_L_max = 4 ## maximal L number in gravitational wave +GW_M_max = 4 ## maximal M number in gravitational wave +Detector_Number = 12 ## number of dector +Detector_Rmin = 50.0 ## nearest dector distance +Detector_Rmax = 160.0 ## farest dector distance + +################################################# + + +################################################# + +## Setting the apprent horizon + +AHF_Find = "no" ## whether to find the apparent horizon: choose "yes" or "no" + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## Other parameters (testing) +## Only influence the Equation_Class = "BSSN-EScalar" case + +FR_a2 = 3.0 ## f(R) = R + a2 * R^2 +FR_l2 = 10000.0 +FR_phi0 = 0.00005 +FR_r0 = 120.0 +FR_sigma0 = 8.0 +FR_Choice = 2 ## Choice options: 1 2 3 4 5 + ## 1: phi(r) = phi0 * Exp(-(r-r0)**2/sigma0) + ## V(r) = 0 + ## 2: phi(r) = phi0 * a2^2/(1+a2^2) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 3: Schrodinger-Newton gived by system phi(r) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 4: phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma0) - tanh((r-r0)/sigma0) ) + ## V(r) = 0 + ## f(R) = R + a2*R^2 with a2 = +oo + ## 5: phi(r) = phi0 * Exp(-(r-r0)**2/sigma) + ## V(r) = 0 + +################################################# + + +################################################# + +## Other parameters (testing) +## (please do not change if not necessary) + +boundary_choice = "BAM-choice" ## Sommerfeld boundary condition : choose "BAM-choice" or "Shibata-choice" + ## prefer "BAM-choice" + +gauge_choice = 0 ## gauge choice + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## prefer 0 or 1 + +tetrad_type = 2 ## tetradtype + ## v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## this version recommend set to 2 + ## prefer 2 + +################################################# + diff --git a/inputfile_example/BSSN_EM_Input.py b/inputfile_example/BSSN_EM_Input.py new file mode 100644 index 0000000..afcc7b7 --- /dev/null +++ b/inputfile_example/BSSN_EM_Input.py @@ -0,0 +1,215 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "xiaoqu_Results_testBSSNEM" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "BSSN-EM" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里没有选择 BSSN-EScalar， F(R) 理论的参数不是必须要设定的 +Initial_Data_Method = "Ansorg-TwoPuncture" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 1500.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 300.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.2 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 10 ## 设置格点的总层数 +static_grid_level = 6 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 4 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [500.0, 500.0, 500.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 96 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 48 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [32, 32, 100] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 2 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 10.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.5, 0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.5, -0.46 ] +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +4.4615385, 0.0 ] +position_BH[1] = [ 0.0, -5.5384615, 0.0 ] + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.0953015, -0.00084515, 0.0 ] +momentum_BH[1] = [ +0.0953015, +0.00084515, 0.0 ] + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 0 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + + diff --git a/inputfile_example/BSSN_EScalar_Input.py b/inputfile_example/BSSN_EScalar_Input.py new file mode 100644 index 0000000..34ee00e --- /dev/null +++ b/inputfile_example/BSSN_EScalar_Input.py @@ -0,0 +1,243 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "xiaoqu_Results_testEScalar" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "BSSN-EScalar" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里选择 BSSN-EScalar，需要在后面设定 F(R) 理论的参数 +Initial_Data_Method = "Ansorg-TwoPuncture" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 1500.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 300.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.2 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 10 ## 设置格点的总层数 +static_grid_level = 6 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 4 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [500.0, 500.0, 500.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 96 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 48 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [32, 32, 100] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 2 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 10.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.0, 0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.0, -0.46 ] +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +4.4615385, 0.0 ] +position_BH[1] = [ 0.0, -5.5384615, 0.0 ] + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.0953015, -0.00084515, 0.0 ] +momentum_BH[1] = [ +0.0953015, +0.00084515, 0.0 ] + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 标量-张量-f(R) 理论的一些参数 +## 仅对 BSSN-EScalar 的计算有影响 + +FR_a2 = 3.0 ## f(R) = R + a2 * R^2 +FR_l2 = 10000.0 +FR_phi0 = 0.00005 +FR_r0 = 120.0 +FR_sigma0 = 8.0 +FR_Choice = 2 ## Choice 可选为 1 2 3 4 5 + ## 1: phi(r) = phi0 * Exp(-(r-r0)**2/sigma0) + ## V(r) = 0 + ## 2: phi(r) = phi0 * a2^2/(1+a2^2) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 该 V(r) 由 f(R) = R + a2*R^2 诱导 + ## 3: Schrodinger-Newton 系统给定的 phi(r) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 该 V(r) 由 f(R) = R + a2*R^2 诱导 + ## 4: phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma0) - tanh((r-r0)/sigma0) ) + ## V(r) = 0 + ## f(R) = R + a2*R^2 其中 a2 设定为 a2 = +oo + ## 5: phi(r) = phi0 * Exp(-(r-r0)**2/sigma) + ## V(r) = 0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 0 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + + diff --git a/inputfile_example/BSSN_Input.py b/inputfile_example/BSSN_Input.py new file mode 100644 index 0000000..90cd698 --- /dev/null +++ b/inputfile_example/BSSN_Input.py @@ -0,0 +1,215 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "xiaoqu_Results_GW150914_testBSSN" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "BSSN" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里没有选择 BSSN-EScalar， F(R) 理论的参数不是必须要设定的 +Initial_Data_Method = "Ansorg-TwoPuncture" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 1500.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 300.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.2 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 10 ## 设置格点的总层数 +static_grid_level = 6 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 4 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [500.0, 500.0, 500.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 96 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 48 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [32, 32, 100] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 2 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 10.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.0, 0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.0, -0.46 ] +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +4.4615385, 0.0 ] +position_BH[1] = [ 0.0, -5.5384615, 0.0 ] + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.0953015, -0.00084515, 0.0 ] +momentum_BH[1] = [ +0.0953015, +0.00084515, 0.0 ] + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 0 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + + diff --git a/inputfile_example/BSSN_ShellPatch_Input.py b/inputfile_example/BSSN_ShellPatch_Input.py new file mode 100644 index 0000000..dac05da --- /dev/null +++ b/inputfile_example/BSSN_ShellPatch_Input.py @@ -0,0 +1,243 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "Results_BBH_q=1_test_shellpatch" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "BSSN" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里选择 BSSN-EScalar，需要在后面设定 F(R) 理论的参数 +Initial_Data_Method = "Ansorg-TwoPuncture" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、 + ## Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 1800.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 400.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.1 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Shell-Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 7 ## 设置格点的总层数 +static_grid_level = 3 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 1 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [100.0, 100.0, 100.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 96 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 48 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [40, 40, 400] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 2 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 11.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 0.487208758, 0.0, 0.0 ] +parameter_BH[1] = [ 0.487208758, 0.0, -0.0 ] +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.0 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.0 ] + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +5.5, 0.0 ] +position_BH[1] = [ 0.0, -5.5, 0.0 ] + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.090109887, -0.000703975, 0.0 ] +momentum_BH[1] = [ +0.090109887, +0.000703975, 0.0 ] + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 标量-张量-f(R) 理论的一些参数 +## 仅对 BSSN-EScalar 的计算有影响 + +FR_a2 = 3.0 ## f(R) = R + a2 * R^2 +FR_l2 = 10000.0 +FR_phi0 = 0.00005 +FR_r0 = 120.0 +FR_sigma0 = 8.0 +FR_Choice = 2 ## Choice 可选为 1 2 3 4 5 + ## 1: phi(r) = phi0 * Exp(-(r-r0)**2/sigma0) + ## V(r) = 0 + ## 2: phi(r) = phi0 * a2^2/(1+a2^2) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 该 V(r) 由 f(R) = R + a2*R^2 诱导 + ## 3: Schrodinger-Newton 系统给定的 phi(r) + ## V(r) = Exp(-8*Sqrt(PI/3)*phi(r)) * (1-Exp(4*Sqrt(PI/3)*phi(r)))**2 / (32*PI*a2) + ## 该 V(r) 由 f(R) = R + a2*R^2 诱导 + ## 4: phi(r) = phi0 * 0.5 * ( tanh((r+r0)/sigma0) - tanh((r-r0)/sigma0) ) + ## V(r) = 0 + ## f(R) = R + a2*R^2 其中 a2 设定为 a2 = +oo + ## 5: phi(r) = phi0 * Exp(-(r-r0)**2/sigma) + ## V(r) = 0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 2 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + diff --git a/inputfile_example/Three_Body_Input.py b/inputfile_example/Three_Body_Input.py new file mode 100644 index 0000000..7db3ea0 --- /dev/null +++ b/inputfile_example/Three_Body_Input.py @@ -0,0 +1,220 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "xiaoqu_Results_test3body" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "BSSN" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里没有选择 BSSN-EScalar，F(R) 理论的参数不是必须要设定的 +Initial_Data_Method = "Lousto-Analytical" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 500.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 300.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.2 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 10 ## 设置格点的总层数 +static_grid_level = 6 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 4 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [500.0, 500.0, 500.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 128 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 40 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [32, 32, 100] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 3 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 +## angular_momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的自旋角动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 10.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 0.3, 0.0, 0.0 ] +parameter_BH[1] = [ 0.3, 0.0, 0.0 ] +parameter_BH[2] = [ 0.4, 0.0, 0.0 ] # 更多黑洞手动补加 +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.0 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, 0.0 ] +dimensionless_spin_BH[2] = [ 0.0, 0.0, 0.0 ] # 更多黑洞手动补加 + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +5.0, 0.0 ] +position_BH[1] = [ 0.0, -5.0, 0.0 ] +position_BH[2] = [ 0.0, 0.0, 0.0 ] # 更多黑洞手动补加 + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.03, -0.00025, 0.0 ] +momentum_BH[1] = [ +0.03, +0.00025, 0.0 ] +momentum_BH[2] = [ 0.0, 0.0, 0.0 ] # 更多黑洞手动补加 + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 0 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + + diff --git a/inputfile_example/Z4C_Input.py b/inputfile_example/Z4C_Input.py new file mode 100644 index 0000000..f4e42f5 --- /dev/null +++ b/inputfile_example/Z4C_Input.py @@ -0,0 +1,215 @@ + +################################################# +## +## 这个文件包含了数值相对论所需要的输入 +## 小曲 +## 2024/03/19 --- 2025/09/14 +## +################################################# + +import numpy ## 导入 numpy 包 + +################################################# + +## 设置程序运行目录和计算资源 + +File_directionary = "xiaoqu_Results_GW150914_testZ4C" ## 程序运行目录 +Output_directionary = "output_file" ## 存放二进制数据的子目录 +MPI_processes = 16 ## 想要调用的进程数目 + +GPU_Calculation = "no" ## 是否开启 GPU 计算，可选 yes 或 no +CPU_Part = 0.5 +GPU_Part = 0.5 + +################################################# + + +################################################# + +## 设置程序计算方法 + +Symmetry = "equatorial-symmetry" ## 系统对称性，可选 equatorial-symmetry、no-symmetry +Equation_Class = "Z4C" ## 设置方程形式，可选 BSSN、Z4C、BSSN-EScalar、BSSN-EM + ## BSSN 和 Z4C 适合于 GR 旋转黑洞的真空计算 + ## BSSN-EM 涉及 GR 带电黑洞的真空计算 + ## BSSN-EScalar 涉及到标量张量-F(R) 理论的计算，需要在后面设定额外参数 + ## 注意：GPU 计算仅支持 BSSN + ## 这里没有选择 BSSN-EScalar， F(R) 理论的参数不是必须要设定的 +Initial_Data_Method = "Ansorg-TwoPuncture" ## 设置求解数值相对论初值的方法 + ## 可选 Ansorg-TwoPuncture、Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 注意：当前 BSSN-EM 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical + ## 当前 BSSN-EScalar 的计算不支持用解析公式 Lousto-Analytical、Cao-Analytical、KerrSchild-Analytical +Time_Evolution_Method = "runge-kutta-45" ## 时间演化方法，可选 runge-kutta-45 +Finite_Diffenence_Method = "6th-order" ## 有限差分方法，可选 2nd-order、4th-order、6th-order、8th-order + +################################################# + + +################################################# + +## 设置时间演化信息 + +Start_Evolution_Time = 0.0 ## 起始演化时间 +Final_Evolution_Time = 1500.0 ## 最终演化时间 +Check_Time = 100.0 +Dump_Time = 50.0 ## 每隔一定时间间隔储存数据 +D2_Dump_Time = 300.0 +Analysis_Time = 0.1 +Evolution_Step_Number = 10000000 ## 时间迭代次数 +Courant_Factor = 0.5 ## Courant 因子（决定每一步时间演化的时间间隔） +Dissipation = 0.1 ## 耗散因子 + +################################################# + + +################################################# + +## 设置多层格点信息 + +basic_grid_set = "Patch" ## 设定网格类型，可选 Patch 和 Shell-Patch +grid_center_set = "Cell" ## 网格中心设置，可选 Cell 和 Vertex + +grid_level = 10 ## 设置格点的总层数 +static_grid_level = 6 ## 设置静态格点的层数 +moving_grid_level = grid_level - static_grid_level ## 可移动格点的层数 + +analysis_level = 0 +refinement_level = 4 ## 从该层开始进行时间细化 + +largest_box_xyz_max = [500.0, 500.0, 500.0] ## 设置最外层格点的坐标最大值 +largest_box_xyz_min = - numpy.array(largest_box_xyz_max) ## 设置最外层格点的坐标最小值 + +static_grid_number = 96 ## 设置固定格点每一层每一维数的格点数目（这里对应的 x 轴格点数目，yz 轴格点自动调整） +moving_grid_number = 48 ## 设置可移动格点每一层每一维数的格点数目 +shell_grid_number = [32, 32, 100] ## 设置最外层球状网格（shell patch）的格点数目 + ## 以 phi、theta、r 的顺序给定 +devide_factor = 2.0 ## 设置相邻两层网格分辨率的比例（不要轻易改变） +static_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' +moving_grid_type = 'Linear' ## 设置固定格点的类型，可选 'Linear' + +quarter_sphere_number = 64 ## 1/4 球面积分的格点数目 + +################################################# + + +################################################# + +## 设置黑洞 puncture （穿刺法）的信息 + +puncture_number = 2 ## 设置 puncture 的数目 + +position_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的初始位置 +parameter_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的参数 +dimensionless_spin_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的无量纲自旋 +momentum_BH = numpy.zeros( (puncture_number, 3) ) ## 初始化每个黑洞的动量 + +puncture_data_set = "Manually" ## 设置双星轨道坐标的方式，可选 Manually 和 Automatically-BBH + +#--------------------------------------------- + +## 如果设置双星初始轨道坐标的方式选为 Automatically-BBH，只需要给定黑洞参数，偏心率，距离即可 + +## 这一步与初值求解中的 Ansorg-TwoPuncture 配合使用中需要注意的问题 +## 用 Ansorg-TwoPuncture 求解初值，轨道坐标设置可以设置 Manually 和 Automatically-BBH 设置双星轨道坐标 +## 但双星轨道坐标如果设置为 Manually 而不是 Automatically-BBH，则要细致设置 Puncture 的位置和动量取值，否则可能会使 TwoPuncture 程序无法正确读入输入而报错） + +Distance = 10.0 +e0 = 0.0 + +## 设置每个黑洞的参数 (M Q* a*) +## 质量 无量纲电荷 无量纲自旋 +parameter_BH[0] = [ 36.0/(36.0+29.0), 0.0, 0.31 ] +parameter_BH[1] = [ 29.0/(36.0+29.0), 0.0, -0.46 ] +## 注意，如果求解数值相对论初值的方法选为 Ansorg-TwoPuncture，第一个黑洞必须为质量较大的那个，且黑洞总质量会自动 rescale 为 M=1 （其它情况下必须手动 rescale） + +## 设置每个黑洞的无量纲自旋 +## 无对称性时 ，需要手动给 3 个方向的自旋角动量 +dimensionless_spin_BH[0] = [ 0.0, 0.0, 0.31 ] +dimensionless_spin_BH[1] = [ 0.0, 0.0, -0.46 ] + +## 注意，如果设置双星初始轨道坐标的方式选为 Automatically-BBH，则程序自动调整将较大质量黑洞放在 y 轴正向，将较小质量黑洞放在 y 轴负向 +## 如果设置双星初始轨道坐标的方式选为 Manually，则需要手动调整到 y 轴方向 +## use Brugmann's convention +## -----0-----> y +## - + + +#--------------------------------------------- + +## 如果设置 puncture 初始轨道坐标的方式选为 Manually，还需要手动给定所有黑洞参数 + +## 设置每个黑洞的初始位置 +position_BH[0] = [ 0.0, +4.4615385, 0.0 ] +position_BH[1] = [ 0.0, -5.5384615, 0.0 ] + +## 设置每个黑洞的动量信息 +momentum_BH[0] = [ -0.0953015, -0.00084515, 0.0 ] +momentum_BH[1] = [ +0.0953015, +0.00084515, 0.0 ] + + +################################################# + + +################################################# + +## 设置引力波和探测器的相关信息 + +GW_L_max = 4 ## 引力波最大的 L +GW_M_max = 4 ## 引力波最大的 M +Detector_Number = 11 ## 探测器的数目 +Detector_Rmin = 50.0 ## 最近探测器的距离 +Detector_Rmax = 150.0 ## 最远探测器的距离 + +################################################# + + +################################################# + +## 设置表观视界的参数 + +AHF_Find = "no" ## 是否开启表观视界计算，可选 yes 或 no + +AHF_Find_Every = 24 +AHF_Dump_Time = 20.0 + +################################################# + + +################################################# + +## 其它选项 +## 还在测试中 +## 但不建议用户轻易改动这些选项 + +boundary_choice = "BAM-choice" ## 索莫菲边界条件设定，可选 "BAM-choice" 和 "Shibata-choice" + ## 目前的版本定建议选为 "BAM-choice" + +gauge_choice = 0 ## 规范条件选取 + ## 0: B^i gauge + ## 1: David's puncture gauge + ## 2: MB B^i gauge ## 对Z4C和GPU计算好像有bug + ## 3: RIT B^i gauge + ## 4: MB beta gauge + ## 5: RIT beta gauge + ## 6: MGB1 B^i gauge + ## 7: MGB2 B^i gauge + ## 目前的版本建议选为 0 或 1 + +tetrad_type = 2 ## tetradtype 选取 + ## 以下 v:r; u: phi; w: theta + ## v^a = (x,y,z) + ## 0: orthonormal order: v,u,w + ## v^a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 1: orthonormal order: w,u,v + ## m = (theta + i phi)/sqrt(2) + ## following Sperhake, Eq.(3.2) of PRD 85, 124062(2012) + ## 2: orthonormal order: v,u,w + ## v_a = (x,y,z) + ## m = (phi - i theta)/sqrt(2) + ## following Frans, Eq.(8) of PRD 75, 124018(2007) + ## 目前的版本建议选为 2 + +################################################# + + diff --git a/makefile_and_run.py b/makefile_and_run.py new file mode 100755 index 0000000..22e4de2 --- /dev/null +++ b/makefile_and_run.py @@ -0,0 +1,175 @@ + +################################################################## +## +## This file defines the commands used to build and run AMSS-NCKU +## Author: Xiaoqu +## 2025/01/24 +## +################################################################## + + +import AMSS_NCKU_Input as input_data +import subprocess + + +################################################################## + + + +################################################################## + +## Compile the AMSS-NCKU main program ABE + +def makefile_ABE(): + + print( ) + print( " Compiling the AMSS-NCKU executable file ABE/ABEGPU " ) + print( ) + + ## Build command + if (input_data.GPU_Calculation == "no"): + makefile_command = "make -j4" + " ABE" + elif (input_data.GPU_Calculation == "yes"): + makefile_command = "make -j4" + " ABEGPU" + else: + print( " CPU/GPU numerical calculation setting is wrong " ) + print( ) + + ## Execute the command with subprocess.Popen and stream output + makefile_process = subprocess.Popen(makefile_command, shell=True, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, text=True) + + ## Read and print output lines as they arrive + for line in makefile_process.stdout: + print(line, end='') # stream output in real time + + ## Wait for the process to finish + makefile_return_code = makefile_process.wait() + if makefile_return_code != 0: + raise subprocess.CalledProcessError(makefile_return_code, makefile_command) + + print( ) + print( " Compilation of the AMSS-NCKU executable file ABE is finished " ) + print( ) + + return + +################################################################## + + + +################################################################## + +## Compile the AMSS-NCKU TwoPuncture program TwoPunctureABE + +def makefile_TwoPunctureABE(): + + print( ) + print( " Compiling the AMSS-NCKU executable file TwoPunctureABE " ) + print( ) + + ## Build command + makefile_command = "make" + " TwoPunctureABE" + + ## Execute the command with subprocess.Popen and stream output + makefile_process = subprocess.Popen(makefile_command, shell=True, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, text=True) + + ## Read and print output lines as they arrive + for line in makefile_process.stdout: + print(line, end='') # stream output in real time + + ## Wait for the process to finish + makefile_return_code = makefile_process.wait() + if makefile_return_code != 0: + raise subprocess.CalledProcessError(makefile_return_code, makefile_command) + + print( ) + print( " Compilation of the AMSS-NCKU executable file TwoPunctureABE is finished " ) + print( ) + + return + +################################################################## + + + +################################################################## + +## Run the AMSS-NCKU main program ABE + +def run_ABE(): + + print( ) + print( " Running the AMSS-NCKU executable file ABE/ABEGPU " ) + print( ) + + ## Define the command to run; cast other values to strings as needed + + if (input_data.GPU_Calculation == "no"): + mpi_command = "mpirun -np " + str(input_data.MPI_processes) + " ./ABE" + mpi_command_outfile = "ABE_out.log" + elif (input_data.GPU_Calculation == "yes"): + mpi_command = "mpirun -np " + str(input_data.MPI_processes) + " ./ABEGPU" + mpi_command_outfile = "ABEGPU_out.log" + + ## Execute the MPI command and stream output + mpi_process = subprocess.Popen(mpi_command, shell=True, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, text=True) + + ## Write ABE run output to file while printing to stdout + with open(mpi_command_outfile, 'w') as file0: + ## Read and print output lines; also write each line to file + for line in mpi_process.stdout: + print(line, end='') # stream output in real time + file0.write(line) # write the line to file + file0.flush() # flush to ensure each line is written immediately (optional) + file0.close() + + ## Wait for the process to finish + mpi_return_code = mpi_process.wait() + + print( ) + print( " The ABE/ABEGPU simulation is finished " ) + print( ) + + return + +################################################################## + + + +################################################################## + +## Run the AMSS-NCKU TwoPuncture program TwoPunctureABE + +def run_TwoPunctureABE(): + + print( ) + print( " Running the AMSS-NCKU executable file TwoPunctureABE " ) + print( ) + + ## Define the command to run + TwoPuncture_command = "./TwoPunctureABE" + TwoPuncture_command_outfile = "TwoPunctureABE_out.log" + + ## Execute the command with subprocess.Popen and stream output + TwoPuncture_process = subprocess.Popen(TwoPuncture_command, shell=True, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, text=True) + + ## Write TwoPunctureABE run output to file while printing to stdout + with open(TwoPuncture_command_outfile, 'w') as file0: + ## Read and print output lines; also write each line to file + for line in TwoPuncture_process.stdout: + print(line, end='') # stream output in real time + file0.write(line) # write the line to file + file0.flush() # flush to ensure each line is written immediately (optional) + file0.close() + + ## Wait for the process to finish + TwoPuncture_command_return_code = TwoPuncture_process.wait() + + print( ) + print( " The TwoPunctureABE simulation is finished " ) + print( ) + + return + +################################################################## + diff --git a/makefile_include/cpu part/makefile_alps b/makefile_include/cpu part/makefile_alps new file mode 100644 index 0000000..3def10d --- /dev/null +++ b/makefile_include/cpu part/makefile_alps @@ -0,0 +1,17 @@ +# $Id: makefile_alps,v 1.1 2012/11/08 11:54:00 zjcao Exp $ +#for ALPS PGI/openmpi + +filein = +LDLIBS = -lpgf90 -lpgf902 -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi +# you can also replace the above long list with just "-lpgf90libs" + + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc +f90appflags = -O2 -Mpreprocess + +f90 = mpif90 +f77 = +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx + diff --git a/makefile_include/cpu part/makefile_altix b/makefile_include/cpu part/makefile_altix new file mode 100644 index 0000000..eaab656 --- /dev/null +++ b/makefile_include/cpu part/makefile_altix @@ -0,0 +1,13 @@ +# $Id: makefile_altix,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by altix.sccas.cn +filein = -I/usr/include + +LDLIBS = -L/usr/lib -L/opt/intel/fc/10.1.008/lib -lmpi -lifcore -limf -lintrins + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 +f90appflags = -O2 +f90 = ifort +f77 = ifort +CXX = icpc +CC = icc +CLINKER = icpc diff --git a/makefile_include/cpu part/makefile_bnu b/makefile_include/cpu part/makefile_bnu new file mode 100644 index 0000000..43af184 --- /dev/null +++ b/makefile_include/cpu part/makefile_bnu @@ -0,0 +1,15 @@ +#$Id: makefile_bnu,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +# bnu has two compiler systems +# one is altix330 +# one is chess which is used here +filein = -I/usr/chess/mpich-gm-gcc34-1.2.6..14b/include + +LDLIBS = -L/opt/intel/fce/9.0/lib -lifcore -L/usr/chess/mpich-gm-gcc34-1.2.6..14b/lib64 -lmpich + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -O2 +f90appflags = -O2 +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = g++ +CC = gcc -Wno-deprecated -DANSI_HEADERS -O2 +CLINKER = g++ diff --git a/makefile_include/cpu part/makefile_cao b/makefile_include/cpu part/makefile_cao new file mode 100644 index 0000000..70b690a --- /dev/null +++ b/makefile_include/cpu part/makefile_cao @@ -0,0 +1,62 @@ +# $Id: makefile_cao,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +filein = -I/home/zjcao/local/include + +LDLIBS = -L/home/zjcao/local/lib -lmpich -L/usr/lib -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +CXX = g++ +CLINKER = g++ +.SUFFIXES: .o .f90 .C + +.f90.o: + $(f90) $(f90appflags) -c $< -o $@ + +.C.o: + ${CXX} ${CXXAPPFLAGS} -c $< ${filein} -o $@ + +# Input files +C++FILES = ABE.o cgh.o grid.o misc.o var.o var_list.o gsl.o operate_gsl.o\ + bssn_class.o monitor.o surface_integral.o interpolation_cgh.o\ + moving_box.o + +F90FILES = initial_puncture.o prolongrestrict_cell.o polynomial_interpolation.o\ + fmisc.o bssn.o cell_diff4.o rungekutta4_bssn.o sommerfeld_bssn.o\ + rungekutta4_lapse_shift.o sommerfeld_lapse_shift.o\ + enforce_algebra.o alwind_4th_9.o gauge_condition_9.o\ + bssn_constraint.o fadmquantites_bssn.o getnp4.o kodiss.o + +bssn_class.o: bssn_class.h cgh.h grid.h misc.h var.h gsl.h initial_puncture.h\ + prolongrestrict.h bssn.h rungekutta4_bssn.h sommerfeld_bssn.h\ + rungekutta4_lapse_shift.h sommerfeld_lapse_shift.h\ + enforce_algebra.h alwind_9.h gauge_condition_9.h operate_gsl.h\ + monitor.h surface_integral.h getnp4.h moving_box.h kodiss.h + +cgh.o: cgh.h + +grid.o: grid.h + +misc.o: misc.h + +var.o: var.h + +var_list.o: var.h var_list.h + +gsl.o: gsl.h + +operate_gsl.o: operate_gsl.h gsl.h + +bssn_class.o: bssn_class.h + +surface_integral.o: fadmquantites_bssn.h derivatives.h interpolation_cgh.h + +ABE.o: bssn_class.h + +interpolation_cgh.o: interpolation_cgh.h + +moving_box.o: moving_box.h + +ABE: $(C++FILES) $(F90FILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES) $(F90FILES) $(LDLIBS) diff --git a/makefile_include/cpu part/makefile_ibm1350 b/makefile_include/cpu part/makefile_ibm1350 new file mode 100644 index 0000000..45dfb18 --- /dev/null +++ b/makefile_include/cpu part/makefile_ibm1350 @@ -0,0 +1,12 @@ +#$Id: makefile_ibm1350,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +filein = -I/opt/vltmpi/OPENIB/mpi.pgcc.rsh/include -I/opt/pgi/linux86-64/6.2/include + +LDLIBS = -L/opt/vltmpi/OPENIB/mpi.pgcc.rsh/lib -lmpich -L/usr/local/ofed/lib64 -libverbs -L/opt/pgi/linux86-64/6.2/lib -lpgf90 -lpgf902 -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi -lstdc++ + +CXXAPPFLAGS = -O2 -fast --no_warnings -DUNDERSCORE -DWant_c_files -DANSI_HEADERS -Dfortran3 -Dnewc +f90appflags = -O3 -fast +f90 = pgf90 +f77 = pgf77 -O3 -fast +CXX = pgCC +CC = pgcc -O2 -fast --no_warnings -DUNDERSCORE -DWant_c_files -DANSI_HEADERS +CLINKER = pgCC diff --git a/makefile_include/cpu part/makefile_icm b/makefile_include/cpu part/makefile_icm new file mode 100644 index 0000000..4b6b46a --- /dev/null +++ b/makefile_include/cpu part/makefile_icm @@ -0,0 +1,16 @@ +#$Id: makefile_icm,v 1.3 2013/08/20 11:49:04 zjcao Exp $ +filein = + +LDLIBS = -L/opt/intel/Compiler/11.1/064/lib/intel64 -lifcore\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t -lmkl -lguide -lpthread + +GSLIB = -L/usr/lib64 -lgsl + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -fpp +f90 = mpif90 +f77 = mpif77 +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx diff --git a/makefile_include/cpu part/makefile_itp b/makefile_include/cpu part/makefile_itp new file mode 100644 index 0000000..93e442d --- /dev/null +++ b/makefile_include/cpu part/makefile_itp @@ -0,0 +1,12 @@ +#$Id: makefile_itp,v 1.1 2013/01/26 11:23:09 zjcao Exp $ +filein = + +LDLIBS = -lifcore + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -fpp +f90 = mpif90 +f77 = mpif77 +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx diff --git a/makefile_include/cpu part/makefile_makoto b/makefile_include/cpu part/makefile_makoto new file mode 100644 index 0000000..15eaa80 --- /dev/null +++ b/makefile_include/cpu part/makefile_makoto @@ -0,0 +1,62 @@ +# $Id: makefile_makoto,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by makoto +filein = -I/opt/mpich127_gnu/include + +LDLIBS = -L/opt/mpich127_gnu/lib -lmpich -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +CXX = g++ +CLINKER = g++ +.SUFFIXES: .o .f90 .C + +.f90.o: + $(f90) $(f90appflags) -c $< -o $@ + +.C.o: + ${CXX} ${CXXAPPFLAGS} -c $< ${filein} -o $@ + +# Input files +C++FILES = ABE.o cgh.o grid.o misc.o var.o var_list.o gsl.o operate_gsl.o\ + bssn_class.o monitor.o surface_integral.o interpolation_cgh.o\ + moving_box.o + +F90FILES = initial_puncture.o prolongrestrict_cell.o polynomial_interpolation.o\ + fmisc.o bssn.o cell_diff4.o rungekutta4_bssn.o sommerfeld_bssn.o\ + rungekutta4_lapse_shift.o sommerfeld_lapse_shift.o\ + enforce_algebra.o alwind_4th_9.o gauge_condition_9.o\ + bssn_constraint.o fadmquantites_bssn.o getnp4.o kodiss.o + +bssn_class.o: bssn_class.h cgh.h grid.h misc.h var.h gsl.h initial_puncture.h\ + prolongrestrict.h bssn.h rungekutta4_bssn.h sommerfeld_bssn.h\ + rungekutta4_lapse_shift.h sommerfeld_lapse_shift.h\ + enforce_algebra.h alwind_9.h gauge_condition_9.h operate_gsl.h\ + monitor.h surface_integral.h getnp4.h moving_box.h kodiss.h + +cgh.o: cgh.h + +grid.o: grid.h + +misc.o: misc.h + +var.o: var.h + +var_list.o: var.h var_list.h + +gsl.o: gsl.h + +operate_gsl.o: operate_gsl.h gsl.h + +bssn_class.o: bssn_class.h + +surface_integral.o: fadmquantites_bssn.h derivatives.h interpolation_cgh.h + +ABE.o: bssn_class.h + +interpolation_cgh.o: interpolation_cgh.h + +moving_box.o: moving_box.h + +ABE: $(C++FILES) $(F90FILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES) $(F90FILES) $(LDLIBS) diff --git a/makefile_include/cpu part/makefile_nchc b/makefile_include/cpu part/makefile_nchc new file mode 100644 index 0000000..fd7b951 --- /dev/null +++ b/makefile_include/cpu part/makefile_nchc @@ -0,0 +1,10 @@ +#$Id: makefile_nchc,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +LDLIBS = -lxlf90 -lC -lm +# +CXXAPPFLAGS = -q64 -O2 -qstrict -qarch=auto -qtune=auto -qcache=auto -qlanglvl=oldmath -lxlf90 -lm -lC -Dfortran1 -Dnewc +f90appflags = -q64 -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -qsuffix=f=f90 +f90 = mpxlf90_r +f77 = mpxlf77_r +CXX = mpCC_r +CC = mpcc_r +CLINKER = mpCC_r diff --git a/makefile_include/cpu part/makefile_ncku b/makefile_include/cpu part/makefile_ncku new file mode 100644 index 0000000..13f7a9d --- /dev/null +++ b/makefile_include/cpu part/makefile_ncku @@ -0,0 +1,15 @@ +# $Id: makefile_ncku,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by NCKU's cluster sge +filein = -I/ap/pgi/linux86-64/6.2/mpi/mpich/include + +LDLIBS = -lblas -L/ap/pgi/linux86-64/6.2/mpi/mpich/lib -lmpich \ + -L/ap/pgi/linux86-64/6.2/lib -lpgf90 -lpgf902 \ + -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi -lstdc++ + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = pgf90 +f77 = pgf77 +CXX = pgCC +CC = pgcc +CLINKER = pgCC -Bstatic diff --git a/makefile_include/cpu part/makefile_quad1 b/makefile_include/cpu part/makefile_quad1 new file mode 100644 index 0000000..8288cc5 --- /dev/null +++ b/makefile_include/cpu part/makefile_quad1 @@ -0,0 +1,17 @@ +# $Id: makefile_quad1,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by quad1 +#used for memorry leak debuging +#~/soft/bin/valgrind --tool=memcheck --leak-check=full /home/jpyu/local/mpich127_64/bin/mpirun -np 4 -machinefile ../machines ABE >& out.log +filein = -I/home/jpyu/local/mpich127_64/include -I/usr/include/gsl + +LDLIBS = -L/home/jpyu/local/mpich127_64/lib -lmpich -L/opt/intel/fce/10.1.018/lib -lifcore + +GSLIB = -L/usr/lib64 -lgsl -lgslcblas + +CXXAPPFLAGS = -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -O2 -IPF-fp-strict +f90appflags = -pc64 -O2 -IPF-fp-strict +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = icpc +CC = icc -Wno-deprecated -DANSI_HEADERS -O2 -IPF-fp-strict +CLINKER = icpc diff --git a/makefile_include/cpu part/makefile_quad2 b/makefile_include/cpu part/makefile_quad2 new file mode 100644 index 0000000..5ca69c3 --- /dev/null +++ b/makefile_include/cpu part/makefile_quad2 @@ -0,0 +1,13 @@ +# $Id: makefile_quad2,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +filein = -I/usr/include -I/home/zjcao/mpich-1.2.7p1/include + +LDLIBS = -L/home/zjcao/mpich-1.2.7p1/lib -lmpich -L/usr/lib -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -x f95-cpp-input +f90 = gfortran +f77 = gfortran +CXX = g++ +CC = gcc +CLINKER = g++ diff --git a/makefile_include/cpu part/makefile_shenteng b/makefile_include/cpu part/makefile_shenteng new file mode 100644 index 0000000..8f156c6 --- /dev/null +++ b/makefile_include/cpu part/makefile_shenteng @@ -0,0 +1,10 @@ +# $Id: makefile_shenteng,v 1.2 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/home_soft/soft/x86_64/mpi/mpich2/1.0.8p1/include + +LDLIBS = -L/home_soft/soft/x86_64/mpi/mpich2/1.0.8p1/lib -lmpich -lifcore + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 +f90appflags = -O2 +f90 = ifort +CXX = icpc +CLINKER = mpiicpc diff --git a/makefile_include/cpu part/makefile_ssc b/makefile_include/cpu part/makefile_ssc new file mode 100644 index 0000000..fac7be6 --- /dev/null +++ b/makefile_include/cpu part/makefile_ssc @@ -0,0 +1,12 @@ +#$Id: makefile_ssc,v 1.2 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/usr/include -I/home/compiler/mpi/mvapich/1.0/gcc.gfortran/include + +LDLIBS = -L/home/compiler/mpi/mvapich/1.0/gcc.gfortran/lib -lmpich -L/usr/lib64 -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +f77 = gfortran +CXX = g++ +CC = gcc +CLINKER = mpiCC diff --git a/makefile_include/cpu part/makefile_valgrind b/makefile_include/cpu part/makefile_valgrind new file mode 100644 index 0000000..314f068 --- /dev/null +++ b/makefile_include/cpu part/makefile_valgrind @@ -0,0 +1,15 @@ +#$Id: makefile_valgrind,v 1.1 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/usr/include -I/home/zjcao/soft/mpich/include + +LDLIBS = -L/opt/intel/Compiler/11.1/064/lib/intel64 -lifcore\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t -lmkl -lguide -lpthread\ + -L/home/zjcao/soft/mpich/lib -lmpich -lmpichcxx -lmpl + +CXXAPPFLAGS = -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -g -IPF-fp-strict +f90appflags = -pc64 -g -IPF-fp-strict +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = icpc +CC = icc -Wno-deprecated -DANSI_HEADERS -O2 -IPF-fp-strict +CLINKER = icpc diff --git a/makefile_include/gpu/makefile.inc.duzh b/makefile_include/gpu/makefile.inc.duzh new file mode 100644 index 0000000..40bc7d5 --- /dev/null +++ b/makefile_include/gpu/makefile.inc.duzh @@ -0,0 +1,31 @@ +# $Id: makefile_cao,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +#modified by duzh, Feb.3,2013 + +#filein define all the directories should be included for head files +filein = $(filein_old) $(filein_mpi) $(filein_cuda) +filein_old = -I/usr/include +filein_mpi= -I/usr/local/mpi-gcc/include +filein_cuda= -I/usr/local/cuda/cuda-4.0/include +filein_cuda_sdk= -I/usr/local/cuda/sdk-4.0/CUDALibraries/common/inc + + +#LDLIB defines all the libs should be included +LDLIBS = $(LDLIB_CUDA) $(LDLAB_MPI) $(LDLIB_FORTRAN) +LDLIB_CUDA= -L/usr/local/cuda/cuda-4.0/lib64 -lcudart +LDLIB_MPI= -L/usr/local/mpi-gcc/lib -lmpich +LDLIB_FORTRAN= -L/vol-th/software/gcc-4.6.1/lib64 -lgfortran + +#CXXAPPFLAGS defines all the flages for c plus compiler +#CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc -fopenmp +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +#f90appflags = -O2 -fopenmp +f90appflags = -O2 -x f95-cpp-input +f90 = gfortran +CXX = mpicxx +CLINKER = mpicxx + +#CUDA compile configure +Cu = nvcc +CUDA_LIB_PATH = -L/usr/local/cuda/cuda-4.0/lib64 -I/usr/local/cuda/sdk-4.0/CUDALibraries/common/inc +CUDA_APP_FLAGS = -O2 --ptxas-options=-v -arch compute_20 -code compute_20,sm_20 diff --git a/makefile_include/gpu/makefile.inc.tianhe b/makefile_include/gpu/makefile.inc.tianhe new file mode 100644 index 0000000..40bc7d5 --- /dev/null +++ b/makefile_include/gpu/makefile.inc.tianhe @@ -0,0 +1,31 @@ +# $Id: makefile_cao,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +#modified by duzh, Feb.3,2013 + +#filein define all the directories should be included for head files +filein = $(filein_old) $(filein_mpi) $(filein_cuda) +filein_old = -I/usr/include +filein_mpi= -I/usr/local/mpi-gcc/include +filein_cuda= -I/usr/local/cuda/cuda-4.0/include +filein_cuda_sdk= -I/usr/local/cuda/sdk-4.0/CUDALibraries/common/inc + + +#LDLIB defines all the libs should be included +LDLIBS = $(LDLIB_CUDA) $(LDLAB_MPI) $(LDLIB_FORTRAN) +LDLIB_CUDA= -L/usr/local/cuda/cuda-4.0/lib64 -lcudart +LDLIB_MPI= -L/usr/local/mpi-gcc/lib -lmpich +LDLIB_FORTRAN= -L/vol-th/software/gcc-4.6.1/lib64 -lgfortran + +#CXXAPPFLAGS defines all the flages for c plus compiler +#CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc -fopenmp +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +#f90appflags = -O2 -fopenmp +f90appflags = -O2 -x f95-cpp-input +f90 = gfortran +CXX = mpicxx +CLINKER = mpicxx + +#CUDA compile configure +Cu = nvcc +CUDA_LIB_PATH = -L/usr/local/cuda/cuda-4.0/lib64 -I/usr/local/cuda/sdk-4.0/CUDALibraries/common/inc +CUDA_APP_FLAGS = -O2 --ptxas-options=-v -arch compute_20 -code compute_20,sm_20 diff --git a/makefile_include/gpu/makefile_alps b/makefile_include/gpu/makefile_alps new file mode 100644 index 0000000..c63086c --- /dev/null +++ b/makefile_include/gpu/makefile_alps @@ -0,0 +1,17 @@ +# $Id: makefile_alps,v 1.1 2012/11/08 11:54:00 zjcao Exp $ +#for ALPS PGI/openmpi + +filein = +LDLIBS = -lpgf90 -lpgf902 -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi +# you can also replace the above long list with just "-lpgf90libs" + + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc +f90appflags = -O2 -Mpreprocess + +f90 = mpif90 +f77 = +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx + diff --git a/makefile_include/gpu/makefile_altix b/makefile_include/gpu/makefile_altix new file mode 100644 index 0000000..b0a5fac --- /dev/null +++ b/makefile_include/gpu/makefile_altix @@ -0,0 +1,13 @@ +# $Id: makefile_altix,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by altix.sccas.cn +filein = -I/usr/include + +LDLIBS = -L/usr/lib -L/opt/intel/fc/10.1.008/lib -lmpi -lifcore -limf -lintrins + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 +f90appflags = -O2 +f90 = ifort +f77 = ifort +CXX = icpc +CC = icc +CLINKER = icpc diff --git a/makefile_include/gpu/makefile_bnu b/makefile_include/gpu/makefile_bnu new file mode 100644 index 0000000..57d0866 --- /dev/null +++ b/makefile_include/gpu/makefile_bnu @@ -0,0 +1,15 @@ +#$Id: makefile_bnu,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +# bnu has two compiler systems +# one is altix330 +# one is chess which is used here +filein = -I/usr/chess/mpich-gm-gcc34-1.2.6..14b/include + +LDLIBS = -L/opt/intel/fce/9.0/lib -lifcore -L/usr/chess/mpich-gm-gcc34-1.2.6..14b/lib64 -lmpich + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -O2 +f90appflags = -O2 +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = g++ +CC = gcc -Wno-deprecated -DANSI_HEADERS -O2 +CLINKER = g++ diff --git a/makefile_include/gpu/makefile_cao b/makefile_include/gpu/makefile_cao new file mode 100644 index 0000000..5104364 --- /dev/null +++ b/makefile_include/gpu/makefile_cao @@ -0,0 +1,62 @@ +# $Id: makefile_cao,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +filein = -I/home/zjcao/local/include + +LDLIBS = -L/home/zjcao/local/lib -lmpich -L/usr/lib -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +CXX = g++ +CLINKER = g++ +.SUFFIXES: .o .f90 .C + +.f90.o: + $(f90) $(f90appflags) -c $< -o $@ + +.C.o: + ${CXX} ${CXXAPPFLAGS} -c $< ${filein} -o $@ + +# Input files +C++FILES = ABE.o cgh.o grid.o misc.o var.o var_list.o gsl.o operate_gsl.o\ + bssn_class.o monitor.o surface_integral.o interpolation_cgh.o\ + moving_box.o + +F90FILES = initial_puncture.o prolongrestrict_cell.o polynomial_interpolation.o\ + fmisc.o bssn.o cell_diff4.o rungekutta4_bssn.o sommerfeld_bssn.o\ + rungekutta4_lapse_shift.o sommerfeld_lapse_shift.o\ + enforce_algebra.o alwind_4th_9.o gauge_condition_9.o\ + bssn_constraint.o fadmquantites_bssn.o getnp4.o kodiss.o + +bssn_class.o: bssn_class.h cgh.h grid.h misc.h var.h gsl.h initial_puncture.h\ + prolongrestrict.h bssn.h rungekutta4_bssn.h sommerfeld_bssn.h\ + rungekutta4_lapse_shift.h sommerfeld_lapse_shift.h\ + enforce_algebra.h alwind_9.h gauge_condition_9.h operate_gsl.h\ + monitor.h surface_integral.h getnp4.h moving_box.h kodiss.h + +cgh.o: cgh.h + +grid.o: grid.h + +misc.o: misc.h + +var.o: var.h + +var_list.o: var.h var_list.h + +gsl.o: gsl.h + +operate_gsl.o: operate_gsl.h gsl.h + +bssn_class.o: bssn_class.h + +surface_integral.o: fadmquantites_bssn.h derivatives.h interpolation_cgh.h + +ABE.o: bssn_class.h + +interpolation_cgh.o: interpolation_cgh.h + +moving_box.o: moving_box.h + +ABE: $(C++FILES) $(F90FILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES) $(F90FILES) $(LDLIBS) diff --git a/makefile_include/gpu/makefile_ibm1350 b/makefile_include/gpu/makefile_ibm1350 new file mode 100644 index 0000000..4e0b123 --- /dev/null +++ b/makefile_include/gpu/makefile_ibm1350 @@ -0,0 +1,12 @@ +#$Id: makefile_ibm1350,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +filein = -I/opt/vltmpi/OPENIB/mpi.pgcc.rsh/include -I/opt/pgi/linux86-64/6.2/include + +LDLIBS = -L/opt/vltmpi/OPENIB/mpi.pgcc.rsh/lib -lmpich -L/usr/local/ofed/lib64 -libverbs -L/opt/pgi/linux86-64/6.2/lib -lpgf90 -lpgf902 -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi -lstdc++ + +CXXAPPFLAGS = -O2 -fast --no_warnings -DUNDERSCORE -DWant_c_files -DANSI_HEADERS -Dfortran3 -Dnewc +f90appflags = -O3 -fast +f90 = pgf90 +f77 = pgf77 -O3 -fast +CXX = pgCC +CC = pgcc -O2 -fast --no_warnings -DUNDERSCORE -DWant_c_files -DANSI_HEADERS +CLINKER = pgCC diff --git a/makefile_include/gpu/makefile_icm b/makefile_include/gpu/makefile_icm new file mode 100644 index 0000000..7d1636c --- /dev/null +++ b/makefile_include/gpu/makefile_icm @@ -0,0 +1,14 @@ +#$Id: makefile_icm,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +filein = + +LDLIBS = -L/opt/intel/Compiler/11.1/064/lib/intel64 -lifcore\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t -lmkl -lguide -lpthread + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -fpp +f90 = mpif90 +f77 = mpif77 +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx diff --git a/makefile_include/gpu/makefile_itp b/makefile_include/gpu/makefile_itp new file mode 100644 index 0000000..621e7e0 --- /dev/null +++ b/makefile_include/gpu/makefile_itp @@ -0,0 +1,12 @@ +#$Id: makefile_itp,v 1.1 2013/01/26 11:23:09 zjcao Exp $ +filein = + +LDLIBS = -lifcore + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -fpp +f90 = mpif90 +f77 = mpif77 +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx diff --git a/makefile_include/gpu/makefile_jtao b/makefile_include/gpu/makefile_jtao new file mode 100644 index 0000000..069632a --- /dev/null +++ b/makefile_include/gpu/makefile_jtao @@ -0,0 +1,10 @@ +filein = + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -cpp -ffree-line-length-256 +LDLIBS = -lgfortran +f90 = mpif90 +f77 = mpif77 +CXX = mpicxx +CC = mpicc +CLINKER = mpicxx diff --git a/makefile_include/gpu/makefile_makoto b/makefile_include/gpu/makefile_makoto new file mode 100644 index 0000000..fc18d0b --- /dev/null +++ b/makefile_include/gpu/makefile_makoto @@ -0,0 +1,62 @@ +# $Id: makefile_makoto,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by makoto +filein = -I/opt/mpich127_gnu/include + +LDLIBS = -L/opt/mpich127_gnu/lib -lmpich -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +CXX = g++ +CLINKER = g++ +.SUFFIXES: .o .f90 .C + +.f90.o: + $(f90) $(f90appflags) -c $< -o $@ + +.C.o: + ${CXX} ${CXXAPPFLAGS} -c $< ${filein} -o $@ + +# Input files +C++FILES = ABE.o cgh.o grid.o misc.o var.o var_list.o gsl.o operate_gsl.o\ + bssn_class.o monitor.o surface_integral.o interpolation_cgh.o\ + moving_box.o + +F90FILES = initial_puncture.o prolongrestrict_cell.o polynomial_interpolation.o\ + fmisc.o bssn.o cell_diff4.o rungekutta4_bssn.o sommerfeld_bssn.o\ + rungekutta4_lapse_shift.o sommerfeld_lapse_shift.o\ + enforce_algebra.o alwind_4th_9.o gauge_condition_9.o\ + bssn_constraint.o fadmquantites_bssn.o getnp4.o kodiss.o + +bssn_class.o: bssn_class.h cgh.h grid.h misc.h var.h gsl.h initial_puncture.h\ + prolongrestrict.h bssn.h rungekutta4_bssn.h sommerfeld_bssn.h\ + rungekutta4_lapse_shift.h sommerfeld_lapse_shift.h\ + enforce_algebra.h alwind_9.h gauge_condition_9.h operate_gsl.h\ + monitor.h surface_integral.h getnp4.h moving_box.h kodiss.h + +cgh.o: cgh.h + +grid.o: grid.h + +misc.o: misc.h + +var.o: var.h + +var_list.o: var.h var_list.h + +gsl.o: gsl.h + +operate_gsl.o: operate_gsl.h gsl.h + +bssn_class.o: bssn_class.h + +surface_integral.o: fadmquantites_bssn.h derivatives.h interpolation_cgh.h + +ABE.o: bssn_class.h + +interpolation_cgh.o: interpolation_cgh.h + +moving_box.o: moving_box.h + +ABE: $(C++FILES) $(F90FILES) + $(CLINKER) $(CXXAPPFLAGS) -o $@ $(C++FILES) $(F90FILES) $(LDLIBS) diff --git a/makefile_include/gpu/makefile_nchc b/makefile_include/gpu/makefile_nchc new file mode 100644 index 0000000..936ef3c --- /dev/null +++ b/makefile_include/gpu/makefile_nchc @@ -0,0 +1,10 @@ +#$Id: makefile_nchc,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +LDLIBS = -lxlf90 -lC -lm +# +CXXAPPFLAGS = -q64 -O2 -qstrict -qarch=auto -qtune=auto -qcache=auto -qlanglvl=oldmath -lxlf90 -lm -lC -Dfortran1 -Dnewc +f90appflags = -q64 -O3 -qstrict -qarch=auto -qtune=auto -qcache=auto -qsuffix=f=f90 +f90 = mpxlf90_r +f77 = mpxlf77_r +CXX = mpCC_r +CC = mpcc_r +CLINKER = mpCC_r diff --git a/makefile_include/gpu/makefile_ncku b/makefile_include/gpu/makefile_ncku new file mode 100644 index 0000000..45eba91 --- /dev/null +++ b/makefile_include/gpu/makefile_ncku @@ -0,0 +1,15 @@ +# $Id: makefile_ncku,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by NCKU's cluster sge +filein = -I/ap/pgi/linux86-64/6.2/mpi/mpich/include + +LDLIBS = -lblas -L/ap/pgi/linux86-64/6.2/mpi/mpich/lib -lmpich \ + -L/ap/pgi/linux86-64/6.2/lib -lpgf90 -lpgf902 \ + -lpgf90rtl -lpgf90_rpm1 -lpgftnrtl -lpghpf -lpghpf2 -lpghpf_mpi -lstdc++ + +CXXAPPFLAGS = -O2 -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = pgf90 +f77 = pgf77 +CXX = pgCC +CC = pgcc +CLINKER = pgCC -Bstatic diff --git a/makefile_include/gpu/makefile_quad1 b/makefile_include/gpu/makefile_quad1 new file mode 100644 index 0000000..01572c6 --- /dev/null +++ b/makefile_include/gpu/makefile_quad1 @@ -0,0 +1,15 @@ +# $Id: makefile_quad1,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by quad1 +#used for memorry leak debuging +#~/soft/bin/valgrind --tool=memcheck --leak-check=full /home/jpyu/local/mpich127_64/bin/mpirun -np 4 -machinefile ../machines ABE >& out.log +filein = -I/home/jpyu/local/mpich127_64/include + +LDLIBS = -L/home/jpyu/local/mpich127_64/lib -lmpich -L/opt/intel/fce/10.1.018/lib -lifcore + +CXXAPPFLAGS = -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -g -IPF-fp-strict +f90appflags = -pc64 -g -IPF-fp-strict +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = icpc +CC = icc -Wno-deprecated -DANSI_HEADERS -O2 -IPF-fp-strict +CLINKER = icpc diff --git a/makefile_include/gpu/makefile_quad2 b/makefile_include/gpu/makefile_quad2 new file mode 100644 index 0000000..2ed5cc6 --- /dev/null +++ b/makefile_include/gpu/makefile_quad2 @@ -0,0 +1,13 @@ +# $Id: makefile_quad2,v 1.2 2012/04/03 10:49:56 zjcao Exp $ +#used by mydesktop +filein = -I/usr/include -I/home/zjcao/mpich-1.2.7p1/include + +LDLIBS = -L/home/zjcao/mpich-1.2.7p1/lib -lmpich -L/usr/lib -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 -x f95-cpp-input +f90 = gfortran +f77 = gfortran +CXX = g++ +CC = gcc +CLINKER = g++ diff --git a/makefile_include/gpu/makefile_shenteng b/makefile_include/gpu/makefile_shenteng new file mode 100644 index 0000000..05ef446 --- /dev/null +++ b/makefile_include/gpu/makefile_shenteng @@ -0,0 +1,10 @@ +# $Id: makefile_shenteng,v 1.2 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/home_soft/soft/x86_64/mpi/mpich2/1.0.8p1/include + +LDLIBS = -L/home_soft/soft/x86_64/mpi/mpich2/1.0.8p1/lib -lmpich -lifcore + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 +f90appflags = -O2 +f90 = ifort +CXX = icpc +CLINKER = mpiicpc diff --git a/makefile_include/gpu/makefile_ssc b/makefile_include/gpu/makefile_ssc new file mode 100644 index 0000000..6d4ccdf --- /dev/null +++ b/makefile_include/gpu/makefile_ssc @@ -0,0 +1,12 @@ +#$Id: makefile_ssc,v 1.2 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/usr/include -I/home/compiler/mpi/mvapich/1.0/gcc.gfortran/include + +LDLIBS = -L/home/compiler/mpi/mvapich/1.0/gcc.gfortran/lib -lmpich -L/usr/lib64 -lgfortran + +CXXAPPFLAGS = -O2 -Wno-deprecated -Dfortran3 -Dnewc +f90appflags = -O2 +f90 = gfortran +f77 = gfortran +CXX = g++ +CC = gcc +CLINKER = mpiCC diff --git a/makefile_include/gpu/makefile_valgrind b/makefile_include/gpu/makefile_valgrind new file mode 100644 index 0000000..229b046 --- /dev/null +++ b/makefile_include/gpu/makefile_valgrind @@ -0,0 +1,15 @@ +#$Id: makefile_valgrind,v 1.1 2012/04/03 10:49:57 zjcao Exp $ +filein = -I/usr/include -I/home/zjcao/soft/mpich/include + +LDLIBS = -L/opt/intel/Compiler/11.1/064/lib/intel64 -lifcore\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t\ + -L/opt/intel/Compiler/11.1/064/mkl/lib/em64t -lmkl -lguide -lpthread\ + -L/home/zjcao/soft/mpich/lib -lmpich -lmpichcxx -lmpl + +CXXAPPFLAGS = -Dfortran3 -Dnewc -Wno-deprecated -DANSI_HEADERS -g -IPF-fp-strict +f90appflags = -pc64 -g -IPF-fp-strict +f90 = ifort -fpp +f77 = ifort -fpp -fixed +CXX = icpc +CC = icc -Wno-deprecated -DANSI_HEADERS -O2 -IPF-fp-strict +CLINKER = icpc diff --git a/makefile_include/gpu/note_step.txt b/makefile_include/gpu/note_step.txt new file mode 100644 index 0000000..4a998b9 --- /dev/null +++ b/makefile_include/gpu/note_step.txt @@ -0,0 +1,12 @@ +#if (PSTR == 0) 1604 + #if 1 1605 + step 1606 + #else 2358 + step 2360 + #endif 3035 +#elif (PSTR == 1) 3036 + step{ 3037 + { + } 3471 + + void bssn_class::SHStep() diff --git a/numerical_grid.py b/numerical_grid.py new file mode 100755 index 0000000..d4e583e --- /dev/null +++ b/numerical_grid.py @@ -0,0 +1,674 @@ + +################################################# +## +## This file includes the numerical grid needed in numerical relativity +## author: xiaoqu +## 2024/03/20 +## 2025/09/14 modified +## +################################################# + +import numpy +import matplotlib.pyplot as plt +import os + +import AMSS_NCKU_Input as input_data +## import print_information + +################################################# + +# set the information of black hole puncture + +puncture = numpy.zeros( (input_data.puncture_number,3) ) + +print( ) +print( " Setting Puncture's position and momentum " ) +print( ) + +################################################# + +## setting puncture position + +## read resetted puncture position if puncture_data_set is Automatically-BBH + +if (input_data.puncture_data_set == "Automatically-BBH" ): + + import generate_TwoPuncture_input + + for i in range(input_data.puncture_number): + if (i<=1): + puncture[i] = generate_TwoPuncture_input.position_BH[i] + else: + puncture[i] = input_data.position_BH[i] + +## read in puncture position directly if puncture_data_set is Manually + +elif (input_data.puncture_data_set == "Manually" ): + + puncture = input_data.position_BH + +else: + + print( ) + print( " Found Error in setting Puncture's position and momentum !!! " ) + print( ) + +################################################# + +## output grid information + +print( ) +print( " Wirte Down The Grid Information " ) +print( ) +print( " Number of Total Grid Level = ", input_data.grid_level ) +print( " Number of Static Grid Level = ", input_data.static_grid_level ) +print( " Number of Moving Grid Level = ", input_data.moving_grid_level ) +## print( " Number of Points in Each Grid Level = ", input_data.grid_number ) +print( ) + +################################################# + +print( ) +print( " Setting the demanded numerical grid " ) +print( ) + +################################################# + +## initialize the grid information + +## initialize the grid min and max points and grid number + +Grid_X_Min = numpy.zeros( (input_data.grid_level) ) +Grid_X_Max = numpy.zeros( (input_data.grid_level) ) +Grid_Y_Min = numpy.zeros( (input_data.grid_level) ) +Grid_Y_Max = numpy.zeros( (input_data.grid_level) ) +Grid_Z_Min = numpy.zeros( (input_data.grid_level) ) +Grid_Z_Max = numpy.zeros( (input_data.grid_level) ) + +Grid_Resolution = numpy.zeros( input_data.grid_level ) + +largest_box_X_Max = input_data.largest_box_xyz_max[0] +largest_box_Y_Max = input_data.largest_box_xyz_max[1] +largest_box_Z_Max = input_data.largest_box_xyz_max[2] +largest_box_X_Min = input_data.largest_box_xyz_min[0] +largest_box_Y_Min = input_data.largest_box_xyz_min[1] +largest_box_Z_Min = input_data.largest_box_xyz_min[2] + +# define integer number as the grid number in each direction of static grid at each level +static_grid_number_x = input_data.static_grid_number +static_grid_number_y = int( (largest_box_Y_Max - largest_box_Y_Min) * ( static_grid_number_x / (largest_box_X_Max-largest_box_X_Min) ) ) +static_grid_number_z = int( (largest_box_Z_Max - largest_box_Z_Min) * ( static_grid_number_x / (largest_box_X_Max-largest_box_X_Min) ) ) + +# define integer array as the grid number in each direction of moving grid at each level +moving_grid_number = input_data.moving_grid_number + +################################################# + +## initialize static grids + +# adjust the grid number in each direction to be even number +# print(static_grid_number_x % 2) +if ( (static_grid_number_x % 2) != 0) : + static_grid_number_x = static_grid_number_x + 1 +if ( (static_grid_number_y % 2) != 0) : + static_grid_number_y = static_grid_number_y + 1 +if ( (static_grid_number_z % 2) != 0) : + static_grid_number_z = static_grid_number_z + 1 +# require the grid number in each direction to be the multiple of 4 for better alignment between moving and static grids + +if ( (static_grid_number_x % 4) != 0) : + static_grid_number_x = static_grid_number_x + 2 +if ( (static_grid_number_y % 4) != 0) : + static_grid_number_y = static_grid_number_y + 2 +if ( (static_grid_number_z % 4) != 0) : + static_grid_number_z = static_grid_number_z + 2 +''' +# require the grid number in each direction to be the multiple of 8 for better alignment between moving and static grids +if ( (static_grid_number_x % 8) != 0) : + static_grid_number_x = static_grid_number_x + 4 +if ( (static_grid_number_y % 8) != 0) : + static_grid_number_y = static_grid_number_y + 4 +if ( (static_grid_number_z % 8) != 0) : + static_grid_number_z = static_grid_number_z + 4 +''' + +## Define real arrays, dimension grid_number * static_grid_level, as the X Y Z coordinates of each level of static grid +Static_Grid_X = numpy.zeros( (input_data.static_grid_level, static_grid_number_x+1) ) +Static_Grid_Y = numpy.zeros( (input_data.static_grid_level, static_grid_number_y+1) ) +Static_Grid_Z = numpy.zeros( (input_data.static_grid_level, static_grid_number_z+1) ) + +################################################# + +## initialize moving grids + +## define real arrays, dimension grid_number * puncture_number * moving_grid_level, as the X Y Z coordinates of each level of moving grid +Moving_Grid_X = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number, input_data.moving_grid_number+1) ) +Moving_Grid_Y = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number, input_data.moving_grid_number+1) ) +Moving_Grid_Z = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number, input_data.moving_grid_number+1) ) + +################################################# + +## initialize the min and max grid points of moving grids + +Moving_Grid_X_Min = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) +Moving_Grid_X_Max = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) +Moving_Grid_Y_Min = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) +Moving_Grid_Y_Max = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) +Moving_Grid_Z_Min = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) +Moving_Grid_Z_Max = numpy.zeros( (input_data.moving_grid_level, input_data.puncture_number) ) + +################################################# + +## set the grid resolution of each level + +for i in range(input_data.static_grid_level) : + if i==0: + Grid_Resolution[i] = ( largest_box_X_Max - largest_box_X_Min ) / static_grid_number_x + else: + Grid_Resolution[i] = Grid_Resolution[i-1] / input_data.devide_factor + +for j in range(input_data.moving_grid_level) : + i = j + input_data.static_grid_level + Grid_Resolution[i] = Grid_Resolution[i-1] / input_data.devide_factor + +################################################# + +## according to the input file, set the minimum and maximum grid points of each level static patch grid + +## set the maximum and minimum grid points of the first static patch grid +Grid_X_Min[0] = largest_box_X_Min +Grid_X_Max[0] = largest_box_X_Max +Grid_Y_Min[0] = largest_box_Y_Min +Grid_Y_Max[0] = largest_box_Y_Max +Grid_Z_Min[0] = largest_box_Z_Min +Grid_Z_Max[0] = largest_box_Z_Max +## recalculate Grid_Y_Max[0] to ensure the same resolution in xyz directions +Grid_Y_Max[0] = Grid_Y_Min[0] + Grid_Resolution[0] * static_grid_number_y +Grid_Z_Max[0] = Grid_Z_Min[0] + Grid_Resolution[0] * static_grid_number_z +## adjust grid boundary according to the symmetry condition +if ( input_data.Symmetry == "equatorial-symmetry" ): + Grid_Z_Min[0] = - Grid_Resolution[0] * static_grid_number_z / 2 + Grid_Z_Max[0] = + Grid_Resolution[0] * static_grid_number_z / 2 +elif ( input_data.Symmetry == "octant-symmetry" ): + Grid_X_Min[0] = - Grid_Resolution[0] * static_grid_number_x / 2 + Grid_X_Max[0] = + Grid_Resolution[0] * static_grid_number_x / 2 + Grid_Y_Min[0] = - Grid_Resolution[0] * static_grid_number_y / 2 + Grid_Y_Max[0] = + Grid_Resolution[0] * static_grid_number_y / 2 + Grid_Z_Min[0] = - Grid_Resolution[0] * static_grid_number_z / 2 + Grid_Z_Max[0] = + Grid_Resolution[0] * static_grid_number_z / 2 + +## print( " Grid_Y_Max[0] = ", Grid_Y_Max[0] ) + + +print( " adjusting the static gird points, making the original point (0,0,0) to the static gird points " ) +print( ) + +## set maximum and minimum grid points of other static patch grids +for i in range(input_data.static_grid_level-1) : + ## if the coordinate origin is not on the outermost static grid, adjust the outermost static grid to make the origin on the grid + if i==0: + for nn in range(static_grid_number_x): + if (Grid_X_Min[i] + nn*Grid_Resolution[i]) < 0.0 < (Grid_X_Min[i] + (nn+1)*Grid_Resolution[i]): + print( " before adjust: Grid X_min = ", Grid_X_Min[i] ) + print( " before adjust: Grid X_max = ", Grid_X_Max[i] ) + grid_adjust = Grid_X_Min[i] + (nn+1)*Grid_Resolution[i] + Grid_X_Min[i] = Grid_X_Min[i] - grid_adjust + Grid_X_Max[i] = Grid_X_Max[i] - grid_adjust + print( " after adjust: Grid X_min = ", Grid_X_Min[i] ) + print( " after adjust: Grid X_max = ", Grid_X_Max[i] ) + for nn in range(static_grid_number_y): + if (Grid_Y_Min[i] + nn*Grid_Resolution[i]) < 0.0 < (Grid_Y_Min[i] + (nn+1)*Grid_Resolution[i]): + print( " before adjust: Grid Y_min = ", Grid_Y_Min[i] ) + print( " before adjust: Grid Y_max = ", Grid_Y_Max[i] ) + grid_adjust = Grid_Y_Min[i] + (nn+1)*Grid_Resolution[i] + Grid_Y_Min[i] = Grid_Y_Min[i] - grid_adjust + Grid_Y_Max[i] = Grid_Y_Max[i] - grid_adjust + print( " after adjust: Grid Y_min = ", Grid_Y_Min[i] ) + print( " after adjust: Grid Y_max = ", Grid_Y_Max[i] ) + for nn in range(static_grid_number_z): + if (Grid_Z_Min[i] + nn*Grid_Resolution[i]) < 0.0 < (Grid_Z_Min[i] + (nn+1)*Grid_Resolution[i]): + print( " before adjust: Grid Z_min = ", Grid_Z_Min[i] ) + print( " before adjust: Grid Z_max = ", Grid_Z_Max[i] ) + grid_adjust = Grid_X_Min[i] + (nn+1)*Grid_Resolution[i] + Grid_Z_Min[i] = Grid_Z_Min[i] - grid_adjust + Grid_Z_Max[i] = Grid_Z_Max[i] - grid_adjust + print( " after adjust: Grid Z_min = ", Grid_Z_Min[i] ) + print( " after adjust: Grid Z_max = ", Grid_Z_Max[i] ) + ## the maximum and minimum grid points equal to the previous grid level divided by devide_factor + Grid_X_Min[i+1] = Grid_X_Min[i] / input_data.devide_factor + Grid_X_Max[i+1] = Grid_X_Max[i] / input_data.devide_factor + Grid_Y_Min[i+1] = Grid_Y_Min[i] / input_data.devide_factor + Grid_Y_Max[i+1] = Grid_Y_Max[i] / input_data.devide_factor + Grid_Z_Min[i+1] = Grid_Z_Min[i] / input_data.devide_factor + Grid_Z_Max[i+1] = Grid_Z_Max[i] / input_data.devide_factor + + +## add adjust factor to ensure the moving grid boundary aligns with static grid boundary +adjust_factor = input_data.moving_grid_number / input_data.static_grid_number + +## set maximum and minimum grid points of the first moving patch grid +i = input_data.static_grid_level +if (i < input_data.grid_level): + Grid_X_Min[i] = ( Grid_X_Min[i-1] / input_data.devide_factor ) * adjust_factor + Grid_X_Max[i] = - Grid_X_Min[i] + # Grid_X_Max[i] = ( Grid_X_Max[i-1] / input_data.devide_factor ) * adjust_factor + ## original setting + # Grid_Y_Min[i] = ( Grid_Y_Min[i-1] / input_data.devide_factor ) * adjust_factor + # Grid_Y_Max[i] = ( Grid_Y_Max[i-1] / input_data.devide_factor ) * adjust_factor + # Grid_Z_Min[i] = ( Grid_Z_Min[i-1] / input_data.devide_factor ) * adjust_factor + # Grid_Z_Max[i] = ( Grid_Z_Max[i-1] / input_data.devide_factor ) * adjust_factor + ## current setting to ensure moving grid is cubic + Grid_Y_Min[i] = Grid_X_Min[i] + Grid_Y_Max[i] = Grid_X_Max[i] + Grid_Z_Min[i] = Grid_X_Min[i] + Grid_Z_Max[i] = Grid_X_Max[i] + + # print( " Grid_X_Max[i] = ", Grid_X_Max[i] ) + # print( " Grid_Y_Max[i] = ", Grid_Y_Max[i] ) + +## set maximum and minimum grid points of moving patch grids +for j in range(input_data.moving_grid_level-1) : + k = input_data.static_grid_level + j + Grid_X_Min[k+1] = Grid_X_Min[k] / input_data.devide_factor + Grid_X_Max[k+1] = Grid_X_Max[k] / input_data.devide_factor + Grid_Y_Min[k+1] = Grid_Y_Min[k] / input_data.devide_factor + Grid_Y_Max[k+1] = Grid_Y_Max[k] / input_data.devide_factor + Grid_Z_Min[k+1] = Grid_Z_Min[k] / input_data.devide_factor + Grid_Z_Max[k+1] = Grid_Z_Max[k] / input_data.devide_factor + +## set maximum and minimum grid points of the outermost shell patch grid + +Shell_R_Resolution = Grid_Resolution[0] +Shell_R_Min = largest_box_X_Max +Shell_R_Max = Shell_R_Min + Grid_Resolution[0] * input_data.shell_grid_number[2] + +################################################# + + +################################################# + +## set grid points position of each level + +################################################# + +## setting static grid points position + +## linear grid points + +if input_data.static_grid_type == 'Linear' : + + for i in range(input_data.static_grid_level): + Static_Grid_X[i] = numpy.linspace( Grid_X_Min[i], Grid_X_Max[i], static_grid_number_x+1 ) + Static_Grid_Y[i] = numpy.linspace( Grid_Y_Min[i], Grid_Y_Max[i], static_grid_number_y+1 ) + Static_Grid_Z[i] = numpy.linspace( Grid_Z_Min[i], Grid_Z_Max[i], static_grid_number_z+1 ) + # use numpy to set linear grid points, parameters are Rmin, Rmax, Rnum + # Note that if it is linear grid points, the maximum grid point coordinate is GridMax; if it is logarithmic grid points, the maximum grid point coordinate is e^{GridMax} + +else: + print( ) + print( " Static Grid Error: Grid Type is Undifined !!!!!!! " ) + print( ) + +################################################# + +## set moving grid points position + +print( ) +print( " adjusting the moving gird points, ensuring the alliance of moving grids points and static grids points " ) +print( ) + +## adjust puncture position to ensure moving grid boundary aligns with static grid boundary +adjust_puncture = numpy.zeros( (input_data.puncture_number, 3) ) + +## linear grid points + +if ( input_data.moving_grid_type == "Linear" ): + + ## circle over moving grid level + for j in range(input_data.moving_grid_level) : + + i = j + input_data.static_grid_level + + ## circle over puncture number + for k in range(input_data.puncture_number) : + + ## adjust the puncture position + if j==0 : + + level0 = input_data.static_grid_level - 1 ## add new variable to avoid long code + + for m in range(static_grid_number_x) : + if ( Static_Grid_X[level0, m] <= puncture[k,0] <= Static_Grid_X[level0, m+1] ): + if ( abs( puncture[k,0] - Static_Grid_X[level0, m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,0] = Static_Grid_X[level0, m] + elif ( abs( puncture[k,0] - Static_Grid_X[level0, m+1 ] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,0] = Static_Grid_X[level0, m+1 ] + else: + adjust_puncture[k,0] = ( Static_Grid_X[level0, m] + Static_Grid_X[level0, m+1] ) / 2.0 + + for m in range(static_grid_number_y) : + if ( Static_Grid_Y[level0, m] <= puncture[k,1] <= Static_Grid_Y[level0, m+1] ): + if ( abs( puncture[k,1] - Static_Grid_Y[level0, m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,1] = Static_Grid_Y[level0, m] + elif ( abs( puncture[k,1] - Static_Grid_Y[level0, m+1] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,1] = Static_Grid_Y[level0, m+1] + else: + adjust_puncture[k,1] = ( Static_Grid_Y[level0, m] + Static_Grid_Y[level0, m+1] ) / 2.0 + + for m in range(static_grid_number_z) : + if ( Static_Grid_Z[level0, m] <= puncture[k,2] <= Static_Grid_Z[level0, m+1] ): + if ( abs( puncture[k,2] - Static_Grid_Z[level0, m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,2] = Static_Grid_Z[level0, m] + elif ( abs( puncture[k,2] - Static_Grid_Z[level0, m+1] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,2] = Static_Grid_Z[level0, m+1] + else: + adjust_puncture[k,2] = ( Static_Grid_Z[level0, m] + Static_Grid_Z[level0, m+1] ) / 2.0 + + + elif j>0 : + for m in range(moving_grid_number) : + + if ( Moving_Grid_X[j-1,k,m] <= puncture[k,0] <= Moving_Grid_X[j-1,k,m+1] ): + if ( abs( puncture[k,0] - Moving_Grid_X[j-1,k,m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,0] = Moving_Grid_X[j-1,k,m] + elif ( abs( puncture[k,0] - Moving_Grid_X[j-1,k,m+1] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,0] = Moving_Grid_X[j-1,k,m+1] + else: + adjust_puncture[k,0] = ( Moving_Grid_X[j-1,k,m] + Moving_Grid_X[j-1,k,m+1] ) / 2.0 + + if ( Moving_Grid_Y[j-1,k,m] <= puncture[k,1] <= Moving_Grid_Y[j-1,k,m+1] ): + if ( abs( puncture[k,1] - Moving_Grid_Y[j-1,k,m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,1] = Moving_Grid_Y[j-1,k,m] + elif ( abs( puncture[k,1] - Moving_Grid_Y[j-1,k,m+1] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,1] = Moving_Grid_Y[j-1,k,m+1] + else: + adjust_puncture[k,1] = ( Moving_Grid_Y[j-1,k,m] + Moving_Grid_Y[j-1,k,m+1] ) / 2.0 + + if ( Moving_Grid_Z[j-1,k,m] <= puncture[k,2] <= Moving_Grid_Z[j-1,k,m+1] ): + if ( abs( puncture[k,2] - Moving_Grid_Z[j-1,k,m] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,2] = Moving_Grid_Z[j-1,k,m] + elif ( abs( puncture[k,2] - Moving_Grid_Z[j-1,k,m+1] ) < ( Grid_Resolution[i]/2.0 ) ): + adjust_puncture[k,2] = Moving_Grid_Z[j-1,k,m+1] + else: + adjust_puncture[k,2] = ( Moving_Grid_Z[j-1,k,m] + Moving_Grid_Z[j-1,k,m+1] ) / 2.0 + + else: + print( " Adjusting puncture position to compatable with coaser grid ! Error !!! " ) + ## adjusted puncture position is done + + ## to avoid error in C++ input reading + ## small number as 1e-10 set to 0.00 with 2 decimal places + if ( abs(adjust_puncture[k,0]) < 1e-10 ): + adjust_puncture[k,0] = 0.00 + # adjust_puncture[k,0] = f"{ adjust_puncture[k,0]:.2f } + if ( abs(adjust_puncture[k,1]) < 1e-10 ): + adjust_puncture[k,1] = 0.00 + # adjust_puncture[k,1] = f"{ adjust_puncture[k,1]:.2f } + if ( abs(adjust_puncture[k,2]) < 1e-10 ): + adjust_puncture[k,2] = 0.00 + # adjust_puncture[k,2] = f"{ adjust_puncture[k,2]:.2f } + + # the j-th moving grid's XYZ min (or max) = the i-th grid's XYZ min (or max) + the k-th puncture's XYZ position + Moving_Grid_X_Min[j,k] = adjust_puncture[k,0] + Grid_X_Min[i] + Moving_Grid_X_Max[j,k] = adjust_puncture[k,0] + Grid_X_Max[i] + Moving_Grid_Y_Min[j,k] = adjust_puncture[k,1] + Grid_Y_Min[i] + Moving_Grid_Y_Max[j,k] = adjust_puncture[k,1] + Grid_Y_Max[i] + Moving_Grid_Z_Min[j,k] = adjust_puncture[k,2] + Grid_Z_Min[i] + Moving_Grid_Z_Max[j,k] = adjust_puncture[k,2] + Grid_Z_Max[i] + + ## to avoid error in C++ input reading + ## small number as 1e-10 set to 0.00 with 2 decimal places + if ( abs(Moving_Grid_X_Min[j,k]) < 1e-10 ): + Moving_Grid_X_Min[j,k] = 0.00 + if ( abs(Moving_Grid_X_Max[j,k]) < 1e-10 ): + Moving_Grid_X_Max[j,k] = 0.00 + + if ( abs(Moving_Grid_Y_Min[j,k]) < 1e-10 ): + Moving_Grid_Y_Min[j,k] = 0.00 + if ( abs(Moving_Grid_Y_Max[j,k]) < 1e-10 ): + Moving_Grid_Y_Max[j,k] = 0.00 + + if ( abs(Moving_Grid_Z_Min[j,k]) < 1e-10 ): + Moving_Grid_Z_Min[j,k] = 0.00 + if ( abs(Moving_Grid_Z_Max[j,k]) < 1e-10 ): + Moving_Grid_Z_Max[j,k] = 0.00 + + print( f" adjust_puncture[{i},{k},0] = { adjust_puncture[k,0] } " ) + print( f" adjust_puncture[{i},{k},1] = { adjust_puncture[k,1] } " ) + print( f" adjust_puncture[{i},{k},2] = { adjust_puncture[k,2] } " ) + + ## using numpy to set linear grid points, parameters are Rmin, Rmax, Rnum + Moving_Grid_X[j,k] = numpy.linspace( Moving_Grid_X_Min[j,k], Moving_Grid_X_Max[j,k], moving_grid_number + 1 ) + Moving_Grid_Y[j,k] = numpy.linspace( Moving_Grid_Y_Min[j,k], Moving_Grid_Y_Max[j,k], moving_grid_number + 1 ) + Moving_Grid_Z[j,k] = numpy.linspace( Moving_Grid_Z_Min[j,k], Moving_Grid_Z_Max[j,k], moving_grid_number + 1 ) + +else: + print( ) + print( " Moving Grid Error: Grid Type is Undifined !!!!!!! " ) + print( ) + +print( ) +print( " The moving grid puncture position adjustment is done " ) +print( ) + +################################################# + + +################################################# + +## this function plots the initial numerical grids + +def plot_initial_grid(): + +## plot the final grids + + if (input_data.static_grid_level > 0): + X0, Y0 = numpy.meshgrid( Static_Grid_X[0], Static_Grid_Y[0] ) + plt.plot( X0, Y0, + color='brown', + marker='.', + linestyle='' ) + + if (input_data.static_grid_level > 1): + X1, Y1 = numpy.meshgrid( Static_Grid_X[1], Static_Grid_Y[1] ) + plt.plot( X1, Y1, + color='red', + marker='.', + linestyle='' ) + + if (input_data.static_grid_level > 2): + X2, Y2 = numpy.meshgrid( Static_Grid_X[2], Static_Grid_Y[2] ) + plt.plot( X2, Y2, + color='orange', + marker='.', + linestyle='' ) + + if (input_data.static_grid_level > 3): + X3, Y3 = numpy.meshgrid( Static_Grid_X[3], Static_Grid_Y[3] ) + plt.plot( X3, Y3, + color='yellow', + marker='.', + linestyle='' ) + + if (input_data.static_grid_level > 4): + X4, Y4 = numpy.meshgrid( Static_Grid_X[4], Static_Grid_Y[4] ) + plt.plot( X4, Y4, + color='greenyellow', + marker='.', + linestyle='' ) + + ## plot the moving grids + + if (input_data.moving_grid_level > 0): + for k in range(input_data.puncture_number): + Xk0, Yk0 = numpy.meshgrid( Moving_Grid_X[0,k], Moving_Grid_Y[0,k] ) + plt.plot( Xk0, Yk0, + color='cyan', + marker='.', + linestyle='' ) + + if (input_data.moving_grid_level > 1): + for k in range(input_data.puncture_number): + Xk1, Yk1 = numpy.meshgrid( Moving_Grid_X[1,k], Moving_Grid_Y[1,k] ) + plt.plot( Xk1, Yk1, + color='blue', + marker='.', + linestyle='' ) + + if (input_data.moving_grid_level > 2): + for k in range(input_data.puncture_number): + Xk2, Yk2 = numpy.meshgrid( Moving_Grid_X[2,k], Moving_Grid_Y[2,k] ) + plt.plot( Xk2, Yk2, + color='navy', + marker='.', + linestyle='' ) + + if (input_data.moving_grid_level > 3): + for k in range(input_data.puncture_number): + Xk3, Yk3 = numpy.meshgrid( Moving_Grid_X[3,k], Moving_Grid_Y[3,k] ) + plt.plot( Xk3, Yk3, + color='gray', + marker='.', + linestyle='' ) + + if (input_data.moving_grid_level > 4): + for k in range(input_data.puncture_number): + Xk4, Yk4 = numpy.meshgrid( Moving_Grid_X[4,k], Moving_Grid_Y[4,k] ) + plt.plot( Xk4, Yk4, + color='black', + marker='.', + linestyle='' ) + + plt.grid(True) + ## plt.show() + plt.savefig( os.path.join(input_data.File_directory, "Initial_Grid.jpeg") ) + plt.savefig( os.path.join(input_data.File_directory, "Initial_Grid.pdf") ) + +################################################# + + +################################################# + +## putting the grid setting into AMSS-NCKU input file + +def append_AMSSNCKU_cgh_input(): + + file1 = open( os.path.join(input_data.File_directory, "AMSS-NCKU.input"), "a") + # "a" for append mode + + ## output the setting of cgh + + print( file=file1 ) + print( "cgh::moving levels start from = ", input_data.static_grid_level, file=file1 ) + print( "cgh::levels = ", input_data.grid_level, file=file1) + + ## output the setting of static grids + + for i in range(input_data.static_grid_level): + + print( f"cgh::grids[{i}] = 1", file=file1 ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::shape[{i}][0][0] = { static_grid_number_x//2 } ", file=file1 ) + print( f"cgh::shape[{i}][0][1] = { static_grid_number_y//2 } ", file=file1 ) + else: + print( f"cgh::shape[{i}][0][0] = { static_grid_number_x } ", file=file1 ) + print( f"cgh::shape[{i}][0][1] = { static_grid_number_y } ", file=file1 ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::shape[{i}][0][2] = { static_grid_number_z//2 } ", file=file1 ) + elif ( input_data.Symmetry == "equatorial-symmetry" ): + print( f"cgh::shape[{i}][0][2] = { static_grid_number_z//2 } ", file=file1 ) + elif ( input_data.Symmetry == "no-symmetry" ): + print( f"cgh::shape[{i}][0][2] = { static_grid_number_z } ", file=file1 ) + else: + print( " Symmetry Setting Error " ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::bbox[{i}][0][0] = 0.0 ", file=file1 ) + print( f"cgh::bbox[{i}][0][1] = 0.0 ", file=file1 ) + else: + print( f"cgh::bbox[{i}][0][0] = { Grid_X_Min[i] } ", file=file1 ) + print( f"cgh::bbox[{i}][0][1] = { Grid_Y_Min[i] } ", file=file1 ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::bbox[{i}][0][2] = 0.0 ", file=file1 ) + elif ( input_data.Symmetry == "equatorial-symmetry" ): + print( f"cgh::bbox[{i}][0][2] = 0.0 ", file=file1 ) + elif ( input_data.Symmetry == "no-symmetry" ): + print( f"cgh::bbox[{i}][0][2] = { Grid_Z_Min[i] } ", file=file1 ) + else: + print( " Symmetry Setting Error " ) + + print( f"cgh::bbox[{i}][0][3] = { Grid_X_Max[i] } ", file=file1 ) + print( f"cgh::bbox[{i}][0][4] = { Grid_Y_Max[i] } ", file=file1 ) + print( f"cgh::bbox[{i}][0][5] = { Grid_Z_Max[i] } ", file=file1 ) + + ## output the setting of moving grids + + ## circle over moving grid levels + + for i in range(input_data.moving_grid_level): + + j = i + input_data.static_grid_level + print( f"cgh::grids[{j}] = { input_data.puncture_number }", file=file1 ) + + ## circle over puncture number + for k in range(input_data.puncture_number): + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::shape[{j}][{k}][0] = { moving_grid_number//2 } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][1] = { moving_grid_number//2 } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][2] = { moving_grid_number//2 } ", file=file1 ) + elif ( input_data.Symmetry == "equatorial-symmetry" ): + print( f"cgh::shape[{j}][{k}][0] = { moving_grid_number } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][1] = { moving_grid_number } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][2] = { moving_grid_number//2 } ", file=file1 ) + elif ( input_data.Symmetry == "no-symmetry" ): + print( f"cgh::shape[{j}][{k}][0] = { moving_grid_number } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][1] = { moving_grid_number } ", file=file1 ) + print( f"cgh::shape[{j}][{k}][2] = { moving_grid_number } ", file=file1 ) + else: + print( " Symmetry Setting Error" ) + + print( f"cgh::bbox[{j}][{k}][0] = { Moving_Grid_X_Min[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][1] = { Moving_Grid_Y_Min[i,k] } ", file=file1 ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( f"cgh::bbox[{j}][{k}][0] = { max(0.0, Moving_Grid_X_Min[i,k]) } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][1] = { max(0.0, Moving_Grid_Y_Min[i,k]) } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][2] = { max(0.0, Moving_Grid_Z_Min[i,k]) } ", file=file1 ) + elif ( input_data.Symmetry == "equatorial-symmetry" ): + print( f"cgh::bbox[{j}][{k}][0] = { Moving_Grid_X_Min[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][1] = { Moving_Grid_Y_Min[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][2] = { max(0.0, Moving_Grid_Z_Min[i,k]) } ", file=file1 ) + elif ( input_data.Symmetry == "no-symmetry" ): + print( f"cgh::bbox[{j}][{k}][0] = { Moving_Grid_X_Min[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][1] = { Moving_Grid_Y_Min[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][2] = { Moving_Grid_Z_Min[i,k] } ", file=file1 ) + else: + print( " Symmetry Setting Error" ) + + print( f"cgh::bbox[{j}][{k}][3] = { Moving_Grid_X_Max[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][4] = { Moving_Grid_Y_Max[i,k] } ", file=file1 ) + print( f"cgh::bbox[{j}][{k}][5] = { Moving_Grid_Z_Max[i,k] } ", file=file1 ) + + ## output the setting of BSSN + + print( file=file1 ) + print( "############ for shell-box coupling set this exactly to box boundary", file=file1 ) + print( "BSSN::Shell shape[0] = ", input_data.shell_grid_number[0], file=file1 ) + print( "BSSN::Shell shape[1] = ", input_data.shell_grid_number[1], file=file1 ) + print( "BSSN::Shell shape[2] = ", input_data.shell_grid_number[2], file=file1 ) + print( "BSSN::Shell R range[0] = ", Shell_R_Min, file=file1 ) + print( "BSSN::Shell R range[1] = ", Shell_R_Max, file=file1 ) + print( file=file1 ) + + file1.close() + + return file1 + +################################################# + + + diff --git a/plot_GW_strain_amplitude_xiaoqu.py b/plot_GW_strain_amplitude_xiaoqu.py new file mode 100755 index 0000000..739f3d4 --- /dev/null +++ b/plot_GW_strain_amplitude_xiaoqu.py @@ -0,0 +1,756 @@ + +################################################# +## +## This file extracts gravitational-wave strain amplitude +## from AMSS-NCKU numerical-relativity outputs and plots it. +## Author: Xiaoqu +## Dates: 2024/10/01 --- 2025/11/20 +## +################################################# + +import numpy ## numpy for array operations +import scipy ## scipy for interpolation and signal processing +import math +import matplotlib.pyplot as plt ## matplotlib for plotting +import os ## os for system/file operations + +import AMSS_NCKU_Input as input_data + +# plt.rcParams['text.usetex'] = True ## enable LaTeX fonts in plots + + +#################################################################################### + + + +#################################################################################### + +## Compute Fourier transform for discrete time data in [t0, t1]. +## Adapted from deepseek examples. + +## Parameters: +## time : time series [0, t0] +## f : function value series +## apply_window : apply windowing (recommended True) +## zero_pad_factor : zero-padding factor (recommended 2-8) + +## Returns: +## frequency : frequency axis (Hz) +## frequency_spectrum : complex frequency spectrum + +def compute_frequency_spectrum(time, signal_f, apply_window=True, zero_pad_factor=4): + + ## Sampling parameters + N = len(time) + dt = time[1] - time[0] ## sample interval + fs = 1/dt ## sampling frequency + omega_s = fs * 2.0 * math.pi ## sampling angular frequency + + ## Data preprocessing + f_detrended = signal_f - numpy.mean(signal_f) ## remove DC offset + + ## Windowing (reduce spectral leakage) + if apply_window: + # window = scipy.signal.windows.hann(N) # Hann window + window = scipy.signal.windows.tukey(N, alpha=0.1) # or Tukey window + f_windowed = f_detrended * window + else: + f_windowed = f_detrended + + # Zero-padding (improve frequency resolution) + M = zero_pad_factor * N + f_padded = numpy.zeros(M) + f_padded[:N] = f_windowed + + # Execute FFT to obtain complex frequency spectrum + + # Use numpy.fft.fft to perform the fast Fourier transform + # Basic signature: numpy.fft.fft(a, n=None, axis=-1, norm=None) + # a: input 1-D array to be transformed + # n: transform length; if n>len(a) the input is zero-padded, if n black-hole quasi-periodic oscillations (QPO) + ## Tukey : adjustable flat-top region -> gravitational-wave chirp signals + ## Blackman: optimal sidelobe suppression -> high dynamic-range data + +#################################################################################### + + +#################################################################################### + +def frequency_filter_integration(omega, frequency_spectrum, omega0): + + ''' + ## modifiy the part |omega| < omega0 + omega_filter = numpy.where(omega < omega0, omega0, omega) + ''' + + ## Replace region |omega| < omega0 with signed omega0 + # Build replacements: positive omegas -> +omega0, negative -> -omega0 + replacements = numpy.where(omega >= 0, omega0, -omega0) + + # Apply replacement where abs(omega) < omega0 + omega_filter = numpy.where( numpy.abs(omega) < omega0, replacements, omega ) + + ## Integrand for frequency-domain integration + ## Note: convolution in time corresponds to multiplication in frequency + frequency_integration = - frequency_spectrum / (omega_filter)**2 + + return frequency_integration + +#################################################################################### + + +#################################################################################### + +## This function replaces |omega| < omega0 with signed omega0 + +def omega_filter(omega, omega0): + + ## Replace region |omega| < omega0 with signed omega0 + # Build replacements: positive omegas -> +omega0, negative -> -omega0 + replacements = numpy.where(omega >= 0, omega0, -omega0) + + # Apply replacements where |omega| < omega0 + # omega_filter = numpy.where(mask, replacements, omega) + omega_filter = numpy.where( numpy.abs(omega) < omega0, replacements, omega ) + + return omega_filter + +#################################################################################### + + +#################################################################################### + +## Inverse Fourier transform utility + +## Inputs: +## omega : frequency axis (Hz) +## F_omega : complex frequency-domain data +## sampling_factor : sampling multiplier for reconstruction +## original_zero_pad_factor : original zero-padding factor used in forward FFT + +## Returns: +## t : time axis +## reconstructed : reconstructed time-domain signal + + +def inverse_fourier_transform(omega, F_omega, sampling_factor=2, original_zero_pad_factor=4): + + # Compute sampling parameters + N = len(F_omega) + domega = omega[1] - omega[0] # frequency resolution + + # Determine sampling rate + # To avoid aliasing, ensure sampling rate >= 2 * max frequency (Nyquist) + if sampling_factor > 2: + sampling_rate_omega = sampling_factor * omega.max() + else: + sampling_rate_omega = 2.0 * omega.max() + # The input omega is angular frequency; convert to ordinary frequency + ## dt = 1.0 / sampling_rate_omega + frequency = omega / (2.0*math.pi) + dt = 2 * math.pi / sampling_rate_omega + + ''' + # DC component check + if not numpy.isclose(omega[0], 0): + warnings.warn("Frequency-domain data does not include zero-frequency component; DC offset may result") + ''' + + # Perform inverse FFT (use same normalization as forward transform) + reconstructed_signal = numpy.fft.ifft(F_omega, norm='ortho') + # Note: numpy.fft.ifft already handles normalization for 'ortho' + + ## Build time axis + ## If zero-padding was used originally, recover the unpadded length + if (original_zero_pad_factor > 1): + N0 = N // original_zero_pad_factor + t = numpy.arange(0, N0*dt, dt) + reconstructed_signal2 = reconstructed_signal[:N0] + ## If no zero-padding + else: + t = numpy.arange(0, N*dt, dt) + reconstructed_signal2 = reconstructed_signal + + # Handle real signals + if numpy.allclose(numpy.imag(reconstructed_signal2), 0): + reconstructed_signal3 = numpy.real(reconstructed_signal2) + + return t[:len(reconstructed_signal3)], reconstructed_signal3 + + +#################################################################################### + + +#################################################################################### + +# Instantaneous frequency estimation using analytic signal (Hilbert transform) + +def instantaneous_frequency(signal, sampling_rate): + """ + Compute instantaneous frequency of a signal. + :param signal: input time-domain sampled signal + :param sampling_rate: sampling rate + :return: time array and instantaneous frequency array + """ + analytic_signal = scipy.signal.hilbert(signal) + phase = numpy.unwrap(numpy.angle(analytic_signal)) + time = numpy.arange(len(signal)) / sampling_rate + frequency = numpy.gradient(phase, time) / (2 * numpy.pi) + return time, frequency + +def get_frequency_at_t1(signal, sampling_rate, t1): + """ + Get instantaneous frequency at time t1 + :param signal: input time-domain sampled signal + :param sampling_rate: sampling rate + :param t1: target time + :return: instantaneous frequency at t1 + """ + time, freq = instantaneous_frequency(signal, sampling_rate) + index = numpy.argmin(numpy.abs(time - t1)) + return freq[index] + + +#################################################################################### + + + +#################################################################################### + +## Function to plot gravitational-wave waveform h + +## Inputs: +## outdir path to data directory +## figure_outdir path to figure output directory +## detector_number_i detector index +## total_mass total system mass + +def generate_gravitational_wave_amplitude_plot( outdir, figure_outdir, detector_number_i ): + + + # build file path + file0 = os.path.join(outdir, "bssn_psi4.dat") + + if ( detector_number_i == 0 ): + print() + print("Plotting the gravitational-wave strain amplitude h") + print() + print("The corresponding data file is", file0) + print() + + print() + print( "Plotting gravitational-wave data for detector no.", detector_number_i ) + + + # read entire data file, assume whitespace-delimited floats + data = numpy.loadtxt(file0) + + # extract columns from psi4 file + time = data[:,0] + psi4_l2m2m_real = data[:,1] + psi4_l2m2m_imaginary = data[:,2] + psi4_l2m1m_real = data[:,3] + psi4_l2m1m_imaginary = data[:,4] + psi4_l2m0_real = data[:,5] + psi4_l2m0_imaginary = data[:,6] + psi4_l2m1_real = data[:,7] + psi4_l2m1_imaginary = data[:,8] + psi4_l2m2_real = data[:,9] + psi4_l2m2_imaginary = data[:,10] + + # Note: file0 is just a filename; no file.open() was used, so nothing to close + # file0.close() + + # Use integer division to compute length per detector + length = len(time) // input_data.Detector_Number + + time2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2m_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2m_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1m_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1m_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m0_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m0_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + + # Split data into per-detector-radius series + for i in range(input_data.Detector_Number): + for j in range(length): + time2[i,j] = time[ j*input_data.Detector_Number + i ] + psi4_l2m2m_real2[i,j] = psi4_l2m2m_real[ j*input_data.Detector_Number + i ] + psi4_l2m2m_imaginary2[i,j] = psi4_l2m2m_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m1m_real2[i,j] = psi4_l2m1m_real[ j*input_data.Detector_Number + i ] + psi4_l2m1m_imaginary2[i,j] = psi4_l2m1m_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m0_real2[i,j] = psi4_l2m0_real[ j*input_data.Detector_Number + i ] + psi4_l2m0_imaginary2[i,j] = psi4_l2m0_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m1_real2[i,j] = psi4_l2m1_real[ j*input_data.Detector_Number + i ] + psi4_l2m1_imaginary2[i,j] = psi4_l2m1_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m2_real2[i,j] = psi4_l2m2_real[ j*input_data.Detector_Number + i ] + psi4_l2m2_imaginary2[i,j] = psi4_l2m2_imaginary[ j*input_data.Detector_Number + i ] + + + ## Compute discrete Fourier transforms of Psi4 data + ## l=2 m=-2 spectrum + psi4_l2m2m_real_frequency, psi4_l2m2m_real_omega, psi4_l2m2m_real_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m2m_real2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + psi4_l2m2m_imaginary_frequency, psi4_l2m2m_imaginary_omega, psi4_l2m2m_imaginary_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m2m_imaginary2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + ## l=2 m=-1 spectrum + psi4_l2m1m_real_frequency, psi4_l2m1m_real_omega, psi4_l2m1m_real_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m1m_real2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + psi4_l2m1m_imaginary_frequency, psi4_l2m1m_imaginary_omega, psi4_l2m1m_imaginary_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m1m_imaginary2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + ## l=2 m=0 spectrum + psi4_l2m0_real_frequency, psi4_l2m0_real_omega, psi4_l2m0_real_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m0_real2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + psi4_l2m0_imaginary_frequency, psi4_l2m0_imaginary_omega, psi4_l2m0_imaginary_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m0_imaginary2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + ## l=2 m=1 spectrum + psi4_l2m1_real_frequency, psi4_l2m1_real_omega, psi4_l2m1_real_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m1_real2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + psi4_l2m1_imaginary_frequency, psi4_l2m1_imaginary_omega, psi4_l2m1_imaginary_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m1_imaginary2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + ## l=2 m=2 spectrum + psi4_l2m2_real_frequency, psi4_l2m2_real_omega, psi4_l2m2_real_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m2_real2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + psi4_l2m2_imaginary_frequency, psi4_l2m2_imaginary_omega, psi4_l2m2_imaginary_omega_spectrem \ + = compute_frequency_spectrum( time2[detector_number_i], psi4_l2m2_imaginary2[detector_number_i], apply_window=True, zero_pad_factor=4 ) + + + # Compute detector distance from input parameters + Detector_Interval = ( input_data.Detector_Rmax - input_data.Detector_Rmin ) / ( input_data.Detector_Number - 1 ) + Detector_Distance_R = input_data.Detector_Rmax - Detector_Interval * detector_number_i + + ################################################# + + ## Set minimum cutoff frequency for frequency-domain integration + + ## Create output file to record frequency-domain cutoff values + + file_cut_path = os.path.join( figure_outdir, "frequency_cut.txt" ) + file_cut = open( file_cut_path, "w" ) + + ## Compute total mass of the system and output + + total_mass = 0.0 + puncture_mass = numpy.zeros( input_data.puncture_number ) + + ## For 'Ansorg-TwoPuncture' initial data: normalize masses of the first two black holes + if ( input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + mass_ratio_Q = input_data.parameter_BH[0,0] / input_data.parameter_BH[1,0] + BBH_M1 = mass_ratio_Q / ( 1.0 + mass_ratio_Q ) + BBH_M2 = 1.0 / ( 1.0 + mass_ratio_Q ) + for k in range( input_data.puncture_number ): + if ( k == 0 ): + puncture_mass[k] = BBH_M1 + elif( k == 1 ): + puncture_mass[k] = BBH_M2 + else: + puncture_mass[k] = input_data.parameter_BH[k,0] + total_mass += puncture_mass[k] + + ## For other initial-data methods: read puncture masses from input + else: + for k in range( input_data.puncture_number ): + puncture_mass[k] = input_data.parameter_BH[k,0] + total_mass += puncture_mass[k] + + ## Output total mass + print( file=file_cut ) + + for k in range( input_data.puncture_number ): + print( f" mass[{k}] = {puncture_mass[k]} ", file=file_cut ) + + print( file=file_cut ) + + print( f" total mass = {total_mass} ", file=file_cut ) + print( file=file_cut ) + + ## Compute and output pairwise puncture distances + puncture_distance = numpy.zeros( (input_data.puncture_number, input_data.puncture_number) ) + puncture_position = input_data.position_BH + + ## Compute pairwise puncture separations + for k1 in range(input_data.puncture_number): + for k2 in range(input_data.puncture_number): + if (k1 != k2): + puncture_distance[k1,k2] = ( ( puncture_position[k1,0] - puncture_position[k2,0] )**2 \ + + ( puncture_position[k1,1] - puncture_position[k2,1] )**2 \ + + ( puncture_position[k1,2] - puncture_position[k2,2] )**2 )**(0.5) + print( f" puncture distance r[{k1,k2}] = {puncture_distance[k1,k2]} ", file=file_cut ) + print( file=file_cut ) + ## If k1 == k2, avoid zero-distance artifacts on the diagonal + else: + puncture_distance[k1,k2] = ( ( puncture_position[0,0] - puncture_position[0,0] )**2 \ + + ( puncture_position[0,1] - puncture_position[0,1] )**2 \ + + ( puncture_position[0,2] - puncture_position[0,2] )**2 )**(0.5) + + print( file=file_cut ) + + ## Estimate orbital periods and frequencies using Newtonian approximation + orbital_period = numpy.zeros( (input_data.puncture_number, input_data.puncture_number) ) + orbital_frequency = numpy.zeros( (input_data.puncture_number, input_data.puncture_number) ) + + ## Estimate maximum orbital frequency using Newtonian approximation + frequency_max = ( numpy.max(puncture_distance) / numpy.min( puncture_mass ) )**(0.5) + + ## Estimate orbital period and frequency for each pair using Newtonian mechanics + for k1 in range(input_data.puncture_number): + for k2 in range(input_data.puncture_number): + if (k1 != k2): + orbital_period[k1,k2] = 2.0 * math.pi * ( puncture_distance[k1,k2]**3 / ( puncture_mass[k1] + puncture_mass[k2] ) )**(0.5) + orbital_frequency[k1,k2] = 1.0 / orbital_period[k1,k2] + print( f" orbital period estimate: T_orbital[{k1,k2}] = {orbital_period[k1,k2]} ", file=file_cut ) + print( f" orbital frequency estimate: f_orbital[{k1,k2}] = {orbital_frequency[k1,k2]} ", file=file_cut ) + print( file=file_cut ) + else: + orbital_frequency[k1,k2] = frequency_max + orbital_period[k1,k2] = 1.0 / orbital_frequency[k1,k2] + + print( file=file_cut ) + + ## Set minimum frequency cutoff based on orbital estimate + orbital_frequency_min = numpy.min( orbital_frequency ) + gravitational_frequency_min = 2.0 * orbital_frequency_min ## GW frequency ~ 2 * orbital frequency for quadrupole + print( " Orbital frequency estimate: f_orbital_min =", orbital_frequency_min, file=file_cut ) + print( " Gravitational Wave frequency estimate: f_GW_min =", orbital_frequency_min, file=file_cut ) + print( file=file_cut ) + + ## Set minimum frequency cutoff based on orbital estimate + frequency_cut = gravitational_frequency_min + omega_cut = 2.0 * math.pi * frequency_cut + print( " Frequency Cut estimate: frequency_cut =", frequency_cut, file=file_cut ) + print( " Omega Cut estimate: omega_cut =", omega_cut, file=file_cut ) + print( file=file_cut ) + + ## Manual cutoff setting (deprecated) + ## omega_cut = 2.0 * math.pi / 100.0 + + ################################################# + + ## Set tortoise coordinate (r*) for waveform retarded-time correction + tortoise_R = Detector_Distance_R + 2.0 * total_mass * math.log( Detector_Distance_R / (2.0*total_mass) - 1.0) + + ## For more than two punctures, tortoise coordinate is ambiguous; use detector radius + if ( input_data.puncture_number > 2 ): + tortoise_R = Detector_Distance_R + + ## Set cutoff based on instantaneous frequency of the Psi4 signal + ## Abandoned due to large errors + ''' + ## Set initial time + t1 = tortoise_R + + ## Compute instantaneous frequency of Psi4 signals + ## instantaneous_frequency_psi4_l2m2_real = instantaneous_frequency( psi4_l2m2_real2[detector_number_i], len(psi4_l2m2_real2[detector_number_i]) ) + instantaneous_frequency_psi4_l2m2m_real = get_frequency_at_t1( psi4_l2m2m_real2[detector_number_i], len(psi4_l2m2m_real2[detector_number_i]), t1 ) / (2.0*math.pi) + instantaneous_frequency_psi4_l2m1m_real = get_frequency_at_t1( psi4_l2m1m_real2[detector_number_i], len(psi4_l2m1m_real2[detector_number_i]), t1 ) / (2.0*math.pi) + instantaneous_frequency_psi4_l2m0_real = get_frequency_at_t1( psi4_l2m0_real2[detector_number_i], len(psi4_l2m0_real2[detector_number_i]), t1 ) / (2.0*math.pi) + instantaneous_frequency_psi4_l2m1_real = get_frequency_at_t1( psi4_l2m1_real2[detector_number_i], len(psi4_l2m1_real2[detector_number_i]), t1 ) / (2.0*math.pi) + instantaneous_frequency_psi4_l2m2_real = get_frequency_at_t1( psi4_l2m2_real2[detector_number_i], len(psi4_l2m2_real2[detector_number_i]), t1 ) / (2.0*math.pi) + print( f" Instantaneous frequency at t - r* = 0, l=2 m=-2 psi4_real = {instantaneous_frequency_psi4_l2m2m_real:.2f} 1/M" ) + print( f" Instantaneous frequency at t - r* = 0, l=2 m=-1 psi4_real = {instantaneous_frequency_psi4_l2m1m_real:.2f} 1/M" ) + print( f" Instantaneous frequency at t - r* = 0, l=2 m=0 psi4_real = {instantaneous_frequency_psi4_l2m0_real:.2f} 1/M" ) + print( f" Instantaneous frequency at t - r* = 0, l=2 m=1 psi4_real = {instantaneous_frequency_psi4_l2m1_real:.2f} 1/M" ) + print( f" Instantaneous frequency at t - r* = 0, l=2 m=2 psi4_real = {instantaneous_frequency_psi4_l2m2_real:.2f} 1/M" ) + + ## Add frequency cutoffs based on instantaneous frequency + frequency_cut_l2m2m = abs( instantaneous_frequency_psi4_l2m2m_real ) * 1.5 + frequency_cut_l2m1m = abs( instantaneous_frequency_psi4_l2m1m_real ) * 1.5 + frequency_cut_l2m0 = abs( instantaneous_frequency_psi4_l2m0_real ) * 1.5 + frequency_cut_l2m1 = abs( instantaneous_frequency_psi4_l2m1_real ) * 1.5 + frequency_cut_l2m2 = abs( instantaneous_frequency_psi4_l2m2_real ) * 1.5 + + ## Add frequency-domain filter conditions + omega_cut_l2m2m = 2.0 * math.pi / frequency_cut_l2m2m + omega_cut_l2m1m = 2.0 * math.pi / frequency_cut_l2m1m + omega_cut_l2m0 = 2.0 * math.pi / frequency_cut_l2m0 + omega_cut_l2m1 = 2.0 * math.pi / frequency_cut_l2m1 + omega_cut_l2m2 = 2.0 * math.pi / frequency_cut_l2m2 + + if (omega_cut_l2m0 < omega_cut_l2m2): + omega_cut_l2m0 = omega_cut_l2m2 + if (omega_cut_l2m1 < omega_cut_l2m2): + omega_cut_l2m1 = omega_cut_l2m2 + if (omega_cut_l2m1m < omega_cut_l2m2): + omega_cut_l2m1m = omega_cut_l2m2 + if (omega_cut_l2m2m < omega_cut_l2m2): + omega_cut_l2m2m = omega_cut_l2m2 + ''' + + ## Obtain integrand for inverse Fourier transform + psi4_l2m2m_real_omega_integration = frequency_filter_integration( psi4_l2m2m_real_omega, psi4_l2m2m_real_omega_spectrem, omega_cut ) + psi4_l2m2m_imaginary_omega_integration = frequency_filter_integration( psi4_l2m2m_imaginary_omega, psi4_l2m2m_imaginary_omega_spectrem, omega_cut ) + psi4_l2m1m_real_omega_integration = frequency_filter_integration( psi4_l2m1m_real_omega, psi4_l2m1m_real_omega_spectrem, omega_cut ) + psi4_l2m1m_imaginary_omega_integration = frequency_filter_integration( psi4_l2m1m_imaginary_omega, psi4_l2m1m_imaginary_omega_spectrem, omega_cut ) + psi4_l2m0_real_omega_integration = frequency_filter_integration( psi4_l2m0_real_omega, psi4_l2m0_real_omega_spectrem, omega_cut ) + psi4_l2m0_imaginary_omega_integration = frequency_filter_integration( psi4_l2m0_imaginary_omega, psi4_l2m0_imaginary_omega_spectrem, omega_cut ) + psi4_l2m1_real_omega_integration = frequency_filter_integration( psi4_l2m1_real_omega, psi4_l2m1_real_omega_spectrem, omega_cut ) + psi4_l2m1_imaginary_omega_integration = frequency_filter_integration( psi4_l2m1_imaginary_omega, psi4_l2m1_imaginary_omega_spectrem, omega_cut ) + psi4_l2m2_real_omega_integration = frequency_filter_integration( psi4_l2m2_real_omega, psi4_l2m2_real_omega_spectrem, omega_cut ) + psi4_l2m2_imaginary_omega_integration = frequency_filter_integration( psi4_l2m2_imaginary_omega, psi4_l2m2_imaginary_omega_spectrem, omega_cut ) + + ## Perform inverse Fourier transform in frequency domain to obtain gravitational-wave strain amplitudes + ## l=2 m=-2 amplitude + time_grid_h_plus_l2m2m, GW_h_plus_l2m2m \ + = inverse_fourier_transform( psi4_l2m2m_real_omega, psi4_l2m2m_real_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + time_grid_h_cross_l2m2m, GW_h_cross_l2m2m \ + = inverse_fourier_transform( psi4_l2m2m_imaginary_omega, psi4_l2m2m_imaginary_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + ## l=2 m=-1 amplitude + time_grid_h_plus_l2m1m, GW_h_plus_l2m1m \ + = inverse_fourier_transform( psi4_l2m1m_real_omega, psi4_l2m1m_real_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + time_grid_h_cross_l2m1m, GW_h_cross_l2m1m \ + = inverse_fourier_transform( psi4_l2m1m_imaginary_omega, psi4_l2m1m_imaginary_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + ## l=2 m=0 amplitude + time_grid_h_plus_l2m0, GW_h_plus_l2m0 \ + = inverse_fourier_transform( psi4_l2m0_real_omega, psi4_l2m0_real_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + time_grid_h_cross_l2m0, GW_h_cross_l2m0 \ + = inverse_fourier_transform( psi4_l2m0_imaginary_omega, psi4_l2m0_imaginary_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + ## l=2 m=1 amplitude + time_grid_h_plus_l2m1, GW_h_plus_l2m1 \ + = inverse_fourier_transform( psi4_l2m1_real_omega, psi4_l2m1_real_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + time_grid_h_cross_l2m1, GW_h_cross_l2m1 \ + = inverse_fourier_transform( psi4_l2m1_imaginary_omega, psi4_l2m1_imaginary_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + ## l=2 m=2 amplitude + time_grid_h_plus_l2m2, GW_h_plus_l2m2 \ + = inverse_fourier_transform( psi4_l2m2_real_omega, psi4_l2m2_real_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + time_grid_h_cross_l2m2, GW_h_cross_l2m2 \ + = inverse_fourier_transform( psi4_l2m2_imaginary_omega, psi4_l2m2_imaginary_omega_integration, sampling_factor=2, original_zero_pad_factor=4 ) + + + # Construct time grids for computing gravitational-wave strain h + # time_max = max( time2[detector_number_i] ) + # time_grid = numpy.linspace( tortoise_R, time_max, 2000 ) + # time_grid_new = numpy.linspace( 0, time_max-tortoise_R, len(time_grid) ) ## subtract tortoise coordinate from times + # l=2 m=-2 + time_grid_h_plus_l2m2m_new = time_grid_h_plus_l2m2m - tortoise_R + time_grid_h_cross_l2m2m_new = time_grid_h_cross_l2m2m - tortoise_R + # l=2 m=-1 + time_grid_h_plus_l2m1m_new = time_grid_h_plus_l2m1m - tortoise_R + time_grid_h_cross_l2m1m_new = time_grid_h_cross_l2m1m - tortoise_R + # l=2 m=0 + time_grid_h_plus_l2m0_new = time_grid_h_plus_l2m0 - tortoise_R + time_grid_h_cross_l2m0_new = time_grid_h_cross_l2m0 - tortoise_R + # l=2 m=1 + time_grid_h_plus_l2m1_new = time_grid_h_plus_l2m1 - tortoise_R + time_grid_h_cross_l2m1_new = time_grid_h_cross_l2m1 - tortoise_R + # l=2 m=2 + time_grid_h_plus_l2m2_new = time_grid_h_plus_l2m2 - tortoise_R + time_grid_h_cross_l2m2_new = time_grid_h_cross_l2m2 - tortoise_R + + plt.figure( figsize=(8,8) ) ## figsize controls figure size + plt.title( f" Gravitational Wave h Detector Distance = { Detector_Distance_R } ", fontsize=18 ) ## fontsize controls text size + plt.plot( time_grid_h_plus_l2m0_new, GW_h_plus_l2m0, \ + color='red', label="l=2 m=0 h+", linewidth=2 ) + plt.plot( time_grid_h_cross_l2m0_new, GW_h_cross_l2m0, \ + color='orange', label="l=2 m=0 hx", linestyle='--', linewidth=2 ) + plt.plot( time_grid_h_plus_l2m1_new, GW_h_plus_l2m1, \ + color='green', label="l=2 m=1 h+", linewidth=2 ) + plt.plot( time_grid_h_cross_l2m1_new, GW_h_cross_l2m1, \ + color='cyan', label="l=2 m=1 hx", linestyle='--', linewidth=2 ) + plt.plot( time_grid_h_plus_l2m2_new, GW_h_plus_l2m2, \ + color='black', label="l=2 m=2 h+", linewidth=2 ) + plt.plot( time_grid_h_cross_l2m2_new, GW_h_cross_l2m2, \ + color='gray', label="l=2 m=2 hx", linestyle='--', linewidth=2 ) + if ( input_data.puncture_number > 2 ): + plt.xlabel( "T - R [M]", fontsize=16 ) + else: + plt.xlabel( "T - R* [M]", fontsize=16 ) + plt.ylabel( r"R*h", fontsize=16 ) + plt.xlim( 0.0, max(time_grid_h_plus_l2m0_new) ) + plt.legend( loc='upper right' ) + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # show grid lines + plt.savefig( os.path.join(figure_outdir, "Gravitational_Wave_h_Detector_" + str(detector_number_i) + ".pdf") ) + + + print( "Gravitational-wave plot for detector no.", detector_number_i, "finished.") + print() + + if ( detector_number_i == (input_data.Detector_Number-1) ): + print( "All gravitational-wave strain amplitude plots finished." ) + print() + + ''' + # The following block performs direct time-domain integration of Psi4. + # This method was deprecated because of insufficient accuracy. + # h = int_{0}^{t} dt' int_{0}^{t"} Psi4(t") dt" + + # Interpolate per-detector data to obtain smooth functions + # Use cubic spline interpolation + psi4_l2m2m_real2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m2m_real2[detector_number_i], kind='cubic' ) + psi4_l2m2m_imaginary2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m2m_imaginary2[detector_number_i], kind='cubic' ) + psi4_l2m1m_real2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m1m_real2[detector_number_i], kind='cubic' ) + psi4_l2m1m_imaginary2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m1m_imaginary2[detector_number_i], kind='cubic' ) + psi4_l2m0_real2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m0_real2[detector_number_i], kind='cubic' ) + psi4_l2m0_imaginary2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m0_imaginary2[detector_number_i], kind='cubic' ) + psi4_l2m1_real2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m1_real2[detector_number_i], kind='cubic' ) + psi4_l2m1_imaginary2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m1_imaginary2[detector_number_i], kind='cubic' ) + psi4_l2m2_real2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m2_real2[detector_number_i], kind='cubic' ) + psi4_l2m2_imaginary2_interpolation = scipy.interpolate.interp1d( time2[detector_number_i], psi4_l2m2_imaginary2[detector_number_i], kind='cubic' ) + + # Compute detector distance from input parameters + Detector_Interval = ( input_data.Detector_Rmax - input_data.Detector_Rmin ) / ( input_data.Detector_Number - 1 ) + Detector_Distance_R = input_data.Detector_Rmax - Detector_Interval * detector_number_i + + # Set tortoise coordinate + tortoise_R = Detector_Distance_R + 2.0 * total_mass * math.log( Detector_Distance_R / (2.0*total_mass) - 1.0) + + # Construct time grid for gravitational-wave amplitude h + time_max = max( time2[detector_number_i] ) + time_grid = numpy.linspace( tortoise_R, time_max, 2000 ) + time_grid_new = numpy.linspace( 0, time_max-tortoise_R, len(time_grid) ) # subtract tortoise coordinate + + GW_h_plus_l2m2m = numpy.zeros( len(time_grid) ) + GW_h_cross_l2m2m = numpy.zeros( len(time_grid) ) + GW_h_plus_l2m1m = numpy.zeros( len(time_grid) ) + GW_h_cross_l2m1m = numpy.zeros( len(time_grid) ) + GW_h_plus_l2m0 = numpy.zeros( len(time_grid) ) + GW_h_cross_l2m0 = numpy.zeros( len(time_grid) ) + GW_h_plus_l2m1 = numpy.zeros( len(time_grid) ) + GW_h_cross_l2m1 = numpy.zeros( len(time_grid) ) + GW_h_plus_l2m2 = numpy.zeros( len(time_grid) ) + GW_h_cross_l2m2 = numpy.zeros( len(time_grid) ) + + # Solve for h by double numerical integration: h = int_{0}^{t} dt' int_{0}^{t"} Psi4(t") dt" + # The double integral can be reordered and simplified to h = int_{0}^{t} (t-t") Psi4(t") dt" + def GW_h_plus_l2m2m_integrand(t, tmax): + return psi4_l2m2m_real2_interpolation(t) * (tmax-t) + def GW_h_cross_l2m2m_integrand(t, tmax): + return psi4_l2m2m_imaginary2_interpolation(t) * (tmax-t) + def GW_h_plus_l2m1m_integrand(t, tmax): + return psi4_l2m1m_real2_interpolation(t) * (tmax-t) + def GW_h_cross_l2m1m_integrand(t, tmax): + return psi4_l2m1m_imaginary2_interpolation(t) * (tmax-t) + def GW_h_plus_l2m0_integrand(t, tmax): + return psi4_l2m0_real2_interpolation(t) * (tmax-t) + def GW_h_cross_l2m0_integrand(t, tmax): + return psi4_l2m0_imaginary2_interpolation(t) * (tmax-t) + def GW_h_plus_l2m1_integrand(t, tmax): + return psi4_l2m1_real2_interpolation(t) * (tmax-t) + def GW_h_cross_l2m1_integrand(t, tmax): + return psi4_l2m1_imaginary2_interpolation(t) * (tmax-t) + def GW_h_plus_l2m2_integrand(t, tmax): + return psi4_l2m2_real2_interpolation(t) * (tmax-t) + def GW_h_cross_l2m2_integrand(t, tmax): + return psi4_l2m2_imaginary2_interpolation(t) * (tmax-t) + + # Compute gravitational-wave strains h+ and hx + # Redefine integrand with a lambda so it becomes a single-variable function for integration + + for j in range( len(time_grid) ): + + print( " j = ", j ) + + GW_h_plus_l2m2m_integrand2 = lambda t: GW_h_plus_l2m2m_integrand(t, time_grid[j]) + ## Note: scipy.integrate.quad returns a tuple (value, error) + GW_h_plus_l2m2m[j], err0 = scipy.integrate.quad( GW_h_plus_l2m2m_integrand2, 0.0, time_grid[j], limit=600 ) + # epsabs=1e-8, # absolute tolerance + # limit=600 ) # increase number of subintervals + + GW_h_cross_l2m2m_integrand2 = lambda t: GW_h_cross_l2m2m_integrand(t, time_grid[j]) + GW_h_cross_l2m2m[j], err0 = scipy.integrate.quad( GW_h_cross_l2m2m_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_plus_l2m1m_integrand2 = lambda t: GW_h_plus_l2m1m_integrand(t, time_grid[j]) + GW_h_plus_l2m1m[j], err0 = scipy.integrate.quad( GW_h_plus_l2m1m_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_cross_l2m1m_integrand2 = lambda t: GW_h_cross_l2m1m_integrand(t, time_grid[j]) + GW_h_cross_l2m1m[j], err0 = scipy.integrate.quad( GW_h_cross_l2m1m_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_plus_l2m0_integrand2 = lambda t: GW_h_plus_l2m0_integrand(t, time_grid[j]) + GW_h_plus_l2m0[j], err0 = scipy.integrate.quad( GW_h_plus_l2m0_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_cross_l2m0_integrand2 = lambda t: GW_h_cross_l2m0_integrand(t, time_grid[j]) + GW_h_cross_l2m0[j], err0 = scipy.integrate.quad( GW_h_cross_l2m0_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_plus_l2m1_integrand2 = lambda t: GW_h_plus_l2m1_integrand(t, time_grid[j]) + GW_h_plus_l2m1[j], err0 = scipy.integrate.quad( GW_h_plus_l2m1_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_cross_l2m1_integrand2 = lambda t: GW_h_cross_l2m1_integrand(t, time_grid[j]) + GW_h_cross_l2m1[j], err0 = scipy.integrate.quad( GW_h_cross_l2m1_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_plus_l2m2_integrand2 = lambda t: GW_h_plus_l2m2_integrand(t, time_grid[j]) + GW_h_plus_l2m2[j], err0 = scipy.integrate.quad( GW_h_plus_l2m2_integrand2, 0.0, time_grid[j], limit=600 ) + + GW_h_cross_l2m2_integrand2 = lambda t: GW_h_cross_l2m2_integrand(t, time_grid[j]) + GW_h_cross_l2m2[j], err0 = scipy.integrate.quad( GW_h_cross_l2m2_integrand2, 0.0, time_grid[j], limit=600 ) + + # Computation of gravitational-wave amplitudes h+ and hx complete + + # Now perform plotting + plt.figure( figsize=(8,8) ) ## figsize controls figure size + plt.title( f" Gravitational Wave h Detector Distance = { Detector_Distance_R } ", fontsize=18 ) ## fontsize controls text size + plt.plot( time_grid_new, GW_h_plus_l2m0, \ + color='red', label="l=2 m=0 h+", linewidth=2 ) + plt.plot( time_grid_new, GW_h_cross_l2m0, \ + color='orange', label="l=2 m=0 hx", linestyle='--', linewidth=2 ) + plt.plot( time_grid_new, GW_h_plus_l2m1, \ + color='green', label="l=2 m=1 h+", linewidth=2 ) + plt.plot( time_grid_new, GW_h_cross_l2m1, \ + color='cyan', label="l=2 m=1 hx", linestyle='--', linewidth=2 ) + plt.plot( time_grid_new, GW_h_plus_l2m2, \ + color='black', label="l=2 m=2 h+", linewidth=2 ) + plt.plot( time_grid_new, GW_h_cross_l2m2, \ + color='gray', label="l=2 m=2 hx", linestyle='--', linewidth=2 ) + plt.xlabel( "T [M]", fontsize=16 ) + plt.ylabel( r"R*h", fontsize=16 ) + plt.legend( loc='upper right' ) + plt.savefig( os.path.join(figure_outdir, "Gravitational_Wave_h_Detector_" + str(detector_number_i) + ".pdf") ) + + print() + print( "Gravitational-wave plot for detector no.", detector_number_i, "finished.") + print( "Plotting of gravitational-wave strain amplitude h completed.") + print() + ''' + + return + +#################################################################################### + + + +#################################################################################### + +## Standalone usage example +''' +## outdir = "./BBH_q=1" +outdir = "./3BH" +for i in range( input_data.Detector_Number ): + generate_gravitational_wave_amplitude_plot(outdir, outdir, i) +''' +#################################################################################### + + + diff --git a/plot_binary_data.py b/plot_binary_data.py new file mode 100755 index 0000000..0694f4f --- /dev/null +++ b/plot_binary_data.py @@ -0,0 +1,194 @@ + +################################################# +## +## This file contains utilities to plot binary data produced by the +## numerical-relativity group (AMSS-NCKU). +## Author: Xiaoqu +## Dates: 2024/10/01 --- 2025/09/14 +## +################################################# + +import numpy +import scipy +import matplotlib.pyplot as plt +from matplotlib.colors import LogNorm +from mpl_toolkits.mplot3d import Axes3D +## import torch +import AMSS_NCKU_Input as input_data + +import os + + +######################################################################################### + +def plot_binary_data( filename, binary_outdir, figure_outdir ): + + figure_title0 = filename.replace(binary_outdir + "/", "") # remove directory prefix + figure_title = figure_title0.replace(".bin", "") # remove .bin suffix + + print() + print( "reading binary data from file =", figure_title0 ) + +################################### + + # Open file + # Read binary array in the AMSS-NCKU output order + with open(filename, 'rb') as file: + + physical_time = numpy.fromfile( file, dtype=numpy.float64, count=1 ) + nx, ny, nz = numpy.fromfile( file, dtype=numpy.int32, count=3 ) + xmin, xmax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + ymin, ymax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + zmin, zmax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + data = numpy.fromfile( file, dtype=numpy.float64 ) + + # Now `data` array contains the binary data read from file + + print( "obtained data shape =", data.shape ) + print( "obtained data size =", data.size ) + print( "obtained data points =", nx, "*", ny, "*", nz, "=", nx*ny*nz ) + +################################### + + # Reshape flat array into a multi-dimensional grid + data_reshape = data.reshape( (nz, ny, nx) ) ## tests show this ordering yields correct plots (z first) + # print(data_reshape) + + # data1 = data_reshape[0,:,:] + # print(data1) + + Rmin = [xmin, ymin, zmin] + Rmax = [xmax, ymax, zmax] + N = [nx, ny, nz] + print( "coordinate minimum =", Rmin ) + print( "coordinate maximum =", Rmax ) + print( "grid point =", N ) + + print() + print( "Data file read successfully. Plotting data." ) + print() + + # Call plotting helper to produce contour/density/surface plots + figure_title0 = filename.replace(binary_outdir + "/", "") # remove directory prefix + figure_title = figure_title.replace(".bin", "") # remove .bin suffix + figure_title_new = figure_title[:-6] # strip trailing 6 characters (iteration label) + + get_data_xy( Rmin, Rmax, N, data_reshape, physical_time[0], figure_title_new, figure_outdir ) + # Note: numpy.fromfile returns an array for `physical_time` (even though + # it contains a single element), so use `physical_time[0]` as the scalar time. + + # Explicitly delete large arrays to free memory + del data + del data_reshape + + print( "binary data file =", figure_title0, "plot has finished" ) + print( ) + + return + + +######################################################################################### + + + + +#################################################################################### + +# Plot a single binary dataset (2D slices and 3D surface) + +def get_data_xy( Rmin, Rmax, n, data0, time, figure_title, figure_outdir ): + + figure_contourplot_outdir = os.path.join(figure_outdir, "contour plot") + figure_densityplot_outdir = os.path.join(figure_outdir, "density plot") + figure_surfaceplot_outdir = os.path.join(figure_outdir, "surface plot") + + # Reconstruct coordinates from grid metadata + x = numpy.linspace(Rmin[0], Rmax[0], n[0]) + y = numpy.linspace(Rmin[1], Rmax[1], n[1]) + z = numpy.linspace(Rmin[2], Rmax[2], n[2]) + # print(x) + # print(y) + # print(z) + + # Build 2D meshgrid for plotting + # X, Y = torch.meshgrid(torch.tensor(x), torch.tensor(y)) # torch can also build meshgrids + X, Y = numpy.meshgrid(x, y) + + # Notes on numpy.meshgrid: + # If x has length nx and y has length ny, then X,Y = numpy.meshgrid(x,y) + # produce arrays with shape (ny, nx). X has rows copied from x and + # Y has columns copied from y. + + # print( X.shape ) + # print( Y.shape ) + # print( X[0,:] ) + # print( Y[:,0] ) + + # Extract data on the central xy plane + if input_data.Symmetry == "no-symmetry": + data_xy = data0[n[2]//2,:,:] + else: + data_xy = data0[0,:,:] + + # The original data ordering was thought to be column-major; tests + # indicate no transpose is required. + + # print( data_xy_0.shape ) + # print( data_xy.shape ) + + # Define finer coordinate grids for interpolation + x_new = numpy.linspace(Rmin[0], Rmax[0], int(2.5*n[0])) + y_new = numpy.linspace(Rmin[1], Rmax[1], int(2.5*n[1])) + z_new = numpy.linspace(Rmin[2], Rmax[2], int(2.5*n[2])) + X_new, Y_new = numpy.meshgrid(x_new, y_new) + + # Interpolate data onto the finer grid + data_xy_fit = scipy.interpolate.griddata( (X.flatten(), Y.flatten()), data_xy.flatten(), (X_new, Y_new), method="cubic" ) + + # Plot 2D contour map + fig, ax = plt.subplots() + # contourf = ax.contourf(X, Y, data_xy, 8, cmap='coolwarm', norm=LogNorm(vmin=1, vmax=10), levels=numpy.logspace(-2, 2, 8)) # use 'coolwarm' colormap with LogNorm + # contourf = ax.contourf( X, Y, data_xy_0, cmap=plt.get_cmap('RdYlGn_r') ) + # contour = ax.contour( X, Y, data_xy_0, 8, colors='k', linewidths=0.5 ) # add contour lines + # Use interpolated data for plotting + contourf = ax.contourf( X_new, Y_new, data_xy_fit, cmap=plt.get_cmap('RdYlGn_r') ) + contour = ax.contour( X_new, Y_new, data_xy_fit, 8, colors='k', linewidths=0.5 ) # add contour lines + cbar = plt.colorbar(contourf) # add colorbar + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and axis labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + # plt.show() # display figure + plt.savefig( os.path.join(figure_contourplot_outdir, figure_title + " time = " + str(time) + " contour_plot.pdf") ) # save figure + plt.close() + + # Plot 2D density (heat) map + # fig1 = plt.figure() + fig1, ax = plt.subplots() + # Tests show no transpose is necessary; however the y-axis appears + # flipped in the image, so set extent accordingly. + imshowfig = plt.imshow( data_xy, interpolation='bicubic', extent=[X.min(), X.max(), Y.max(), Y.min()] ) + ax.invert_yaxis() # invert y-axis + cbar = plt.colorbar(imshowfig) # add colorbar + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and axis labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + # plt.show() + plt.savefig( os.path.join(figure_densityplot_outdir, figure_title + " time = " + str(time) + " density_plot.pdf") ) + plt.close() + + # Plot 3D surface + fig2 = plt.figure() # create new figure + ax = fig2.add_subplot( 111, projection='3d' ) # 3D axes + # plot interpolated surface + ax.plot_surface( X_new, Y_new, data_xy_fit, cmap='viridis' ) # surface plot + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + # plt.show() # display figure + plt.savefig( os.path.join(figure_surfaceplot_outdir, figure_title + " time = " + str(time) + " surface_plot.pdf") ) # save figure + plt.close() + + return + +#################################################################################### + diff --git a/plot_binary_data_test.py b/plot_binary_data_test.py new file mode 100755 index 0000000..79027c7 --- /dev/null +++ b/plot_binary_data_test.py @@ -0,0 +1,216 @@ + +################################################# +## +## This file contains utilities to plot binary data produced by the +## numerical-relativity group (AMSS-NCKU). +## Author: Xiaoqu +## Dates: 2024/10/01 --- 2025/09/14 +## +################################################# + +import numpy +import matplotlib.pyplot as plt +from matplotlib.colors import LogNorm +from mpl_toolkits.mplot3d import Axes3D +## import torch +import AMSS_NCKU_Input as input_data + +import os + + +######################################################################################### + +def plot_binary_data( filename, binary_outdir, figure_outdir ): + + figure_title0 = filename.replace(binary_outdir + "/", "") # remove directory prefix + figure_title = figure_title0.replace(".bin", "") # remove .bin suffix + + print() + print( "reading binary data from file =", figure_title0 ) + +################################### + + # Open file + # Read binary array in the AMSS-NCKU output order + with open(filename, 'rb') as file: + + physical_time = numpy.fromfile( file, dtype=numpy.float64, count=1 ) + nx, ny, nz = numpy.fromfile( file, dtype=numpy.int32, count=3 ) + xmin, xmax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + ymin, ymax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + zmin, zmax = numpy.fromfile( file, dtype=numpy.float64, count=2 ) + data = numpy.fromfile( file, dtype=numpy.float64 ) + + # Now `data` array contains the binary data read from file + + print( "obtained data shape =", data.shape ) + print( "obtained data size =", data.size ) + print( "obtained data points =", nx, "*", ny, "*", nz, "=", nx*ny*nz ) + +################################### + + # Reshape flat array into a multi-dimensional grid + data_reshape = data.reshape( (nz, ny, nx) ) ## this ordering produces correct plots + # print(data_reshape) + + # data1 = data_reshape[0,:,:] + # print(data1) + + Rmin = [xmin, ymin, zmin] + Rmax = [xmax, ymax, zmax] + N = [nx, ny, nz] + print( "coordinate minimum =", Rmin ) + print( "coordinate maximum =", Rmax ) + print( "grid point =", N ) + + print() + print( "Data file read successfully. Plotting data." ) + print() + + # Call plotting helper to produce plots + figure_title0 = filename.replace(binary_outdir + "/", "") # remove directory prefix + figure_title = figure_title.replace(".bin", "") # remove .bin suffix + figure_title_new = figure_title[:-6] # strip trailing 6 characters (iteration label) + + get_data_xy( Rmin, Rmax, N, data_reshape, physical_time[0], figure_title_new, figure_outdir ) + # Note: numpy.fromfile returns an array for `physical_time` (even though + # it contains a single element), so use `physical_time[0]` as the scalar time. + + # Explicitly delete large arrays to free memory + del data + del data_reshape + + print( "binary data file =", figure_title0, "plot has finished" ) + print( ) + + return + + +######################################################################################### + + + + +#################################################################################### + +# Plot a single binary dataset (2D slices and 3D surface) + +def get_data_xy( Rmin, Rmax, n, data0, time, figure_title, figure_outdir ): + + figure_contourplot_outdir = os.path.join(figure_outdir, "contour plot") + figure_densityplot_outdir = os.path.join(figure_outdir, "density plot") + figure_surfaceplot_outdir = os.path.join(figure_outdir, "surface plot") + + # Reconstruct coordinates from grid metadata + x = numpy.linspace(Rmin[0], Rmax[0], n[0]) + y = numpy.linspace(Rmin[1], Rmax[1], n[1]) + z = numpy.linspace(Rmin[2], Rmax[2], n[2]) + print( " x = ", x ) + print( " y = ", y ) + print( " z = ", z ) + + # Build 2D meshgrid for plotting + # X, Y = numpy.meshgrid(x, y) + # X, Y = torch.meshgrid(torch.tensor(x), torch.tensor(y)) + Y, X = numpy.meshgrid(y, x) + + # Notes on numpy.meshgrid: + # If x has length nx and y has length ny, then X,Y = numpy.meshgrid(x,y) + # produce arrays with shape (ny, nx). X has rows copied from x and + # Y has columns copied from y. + + print( " X0 = ", X[:,0] ) + print( " Y0 = ", Y[0,:] ) + + # Extract data on the central xy plane + if input_data.Symmetry == "no-symmetry": + data_xy = data0[n[2]//2,:,:] + else: + data_xy = data0[0,:,:] + + # The original data ordering was thought to be column-major; tests + # indicate no transpose is required. + + # print( data_xy_0.shape ) + # print( data_xy.shape ) + + # Define finer coordinate grids for interpolation + x_new = numpy.linspace(Rmin[0], Rmax[0], int(2.5*n[0])) + y_new = numpy.linspace(Rmin[1], Rmax[1], int(2.5*n[1])) + z_new = numpy.linspace(Rmin[2], Rmax[2], int(2.5*n[2])) + X_new, Y_new = numpy.meshgrid(x_new, y_new) + + # Interpolate data onto the finer grid + data_xy_fit = scipy.interpolate.griddata( (X.flatten(), Y.flatten()), data_xy.flatten(), (X_new, Y_new), method="cubic" ) + + # Plot 2D contour map + fig, ax = plt.subplots() + # contourf = ax.contourf(X, Y, data_xy, 8, cmap='coolwarm', norm=LogNorm(vmin=1, vmax=10), levels=numpy.logspace(-2, 2, 8)) # use 'coolwarm' colormap with LogNorm scaling + # contourf = ax.contourf( X, Y, data_xy_0, cmap=plt.get_cmap('RdYlGn_r') ) + # contour = ax.contour( X, Y, data_xy_0, 8, colors='k', linewidths=0.5 ) # add contour lines + # Use interpolated data for plotting + contourf = ax.contourf( X_new, Y_new, data_xy_fit, cmap=plt.get_cmap('RdYlGn_r') ) + contour = ax.contour( X_new, Y_new, data_xy_fit, 8, colors='k', linewidths=0.5 ) # add contour lines + cbar = plt.colorbar(contourf) # add colorbar + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and axis labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + # plt.show() # display figure + plt.savefig( os.path.join(figure_contourplot_outdir, figure_title + " time = " + str(time) + " contour_plot.pdf") ) # save figure + plt.close() + + # Plot 2D density (heat) map + # fig1 = plt.figure() + fig1, ax = plt.subplots() + # Tests show no transpose is necessary; however the y-axis appears + # flipped in the image, so set extent accordingly. + imshowfig = plt.imshow( data_xy, interpolation='bicubic', extent=[X.min(), X.max(), Y.max(), Y.min()] ) + # ax.invert_xaxis() + ax.invert_yaxis() # invert y-axis + cbar = plt.colorbar(imshowfig) # add colorbar + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and axis labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + # plt.show() + plt.savefig( os.path.join(figure_densityplot_outdir, figure_title + " time = " + str(time) + " density_plot.pdf") ) + plt.close() + + # Plot 3D surface + fig2 = plt.figure() # create new figure + ax = fig2.add_subplot( 111, projection='3d' ) # 3D axes + # plot interpolated surface + ax.plot_surface( X_new, Y_new, data_xy_fit, cmap='viridis' ) # surface plot + ax.set_title( figure_title + " physical time = " + str(time) ) # set title and labels + ax.set_xlabel( "X [M]" ) + ax.set_ylabel( "Y [M]" ) + plt.savefig( os.path.join(figure_surfaceplot_outdir, figure_title + " time = " + str(time) + " surface_plot.pdf") ) # save image + plt.close() + + return + +#################################################################################### + +# Configure directories based on input configuration +File_directionary = os.path.join(input_data.File_directionary) + +output_directionary = os.path.join(File_directionary, "AMSS_NCKU_output") +binary_results_directionary = os.path.join(output_directionary, input_data.Output_directionary) + +figure_directionary = "figure" +if not os.path.exists(figure_directionary): + os.mkdir(figure_directionary) + +surface_plot_directionary = os.path.join(figure_directionary, "surface plot") +density_plot_directionary = os.path.join(figure_directionary, "density plot") +contour_plot_directionary = os.path.join(figure_directionary, "contour plot") +if not os.path.exists(surface_plot_directionary): + os.mkdir(surface_plot_directionary) +if not os.path.exists(density_plot_directionary): + os.mkdir(density_plot_directionary) +if not os.path.exists(contour_plot_directionary): + os.mkdir(contour_plot_directionary) + +filename = os.path.join(binary_results_directionary, 'Lev05-00_phi0_00154.bin') + +plot_binary_data( filename, binary_results_directionary, figure_directionary ) + diff --git a/plot_xiaoqu.py b/plot_xiaoqu.py new file mode 100755 index 0000000..7711d5a --- /dev/null +++ b/plot_xiaoqu.py @@ -0,0 +1,885 @@ + +################################################# +## +## Plotting utilities for AMSS-NCKU numerical relativity outputs +## Author: Xiaoqu +## 2024/10/01 --- 2025/09/14 +## +################################################# + +import numpy ## numpy for array operations +import matplotlib.pyplot as plt ## matplotlib for plotting +from mpl_toolkits.mplot3d import Axes3D ## needed for 3D plots +import glob +import os ## operating system utilities + +import plot_binary_data +import AMSS_NCKU_Input as input_data + +# plt.rcParams['text.usetex'] = True ## enable LaTeX fonts in plots + + + +#################################################################################### + +## Generate all 2D plots from AMSS-NCKU binary output + +def generate_binary_data_plot( binary_outdir, figure_outdir ): + + # create directories to store generated figures + + surface_plot_outdir = os.path.join( figure_outdir, "surface plot" ) + os.mkdir( surface_plot_outdir ) + + density_plot_outdir = os.path.join( figure_outdir, "density plot" ) + os.mkdir( density_plot_outdir ) + + contour_plot_outdir = os.path.join( figure_outdir, "contour plot" ) + os.mkdir( contour_plot_outdir ) + + print( ) + print( " Reading AMSS-NCKU Binary Data From Output " ) + print( ) + + print( " List of binary data " ) + + ## Set which files to plot (here: all .bin files) + globby = glob.glob( os.path.join(binary_outdir, '*.bin') ) + file_list = [] + for x in sorted(globby): + file_list.append(x) + print(x) + + ## Plot each file in the list + for filename in file_list: + print(filename) + plot_binary_data.plot_binary_data(filename, binary_outdir, figure_outdir) + + print( ) + print( " Binary Data Plot Has been Finished " ) + print( ) + + return + +#################################################################################### + + + +#################################################################################### + +## Plot black-hole puncture trajectories (2D) + +def generate_puncture_orbit_plot( outdir, figure_outdir ): + + print( ) + print( " Plotting the black holes' trajectory (2D plot)" ) + print( ) + + # path to data file + file0 = os.path.join(outdir, "bssn_BH.dat") + + print( " Corresponding data file = ", file0 ) + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # print(data[:,0]) + # print(data[:,2]) + + # initialize min/max arrays for black-hole coordinates + BH_Xmin = numpy.zeros(input_data.puncture_number) + BH_Xmax = numpy.zeros(input_data.puncture_number) + BH_Ymin = numpy.zeros(input_data.puncture_number) + BH_Ymax = numpy.zeros(input_data.puncture_number) + BH_Zmin = numpy.zeros(input_data.puncture_number) + BH_Zmax = numpy.zeros(input_data.puncture_number) + + # -------------------------- + + # Plot black-hole displacement trajectory (XY) + + plt.figure( figsize=(8,8) ) ## figsize sets the figure size + plt.title( " Black Hole Trajectory ", fontsize=18 ) ## fontsize sets the title size + + for i in range(input_data.puncture_number): + BH_x = data[:, 3*i+1] + BH_y = data[:, 3*i+2] + BH_z = data[:, 3*i+3] + BH_Xmin[i] = min( BH_x ) + BH_Xmax[i] = max( BH_x ) + BH_Ymin[i] = min( BH_y ) + BH_Ymax[i] = max( BH_y ) + if i==0: + plt.plot( BH_x, BH_y, color='red', label="BH"+str(i+1), linewidth=2 ) + elif i==1: + plt.plot( BH_x, BH_y, color='green', label="BH"+str(i+1), linewidth=2 ) + elif i==2: + plt.plot( BH_x, BH_y, color='blue', label="BH"+str(i+1), linewidth=2 ) + elif i==3: + plt.plot( BH_x, BH_y, color='gray', label="BH"+str(i+1), linewidth=2 ) + + plt.xlabel( "X [M]", fontsize=16 ) + plt.ylabel( "Y [M]", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Xmin0 = min( BH_Xmin ) + Xmax0 = max( BH_Xmax ) + Ymin0 = min( BH_Ymin ) + Ymax0 = max( BH_Ymax ) + Xmin = min( Xmin0-2.0, -5.0 ) + Xmax = max( Xmax0+2.0, +5.0 ) + Ymin = min( Ymin0-2.0, -5.0 ) + Ymax = max( Ymax0+2.0, +5.0 ) + plt.xlim( Xmin, Xmax ) # x axis range from Xmin to Xmax + plt.ylim( Ymin, Ymax ) # y axis range from Ymin to Ymax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + + # plt.show( ) + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_XY.pdf") ) + plt.close( ) + + # -------------------------- + + # Plot black-hole displacement trajectory (XZ) + + plt.figure( figsize=(8,8) ) ## figsize sets the figure size + plt.title( " Black Hole Trajectory ", fontsize=18 ) ## fontsize sets the title size + + for i in range(input_data.puncture_number): + BH_x = data[:, 3*i+1] + BH_y = data[:, 3*i+2] + BH_z = data[:, 3*i+3] + BH_Xmin[i] = min( BH_x ) + BH_Xmax[i] = max( BH_x ) + BH_Zmin[i] = min( BH_z ) + BH_Zmax[i] = max( BH_z ) + if i==0: + plt.plot( BH_x, BH_z, color='red', label="BH"+str(i+1), linewidth=2 ) + elif i==1: + plt.plot( BH_x, BH_z, color='green', label="BH"+str(i+1), linewidth=2 ) + elif i==2: + plt.plot( BH_x, BH_z, color='blue', label="BH"+str(i+1), linewidth=2 ) + elif i==3: + plt.plot( BH_x, BH_z, color='gray', label="BH"+str(i+1), linewidth=2 ) + + plt.xlabel( "X [M]", fontsize=16 ) + plt.ylabel( "Z [M]", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Xmin0 = min( BH_Xmin ) + Xmax0 = max( BH_Xmax ) + Zmin0 = min( BH_Zmin ) + Zmax0 = max( BH_Zmax ) + Xmin = min( Xmin0-2.0, -5.0 ) + Xmax = max( Xmax0+2.0, +5.0 ) + Zmin = min( Zmin0-2.0, -5.0 ) + Zmax = max( Zmax0+2.0, +5.0 ) + plt.xlim( Xmin, Xmax ) # x axis range from Xmin to Xmax + plt.ylim( Zmin, Zmax ) # z axis range from Zmin to Zmax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + + # plt.show( ) + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_XZ.pdf") ) + plt.close( ) + + # -------------------------- + + # Plot black-hole displacement trajectory (YZ) + + plt.figure( figsize=(8,8) ) ## figsize sets the figure size + plt.title( " Black Hole Trajectory ", fontsize=18 ) ## fontsize sets the title size + + for i in range(input_data.puncture_number): + BH_x = data[:, 3*i+1] + BH_y = data[:, 3*i+2] + BH_z = data[:, 3*i+3] + BH_Ymin[i] = min( BH_y ) + BH_Ymax[i] = max( BH_y ) + BH_Zmin[i] = min( BH_z ) + BH_Zmax[i] = max( BH_z ) + if i==0: + plt.plot( BH_y, BH_z, color='red', label="BH"+str(i+1), linewidth=2 ) + elif i==1: + plt.plot( BH_y, BH_z, color='green', label="BH"+str(i+1), linewidth=2 ) + elif i==2: + plt.plot( BH_y, BH_z, color='blue', label="BH"+str(i+1), linewidth=2 ) + elif i==3: + plt.plot( BH_y, BH_z, color='gray', label="BH"+str(i+1), linewidth=2 ) + + plt.xlabel( "Y [M]", fontsize=16 ) + plt.ylabel( "Z [M]", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Ymin0 = min( BH_Ymin ) + Ymax0 = max( BH_Ymax ) + Zmin0 = min( BH_Zmin ) + Zmax0 = max( BH_Zmax ) + Ymin = min( Ymin0-2.0, -5.0 ) + Ymax = max( Ymax0+2.0, +5.0 ) + Zmin = min( Zmin0-2.0, -5.0 ) + Zmax = max( Zmax0+2.0, +5.0 ) + plt.xlim( Ymin, Ymax ) # x axis range from Ymin to Ymax + plt.ylim( Zmin, Zmax ) # z axis range from Zmin to Zmax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + + # plt.show( ) + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_YZ.pdf") ) + plt.close( ) + + # -------------------------- + + # extract coordinates for BH1 and BH2 + BH_x1 = data[:, 1] + BH_y1 = data[:, 2] + BH_z1 = data[:, 3] + BH_x2 = data[:, 4] + BH_y2 = data[:, 5] + BH_z2 = data[:, 6] + + # -------------------------- + + # Plot relative trajectory: (X2-X1) vs (Y2-Y1) + + plt.figure( figsize=(8,8) ) + plt.title( " Black Hole Trajectory ", fontsize=18 ) + plt.plot( (BH_x2-BH_x1), (BH_y2-BH_y1), color='blue', linewidth=2 ) + plt.xlabel( " $X_{2}$ - $X_{1}$ [M] ", fontsize=16 ) + plt.ylabel( " $Y_{2}$ - $Y_{1}$ [M] ", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Xmin0 = min( (BH_x2 - BH_x1) ) + Xmax0 = max( (BH_x2 - BH_x1) ) + Ymin0 = min( (BH_y2 - BH_y1) ) + Ymax0 = max( (BH_y2 - BH_y1) ) + Xmin = min( Xmin0-2.0, -5.0 ) + Xmax = max( Xmax0+2.0, +5.0 ) + Ymin = min( Ymin0-2.0, -5.0 ) + Ymax = max( Ymax0+2.0, +5.0 ) + plt.xlim( Xmin, Xmax ) # x axis range from Xmin to Xmax + plt.ylim( Ymin, Ymax ) # y axis range from Ymin to Ymax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # show grid lines + + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_21_XY.pdf") ) + plt.close( ) + + # -------------------------- + + # plot BH displacement trajectory (X2-X1 Z2-Z1) + + plt.figure( figsize=(8,8) ) + plt.title( " Black Hole Trajectory ", fontsize=18 ) + plt.plot( (BH_x2-BH_x1), (BH_z2-BH_z1), color='blue', linewidth=2 ) + plt.xlabel( " $X_{2}$ - $X_{1}$ [M] ", fontsize=16 ) + plt.ylabel( " $Z_{2}$ - $Z_{1}$ [M] ", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Xmin0 = min( (BH_x2 - BH_x1) ) + Xmax0 = max( (BH_x2 - BH_x1) ) + Zmin0 = min( (BH_z2 - BH_z1) ) + Zmax0 = max( (BH_z2 - BH_z1) ) + Xmin = min( Xmin0-2.0, -5.0 ) + Xmax = max( Xmax0+2.0, +5.0 ) + Zmin = min( Zmin0-2.0, -5.0 ) + Zmax = max( Zmax0+2.0, +5.0 ) + plt.xlim( Xmin, Xmax ) # x axis range from Xmin to Xmax + plt.ylim( Zmin, Zmax ) # z axis range from Zmin to Zmax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # show grid lines + + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_21_XZ.pdf") ) + plt.close( ) + + # -------------------------- + + # plot BH displacement trajectory (Y2-Y1 Z2-Z1) + + plt.figure( figsize=(8,8) ) + plt.title( " Black Hole Trajectory ", fontsize=18 ) + plt.plot( (BH_y2-BH_y1), (BH_z2-BH_z1), color='blue', linewidth=2 ) + plt.xlabel( " $Y_{2}$ - $Y_{1}$ [M] ", fontsize=16 ) + plt.ylabel( " $Z_{2}$ - $Z_{1}$ [M] ", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Ymin0 = min( (BH_y2 - BH_y1) ) + Ymax0 = max( (BH_y2 - BH_y1) ) + Zmin0 = min( (BH_z2 - BH_z1) ) + Zmax0 = max( (BH_z2 - BH_z1) ) + Ymin = min( Ymin0-2.0, -5.0 ) + Ymax = max( Ymax0+2.0, +5.0 ) + Zmin = min( Zmin0-2.0, -5.0 ) + Zmax = max( Zmax0+2.0, +5.0 ) + plt.xlim( Ymin, Ymax ) # x axis range from Ymin to Ymax + plt.ylim( Zmin, Zmax ) # z axis range from Zmin to Zmax + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # show grid lines + + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_21_YZ.pdf") ) + plt.close( ) + + # -------------------------- + + # NOTE: file0 is only a filename string here; no file object to close + + print( ) + print( " Black holes' trajectory plot has been finished (2D plot)" ) + print( ) + + return + +#################################################################################### + + + +#################################################################################### + +## Plot relative distances between black holes + +def generate_puncture_distence_plot( outdir, figure_outdir ): + + print( ) + print( " Plotting the black hole relative distance " ) + print( ) + + # path to data file + file0 = os.path.join(outdir, "bssn_BH.dat") + + print( " Corresponding data file = ", file0 ) + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # -------------------------- + + # -------------------------- + + # Plot each black hole's distance R from the origin as a function of time + + # initialize min/max arrays for BH distances + BH_Rmin = numpy.zeros(input_data.puncture_number) + BH_Rmax = numpy.zeros(input_data.puncture_number) + + # create a new figure + fig = plt.figure( figsize=(8,8) ) + plt.title( " Black Hole Position R ", fontsize=18 ) # title + + BH_time = data[:, 0] + + for i in range(input_data.puncture_number): + BH_x = data[:, 3*i+1] + BH_y = data[:, 3*i+2] + BH_z = data[:, 3*i+3] + BH_R = (BH_x*BH_x + BH_y*BH_y + BH_z*BH_z)**0.5 + # compute distance R using numpy + BH_Rmin[i] = min( BH_R ) + BH_Rmax[i] = max( BH_R ) + if i==0: + plt.plot( BH_time, BH_R, color='red', label="BH"+str(i+1), linewidth=2 ) + elif i==1: + plt.plot( BH_time, BH_R, color='green', label="BH"+str(i+1), linewidth=2 ) + elif i==2: + plt.plot( BH_time, BH_R, color='blue', label="BH"+str(i+1), linewidth=2 ) + elif i==3: + plt.plot( BH_time, BH_R, color='gray', label="BH"+str(i+1), linewidth=2 ) + + # set axis labels + plt.xlabel( " $T$ [M] ", fontsize=16 ) + plt.ylabel( " $R$ [M] ", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + R_min0 = min( BH_Rmin ) + R_max0 = max( BH_Rmax ) + R_min = max( R_min0-2.0, 0.0 ) + R_max = max( R_max0+2.0, +5.0 ) + plt.ylim( R_min, R_max ) # y axis range from R_min to R_max + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + + # plt.show( ) + plt.savefig( os.path.join(figure_outdir, "BH_Position_R.pdf") ) + plt.close( ) + + # -------------------------- + + # extract coordinates for BH1 and BH2 + BH_x1 = data[:, 1] + BH_y1 = data[:, 2] + BH_z1 = data[:, 3] + BH_x2 = data[:, 4] + BH_y2 = data[:, 5] + BH_z2 = data[:, 6] + + # compute relative distance R12 between BH1 and BH2 + BH_R12 = ( (BH_x2-BH_x1)**2 + (BH_y2-BH_y1)**2 + (BH_z2-BH_z1)**2 )**0.5 + + # -------------------------- + + # plot relative distance R12 between BH1 and BH2 as a function of time + + plt.figure( figsize=(8,8) ) + plt.title( " Black Hole Distance ", fontsize=18 ) + plt.plot( BH_time, BH_R12, color='blue', linewidth=2 ) + plt.xlabel( " $T$ [M] ", fontsize=16 ) + plt.ylabel( " $R_{12}$ [M] ", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + R12_min0 = min( BH_R12 ) + R12_max0 = max( BH_R12 ) + R12_min = max( R12_min0-2.0, 0.0 ) + R12_max = max( R12_max0+2.0, +5.0 ) + plt.ylim( R12_min, R12_max ) # y axis range from R12_min to R12_max + + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # show grid lines + + plt.savefig( os.path.join(figure_outdir, "BH_Distance_21.pdf") ) + plt.close( ) + + print( ) + print( " black hole relative distance plot has been finished " ) + print( ) + + # -------------------------- + + return + +#################################################################################### + + + +#################################################################################### + +## Plot black-hole puncture trajectories (3D) + +def generate_puncture_orbit_plot3D( outdir, figure_outdir ): + + print( ) + print( " Plotting the black holes' trajectory (3D plot) " ) + print( ) + + # path to data file + file0 = os.path.join(outdir, "bssn_BH.dat") + + print( " Corresponding data file = ", file0 ) + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # initialize min/max arrays for black-hole coordinates + BH_Xmin = numpy.zeros(input_data.puncture_number) + BH_Xmax = numpy.zeros(input_data.puncture_number) + BH_Ymin = numpy.zeros(input_data.puncture_number) + BH_Ymax = numpy.zeros(input_data.puncture_number) + BH_Zmin = numpy.zeros(input_data.puncture_number) + BH_Zmax = numpy.zeros(input_data.puncture_number) + + # create a new figure + fig = plt.figure( figsize=(8,8) ) + + # create a 3D axes + ax = fig.add_subplot(111, projection='3d') + # set title + ax.set_title( " Black Hole Trajectory ", fontsize=18 ) + + for i in range(input_data.puncture_number): + BH_x = data[:, 3*i+1] + BH_y = data[:, 3*i+2] + BH_z = data[:, 3*i+3] + BH_Xmin[i] = min( BH_x ) + BH_Xmax[i] = max( BH_x ) + BH_Ymin[i] = min( BH_y ) + BH_Ymax[i] = max( BH_y ) + BH_Zmin[i] = min( BH_z ) + BH_Zmax[i] = max( BH_z ) + if i==0: + ax.plot( BH_x, BH_y, BH_z, color='red', label="BH"+str(i+1), linewidth=2 ) + elif i==1: + ax.plot( BH_x, BH_y, BH_z, color='green', label="BH"+str(i+1), linewidth=2 ) + elif i==2: + ax.plot( BH_x, BH_y, BH_z, color='blue', label="BH"+str(i+1), linewidth=2 ) + elif i==3: + ax.plot( BH_x, BH_y, BH_z, color='gray', label="BH"+str(i+1), linewidth=2 ) + + # set axis labels + ax.set_xlabel( "X [M]", fontsize=16 ) + ax.set_ylabel( "Y [M]", fontsize=16 ) + ax.set_zlabel( "Z [M]", fontsize=16 ) + plt.legend( loc='upper right' ) + + # set axis ranges + Xmin0 = min( BH_Xmin ) + Xmax0 = max( BH_Xmax ) + Ymin0 = min( BH_Ymin ) + Ymax0 = max( BH_Ymax ) + Zmin0 = min( BH_Zmin ) + Zmax0 = max( BH_Zmax ) + Xmin = min( Xmin0-2.0, -5.0 ) + Xmax = max( Xmax0+2.0, +5.0 ) + Ymin = min( Ymin0-2.0, -5.0 ) + Ymax = max( Ymax0+2.0, +5.0 ) + Zmin = min( Zmin0-2.0, -5.0 ) + Zmax = max( Zmax0+2.0, +5.0 ) + ax.set_xlim( [Xmin, Xmax] ) + ax.set_ylim( [Ymin, Ymax] ) + ax.set_zlim( [Zmin, Zmax] ) + + plt.savefig( os.path.join(figure_outdir, "BH_Trajectory_3D.pdf") ) + plt.close( ) + + print( ) + print( " Black holes' trajectory plot has been finished (3D plot)" ) + print( ) + + return + + +#################################################################################### + + + +#################################################################################### + +## Plot gravitational-wave waveform Psi4 + +def generate_gravitational_wave_psi4_plot( outdir, figure_outdir, detector_number_i ): + + + # path to data file + file0 = os.path.join(outdir, "bssn_psi4.dat") + + if ( detector_number_i == 0 ): + print( ) + print( " Plotting the Weyl conformal component Psi4 " ) + print( ) + print( " corresponding data file = ", file0 ) + print( ) + + print( " Begin the Weyl conformal Psi4 plot for detector number = ", detector_number_i ) + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # extract columns from the Phi4 file + time = data[:,0] + psi4_l2m2m_real = data[:,1] + psi4_l2m2m_imaginary = data[:,2] + psi4_l2m1m_real = data[:,3] + psi4_l2m1m_imaginary = data[:,4] + psi4_l2m0_real = data[:,5] + psi4_l2m0_imaginary = data[:,6] + psi4_l2m1_real = data[:,7] + psi4_l2m1_imaginary = data[:,8] + psi4_l2m2_real = data[:,9] + psi4_l2m2_imaginary = data[:,10] + + # NOTE: file0 is only a filename string here; no file object to close + + # In Python division returns float; use integer division here + length = len(time) // input_data.Detector_Number + + time2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2m_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2m_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1m_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1m_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m0_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m0_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m1_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2_real2 = numpy.zeros( (input_data.Detector_Number, length) ) + psi4_l2m2_imaginary2 = numpy.zeros( (input_data.Detector_Number, length) ) + + # split data into arrays corresponding to each detector radius + for i in range(input_data.Detector_Number): + for j in range(length): + time2[i,j] = time[ j*input_data.Detector_Number + i ] + psi4_l2m2m_real2[i,j] = psi4_l2m2m_real[ j*input_data.Detector_Number + i ] + psi4_l2m2m_imaginary2[i,j] = psi4_l2m2m_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m1m_real2[i,j] = psi4_l2m1m_real[ j*input_data.Detector_Number + i ] + psi4_l2m1m_imaginary2[i,j] = psi4_l2m1m_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m0_real2[i,j] = psi4_l2m0_real[ j*input_data.Detector_Number + i ] + psi4_l2m0_imaginary2[i,j] = psi4_l2m0_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m1_real2[i,j] = psi4_l2m1_real[ j*input_data.Detector_Number + i ] + psi4_l2m1_imaginary2[i,j] = psi4_l2m1_imaginary[ j*input_data.Detector_Number + i ] + psi4_l2m2_real2[i,j] = psi4_l2m2_real[ j*input_data.Detector_Number + i ] + psi4_l2m2_imaginary2[i,j] = psi4_l2m2_imaginary[ j*input_data.Detector_Number + i ] + + # compute detector distance from input parameters + Detector_Interval = ( input_data.Detector_Rmax - input_data.Detector_Rmin ) / ( input_data.Detector_Number - 1 ) + Detector_Distance_R = input_data.Detector_Rmax - Detector_Interval * detector_number_i + + plt.figure( figsize=(8,8) ) ## figsize sets the figure size + plt.title( f" Gravitational Wave $\Psi_{4}$ Detector Distance = { Detector_Distance_R } ", fontsize=18 ) ## fontsize sets the title size + plt.plot( time2[detector_number_i], psi4_l2m0_real2[detector_number_i], \ + color='red', label="l=2 m=0 real", linewidth=2 ) + plt.plot( time2[detector_number_i], psi4_l2m0_imaginary2[detector_number_i], \ + color='orange', label="l=2 m=0 imaginary", linestyle='--', linewidth=2 ) + plt.plot( time2[detector_number_i], psi4_l2m1_real2[detector_number_i], \ + color='green', label="l=2 m=1 real", linewidth=2 ) + plt.plot( time2[detector_number_i], psi4_l2m1_imaginary2[detector_number_i], \ + color='cyan', label="l=2 m=1 imaginary", linestyle='--', linewidth=2 ) + plt.plot( time2[detector_number_i], psi4_l2m2_real2[detector_number_i], \ + color='black', label="l=2 m=2 real", linewidth=2 ) + plt.plot( time2[detector_number_i], psi4_l2m2_imaginary2[detector_number_i], \ + color='gray', label="l=2 m=2 imaginary", linestyle='--', linewidth=2 ) + plt.xlabel( "T [M]", fontsize=16 ) + plt.ylabel( r"$R*\Psi$", fontsize=16 ) + plt.legend( loc='upper right' ) + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + plt.savefig( os.path.join(figure_outdir, "Gravitational_Psi4_Detector_" + str(detector_number_i) + ".pdf") ) + + + print( " The Weyl Conformal component Psi4 plot has been finished ", " detector number ", detector_number_i ) + print( ) + + if ( detector_number_i == (input_data.Detector_Number-1) ): + print( ) + print( " The Weyl conformal component Psi4 plots have been finished " ) + print( ) + + + return + +#################################################################################### + + + +#################################################################################### + +## Plot ADM mass and angular momentum + +def generate_ADMmass_plot( outdir, figure_outdir, detector_number_i ): + + + # path to data file + file0 = os.path.join(outdir, "bssn_ADMQs.dat") + + if ( detector_number_i == 0 ): + print( ) + print( " Plotting the ADM mass and angular momentum " ) + print( ) + print( " corresponding data file = ", file0 ) + print( ) + + print( " Begin the ADM momentum plot for detector number = ", detector_number_i ) + + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # extract columns from the ADM momentum file + time = data[:,0] + ADM_mass = data[:,1] + ADM_Px = data[:,2] + ADM_Py = data[:,3] + ADM_Pz = data[:,4] + ADM_Jx = data[:,5] + ADM_Jy = data[:,6] + ADM_Jz = data[:,7] + + # NOTE: file0 is only a filename string here; no file object to close + + # In Python division returns a float; use integer division here + length = len(time) // input_data.Detector_Number + + ''' + # split data into arrays corresponding to each detector radius (disabled) + # time2 = time.reshape( (input_data.Detector_Number, length) ) + # ADM_mass2 = ADM_mass.reshape( (input_data.Detector_Number, length) ) + # ADM_Px2 = ADM_Px.reshape( (input_data.Detector_Number, length) ) + # ADM_Py2 = ADM_Py.reshape( (input_data.Detector_Number, length) ) + # ADM_Pz2 = ADM_Pz.reshape( (input_data.Detector_Number, length) ) + # ADM_Jx2 = ADM_Jx.reshape( (input_data.Detector_Number, length) ) + # ADM_Jy2 = ADM_Jy.reshape( (input_data.Detector_Number, length) ) + # ADM_Jz2 = ADM_Jz.reshape( (input_data.Detector_Number, length) ) + ''' + # Rows/cols in reshape were unclear; use straightforward indexing instead + time2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_mass2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Px2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Py2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Pz2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Jx2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Jy2 = numpy.zeros( (input_data.Detector_Number, length) ) + ADM_Jz2 = numpy.zeros( (input_data.Detector_Number, length) ) + + # split data into arrays corresponding to each detector radius + for i in range(input_data.Detector_Number): + for j in range(length): + time2[i,j] = time[ j*input_data.Detector_Number + i ] + ADM_mass2[i,j] = ADM_mass[ j*input_data.Detector_Number + i ] + ADM_Px2[i,j] = ADM_Px[ j*input_data.Detector_Number + i ] + ADM_Py2[i,j] = ADM_Py[ j*input_data.Detector_Number + i ] + ADM_Pz2[i,j] = ADM_Pz[ j*input_data.Detector_Number + i ] + ADM_Jx2[i,j] = ADM_Jx[ j*input_data.Detector_Number + i ] + ADM_Jy2[i,j] = ADM_Jy[ j*input_data.Detector_Number + i ] + ADM_Jz2[i,j] = ADM_Jz[ j*input_data.Detector_Number + i ] + + # compute detector distance from input parameters + Detector_Interval = ( input_data.Detector_Rmax - input_data.Detector_Rmin ) / ( input_data.Detector_Number - 1 ) + Detector_Distance_R = input_data.Detector_Rmax - Detector_Interval * detector_number_i + + # Plot ADM momentum for the current detector radius + plt.figure( figsize=(8,8) ) + plt.title(f" ADM Momentum Detector Distence = {Detector_Distance_R}", fontsize=18 ) + plt.plot( time2[detector_number_i], ADM_mass2[detector_number_i], color='red', label="ADM Mass", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Px2[detector_number_i], color='green', label="ADM Px", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Py2[detector_number_i], color='cyan', label="ADM Py", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Pz2[detector_number_i], color='blue', label="ADM Pz", linewidth=2 ) + plt.xlabel( "T [M]", fontsize=16 ) + plt.ylabel( "ADM Momentum [M]", fontsize=16 ) + plt.legend( loc='upper right' ) + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + plt.savefig( os.path.join(figure_outdir, "ADM_Mass_Dector_" + str(detector_number_i) + ".pdf") ) + + # Plot ADM angular momentum for the current detector radius + plt.figure( figsize=(8,8) ) + plt.title(f" ADM Angular Momentum Detector Distence = {Detector_Distance_R}", fontsize=18 ) + # plt.plot( time2[detector_number_i], ADM_mass2[detector_number_i], color='red', label="ADM Mass", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Jx2[detector_number_i], color='green', label="ADM Jx", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Jy2[detector_number_i], color='cyan', label="ADM Jy", linewidth=2 ) + plt.plot( time2[detector_number_i], ADM_Jz2[detector_number_i], color='blue', label="ADM Jz", linewidth=2 ) + plt.xlabel( "T [M]", fontsize=16 ) + plt.ylabel( "ADM Angular Momentum [$M^2$]", fontsize=16 ) + plt.legend( loc='upper right' ) + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + plt.savefig( os.path.join(figure_outdir, "ADM_Angular_Momentum_Dector_" + str(detector_number_i) + ".pdf") ) + + + print( " ADM momentum plot has been finished, detector number = ", detector_number_i ) + print( ) + + if ( detector_number_i == (input_data.Detector_Number-1) ): + print( " The ADM mass and augular momentum plots have been finished " ) + print( ) + + return + +#################################################################################### + + + +#################################################################################### + +## Plot constraint violation for each grid level + +def generate_constraint_check_plot( outdir, figure_outdir, input_level_number ): + + # path to data file + file0 = os.path.join(outdir, "bssn_constraint.dat") + + if ( input_level_number == 0 ): + print( ) + print( " Plotting the constraint violation for each grid level" ) + print( ) + print( " corresponding data file = ", file0 ) + print( ) + + print( " Begin the constraint violation plot for grid level number = ", input_level_number ) + + # load the full data file (assumed whitespace-separated floats) + data = numpy.loadtxt(file0) + + # extract columns from the constraint data file + time = data[:,0] + Constraint_H = data[:,1] + Constraint_Px = data[:,2] + Constraint_Py = data[:,3] + Constraint_Pz = data[:,4] + Constraint_Gx = data[:,5] + Constraint_Gy = data[:,6] + Constraint_Gz = data[:,7] + + # NOTE: file0 is only a filename string here; no file object to close + + # initialize arrays for different quantities + + if (input_data.basic_grid_set == "Patch"): + level_number = input_level_number + length0 = input_data.grid_level + # In Python division returns a float; use integer division here + length1 = len(time) // length0 + elif (input_data.basic_grid_set == "Shell-Patch"): + # If grid type is Shell-Patch, increment the grid-level count + level_number = input_level_number + 1 + length0 = input_data.grid_level + 1 + # In Python division returns a float; use integer division here + length1 = len(time) // length0 + + time2 = numpy.zeros( (length0, length1) ) + Constraint_H2 = numpy.zeros( (length0, length1) ) + Constraint_Px2 = numpy.zeros( (length0, length1) ) + Constraint_Py2 = numpy.zeros( (length0, length1) ) + Constraint_Pz2 = numpy.zeros( (length0, length1) ) + Constraint_Gx2 = numpy.zeros( (length0, length1) ) + Constraint_Gy2 = numpy.zeros( (length0, length1) ) + Constraint_Gz2 = numpy.zeros( (length0, length1) ) + + # split data into arrays corresponding to each grid level + for i in range(length0): + for j in range(length1): + time2[i,j] = time[ j*length0 + i ] + Constraint_H2[i,j] = Constraint_H[ j*length0 + i ] + Constraint_Px2[i,j] = Constraint_Px[ j*length0 + i ] + Constraint_Py2[i,j] = Constraint_Py[ j*length0 + i ] + Constraint_Pz2[i,j] = Constraint_Pz[ j*length0 + i ] + + # Plot constraint violation for the outermost grid level + plt.figure( figsize=(8,8) ) + plt.title( f" ADM Constraint Grid Level = {input_level_number}", fontsize=18 ) + plt.plot( time2[level_number], Constraint_H2[level_number], color='red', label="ADM Constraint H", linewidth=2 ) + plt.plot( time2[level_number], Constraint_Px2[level_number], color='green', label="ADM Constraint Px", linewidth=2 ) + plt.plot( time2[level_number], Constraint_Py2[level_number], color='cyan', label="ADM Constraint Py", linewidth=2 ) + plt.plot( time2[level_number], Constraint_Pz2[level_number], color='blue', label="ADM Constraint Pz", linewidth=2 ) + plt.xlabel( "T [M]", fontsize=16 ) + plt.ylabel( "ADM Constraint", fontsize=16 ) + plt.legend( loc='upper right' ) + plt.grid( color='gray', linestyle='--', linewidth=0.5 ) # display grid lines + plt.savefig( os.path.join(figure_outdir, "ADM_Constraint_Grid_Level_" + str(input_level_number) + ".pdf") ) + + + print( " Constraint violation plot has been finished, grid level number = ", input_level_number ) + print( ) + + if ( input_level_number == (input_data.grid_level-1) ): + print( " Constraint violation plot has been finished " ) + print( ) + + return + +#################################################################################### + + + +#################################################################################### + +# Standalone examples +''' +outdir = "./BBH_q=1" + +generate_puncture_orbit_plot( outdir, outdir ) +generate_puncture_orbit_plot3D( outdir, outdir ) +generate_puncture_distence_plot( outdir, outdir ) + +for i in range(input_data.grid_level): + generate_constraint_check_plot( outdir, outdir, i ) + +for i in range(input_data.Detector_Number): + generate_ADMmass_plot( outdir, outdir, i ) + +for i in range(input_data.Detector_Number): + generate_gravitational_wave_psi4_plot( outdir, outdir, i ) +''' +#################################################################################### + + diff --git a/print_information.py b/print_information.py new file mode 100755 index 0000000..26c3f55 --- /dev/null +++ b/print_information.py @@ -0,0 +1,42 @@ + +################################################################## +## +## the introduction of AMSS-NCKU program +## author:xiaoqu +## 2025/02/07 +## +################################################################## + + + +################################################################## + + +def print_program_introduction(): + print( ) + print( "------------------------------------------------------------------------------------------" ) + print( ) + print( " Numerical Relativity AMSS-NCKU " ) + print( ) + print( " Author of AMSS-NCKU Code: Zhou-Jian Cao et al. " ) + print( " Author of AMSS-NCKU Python Interface: Xiao Qu " ) + print( ) + print( " AMSS-NCKU is an open source numerical relativity code " ) + print( " It can be used to simulate the dynamical evolution on mergering process of black hole systems, " ) + print( " calculating the variation of gravitational field, black holes' trajectories, and gravitational wave " ) + print( " emissions through directly solving the Einstein field equations " ) + print( ) + print( " This AMSS-NCKU code uses the finite-difference method to evaluate the numerical simulation. The " ) + print( " finite-difference schemes can be chosen as: 2nd order, 4th order, 6th order, 8th order. " ) + print( " The computation equation form in AMSS-NCKU code can be chosen as: BSSN equations, Z4C equations, " ) + print( " BSSN equations coupled with scalars (in f(R) theory), BSSN equations coupled with electromagnetic " ) + print( " fields. " ) + print( " The numerical grid system in this code includes: patch AMR grid, shell-patch AMR grid. " ) + print( ) + print( " Furthermore, This code has fulfilled the CPU and GPU hybrid calculation. " ) + print( ) + print( "------------------------------------------------------------------------------------------" ) + print( ) + +################################################################## + diff --git a/renew_puncture_parameter.py b/renew_puncture_parameter.py new file mode 100755 index 0000000..7a76ccd --- /dev/null +++ b/renew_puncture_parameter.py @@ -0,0 +1,133 @@ + +################################################################## +## +## Update puncture parameters from TwoPuncture output +## Author: Xiaoqu +## 2024/12/04 +## +################################################################## + +import AMSS_NCKU_Input as input_data +import numpy +import os + +################################################################## + + + +################################################################## + +def read_TwoPuncture_Output(Output_File_directory): + + dimensionless_mass_BH = numpy.zeros( input_data.puncture_number ) + bare_mass_BH = numpy.zeros( input_data.puncture_number ) ## initialize bare mass for each black hole + position_BH = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize initial position for each black hole + momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize momentum for each black hole + angular_momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize spin angular momentum for each black hole + + # Read TwoPuncture output file + data = numpy.loadtxt( os.path.join(Output_File_directory, "puncture_parameters_new.txt") ) + # Ensure data is parsed as a 1-D array + data = data.reshape(-1) + + for i in range(input_data.puncture_number): + + ## Read parameters for the first two punctures from TwoPuncture output + ## For additional punctures, read parameters from the input file + if i<2: + bare_mass_BH[i] = data[12*i] + dimensionless_mass_BH[i] = data[12*i+1] + position_BH[i] = [ data[12*i+3], data[12*i+4], data[12*i+5] ] + momentum_BH[i] = [ data[12*i+6], data[12*i+7], data[12*i+8] ] + angular_momentum_BH[i] = [ data[12*i+9], data[12*i+10], data[12*i+11] ] + else: + dimensionless_mass_BH[i] = input_data.parameter_BH[i,0] + bare_mass_BH[i] = input_data.parameter_BH[i,0] + position_BH[i] = input_data.position_BH[i] + momentum_BH[i] = input_data.momentum_BH[i] + ## Read angular momentum according to symmetry + if ( input_data.Symmetry == "equatorial-symmetry" ): + angular_momentum_BH[i] = [ 0.0, 0.0, (input_data.parameter_BH[i,0]**2) * input_data.parameter_BH[i,2] ] + elif ( input_data.Symmetry == "no-symmetry" ): + angular_momentum_BH[i] = (dimensionless_mass_BH[i]**2) * input_data.dimensionless_spin_BH[i] + + return bare_mass_BH, dimensionless_mass_BH, position_BH, momentum_BH, angular_momentum_BH + +################################################################## + + +################################################################## + +## Append the computed puncture information into the AMSS-NCKU input file + +def append_AMSSNCKU_BSSN_input(File_directory, TwoPuncture_File_directory): + + charge_Q_BH = numpy.zeros( input_data.puncture_number ) ## initialize charge for each black hole + + ## If using Ansorg-TwoPuncture to solve the initial-data problem, read + ## bare masses, positions and angular momenta from TwoPuncture output + if (input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + bare_mass_BH, dimensionless_mass_BH, position_BH, momentum_BH, angular_momentum_BH = read_TwoPuncture_Output(TwoPuncture_File_directory) + # set charge for each black hole + for i in range(input_data.puncture_number): + charge_Q_BH[i] = dimensionless_mass_BH[i] * input_data.parameter_BH[i,1] + + ## If using another method for initial data, read parameters directly from input + else: + position_BH = input_data.position_BH + momentum_BH = input_data.momentum_BH + ## angular_momentum_BH = input_data.angular_momentum_BH + angular_momentum_BH = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize spin angular momentum array + mass_BH = numpy.zeros( input_data.puncture_number ) ## initialize mass array + + ## Set charge and spin angular momentum for each puncture + for i in range(input_data.puncture_number): + + if ( input_data.Symmetry == "octant-symmetry" ): + mass_BH[i] = input_data.parameter_BH[i,0] + charge_Q_BH[i] = mass_BH[i]* input_data.parameter_BH[i,1] + angular_momentum_BH[i] = [ 0.0, 0.0, (mass_BH[i]**2) * input_data.parameter_BH[i,2] ] + elif ( input_data.Symmetry == "equatorial-symmetry" ): + mass_BH[i] = input_data.parameter_BH[i,0] + charge_Q_BH[i] = mass_BH[i]* input_data.parameter_BH[i,1] + angular_momentum_BH[i] = [ 0.0, 0.0, (mass_BH[i]**2) * input_data.parameter_BH[i,2] ] + elif ( input_data.Symmetry == "no-symmetry" ): + mass_BH[i] = input_data.parameter_BH[i,0] + angular_momentum_BH[i] = (mass_BH[i]**2) * input_data.dimensionless_spin_BH[i] + charge_Q_BH[i] = mass_BH[i] * input_data.parameter_BH[i,1] + + file1 = open( os.path.join(input_data.File_directory, "AMSS-NCKU.input"), "a") ## open file in append mode + + ## Output BSSN related settings + + print( file=file1 ) + print( "BSSN::chitiny = 1e-5", file=file1 ) + print( "BSSN::time refinement start from level = ", input_data.refinement_level, file=file1 ) + print( "BSSN::BH_num = ", input_data.puncture_number, file=file1 ) + + for i in range(input_data.puncture_number): + + if (input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + print( f"BSSN::Mass[{i}] = { bare_mass_BH[i] } ", file=file1 ) + else: + print( f"BSSN::Mass[{i}] = { mass_BH[i] } ", file=file1 ) + + print( f"BSSN::Qchar[{i}] = { charge_Q_BH[i] } ", file=file1 ) + print( f"BSSN::Porgx[{i}] = { position_BH[i,0] } ", file=file1 ) + print( f"BSSN::Porgy[{i}] = { position_BH[i,1] } ", file=file1 ) + print( f"BSSN::Porgz[{i}] = { position_BH[i,2] } ", file=file1 ) + print( f"BSSN::Pmomx[{i}] = { momentum_BH[i,0] } ", file=file1 ) + print( f"BSSN::Pmomy[{i}] = { momentum_BH[i,1] } ", file=file1 ) + print( f"BSSN::Pmomz[{i}] = { momentum_BH[i,2] } ", file=file1 ) + print( f"BSSN::Spinx[{i}] = { angular_momentum_BH[i,0] } ", file=file1 ) + print( f"BSSN::Spiny[{i}] = { angular_momentum_BH[i,1] } ", file=file1 ) + print( f"BSSN::Spinz[{i}] = { angular_momentum_BH[i,2] } ", file=file1 ) + + print( file=file1 ) + + file1.close() + + return + +################################################# + diff --git a/setup.py b/setup.py new file mode 100755 index 0000000..d418031 --- /dev/null +++ b/setup.py @@ -0,0 +1,341 @@ + +################################################################## +## +## definition of printing the basic information of AMSS-NCKU program +## author:xiaoqu +## 2024/03/22 +## 2025/09/13 modified +## +################################################################## + +import AMSS_NCKU_Input as input_data +import numpy +import os +import math + +################################################################## + +devide_factor = input_data.devide_factor + +static_grid_level = input_data.static_grid_level +moving_grid_level = input_data.moving_grid_level +total_grid_level = input_data.grid_level + +static_grid_number = input_data.static_grid_number +moving_grid_number = input_data.moving_grid_number + +if ( input_data.Symmetry=="octant-symmetry" ): + maximal_domain_size_static_x = numpy.array( [ 0.0, input_data.largest_box_xyz_max[0] ] ) + maximal_domain_size_static_y = numpy.array( [ 0.0, input_data.largest_box_xyz_max[1] ] ) + maximal_domain_size_static_z = numpy.array( [ 0.0, input_data.largest_box_xyz_max[2] ] ) +elif( input_data.Symmetry=="octant-symmetry" ): + maximal_domain_size_static_x = numpy.array( [ input_data.largest_box_xyz_min[0], input_data.largest_box_xyz_max[0] ] ) + maximal_domain_size_static_y = numpy.array( [ input_data.largest_box_xyz_min[1], input_data.largest_box_xyz_max[1] ] ) + maximal_domain_size_static_z = numpy.array( [ 0.0, input_data.largest_box_xyz_max[2] ] ) +else: + maximal_domain_size_static_x = numpy.array( [ input_data.largest_box_xyz_min[0], input_data.largest_box_xyz_max[0] ] ) + maximal_domain_size_static_y = numpy.array( [ input_data.largest_box_xyz_min[1], input_data.largest_box_xyz_max[1] ] ) + maximal_domain_size_static_z = numpy.array( [ input_data.largest_box_xyz_min[2], input_data.largest_box_xyz_max[2] ] ) + +minimal_domain_size_static_x = maximal_domain_size_static_x / ( (devide_factor)**(static_grid_level-1) ) +minimal_domain_size_static_y = maximal_domain_size_static_y / ( (devide_factor)**(static_grid_level-1) ) +minimal_domain_size_static_z = maximal_domain_size_static_z / ( (devide_factor)**(static_grid_level-1) ) +maximal_domain_size_moving = ( minimal_domain_size_static_x / devide_factor ) * ( moving_grid_number / static_grid_number ) +minimal_domain_size_moving = maximal_domain_size_moving / ( (devide_factor)**(input_data.moving_grid_level-1) ) + +maximal_resolution_static = (input_data.largest_box_xyz_max[0] - input_data.largest_box_xyz_min[0]) / static_grid_number +minimal_resolution_static = maximal_resolution_static / ( (devide_factor)**(static_grid_level-1) ) +maximal_resolution_moving = minimal_resolution_static / devide_factor +minimal_resolution_moving = maximal_resolution_moving / ( (devide_factor)**(moving_grid_level-1) ) + +TimeStep = input_data.Courant_Factor * maximal_resolution_static / ( (devide_factor)**(input_data.refinement_level) ) + +shell_grid_number = input_data.shell_grid_number +minimal_domain_size_shellpatch = input_data.largest_box_xyz_max[0] +maximal_domain_size_shellpatch = input_data.largest_box_xyz_max[0] + maximal_resolution_static * shell_grid_number[2] +shellpatch_resolution_R = maximal_resolution_static +shellpatch_resolution_theta = 0.5 * math.pi / shell_grid_number[1] +shellpatch_resolution_phi = 0.5 * math.pi / shell_grid_number[0] + +################################################################## + +## this function is used to print the basic input data of the whole program + +def print_input_data( File_directory ): + + print( "------------------------------------------------------------------------------------------" ) + print( ) + print( " Printing the basic parameter and setting in the AMSS-NCKU simulation " ) + print( ) + print( " The number of MPI processes in the AMSS-NCKU simulation = ", input_data.MPI_processes ) + print( ) + print( " The form of computational equation = ", input_data.Equation_Class ) + print( " The initial data in this simulation = ", input_data.Initial_Data_Method ) + print( ) + print( " Starting evolution time = ", input_data.Start_Evolution_Time ) + print( " Final evolution time = ", input_data.Final_Evolution_Time ) + print( " Maximal iteration number = ", input_data.Evolution_Step_Number ) + print( " Courant factor = ", input_data.Courant_Factor ) + print( " Strength of dissipation = ", input_data.Dissipation ) + print( " Symmetry of system = ", input_data.Symmetry ) + print( " The Runge-Kutta scheme in the time evolution = ", input_data.Time_Evolution_Method ) + print( " The finite-difference scheme in the simulation = ", input_data.Finite_Diffenence_Method ) + print( ) + print( " The static AMR grid type = ", input_data.static_grid_type ) + print( " The moving AMR grid type = ", input_data.moving_grid_type ) + print( ) + print( " The number of static AMR grid levels = ", static_grid_level ) + print( " The number of moving AMR grid levels = ", moving_grid_level ) + print( " The number of total AMR grid levels = ", total_grid_level ) + print( ) + print( " The grid number of each static AMR grid level = ", static_grid_number ) + print( " The grid number of each moving AMR grid level = ", moving_grid_number ) + print( ) + print( " The scale for largest static AMR grid in X direction = ", maximal_domain_size_static_x ) + print( " The scale for largest static AMR grid in Y direction = ", maximal_domain_size_static_y ) + print( " The scale for largest static AMR grid in Z direction = ", maximal_domain_size_static_z ) + print( " The scale for smallest static AMR grid in X direction = ", minimal_domain_size_static_x ) + print( " The scale for smallest static AMR grid in Y direction = ", minimal_domain_size_static_y ) + print( " The scale for smallest static AMR grid in Z direction = ", minimal_domain_size_static_z ) + print( ) + + if ( input_data.moving_grid_level > 0): + print( " The scale for largest moving AMR grid = ", maximal_domain_size_moving ) + print( " The scale for smallest moving AMR grid = ", minimal_domain_size_moving ) + + print( ) + print( " The coarest resolution for static AMR grid = ", maximal_resolution_static ) + print( " The finest resolution for static AMR grid = ", minimal_resolution_static ) + + if ( input_data.moving_grid_level > 0): + print( " The coarest resolution for moving AMR grid = ", maximal_resolution_moving ) + print( " The finest resolution for moving AMR grid = ", minimal_resolution_moving ) + + print( ) + print( " The time refinement starts from AMR grid level = ", input_data.refinement_level+1 ) + print( " The time interval in each step for coarest AMR grid during time evaluation = ", TimeStep ) + print( ) + + if input_data.basic_grid_set == "Shell-Patch": + print( " The Shell-Patch AMR grid structure is used in this simulation " ) + print( " Shell-Patch grid number = ", shell_grid_number ) + print( " Shell-Patch grid minimal radius = ", minimal_domain_size_shellpatch ) + print( " Shell-Patch grid maximal radius = ", maximal_domain_size_shellpatch ) + print( " Shell-Patch grid radial resolution = ", shellpatch_resolution_R ) + print( " Shell-Patch grid angular resolution = ", shellpatch_resolution_phi, \ + shellpatch_resolution_theta ) + print( ) + elif input_data.basic_grid_set == "Patch": + print( " This simulation only uses the Patch AMR grid structure, the Shell-Patch is not used " ) + print( ) + else: + print( " The AMR grid structure setting is wrong !!! " ) + print( ) + + print( "------------------------------------------------------------------------------------------" ) + + ## file output + + filepath = os.path.join( File_directory, "AMSS_NCKU_resolution" ) + file0 = open(filepath, 'w') + + print( file=file0 ) + print( " Printing the basic parameter and setting in the AMSS-NCKU simulation ", file=file0 ) + print( file=file0 ) + print( " The number of MPI processes in the AMSS-NCKU simulation = ", input_data.MPI_processes, file=file0 ) + print( file=file0 ) + print( " The form of computational equation = ", input_data.Equation_Class, file=file0 ) + print( " The initial data in this simulation = ", input_data.Initial_Data_Method, file=file0 ) + print( file=file0 ) + print( " Starting evolution time = ", input_data.Start_Evolution_Time, file=file0 ) + print( " Final evolution time = ", input_data.Final_Evolution_Time, file=file0 ) + print( " Maximal iteration number = ", input_data.Evolution_Step_Number, file=file0 ) + print( " Courant factor = ", input_data.Courant_Factor, file=file0 ) + print( " Strength of dissipation = ", input_data.Dissipation, file=file0 ) + print( " Symmetry of system = ", input_data.Symmetry, file=file0 ) + print( " The Runge-Kutta scheme in the time evolution = ", input_data.Time_Evolution_Method, file=file0 ) + print( " The finite-difference scheme in the simulation = ", input_data.Finite_Diffenence_Method, file=file0 ) + print( file=file0 ) + print( " The static AMR grid type = ", input_data.static_grid_type, file=file0 ) + print( " The moving AMR grid type = ", input_data.moving_grid_type, file=file0 ) + print( file=file0 ) + print( " The number of static AMR grid levels = ", static_grid_level, file=file0 ) + print( " The number of moving AMR grid levels = ", moving_grid_level, file=file0 ) + print( " The number of total AMR grid levels = ", total_grid_level, file=file0 ) + print( file=file0 ) + print( " The grid number of each static AMR grid level = ", static_grid_number, file=file0 ) + print( " The grid number of each moving AMR grid level = ", moving_grid_number, file=file0 ) + print( file=file0 ) + print( " The scale for largest static AMR grid in X direction = ", maximal_domain_size_static_x, file=file0 ) + print( " The scale for largest static AMR grid in Y direction = ", maximal_domain_size_static_y, file=file0 ) + print( " The scale for largest static AMR grid in Z direction = ", maximal_domain_size_static_z, file=file0 ) + print( " The scale for smallest static AMR grid in X direction = ", minimal_domain_size_static_x, file=file0 ) + print( " The scale for smallest static AMR grid in Y direction = ", minimal_domain_size_static_y, file=file0 ) + print( " The scale for smallest static AMR grid in Z direction = ", minimal_domain_size_static_z, file=file0 ) + print( ) + + if ( input_data.moving_grid_level > 0): + print( " The scale for largest moving AMR grid = ", maximal_domain_size_moving, file=file0 ) + print( " The scale for smallest moving AMR grid = ", minimal_domain_size_moving, file=file0 ) + + print( file=file0 ) + print( " The coarest resolution for static AMR grid = ", maximal_resolution_static, file=file0 ) + print( " The finest resolution for static AMR grid = ", minimal_resolution_static, file=file0 ) + + if ( input_data.moving_grid_level > 0): + print( " The coarest resolution for moving AMR grid = ", maximal_resolution_moving, file=file0 ) + print( " The finest resolution for moving AMR grid = ", minimal_resolution_moving, file=file0 ) + + print( file=file0 ) + print( " The time refinement starts from AMR grid level = ", input_data.refinement_level+1, file=file0 ) + print( " The time interval in each step for coarest AMR grid during time evaluation = ", TimeStep, file=file0 ) + print( file=file0 ) + + if input_data.basic_grid_set == "Shell-Patch": + print( " The Shell-Patch AMR grid structure is used in this simulation ", file=file0 ) + print( " Shell-Patch grid number = ", shell_grid_number, file=file0 ) + print( " Shell-Patch grid minimal radius = ", minimal_domain_size_shellpatch, file=file0 ) + print( " Shell-Patch grid maximal radius = ", maximal_domain_size_shellpatch, file=file0 ) + print( " Shell-Patch grid radial resolution = ", shellpatch_resolution_R, file=file0 ) + print( " Shell-Patch grid angular resolution = ", shellpatch_resolution_phi, \ + shellpatch_resolution_theta, file=file0 ) + print( file=file0 ) + elif input_data.basic_grid_set == "Patch": + print( " This simulation only uses the Patch AMR grid structure, the Shell-Patch is not used ", file=file0 ) + print( file=file0 ) + else: + print( " The AMR grid structure setting is wrong !!! ", file=file0 ) + print( file=file0 ) + +################################################################## + + +################################################################## + +# output the puncture information + +def print_puncture_information(): + position = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize the position of each black hole + momentum = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize the momentum of each black hole + angular_momentum = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize the angular momentum of each black hole + parameter = numpy.zeros( (input_data.puncture_number, 3) ) ## initialize the parameter of each black hole + + print("------------------------------------------------------------------------------------------") + print( ) + print( " Printing the puncture information " ) + print( ) + + for i in range(input_data.puncture_number): + + ## set the parameter of each black hole + parameter[i] = input_data.parameter_BH[i] + position[i] = input_data.position_BH[i] + momentum[i] = input_data.momentum_BH[i] + ## angular_momentum[i] = input_data.angular_momentum_BH[i] + + ## setting the angular momentum of each black hole according to the input file + if ( input_data.Symmetry == "equatorial-symmetry" ): + angular_momentum[i] = [ 0.0, 0.0, (input_data.parameter_BH[i,0]**2) * input_data.parameter_BH[i,2] ] + elif ( input_data.Symmetry == "no-symmetry" ): + angular_momentum[i] = (input_data.parameter_BH[i,0]**2) * input_data.dimensionless_spin_BH[i] + + print( f" The information for {i+1} puncture " ) + print( f" Mass({i+1}) = {parameter[i,0] :>10.6f}, Charge({i+1}) = {parameter[i,1] :>10.6f}, a({i+1}) = {parameter[i,2] :>10.6f}" ) + print( f" X({i+1}) = {position[i,0] :>10.6f}, Y({i+1}) = {position[i,1] :>10.6f}, Z({i+1}) = {position[i,2] :>10.6f}" ) + print( f" Px({i+1}) = {momentum[i,0] :>10.6f}, Py({i+1}) = {momentum[i,1] :>10.6f}, Pz({i+1}) = {momentum[i,2] :>10.6f}" ) + print( f" Jx({i+1}) = {angular_momentum[i,0]:>10.6f}, Jy({i+1}) = {angular_momentum[i,1]:>10.6f}, Jz({i+1}) = {angular_momentum[i,2]:>10.6f}" ) + print() + + print("------------------------------------------------------------------------------------------") + +################################################################## + +## Generate the input parfile for AMSS-NCKU program + +def generate_AMSSNCKU_input(): + + file1 = open( os.path.join(input_data.File_directory, "AMSS-NCKU.input"), "w" ) + ## file1 = open( "AMSS-NCKU.input", "w" ) + + ## output ABE related settings + + print( file=file1 ) + print( "ABE::checkrun = 0", file=file1 ) + print( "ABE::checkfile = bssn.chk", file=file1 ) + print( "ABE::Steps = ", input_data.Evolution_Step_Number, file=file1 ) + print( "ABE::StartTime = ", input_data.Start_Evolution_Time, file=file1 ) + print( "ABE::TotalTime = ", input_data.Final_Evolution_Time, file=file1 ) + print( "ABE::DumpTime = ", input_data.Dump_Time, file=file1 ) + print( "ABE::d2DumpTime = ", input_data.D2_Dump_Time, file=file1 ) + print( "ABE::CheckTime = ", input_data.Check_Time, file=file1 ) + print( "ABE::AnalysisTime = ", input_data.Analysis_Time, file=file1 ) + print( "ABE::Courant = ", input_data.Courant_Factor, file=file1 ) + + if ( input_data.Symmetry == "octant-symmetry" ): + print( "ABE::Symmetry = 2 ", file=file1 ) + elif ( input_data.Symmetry == "equatorial-symmetry" ): + print( "ABE::Symmetry = 1 ", file=file1 ) + elif ( input_data.Symmetry == "no-symmetry" ): + print( "ABE::Symmetry = 0 ", file=file1 ) + else : + print( " Symmetry Setting Error" ) + + print( "ABE::small dissipation = ", input_data.Dissipation, file=file1 ) + print( "ABE::big dissipation = ", input_data.Dissipation, file=file1 ) + print( "ABE::shell dissipation = ", input_data.Dissipation, file=file1 ) + print( "ABE::Analysis Level = ", input_data.analysis_level, file=file1 ) + print( "ABE::Max mode l = ", input_data.GW_L_max, file=file1 ) + print( "ABE::detector number = ", input_data.Detector_Number, file=file1 ) + print( "ABE::farest detector position = ", input_data.Detector_Rmax, file=file1 ) + print( f"ABE::detector distance = { (input_data.Detector_Rmax-input_data.Detector_Rmin) / (input_data.Detector_Number-1) }", \ + file=file1 ) + print( "ABE::cpu part = ", input_data.CPU_Part, file=file1 ) + print( "ABE::gpu part = ", input_data.GPU_Part, file=file1 ) + print( "ABE::output dir = ", input_data.Output_directory, file=file1 ) + + if ( input_data.Initial_Data_Method == "Cao-Analytical" ): + print( "ABE::ID Type = -3", file=file1 ) + elif ( input_data.Initial_Data_Method == "KerrSchild-Analytical" ): + print( "ABE::ID Type = -2", file=file1 ) + elif ( input_data.Initial_Data_Method == "Lousto-Analytical" ): + print( "ABE::ID Type = -1", file=file1 ) + elif ( input_data.Initial_Data_Method == "Ansorg-TwoPuncture" ): + print( "ABE::ID Type = 0", file=file1 ) + elif ( input_data.Initial_Data_Method == "Pablo-Olliptic" ): + print( "ABE::ID Type = 1", file=file1 ) + else : + print( " Initial Data Setting Error" ) + + print( file=file1 ) + + ## output AHF related settings + + print( "AHF::AHfindevery = ", input_data.AHF_Find_Every, file=file1 ) + print( "AHF::AHdumptime = ", input_data.AHF_Dump_Time, file=file1 ) + print( file=file1 ) + + ## output other settings + print( file=file1 ) + print( "SurfaceIntegral::number of points for quarter sphere = ", input_data.quarter_sphere_number, file=file1 ) + print( file=file1 ) + + ## output scalar-tensor-F(R) theory settings + ## it will not report error even if there is no FR related setting in the input file AMSS_NCKU_Input.py after adding conditional judgment + if (input_data.Equation_Class == "BSSN-EScalar"): + ## keep certain decimal places in output + print( "FR::a2 = ", format(input_data.FR_a2, '.2f'), file=file1 ) + print( "FR::l2 = ", format(input_data.FR_l2, '.2f'), file=file1 ) + print( "FR::phi0 = ", format(input_data.FR_phi0, '.8f'), file=file1 ) + print( "FR::r0 = ", format(input_data.FR_r0, '.2f'), file=file1 ) + print( "FR::sigma0 = ", format(input_data.FR_sigma0, '.2f'), file=file1 ) + print( file=file1 ) + else: + print( file=file1 ) + + file1.close() + + return file1 + +################################################################## + +